summaryrefslogtreecommitdiff
path: root/guix/packages.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-26 16:43:08 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-26 16:43:08 +0200
commita9db7d10b6e4e86fb2b87a4161db3b1f202002fd (patch)
tree4a22481ab65447d8bc1cc307a76a884a7e7bbee9 /guix/packages.scm
parente33d9d6f09874f83bb5a03f49cb969a84588e10e (diff)
parent2b6bdf7eb3c95716ac107ea6caea2e0b7077ae77 (diff)
downloadguix-patches-a9db7d10b6e4e86fb2b87a4161db3b1f202002fd.tar
guix-patches-a9db7d10b6e4e86fb2b87a4161db3b1f202002fd.tar.gz
Merge branch 'master' into core-updates
Conflicts: Makefile.am gnu/packages/autotools.scm gnu/packages/guile.scm gnu/packages/python.scm gnu/packages/shishi.scm guix/gnu-maintenance.scm guix/scripts/build.scm guix/scripts/gc.scm guix/scripts/package.scm guix/scripts/substitute-binary.scm guix/ui.scm nix/nix-daemon/guix-daemon.cc test-env.in tests/nar.scm tests/store.scm
Diffstat (limited to 'guix/packages.scm')
-rw-r--r--guix/packages.scm33
1 files changed, 33 insertions, 0 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 3a6a07bbcc..7a1b100b8d 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -64,6 +64,7 @@
package-maintainers
package-properties
package-location
+ package-field-location
package-transitive-inputs
package-transitive-propagated-inputs
@@ -182,6 +183,38 @@ corresponds to the arguments expected by `set-path-environment-variable'."
package)
16)))))
+(define (package-field-location package field)
+ "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)
+ (catch 'system
+ (lambda ()
+ (call-with-input-file (search-path %load-path file)
+ (lambda (port)
+ (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 _
+ #f)))
+ (_ #f)))
+
;; Error conditions.