On 2022-07-12 22:50, Antero Mejr wrote: > * 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 > ;;; Copyright © 2021 Oleg Pykhalov > ;;; Copyright © 2022 Ludovic Courtès > +;;; Copyright © 2022 Antero Mejr > ;;; > ;;; 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 > ;;; Copyright © 2018 Steve Sprang > ;;; Copyright © 2022 Josselin Poiret > +;;; Copyright © 2022 Antero Mejr > ;;; > ;;; 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 > + (($ 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 > - (($ 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) Applied locally, tested, LGTM. -- Best regards, Andrew Tropin