pull: Add '--news'.
Suggested by Tobias Geerinckx-Rice <me@tobias.gr>. * 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'.
This commit is contained in:
		
							parent
							
								
									54b41d2d71
								
							
						
					
					
						commit
						c5265a0951
					
				
					 2 changed files with 62 additions and 22 deletions
				
			
		| 
						 | 
					@ -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
 | 
					evaluates to a list of channel objects.  @xref{Channels}, for more
 | 
				
			||||||
information.
 | 
					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}]
 | 
					@item --list-generations[=@var{pattern}]
 | 
				
			||||||
@itemx -l [@var{pattern}]
 | 
					@itemx -l [@var{pattern}]
 | 
				
			||||||
List all the generations of @file{~/.config/guix/current} or, if @var{pattern}
 | 
					List all the generations of @file{~/.config/guix/current} or, if @var{pattern}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -86,6 +86,8 @@ Download and deploy the latest version of Guix.\n"))
 | 
				
			||||||
  (display (G_ "
 | 
					  (display (G_ "
 | 
				
			||||||
      --branch=BRANCH    download the tip of the specified BRANCH"))
 | 
					      --branch=BRANCH    download the tip of the specified BRANCH"))
 | 
				
			||||||
  (display (G_ "
 | 
					  (display (G_ "
 | 
				
			||||||
 | 
					  -N, --news             display news compared to the previous generation"))
 | 
				
			||||||
 | 
					  (display (G_ "
 | 
				
			||||||
  -l, --list-generations[=PATTERN]
 | 
					  -l, --list-generations[=PATTERN]
 | 
				
			||||||
                         list generations matching PATTERN"))
 | 
					                         list generations matching PATTERN"))
 | 
				
			||||||
  (display (G_ "
 | 
					  (display (G_ "
 | 
				
			||||||
| 
						 | 
					@ -117,6 +119,9 @@ Download and deploy the latest version of Guix.\n"))
 | 
				
			||||||
                 (lambda (opt name arg result)
 | 
					                 (lambda (opt name arg result)
 | 
				
			||||||
                   (cons `(query list-generations ,(or arg ""))
 | 
					                   (cons `(query list-generations ,(or arg ""))
 | 
				
			||||||
                         result)))
 | 
					                         result)))
 | 
				
			||||||
 | 
					         (option '(#\N "news") #f #f
 | 
				
			||||||
 | 
					                 (lambda (opt name arg result)
 | 
				
			||||||
 | 
					                   (cons '(query display-news) result)))
 | 
				
			||||||
         (option '("url") #t #f
 | 
					         (option '("url") #t #f
 | 
				
			||||||
                 (lambda (opt name arg result)
 | 
					                 (lambda (opt name arg result)
 | 
				
			||||||
                   (alist-cons 'repository-url arg
 | 
					                   (alist-cons 'repository-url arg
 | 
				
			||||||
| 
						 | 
					@ -162,13 +167,15 @@ Download and deploy the latest version of Guix.\n"))
 | 
				
			||||||
(define indirect-root-added
 | 
					(define indirect-root-added
 | 
				
			||||||
  (store-lift add-indirect-root))
 | 
					  (store-lift add-indirect-root))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (display-profile-news profile)
 | 
					(define* (display-profile-news profile #:key concise?
 | 
				
			||||||
  "Display what's up in PROFILE--new packages, and all that."
 | 
					                               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)
 | 
					  (match (memv (generation-number profile)
 | 
				
			||||||
               (reverse (profile-generations profile)))
 | 
					               (reverse (profile-generations profile)))
 | 
				
			||||||
    ((current previous _ ...)
 | 
					    ((current previous _ ...)
 | 
				
			||||||
     (newline)
 | 
					     (let ((these (fold-available-packages
 | 
				
			||||||
     (let ((old (fold-available-packages
 | 
					 | 
				
			||||||
                   (lambda* (name version result
 | 
					                   (lambda* (name version result
 | 
				
			||||||
                                  #:key supported? deprecated?
 | 
					                                  #:key supported? deprecated?
 | 
				
			||||||
                                  #:allow-other-keys)
 | 
					                                  #:allow-other-keys)
 | 
				
			||||||
| 
						 | 
					@ -176,11 +183,17 @@ Download and deploy the latest version of Guix.\n"))
 | 
				
			||||||
                         (alist-cons name version result)
 | 
					                         (alist-cons name version result)
 | 
				
			||||||
                         result))
 | 
					                         result))
 | 
				
			||||||
                   '()))
 | 
					                   '()))
 | 
				
			||||||
           (new (profile-package-alist
 | 
					           (those (profile-package-alist
 | 
				
			||||||
                 (generation-file-name profile current))))
 | 
					                   (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
 | 
					         (display-new/upgraded-packages old new
 | 
				
			||||||
                                      #:concise? #t
 | 
					                                        #:concise? concise?
 | 
				
			||||||
                                      #:heading (G_ "New in this revision:\n"))))
 | 
					                                        #:heading
 | 
				
			||||||
 | 
					                                        (G_ "New in this revision:\n")))))
 | 
				
			||||||
    (_ #t)))
 | 
					    (_ #t)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define* (build-and-install instances profile
 | 
					(define* (build-and-install instances profile
 | 
				
			||||||
| 
						 | 
					@ -196,7 +209,8 @@ true, display what would be built without actually building it."
 | 
				
			||||||
                      #:hooks %channel-profile-hooks
 | 
					                      #:hooks %channel-profile-hooks
 | 
				
			||||||
                      #:dry-run? dry-run?)
 | 
					                      #:dry-run? dry-run?)
 | 
				
			||||||
      (munless dry-run?
 | 
					      (munless dry-run?
 | 
				
			||||||
        (return (display-profile-news profile))
 | 
					        (return (newline))
 | 
				
			||||||
 | 
					        (return (display-profile-news profile #:concise? #t))
 | 
				
			||||||
        (match (which "guix")
 | 
					        (match (which "guix")
 | 
				
			||||||
          (#f (return #f))
 | 
					          (#f (return #f))
 | 
				
			||||||
          (str
 | 
					          (str
 | 
				
			||||||
| 
						 | 
					@ -394,9 +408,13 @@ display long package lists that would fill the user's screen."
 | 
				
			||||||
                                     column)
 | 
					                                     column)
 | 
				
			||||||
                     4))
 | 
					                     4))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (define concise/max-item-count
 | 
				
			||||||
 | 
					    ;; Maximum number of items to display when CONCISE? is true.
 | 
				
			||||||
 | 
					    12)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define list->enumeration
 | 
					  (define list->enumeration
 | 
				
			||||||
    (if concise?
 | 
					    (if concise?
 | 
				
			||||||
        (lambda* (lst #:optional (max 12))
 | 
					        (lambda* (lst #:optional (max concise/max-item-count))
 | 
				
			||||||
          (if (> (length lst) max)
 | 
					          (if (> (length lst) max)
 | 
				
			||||||
              (string-append (string-join (take lst max) ", ")
 | 
					              (string-append (string-join (take lst max) ", ")
 | 
				
			||||||
                             ", " (ellipsis))
 | 
					                             ", " (ellipsis))
 | 
				
			||||||
| 
						 | 
					@ -404,10 +422,13 @@ display long package lists that would fill the user's screen."
 | 
				
			||||||
        (cut string-join <> ", ")))
 | 
					        (cut string-join <> ", ")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (let-values (((new upgraded) (new/upgraded-packages alist1 alist2)))
 | 
					  (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))
 | 
					    (unless (and (null? new) (null? upgraded))
 | 
				
			||||||
      (display heading))
 | 
					      (display heading))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    (match (length new)
 | 
					    (match new-count
 | 
				
			||||||
      (0 #t)
 | 
					      (0 #t)
 | 
				
			||||||
      (count
 | 
					      (count
 | 
				
			||||||
       (format #t (N_ "  ~h new package: ~a~%"
 | 
					       (format #t (N_ "  ~h new package: ~a~%"
 | 
				
			||||||
| 
						 | 
					@ -415,14 +436,20 @@ display long package lists that would fill the user's screen."
 | 
				
			||||||
               count
 | 
					               count
 | 
				
			||||||
               (pretty (list->enumeration (sort (map first new) string<?))
 | 
					               (pretty (list->enumeration (sort (map first new) string<?))
 | 
				
			||||||
                       30))))
 | 
					                       30))))
 | 
				
			||||||
    (match (length upgraded)
 | 
					    (match upgraded-count
 | 
				
			||||||
      (0 #t)
 | 
					      (0 #t)
 | 
				
			||||||
      (count
 | 
					      (count
 | 
				
			||||||
       (format #t (N_ "  ~h package upgraded: ~a~%"
 | 
					       (format #t (N_ "  ~h package upgraded: ~a~%"
 | 
				
			||||||
                      "  ~h packages upgraded: ~a~%" count)
 | 
					                      "  ~h packages upgraded: ~a~%" count)
 | 
				
			||||||
               count
 | 
					               count
 | 
				
			||||||
               (pretty (list->enumeration (sort upgraded string<?))
 | 
					               (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)
 | 
					(define (display-profile-content-diff profile gen1 gen2)
 | 
				
			||||||
  "Display the changes in PROFILE GEN2 compared to generation GEN1."
 | 
					  "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))
 | 
					                (exit 1))
 | 
				
			||||||
               ((numbers ...)
 | 
					               ((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)
 | 
					(define (channel-list opts)
 | 
				
			||||||
  "Return the list of channels to use.  If OPTS specify a channel file,
 | 
					  "Return the list of channels to use.  If OPTS specify a channel file,
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue