diff options
Diffstat (limited to 'guix/packages.scm')
| -rw-r--r-- | guix/packages.scm | 47 |
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. |