Toggle quote (245 lines)
> * guix/scripts/package.scm (list-installed): New procedure.
> * guix/scripts/home.scm: Use it.
> * guix/scripts/utils.scm (pretty-print-table): New argument "left-pad".
> * doc/guix.texi (Invoking Guix Home): Add information and example for
> --list-installed flag.
> ---
> doc/guix.texi | 15 ++++++++++++
> guix/scripts/home.scm | 52 +++++++++++++++++++++++++++++-----------
> guix/scripts/package.scm | 31 ++++++++++++++----------
> guix/utils.scm | 4 ++--
> 4 files changed, 73 insertions(+), 29 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 097e4a362b..fc3a2d962d 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -40312,6 +40312,17 @@ install anything.
> Describe the current home generation: its file name, as well as
> provenance information when available.
>
> +To show installed packages in the current home generation's profile,
> +the @code{--list-installed} flag is provided, with the same syntax that
> +is used in @command{guix package --list-installed}
> +(@pxref{Invoking guix package}). For instance, the following command
> +shows a table of all emacs-related packages installed in the
> +current home generation's profile, at the end of the description:
> +
> +@example
> +guix home describe --list-installed=emacs
> +@end example
> +
> @item list-generations
> List a summary of each generation of the home environment available on
> disk, in a human-readable way. This is similar to the
> @@ -40327,6 +40338,10 @@ generations that are up to 10 days old:
> $ guix home list-generations 10d
> @end example
>
> +The @code{--list-installed} flag may also be specified, with the same
> +syntax that is used in @command{guix home describe}. This may be helpful
> +if trying to determine when a package was added to the home profile.
> +
> @item import
> Generate a @dfn{home environment} from the packages in the default
> profile and configuration files found in the user's home directory. The
> diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
> index 0f5c3388a1..97d626114a 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 @@ (define (show-help)
> 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 @@ (define %options
> (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 @@ (define-syntax-rule (with-store* store exp ...)
> 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,7 +760,8 @@ (define (search . args)
>
> (define* (display-home-environment-generation
> number
> - #:optional (profile %guix-home))
> + #:optional (profile %guix-home)
> + #:key (list-installed-regex #f))
> "Display a summary of home-environment generation NUMBER in a
> human-readable format."
> (define (display-channel channel)
> @@ -782,9 +795,16 @@ (define-values (channels config-file)
> (format #t (G_ " configuration file: ~a~%")
> (if (supports-hyperlinks?)
> (file-hyperlink config-file)
> - config-file))))))
> -
> -(define* (list-generations pattern #:optional (profile %guix-home))
> + 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."
> @@ -792,14 +812,18 @@ (define* (list-generations pattern #:optional (profile %guix-home))
> (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/package.scm b/guix/scripts/package.scm
> index 99a6cfaa29..af61b50222 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 @@ (define-module (guix scripts package)
> delete-generations
> delete-matching-generations
> guix-package
> + list-installed
>
> search-path-environment-variables
> manifest-entry-version-prefix
> @@ -773,6 +775,20 @@ (define absolute
>
> (add-indirect-root store absolute))
>
> +(define (list-installed regexp 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 +840,8 @@ (define (diff-profiles profile numbers)
> #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/utils.scm b/guix/utils.scm
> index 745da98a79..8484442b29 100644
> --- a/guix/utils.scm
> +++ b/guix/utils.scm
> @@ -1124,7 +1124,7 @@ (define* (string-closest trial tests #:key (threshold 3))
> ;;; Prettified output.
> ;;;
>
> -(define* (pretty-print-table rows #:key (max-column-width 20))
> +(define* (pretty-print-table rows #:key (max-column-width 20) (left-pad 0))
> "Print ROWS in neat columns. All rows should be lists of strings and each
> row should have the same length. The columns are separated by a tab
> character, and aligned using spaces. The maximum width of each column is
> @@ -1143,7 +1143,7 @@ (define* (pretty-print-table rows #:key (max-column-width 20))
> (map (cut min <> max-column-width)
> column-widths)))
> (fmt (string-append (string-join column-formats "\t") "\t~a")))
> - (for-each (cut format #t "~?~%" fmt <>) rows)))
> + (for-each (cut format #t "~v_~?~%" left-pad fmt <>) rows)))
>
> ;;; Local Variables:
> ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
