01/02: pull: Add '--news'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit c5265a095172b213ba6fbdf618d6779359ca56b2
Author: Ludovic Courtès <address@hidden>
Date:   Sun Apr 21 21:26:06 2019 +0200

    pull: Add '--news'.
    
    Suggested by Tobias Geerinckx-Rice <address@hidden>.
    
    * 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 8c7522f..785329a 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.
 
address@hidden --news
address@hidden -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 address@hidden
 @itemx -l address@hidden
 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 71e1368..04e83f9 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) string<?))
                        30))))
-    (match (length upgraded)
+    (match upgraded-count
       (0 #t)
       (count
        (format #t (N_ "  ~h package upgraded: ~a~%"
                       "  ~h packages upgraded: ~a~%" count)
                count
                (pretty (list->enumeration (sort upgraded string<?))
-                       35))))))
+                       35))))
+
+    (when (and concise?
+               (or (> 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,