gnu: inxi-minimal: Update to 3.0.12-1.

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

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 5790715..7b95476 100644 (file)
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 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>
@@ -29,6 +29,7 @@
   #:use-module ((guix build utils)
                 #:select ((package-name->name+version
                            . hyphen-separated-name->name+version)))
+  #:autoload   (guix profiles) (packages->manifest)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -53,7 +54,8 @@
             find-newest-available-packages
 
             specification->package
-            specification->package+output))
+            specification->package+output
+            specifications->manifest))
 
 ;;; Commentary:
 ;;;
@@ -108,8 +110,25 @@ for system '~a'")
                         file-name system)))))))
 
 (define %distro-root-directory
-  ;; Absolute file name of the module hierarchy.
-  (dirname (search-path %load-path "guix.scm")))
+  ;; Absolute file name of the module hierarchy.  Since (gnu packages …) might
+  ;; live in a directory different from (guix), try to get the best match.
+  (letrec-syntax ((dirname* (syntax-rules ()
+                              ((_ file)
+                               (dirname file))
+                              ((_ file head tail ...)
+                               (dirname (dirname* file tail ...)))))
+                  (try      (syntax-rules ()
+                              ((_ (file things ...) rest ...)
+                               (match (search-path %load-path file)
+                                 (#f
+                                  (try rest ...))
+                                 (absolute
+                                  (dirname* absolute things ...))))
+                              ((_)
+                               #f))))
+    (try ("gnu/packages/base.scm" gnu/ packages/)
+         ("gnu/packages.scm"      gnu/)
+         ("guix.scm"))))
 
 (define %package-module-path
   ;; Search path for package modules.  Each item must be either a directory
@@ -138,17 +157,21 @@ for system '~a'")
               directory))
         %load-path)))
 
-(define (fold-packages proc init)
-  "Call (PROC PACKAGE RESULT) for each available package, using INIT as
-the initial value of RESULT.  It is guaranteed to never traverse the
-same package twice."
+(define* (fold-packages proc init
+                        #:optional
+                        (modules (all-modules (%package-module-path)
+                                              #:warn
+                                              warn-about-load-error))
+                        #:key (select? (negate hidden-package?)))
+  "Call (PROC PACKAGE RESULT) for each available package defined in one of
+MODULES that matches SELECT?, using INIT as the initial value of RESULT.  It
+is guaranteed to never traverse the same package twice."
   (fold-module-public-variables (lambda (object result)
-                                  (if (and (package? object)
-                                           (not (hidden-package? object)))
+                                  (if (and (package? object) (select? object))
                                       (proc object result)
                                       result))
                                 init
-                                (all-modules (%package-module-path))))
+                                modules))
 
 (define find-packages-by-name
   (let ((packages (delay
@@ -165,7 +188,7 @@ decreasing version order."
                             version>?)))
         (if version
             (filter (lambda (package)
-                      (string-prefix? version (package-version package)))
+                      (version-prefix? version (package-version package)))
                     matching)
             matching)))))
 
@@ -278,3 +301,11 @@ version; if SPEC does not specify an output, return OUTPUT."
            (leave (G_ "package `~a' lacks output `~a'~%")
                   (package-full-name package)
                   sub-drv))))))
+
+(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)))