aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/packages.scm51
-rw-r--r--guix/scripts/edit.scm29
-rw-r--r--tests/packages.scm23
3 files changed, 85 insertions, 18 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 6796db80a4..cf655e7448 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -55,10 +55,12 @@
fold-packages
find-packages-by-name
+ find-package-locations
find-best-packages-by-name
specification->package
specification->package+output
+ specification->location
specifications->manifest
generate-package-cache))
@@ -274,6 +276,31 @@ decreasing version order."
versions modules symbols)))
(find-packages-by-name/direct name version)))
+(define* (find-package-locations name #:optional version)
+ "Return a list of version/location pairs corresponding to each package
+matching NAME and VERSION."
+ (define cache
+ (load-package-cache (current-profile)))
+
+ (if (and cache (cache-is-authoritative?))
+ (match (cache-lookup cache name)
+ (#f '())
+ ((#(name versions modules symbols outputs
+ supported? deprecated?
+ files lines columns) ...)
+ (fold (lambda (version* file line column result)
+ (if (and file
+ (or (not version)
+ (version-prefix? version version*)))
+ (alist-cons version* (location file line column)
+ result)
+ result))
+ '()
+ versions files lines columns)))
+ (map (lambda (package)
+ (cons (package-version package) (package-location package)))
+ (find-packages-by-name/direct name version))))
+
(define (find-best-packages-by-name name version)
"If version is #f, return the list of packages named NAME with the highest
version numbers; otherwise, return the list of packages named NAME and at
@@ -393,6 +420,30 @@ present, return the preferred newest version."
(let-values (((name version) (package-name->name+version spec)))
(%find-package spec name version)))
+(define (specification->location spec)
+ "Return the location of the highest-numbered package matching SPEC, a
+specification such as \"guile@2\" or \"emacs\"."
+ (let-values (((name version) (package-name->name+version spec)))
+ (match (find-package-locations name version)
+ (()
+ (if version
+ (leave (G_ "~A: package not found for version ~a~%") name version)
+ (leave (G_ "~A: unknown package~%") name)))
+ (lst
+ (let* ((highest (match lst (((version . _) _ ...) version)))
+ (locations (take-while (match-lambda
+ ((version . location)
+ (string=? version highest)))
+ lst)))
+ (match locations
+ (((version . location) . rest)
+ (unless (null? rest)
+ (warning (G_ "ambiguous package specification `~a'~%") spec)
+ (warning (G_ "choosing ~a@~a from ~a~%")
+ name version
+ (location->string location)))
+ location)))))))
+
(define* (specification->package+output spec #:optional (output "out"))
"Return the package and output specified by SPEC, or #f and #f; SPEC may
optionally contain a version number and an output name, as in these examples:
diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm
index 8b2b61d76a..da3d2775e8 100644
--- a/guix/scripts/edit.scm
+++ b/guix/scripts/edit.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -21,7 +21,6 @@
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils)
- #:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
@@ -63,14 +62,13 @@ Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n"))
file path))
absolute-file-name))
-(define (package->location-specification package)
- "Return the location specification for PACKAGE for a typical editor command
+(define (location->location-specification location)
+ "Return the location specification for LOCATION for a typical editor command
line."
- (let ((loc (package-location package)))
- (list (string-append "+"
- (number->string
- (location-line loc)))
- (search-path* %load-path (location-file loc)))))
+ (list (string-append "+"
+ (number->string
+ (location-line location)))
+ (search-path* %load-path (location-file location))))
(define (guix-edit . args)
@@ -83,18 +81,13 @@ line."
'()))
(with-error-handling
- (let* ((specs (reverse (parse-arguments)))
- (packages (map specification->package specs)))
- (for-each (lambda (package)
- (unless (package-location package)
- (leave (G_ "source location of package '~a' is unknown~%")
- (package-full-name package))))
- packages)
+ (let* ((specs (reverse (parse-arguments)))
+ (locations (map specification->location specs)))
(catch 'system-error
(lambda ()
- (let ((file-names (append-map package->location-specification
- packages)))
+ (let ((file-names (append-map location->location-specification
+ locations)))
;; Use `system' instead of `exec' in order to sanely handle
;; possible command line arguments in %EDITOR.
(exit (system (string-join (cons (%editor) file-names))))))
diff --git a/tests/packages.scm b/tests/packages.scm
index 2720ba5a15..8aa117a2e7 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1131,6 +1131,29 @@
(lambda (key . args)
key)))
+(test-equal "find-package-locations"
+ (map (lambda (package)
+ (cons (package-version package)
+ (package-location package)))
+ (find-packages-by-name "guile"))
+ (find-package-locations "guile"))
+
+(test-equal "find-package-locations with cache"
+ (map (lambda (package)
+ (cons (package-version package)
+ (package-location package)))
+ (find-packages-by-name "guile"))
+ (call-with-temporary-directory
+ (lambda (cache)
+ (generate-package-cache cache)
+ (mock ((guix describe) current-profile (const cache))
+ (mock ((gnu packages) cache-is-authoritative? (const #t))
+ (find-package-locations "guile"))))))
+
+(test-equal "specification->location"
+ (package-location (specification->package "guile@2"))
+ (specification->location "guile@2"))
+
(test-end "packages")
;;; Local Variables: