diff options
| author | Oleg Pykhalov <go.wigust@gmail.com> | 2018-11-21 11:23:25 +0300 |
|---|---|---|
| committer | Oleg Pykhalov <go.wigust@gmail.com> | 2018-11-21 14:41:13 +0300 |
| commit | 1255400faabfcf0ca1666d17f2f34ea0d49f6b1f (patch) | |
| tree | 4cfa8bed61f6594c83e66e72eb1bc069f27b6d81 /guix/scripts | |
| parent | 3dd28aa37cc3f3a6bbb5f7f8d9fb49cc457b0c10 (diff) | |
| download | gnu-guix-1255400faabfcf0ca1666d17f2f34ea0d49f6b1f.tar gnu-guix-1255400faabfcf0ca1666d17f2f34ea0d49f6b1f.tar.gz | |
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.
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/describe.scm | 27 |
1 files changed, 17 insertions, 10 deletions
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index d3203e9924..d817d7f7ca 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -41,6 +41,10 @@ (unless (member arg '("human" "channels")) (leave (G_ "~a: unsupported output format~%") arg)) (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 (lambda args (show-help) @@ -58,6 +62,8 @@ Display information about the channels currently in use.\n")) (display (G_ " -f, --format=FORMAT display information in the given FORMAT")) + (display (G_ " + -p, --profile=PROFILE display information about PROFILE")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -78,11 +84,11 @@ Display information about the channels currently in use.\n")) (format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%") string)))))) -(define (display-checkout-info fmt) +(define* (display-checkout-info fmt #:optional directory) "Display information about the current checkout according to FMT, a symbol denoting the requested format. Exit if the current directory does not lie within a Git checkout." - (let* ((program (car (command-line))) + (let* ((program (or directory (car (command-line)))) (directory (catch 'git-error (lambda () (repository-discover (dirname program))) @@ -146,15 +152,16 @@ in the format specified by FMT." ;;; (define (guix-describe . args) - (let* ((opts (args-fold* args %options - (lambda (opt name arg result) - (leave (G_ "~A: unrecognized option~%") - name)) - cons - %default-options)) - (format (assq-ref opts 'format))) + (let* ((opts (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") + name)) + cons + %default-options)) + (format (assq-ref opts 'format)) + (profile (or (assq-ref opts 'profile) (current-profile)))) (with-error-handling - (match (current-profile) + (match profile (#f (display-checkout-info format)) (profile |