Merge branch 'master' into staging

5 files changed, 136 insertions, 58 deletions

diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 0f5c3388a1..4add7e7c69 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -143,6 +144,11 @@ Some ACTIONS support additional ARGS.\n"))
                          use BACKEND for 'extension-graph' and 'shepherd-graph'"))
   (newline)
   (display (G_ "
+  -I, --list-installed[=REGEXP]
+                         for 'describe' or 'list-generations', list installed
+                         packages matching REGEXP"))
+  (newline)
+  (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -V, --version          display version information and exit"))
@@ -183,6 +189,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '("graph-backend") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'graph-backend arg result)))
+         (option '(#\I "list-installed") #f #t
+                 (lambda (opt name arg result)
+                   (alist-cons 'list-installed (or arg "") result)))
 
          ;; Container options.
          (option '(#\N "network") #f #f
@@ -569,17 +578,20 @@ Run @command{guix home reconfigure ~a/home-configuration.scm} to effectively
 deploy the home environment described by these files.\n")
                              destination))))
     ((describe)
-     (match (generation-number %guix-home)
-       (0
-        (leave (G_ "no home environment generation, nothing to describe~%")))
-       (generation
-        (display-home-environment-generation generation))))
+     (let ((list-installed-regex (assoc-ref opts 'list-installed)))
+       (match (generation-number %guix-home)
+         (0
+          (leave (G_ "no home environment generation, nothing to describe~%")))
+         (generation
+          (display-home-environment-generation
+           generation #:list-installed-regex list-installed-regex)))))
     ((list-generations)
-     (let ((pattern (match args
+     (let ((list-installed-regex (assoc-ref opts 'list-installed))
+           (pattern (match args
                       (() #f)
                       ((pattern) pattern)
                       (x (leave (G_ "wrong number of arguments~%"))))))
-       (list-generations pattern)))
+       (list-generations pattern #:list-installed-regex list-installed-regex)))
     ((switch-generation)
      (let ((pattern (match args
                       ((pattern) pattern)
@@ -748,9 +760,11 @@ description matches REGEXPS sorted by relevance, and their score."
 
 (define* (display-home-environment-generation
           number
-          #:optional (profile %guix-home))
-  "Display a summary of home-environment generation NUMBER in a
-human-readable format."
+          #:optional (profile %guix-home)
+          #:key (list-installed-regex #f))
+  "Display a summary of home-environment generation NUMBER in a human-readable
+format.  List packages in that home environment that match
+LIST-INSTALLED-REGEX."
   (define (display-channel channel)
     (format #t     "    ~a:~%" (channel-name channel))
     (format #t (G_ "      repository URL: ~a~%") (channel-url channel))
@@ -782,24 +796,36 @@ human-readable format."
         (format #t (G_ "  configuration file: ~a~%")
                 (if (supports-hyperlinks?)
                     (file-hyperlink config-file)
-                    config-file))))))
-
-(define* (list-generations pattern #:optional (profile %guix-home))
-  "Display in a human-readable format all the home environment
-generations matching PATTERN, a string.  When PATTERN is #f, display
-all the home environment generations."
+                    config-file)))
+      (when list-installed-regex
+        (format #t (G_ "  packages:\n"))
+        (pretty-print-table (list-installed
+                             list-installed-regex
+                             (list (string-append generation "/profile")))
+                            #:left-pad 4)))))
+
+(define* (list-generations pattern #:optional (profile %guix-home)
+                           #:key (list-installed-regex #f))
+  "Display in a human-readable format all the home environment generations
+matching PATTERN, a string.  When PATTERN is #f, display all the home
+environment generations.  List installed packages that match
+LIST-INSTALLED-REGEX."
   (cond ((not (file-exists? profile))             ; XXX: race condition
          (raise (condition (&profile-not-found-error
                             (profile profile)))))
         ((not pattern)
-         (for-each display-home-environment-generation (profile-generations profile)))
+         (for-each (cut display-home-environment-generation <>
+                        #:list-installed-regex list-installed-regex)
+                   (profile-generations profile)))
         ((matching-generations pattern profile)
          =>
          (lambda (numbers)
            (if (null-list? numbers)
                (exit 1)
-               (leave-on-EPIPE
-                (for-each display-home-environment-generation numbers)))))))
+               (leave-on-EPIPE (for-each
+                                (cut display-home-environment-generation <>
+                                     #:list-installed-regex list-installed-regex)
+                                numbers)))))))
 
 
 ;;;
diff --git a/guix/scripts/import/texlive.scm b/guix/scripts/import/texlive.scm
index c5dcc07ea1..203386e31c 100644
--- a/guix/scripts/import/texlive.scm
+++ b/guix/scripts/import/texlive.scm
@@ -22,11 +22,13 @@
   #:use-module (guix utils)
   #:use-module (guix scripts)
   #:use-module (guix import texlive)
+  #:use-module (guix import utils)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
   #:use-module (srfi srfi-41)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-texlive))
@@ -58,6 +60,9 @@ Import and convert the Texlive package for PACKAGE-NAME.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix import texlive")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
          %standard-import-options))
 
 
@@ -78,12 +83,20 @@ Import and convert the Texlive package for PACKAGE-NAME.\n"))
                             (_ #f))
                            (reverse opts))))
     (match args
-      ((name)
-       (let ((sexp (texlive->guix-package name)))
-         (unless sexp
-           (leave (G_ "failed to import package '~a'~%")
-                  name))
-         sexp))
+      ((spec)
+       (let ((name version (package-name->name+version spec)))
+         (if (assoc-ref opts 'recursive)
+             ;; Recursive import
+             (with-error-handling
+               (map package->definition
+                    (filter identity (texlive-recursive-import name
+                                                               #:version version))))
+             ;; Single import
+             (let ((sexp (texlive->guix-package name #:version version)))
+               (unless sexp
+                 (leave (G_ "failed to download description for package '~a'~%")
+                        name))
+               sexp))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 99a6cfaa29..7d92598efa 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
 ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,6 +68,7 @@
             delete-generations
             delete-matching-generations
             guix-package
+            list-installed
 
             search-path-environment-variables
             manifest-entry-version-prefix
@@ -773,6 +775,22 @@ doesn't need it."
 
   (add-indirect-root store absolute))
 
+(define (list-installed regexp profiles)
+  "Write to the current output port the list of packages matching REGEXP in
+PROFILES."
+  (let* ((regexp    (and regexp (make-regexp* regexp regexp/icase)))
+         (manifest  (concatenate-manifests
+                     (map profile-manifest profiles)))
+         (installed (manifest-entries manifest)))
+    (leave-on-EPIPE
+     (let ((rows (filter-map
+                  (match-lambda
+                    (($ <manifest-entry> name version output path _)
+                     (and (regexp-exec regexp name)
+                          (list name (or version "?") output path))))
+                  installed)))
+       rows))))
+
 
 ;;;
 ;;; Queries and actions.
@@ -824,19 +842,8 @@ processed, #f otherwise."
        #t)
 
       (('list-installed regexp)
-       (let* ((regexp    (and regexp (make-regexp* regexp regexp/icase)))
-              (manifest  (concatenate-manifests
-                          (map profile-manifest profiles)))
-              (installed (manifest-entries manifest)))
-         (leave-on-EPIPE
-          (let ((rows (filter-map
-                       (match-lambda
-                         (($ <manifest-entry> name version output path _)
-                          (and (regexp-exec regexp name)
-                               (list name (or version "?") output path))))
-                       installed)))
-            ;; Show most recently installed packages last.
-            (pretty-print-table (reverse rows)))))
+       ;; Show most recently installed packages last.
+       (pretty-print-table (reverse (list-installed regexp profiles)))
        #t)
 
       (('list-available regexp)
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 004ed7af2e..c115a00320 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -390,6 +390,11 @@ return #f and #f."
        ;; If the user already specified a profile, there's nothing more to
        ;; cache.
        (values #f #f))
+      ((('export-manifest? . #t) . _)
+       ;; When exporting a manifest, compute it anew so that '-D' packages
+       ;; lead to 'package-development-manifest' expressions rather than an
+       ;; expanded list of inputs.
+       (values #f #f))
       ((('system . system) . rest)
        (loop rest system file specs))
       ((_ . rest) (loop rest system file specs)))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b9084a401c..bfde0a88ca 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -50,7 +50,8 @@
   #:use-module (guix channels)
   #:use-module (guix scripts build)
   #:autoload   (guix scripts package) (delete-generations
-                                       delete-matching-generations)
+                                       delete-matching-generations
+                                       list-installed)
   #:autoload   (guix scripts pull) (channel-commit-hyperlink)
   #:autoload   (guix graph) (export-graph node-type
                              graph-backend-name lookup-backend)
@@ -480,8 +481,10 @@ list of services."
 ;;;
 
 (define* (display-system-generation number
-                                    #:optional (profile %system-profile))
-  "Display a summary of system generation NUMBER in a human-readable format."
+                                    #:optional (profile %system-profile)
+                                    #:key (list-installed-regex #f))
+  "Display a summary of system generation NUMBER in a human-readable format.
+List packages in that system that match LIST-INSTALLED-REGEX."
   (define (display-channel channel)
     (format #t     "    ~a:~%" (channel-name channel))
     (format #t (G_ "      repository URL: ~a~%") (channel-url channel))
@@ -544,23 +547,35 @@ list of services."
         (format #t (G_ "  configuration file: ~a~%")
                 (if (supports-hyperlinks?)
                     (file-hyperlink config-file)
-                    config-file))))))
-
-(define* (list-generations pattern #:optional (profile %system-profile))
+                    config-file)))
+      (when list-installed-regex
+        (format #t (G_ "  packages:\n"))
+        (pretty-print-table (list-installed
+                             list-installed-regex
+                             (list (string-append generation "/profile")))
+                            #:left-pad 4)))))
+
+(define* (list-generations pattern #:optional (profile %system-profile)
+                           #:key (list-installed-regex #f))
   "Display in a human-readable format all the system generations matching
-PATTERN, a string.  When PATTERN is #f, display all the system generations."
+PATTERN, a string.  When PATTERN is #f, display all the system generations.
+List installed packages that match LIST-INSTALLED-REGEX."
   (cond ((not (file-exists? profile))             ; XXX: race condition
          (raise (condition (&profile-not-found-error
                             (profile profile)))))
         ((not pattern)
-         (for-each display-system-generation (profile-generations profile)))
+         (for-each (cut display-system-generation <>
+                        #:list-installed-regex list-installed-regex)
+                   (profile-generations profile)))
         ((matching-generations pattern profile)
          =>
          (lambda (numbers)
            (if (null-list? numbers)
                (exit 1)
                (leave-on-EPIPE
-                (for-each display-system-generation numbers)))))))
+                (for-each (cut display-system-generation <>
+                               #:list-installed-regex list-installed-regex)
+                          numbers)))))))
 
 
 ;;;
@@ -1032,6 +1047,11 @@ Some ACTIONS support additional ARGS.\n"))
                          use BACKEND for 'extension-graphs' and 'shepherd-graph'"))
   (newline)
   (display (G_ "
+  -I, --list-installed[=REGEXP]
+                         for 'describe' and 'list-generations', list installed
+                         packages matching REGEXP"))
+  (newline)
+  (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -V, --version          display version information and exit"))
@@ -1135,6 +1155,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '("graph-backend") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'graph-backend arg result)))
+         (option '(#\I "list-installed") #f #t
+                 (lambda (opt name arg result)
+                   (alist-cons 'list-installed (or arg "") result)))
          %standard-build-options))
 
 (define %default-options
@@ -1322,25 +1345,29 @@ argument list and OPTS is the option alist."
     ;; The following commands do not need to use the store, and they do not need
     ;; an operating system configuration file.
     ((list-generations)
-     (let ((pattern (match args
+     (let ((list-installed-regex (assoc-ref opts 'list-installed))
+           (pattern (match args
                       (() #f)
                       ((pattern) pattern)
                       (x (leave (G_ "wrong number of arguments~%"))))))
-       (list-generations pattern)))
+       (list-generations pattern #:list-installed-regex list-installed-regex)))
     ((describe)
      ;; Describe the running system, which is not necessarily the current
      ;; generation.  /run/current-system might point to
      ;; /var/guix/profiles/system-N-link, or it might point directly to
      ;; /gnu/store/…-system.  Try both.
-     (match (generation-number "/run/current-system" %system-profile)
-       (0
-        (match (generation-number %system-profile)
-          (0
-           (leave (G_ "no system generation, nothing to describe~%")))
-          (generation
-           (display-system-generation generation))))
-       (generation
-        (display-system-generation generation))))
+     (let ((list-installed-regex (assoc-ref opts 'list-installed)))
+       (match (generation-number "/run/current-system" %system-profile)
+         (0
+          (match (generation-number %system-profile)
+            (0
+             (leave (G_ "no system generation, nothing to describe~%")))
+            (generation
+             (display-system-generation
+              generation #:list-installed-regex list-installed-regex))))
+         (generation
+          (display-system-generation
+           generation #:list-installed-regex list-installed-regex)))))
     ((search)
      (apply (resolve-subcommand "search") args))
     ((edit)