gnu: imapfilter: Update to 2.7.6.

[jackhill/guix/guix.git] / gnu / packages.scm

diff --git a/gnu/packages.scm b/gnu/packages.scm
index ccfc83d..61345f7 100644 (file)
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,9 +1,10 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,11 +40,11 @@
   #:use-module (ice-9 binary-ports)
   #:autoload   (system base compile) (compile)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
+  #:use-module (srfi srfi-71)
   #:export (search-patch
             search-patches
             search-auxiliary-file
@@ -51,6 +52,7 @@
             %auxiliary-files-path
             %package-module-path
             %default-package-module-path
+            cache-is-authoritative?
 
             fold-packages
             fold-available-packages
@@ -64,6 +66,9 @@
             specification->package+output
             specification->location
             specifications->manifest
+            specifications->packages
+
+            package-unique-version-prefix
 
             generate-package-cache))
 
@@ -138,13 +143,10 @@ flags."
   ;; Search path for package modules.  Each item must be either a directory
   ;; name or a pair whose car is a directory and whose cdr is a sub-directory
   ;; to narrow the search.
-  (let*-values (((not-colon)
-                 (char-set-complement (char-set #\:)))
-                ((environment)
-                 (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "")
-                                  not-colon))
-                ((channels-scm channels-go)
-                 (package-path-entries)))
+  (let* ((not-colon   (char-set-complement (char-set #\:)))
+         (environment (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "")
+                                       not-colon))
+         (channels-scm channels-go (package-path-entries)))
     ;; Automatically add channels and items from $GUIX_PACKAGE_PATH to Guile's
     ;; search path.  For historical reasons, $GUIX_PACKAGE_PATH goes to the
     ;; front; channels go to the back so that they don't override Guix' own
@@ -497,13 +499,13 @@ return its return value."
   "Return a package matching SPEC.  SPEC may be a package name, or a package
 name followed by an at-sign and a version number.  If the version number is not
 present, return the preferred newest version."
-  (let-values (((name version) (package-name->name+version spec)))
+  (let ((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)))
+  (let ((name version (package-name->name+version spec)))
     (match (find-package-locations name version)
       (()
        (if version
@@ -538,8 +540,8 @@ version; if SPEC does not specify an output, return OUTPUT.
 
 When OUTPUT is false and SPEC does not specify any output, return #f as the
 output."
-  (let-values (((name version sub-drv)
-                (package-specification->name+version+output spec output)))
+  (let ((name version sub-drv
+              (package-specification->name+version+output spec output)))
     (match (%find-package spec name version)
       (#f
        (values #f #f))
@@ -551,10 +553,36 @@ output."
                   (package-full-name package)
                   sub-drv))))))
 
+(define (specifications->packages specs)
+  "Given SPECS, a list of specifications such as \"emacs@25.2\" or
+\"guile:debug\", return a list of package/output tuples."
+  ;; This procedure exists so users of 'guix home' don't have to write out the
+  ;; (map (compose list specification->package+output)... boilerplate.
+  (map (compose list specification->package+output) specs))
+
 (define (specifications->manifest specs)
   "Given SPECS, a list of specifications such as \"emacs@25.2\" or
 \"guile:debug\", return a profile manifest."
   ;; This procedure exists mostly so users of 'guix package -m' don't have to
   ;; fiddle with multiple-value returns.
   (packages->manifest
-   (map (compose list specification->package+output) specs)))
+   (specifications->packages specs)))
+
+(define (package-unique-version-prefix name version)
+  "Search among all the versions of package NAME that are available, and
+return the shortest unambiguous version prefix to designate VERSION.  If only
+one version of the package is available, return the empty string."
+  (match (map package-version (find-packages-by-name name))
+    ((_)
+     ;; A single version of NAME is available, so do not specify the version
+     ;; number, even if the available version doesn't match VERSION.
+     "")
+    (versions
+     ;; If VERSION is the latest version, don't specify any version.
+     ;; Otherwise return the shortest unique version prefix.  Note that this
+     ;; is based on the currently available packages so the result may vary
+     ;; over time.
+     (if (every (cut version>? version <>)
+                (delete version versions))
+         ""
+         (version-unique-prefix version versions)))))