summaryrefslogtreecommitdiff
path: root/guix/packages.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/packages.scm')
-rw-r--r--guix/packages.scm47
1 files changed, 47 insertions, 0 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 81f09d638e..8490bfe438 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -28,6 +28,8 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module ((ice-9 rdelim) #:select (read-line))
+ #:use-module (ice-9 regex)
#:re-export (%current-system)
#:export (origin
origin?
@@ -58,6 +60,7 @@
package-maintainers
package-properties
package-location
+ package-field-location
package-transitive-inputs
package-transitive-propagated-inputs
@@ -159,6 +162,50 @@ representation."
package)
16)))))
+(define (package-field-location package field)
+ "Return an estimate of the source code location of the definition of FIELD
+for PACKAGE."
+ (define field-rx
+ (make-regexp (string-append "\\("
+ (regexp-quote (symbol->string field))
+ "[[:blank:]]*")))
+ (define (seek-to-line port line)
+ (let ((line (- line 1)))
+ (let loop ()
+ (when (< (port-line port) line)
+ (unless (eof-object? (read-line port))
+ (loop))))))
+
+ (define (find-line port)
+ (let loop ((line (read-line port)))
+ (cond ((eof-object? line)
+ (values #f #f))
+ ((regexp-exec field-rx line)
+ =>
+ (lambda (match)
+ ;; At this point `port-line' points to the next line, so need
+ ;; need to add one.
+ (values (port-line port)
+ (match:end match))))
+ (else
+ (loop (read-line port))))))
+
+ (match (package-location package)
+ (($ <location> file line column)
+ (catch 'system
+ (lambda ()
+ (call-with-input-file (search-path %load-path file)
+ (lambda (port)
+ (seek-to-line port line)
+ (let-values (((line column)
+ (find-line port)))
+ (if (and line column)
+ (location file line column)
+ (package-location package))))))
+ (lambda _
+ (package-location package))))
+ (_ #f)))
+
;; Error conditions.