mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
describe: Add profile option.
* guix/scripts/describe.scm (%options): Add profile option. (show-help): Document this. (display-checkout-info): Check for profile argument. * doc/guix.texi (Invoking guix describe): Document this.
This commit is contained in:
parent
3dd28aa37c
commit
1255400faa
2 changed files with 21 additions and 10 deletions
|
@ -3275,6 +3275,10 @@ produce a list of channel specifications that can be passed to @command{guix
|
||||||
pull -C} or installed as @file{~/.config/guix/channels.scm} (@pxref{Invoking
|
pull -C} or installed as @file{~/.config/guix/channels.scm} (@pxref{Invoking
|
||||||
guix pull}).
|
guix pull}).
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
|
@item --profile=@var{profile}
|
||||||
|
@itemx -p @var{profile}
|
||||||
|
Display information about @var{profile}.
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
@node Invoking guix pack
|
@node Invoking guix pack
|
||||||
|
|
|
@ -41,6 +41,10 @@ (define %options
|
||||||
(unless (member arg '("human" "channels"))
|
(unless (member arg '("human" "channels"))
|
||||||
(leave (G_ "~a: unsupported output format~%") arg))
|
(leave (G_ "~a: unsupported output format~%") arg))
|
||||||
(alist-cons 'format (string->symbol arg) result)))
|
(alist-cons 'format (string->symbol arg) result)))
|
||||||
|
(option '(#\p "profile") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'profile (canonicalize-profile arg)
|
||||||
|
result)))
|
||||||
(option '(#\h "help") #f #f
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-help)
|
(show-help)
|
||||||
|
@ -58,6 +62,8 @@ (define (show-help)
|
||||||
Display information about the channels currently in use.\n"))
|
Display information about the channels currently in use.\n"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-f, --format=FORMAT display information in the given FORMAT"))
|
-f, --format=FORMAT display information in the given FORMAT"))
|
||||||
|
(display (G_ "
|
||||||
|
-p, --profile=PROFILE display information about PROFILE"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
|
@ -78,11 +84,11 @@ (define (display-package-search-path fmt)
|
||||||
(format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%")
|
(format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%")
|
||||||
string))))))
|
string))))))
|
||||||
|
|
||||||
(define (display-checkout-info fmt)
|
(define* (display-checkout-info fmt #:optional directory)
|
||||||
"Display information about the current checkout according to FMT, a symbol
|
"Display information about the current checkout according to FMT, a symbol
|
||||||
denoting the requested format. Exit if the current directory does not lie
|
denoting the requested format. Exit if the current directory does not lie
|
||||||
within a Git checkout."
|
within a Git checkout."
|
||||||
(let* ((program (car (command-line)))
|
(let* ((program (or directory (car (command-line))))
|
||||||
(directory (catch 'git-error
|
(directory (catch 'git-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(repository-discover (dirname program)))
|
(repository-discover (dirname program)))
|
||||||
|
@ -146,15 +152,16 @@ (define number
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define (guix-describe . args)
|
(define (guix-describe . args)
|
||||||
(let* ((opts (args-fold* args %options
|
(let* ((opts (args-fold* args %options
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(leave (G_ "~A: unrecognized option~%")
|
(leave (G_ "~A: unrecognized option~%")
|
||||||
name))
|
name))
|
||||||
cons
|
cons
|
||||||
%default-options))
|
%default-options))
|
||||||
(format (assq-ref opts 'format)))
|
(format (assq-ref opts 'format))
|
||||||
|
(profile (or (assq-ref opts 'profile) (current-profile))))
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(match (current-profile)
|
(match profile
|
||||||
(#f
|
(#f
|
||||||
(display-checkout-info format))
|
(display-checkout-info format))
|
||||||
(profile
|
(profile
|
||||||
|
|
Loading…
Reference in a new issue