home: Add -I, --list-installed option.
* guix/scripts/package.scm (list-installed): New procedure. * guix/scripts/home.scm (%options, show-help): Add '--list-installed'. (process-command): For 'describe' and 'list-generations', honor the 'list-installed option. (display-home-environment-generation): Add #:list-installed-regex and honor it. (list-generations): Likewise. * 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. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Antero Mejr
Ludovic Courtès
parent
18bb89c2b2
commit
55725724dd
@ -40495,6 +40495,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 the
|
||||
packages with ``emacs'' in their name that are installed in the current
|
||||
home generation's profile:
|
||||
|
||||
@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
|
||||
@ -40507,9 +40518,14 @@ generations displayed. For instance, the following command displays
|
||||
generations that are up to 10 days old:
|
||||
|
||||
@example
|
||||
$ guix home list-generations 10d
|
||||
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
|
||||
|
||||
@ -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))))))
|
||||
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))
|
||||
"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."
|
||||
(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)))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -1124,11 +1124,11 @@ according to THRESHOLD, then #f is returned."
|
||||
;;; 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
|
||||
bound by MAX-COLUMN-WIDTH."
|
||||
bound by MAX-COLUMN-WIDTH. Each row is prefixed with LEFT-PAD spaces."
|
||||
(let* ((number-of-columns-to-pad (if (null? rows)
|
||||
0
|
||||
(1- (length (first rows)))))
|
||||
@ -1143,7 +1143,7 @@ bound by MAX-COLUMN-WIDTH."
|
||||
(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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user