diff options
author | Danny Milosavljevic <dannym@scratchpost.org> | 2021-02-11 19:12:36 +0100 |
---|---|---|
committer | Danny Milosavljevic <dannym@scratchpost.org> | 2021-02-11 19:12:36 +0100 |
commit | abd318ff4b741eac11227778bf2e569ee7b186ff (patch) | |
tree | 6abc09a3e01914d891124e9d0dda0f4e0979c485 /guix/scripts | |
parent | 71cb6dfe10540718eb337e7e2248fc809394894b (diff) | |
parent | c5dc87fee840ad620b01637dc4f9ffa5efc9270c (diff) | |
download | guix-patches-abd318ff4b741eac11227778bf2e569ee7b186ff.tar guix-patches-abd318ff4b741eac11227778bf2e569ee7b186ff.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/describe.scm | 78 | ||||
-rw-r--r-- | guix/scripts/environment.scm | 22 |
2 files changed, 62 insertions, 38 deletions
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index e47d207ee0..6f8d9aceec 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -182,20 +182,18 @@ string is ~a.~%") (current-output-port)))) (display-package-search-path fmt))) -(define (display-profile-info profile fmt) +(define* (display-profile-info profile fmt + #:optional + (channels (profile-channels profile))) "Display information about PROFILE, a profile as created by (guix channels), -in the format specified by FMT." +in the format specified by FMT. PROFILE can be #f, in which case CHANNELS is +what matters." (define number - (generation-number profile)) - - (define channels - (profile-channels (if (zero? number) - profile - (generation-file-name profile number)))) + (and profile (generation-number profile))) (match fmt ('human - (display-profile-content profile number)) + (display-profile-content profile number channels)) ('channels (pretty-print `(list ,@(map channel->code channels)))) ('channels-sans-intro @@ -213,33 +211,37 @@ in the format specified by FMT." channels)))) (display-package-search-path fmt)) -(define (display-profile-content profile number) - "Display the packages in PROFILE, generation NUMBER, in a human-readable -way and displaying details about the channel's source code." - (display-generation profile number) - (for-each (lambda (entry) - (format #t " ~a ~a~%" - (manifest-entry-name entry) - (manifest-entry-version entry)) - (match (manifest-entry-channel entry) - ((? channel? channel) - (format #t (G_ " repository URL: ~a~%") - (channel-url channel)) - (when (channel-branch channel) - (format #t (G_ " branch: ~a~%") - (channel-branch channel))) - (format #t (G_ " commit: ~a~%") - (if (supports-hyperlinks?) - (channel-commit-hyperlink channel) - (channel-commit channel)))) - (_ #f))) +(define (profile-generation-channels profile number) + "Return the list of channels for generation NUMBER of PROFILE." + (profile-channels (if (zero? number) + profile + (generation-file-name profile number)))) - ;; Show most recently installed packages last. - (reverse - (manifest-entries - (profile-manifest (if (zero? number) - profile - (generation-file-name profile number))))))) +(define* (display-profile-content profile number + #:optional + (channels + (profile-generation-channels profile + number))) + "Display CHANNELS along with PROFILE info, generation NUMBER, in a +human-readable way and displaying details about the channel's source code. +PROFILE and NUMBER " + (when (and number profile) + (display-generation profile number)) + + (for-each (lambda (channel) + (format #t " ~a ~a~%" + (channel-name channel) + (string-take (channel-commit channel) 7)) + (format #t (G_ " repository URL: ~a~%") + (channel-url channel)) + (when (channel-branch channel) + (format #t (G_ " branch: ~a~%") + (channel-branch channel))) + (format #t (G_ " commit: ~a~%") + (if (supports-hyperlinks?) + (channel-commit-hyperlink channel) + (channel-commit channel)))) + channels)) (define %vcs-web-views ;; Hard-coded list of host names and corresponding web view URL templates. @@ -295,6 +297,10 @@ text. The hyperlink links to a web view of COMMIT, when available." (with-error-handling (match profile (#f - (display-checkout-info format)) + (match (current-channels) + (() + (display-checkout-info format)) + (channels + (display-profile-info #f format channels)))) (profile (display-profile-info (canonicalize-profile profile) format)))))) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index f4d12f89bf..a39347743e 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -21,6 +21,7 @@ (define-module (guix scripts environment) #:use-module (guix ui) #:use-module (guix store) + #:use-module (guix utils) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) #:use-module (guix derivations) @@ -137,6 +138,8 @@ COMMAND or an interactive shell in that environment.\n")) (display (G_ " -m, --manifest=FILE create environment with the manifest from FILE")) (display (G_ " + -p, --profile=PATH create environment from profile at PATH")) + (display (G_ " --ad-hoc include all specified packages in the environment instead of only their inputs")) (display (G_ " @@ -269,6 +272,10 @@ use '--preserve' instead~%")) (option '(#\P "link-profile") #f #f (lambda (opt name arg result) (alist-cons 'link-profile? #t result))) + (option '(#\p "profile") #t #f + (lambda (opt name arg result) + (alist-cons 'profile arg + (alist-delete 'profile result eq?)))) (option '(#\u "user") #t #f (lambda (opt name arg result) (alist-cons 'user arg @@ -706,6 +713,7 @@ message if any test fails." (user (assoc-ref opts 'user)) (bootstrap? (assoc-ref opts 'bootstrap?)) (system (assoc-ref opts 'system)) + (profile (assoc-ref opts 'profile)) (command (or (assoc-ref opts 'exec) ;; Spawn a shell if the user didn't specify ;; anything in particular. @@ -735,8 +743,16 @@ message if any test fails." #:dry-run? (assoc-ref opts 'dry-run?)) (with-status-verbosity (assoc-ref opts 'verbosity) - (define manifest + (define manifest-from-opts (options/resolve-packages store opts)) + (when (and profile + (> (length (manifest-entries manifest-from-opts)) 0)) + (leave (G_ "'--profile' cannot be used with package options~%"))) + + (define manifest + (if profile + (profile-manifest profile) + manifest-from-opts)) (set-build-options-from-command-line store opts) @@ -755,7 +771,9 @@ message if any test fails." system)) (prof-drv (manifest->derivation manifest system bootstrap?)) - (profile -> (derivation->output-path prof-drv)) + (profile -> (if profile + (readlink* profile) + (derivation->output-path prof-drv))) (gc-root -> (assoc-ref opts 'gc-root))) ;; First build the inputs. This is necessary even for |