summaryrefslogtreecommitdiff
path: root/guix/packages.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/packages.scm')
-rw-r--r--guix/packages.scm56
1 files changed, 21 insertions, 35 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 8490bfe438..ec5420f6c0 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -28,8 +28,6 @@
#: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?
@@ -163,32 +161,13 @@ representation."
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))))))
+ "Return the source code location of the definition of FIELD for PACKAGE, or
+#f if it could not be determined."
+ (define (goto port line column)
+ (unless (and (= (port-column port) (- column 1))
+ (= (port-line port) (- line 1)))
+ (unless (eof-object? (read-char port))
+ (goto port line column))))
(match (package-location package)
(($ <location> file line column)
@@ -196,14 +175,21 @@ for PACKAGE."
(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))))))
+ (goto port line column)
+ (match (read port)
+ (('package inits ...)
+ (let ((field (assoc field inits)))
+ (match field
+ ((_ value)
+ (and=> (or (source-properties value)
+ (source-properties field))
+ source-properties->location))
+ (_
+ #f))))
+ (_
+ #f)))))
(lambda _
- (package-location package))))
+ #f)))
(_ #f)))