From c5265a095172b213ba6fbdf618d6779359ca56b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 21 Apr 2019 21:26:06 +0200 Subject: [PATCH] pull: Add '--news'. Suggested by Tobias Geerinckx-Rice . * guix/scripts/pull.scm (%options, show-help): Add '--news'. (display-profile-news): Add #:current-is-newer? and #:concise?. Honor them. (build-and-install): Pass #:concise? #t. (display-new/upgraded-packages)[concise/max-item-count]: New variable. Add call to 'display-hint'. (process-query): Add clause for 'display-news'. * doc/guix.texi (Invoking guix pull): Add '--news'. --- doc/guix.texi | 8 +++++ guix/scripts/pull.scm | 76 ++++++++++++++++++++++++++++++------------- 2 files changed, 62 insertions(+), 22 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 8c7522f286..785329add8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3663,6 +3663,14 @@ Read the list of channels from @var{file} instead of evaluates to a list of channel objects. @xref{Channels}, for more information. +@item --news +@itemx -N +Display the list of packages added or upgraded since the previous generation. + +This is the same information as displayed upon @command{guix pull} completion, +but without ellipses; it is also similar to the output of @command{guix pull +-l} for the last generation (see below). + @item --list-generations[=@var{pattern}] @itemx -l [@var{pattern}] List all the generations of @file{~/.config/guix/current} or, if @var{pattern} diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 71e13686c0..04e83f970f 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -86,6 +86,8 @@ Download and deploy the latest version of Guix.\n")) (display (G_ " --branch=BRANCH download the tip of the specified BRANCH")) (display (G_ " + -N, --news display news compared to the previous generation")) + (display (G_ " -l, --list-generations[=PATTERN] list generations matching PATTERN")) (display (G_ " @@ -117,6 +119,9 @@ Download and deploy the latest version of Guix.\n")) (lambda (opt name arg result) (cons `(query list-generations ,(or arg "")) result))) + (option '(#\N "news") #f #f + (lambda (opt name arg result) + (cons '(query display-news) result))) (option '("url") #t #f (lambda (opt name arg result) (alist-cons 'repository-url arg @@ -162,25 +167,33 @@ Download and deploy the latest version of Guix.\n")) (define indirect-root-added (store-lift add-indirect-root)) -(define (display-profile-news profile) - "Display what's up in PROFILE--new packages, and all that." +(define* (display-profile-news profile #:key concise? + current-is-newer?) + "Display what's up in PROFILE--new packages, and all that. If +CURRENT-IS-NEWER? is true, assume that the current process represents the +newest generation of PROFILE.x" (match (memv (generation-number profile) (reverse (profile-generations profile))) ((current previous _ ...) - (newline) - (let ((old (fold-available-packages - (lambda* (name version result - #:key supported? deprecated? - #:allow-other-keys) - (if (and supported? (not deprecated?)) - (alist-cons name version result) - result)) - '())) - (new (profile-package-alist - (generation-file-name profile current)))) - (display-new/upgraded-packages old new - #:concise? #t - #:heading (G_ "New in this revision:\n")))) + (let ((these (fold-available-packages + (lambda* (name version result + #:key supported? deprecated? + #:allow-other-keys) + (if (and supported? (not deprecated?)) + (alist-cons name version result) + result)) + '())) + (those (profile-package-alist + (generation-file-name profile + (if current-is-newer? + previous + current))))) + (let ((old (if current-is-newer? those these)) + (new (if current-is-newer? these those))) + (display-new/upgraded-packages old new + #:concise? concise? + #:heading + (G_ "New in this revision:\n"))))) (_ #t))) (define* (build-and-install instances profile @@ -196,7 +209,8 @@ true, display what would be built without actually building it." #:hooks %channel-profile-hooks #:dry-run? dry-run?) (munless dry-run? - (return (display-profile-news profile)) + (return (newline)) + (return (display-profile-news profile #:concise? #t)) (match (which "guix") (#f (return #f)) (str @@ -394,9 +408,13 @@ display long package lists that would fill the user's screen." column) 4)) + (define concise/max-item-count + ;; Maximum number of items to display when CONCISE? is true. + 12) + (define list->enumeration (if concise? - (lambda* (lst #:optional (max 12)) + (lambda* (lst #:optional (max concise/max-item-count)) (if (> (length lst) max) (string-append (string-join (take lst max) ", ") ", " (ellipsis)) @@ -404,10 +422,13 @@ display long package lists that would fill the user's screen." (cut string-join <> ", "))) (let-values (((new upgraded) (new/upgraded-packages alist1 alist2))) + (define new-count (length new)) + (define upgraded-count (length upgraded)) + (unless (and (null? new) (null? upgraded)) (display heading)) - (match (length new) + (match new-count (0 #t) (count (format #t (N_ " ~h new package: ~a~%" @@ -415,14 +436,20 @@ display long package lists that would fill the user's screen." count (pretty (list->enumeration (sort (map first new) stringenumeration (sort upgraded string new-count concise/max-item-count) + (> upgraded-count concise/max-item-count))) + (display-hint (G_ "Run @command{guix pull --news} to view the complete +list of package changes."))))) (define (display-profile-content-diff profile gen1 gen2) "Display the changes in PROFILE GEN2 compared to generation GEN1." @@ -462,7 +489,12 @@ display long package lists that would fill the user's screen." (() (exit 1)) ((numbers ...) - (list-generations profile numbers))))))))) + (list-generations profile numbers))))))) + (('display-news) + ;; Display profile news, with the understanding that this process + ;; represents the newest generation. + (display-profile-news profile + #:current-is-newer? #t)))) (define (channel-list opts) "Return the list of channels to use. If OPTS specify a channel file,