ui: 'show-what-to-build' colorizes store file names.
* guix/ui.scm (colorize-store-file-name): New procedure. (show-what-to-build)[colorize-store-item]: New variable. Use it throughout.
This commit is contained in:
		
							parent
							
								
									8e5ffebeaa
								
							
						
					
					
						commit
						8b4615ab54
					
				
					 1 changed files with 30 additions and 10 deletions
				
			
		
							
								
								
									
										40
									
								
								guix/ui.scm
									
										
									
									
									
								
							
							
						
						
									
										40
									
								
								guix/ui.scm
									
										
									
									
									
								
							| 
						 | 
					@ -867,6 +867,17 @@ warning."
 | 
				
			||||||
    ('profile-hook #t)
 | 
					    ('profile-hook #t)
 | 
				
			||||||
    (_ #f)))
 | 
					    (_ #f)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (colorize-store-file-name file)
 | 
				
			||||||
 | 
					  "Colorize FILE, a store file name, such that the hash part is less prominent
 | 
				
			||||||
 | 
					that the rest."
 | 
				
			||||||
 | 
					  (let ((len    (string-length file))
 | 
				
			||||||
 | 
					        (prefix (+ (string-length (%store-prefix)) 32 2)))
 | 
				
			||||||
 | 
					    (if (< len prefix)
 | 
				
			||||||
 | 
					        file
 | 
				
			||||||
 | 
					        (string-append (colorize-string (string-take file prefix)
 | 
				
			||||||
 | 
					                                        (color DARK))
 | 
				
			||||||
 | 
					                       (string-drop file prefix)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define* (show-what-to-build store drv
 | 
					(define* (show-what-to-build store drv
 | 
				
			||||||
                             #:key dry-run? (use-substitutes? #t)
 | 
					                             #:key dry-run? (use-substitutes? #t)
 | 
				
			||||||
                             (mode (build-mode normal)))
 | 
					                             (mode (build-mode normal)))
 | 
				
			||||||
| 
						 | 
					@ -890,6 +901,11 @@ check and report what is prerequisites are available for download."
 | 
				
			||||||
        (substitution-oracle store inputs #:mode mode)
 | 
					        (substitution-oracle store inputs #:mode mode)
 | 
				
			||||||
        (const #f)))
 | 
					        (const #f)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (define colorized-store-item
 | 
				
			||||||
 | 
					    (if (color-output? (current-error-port))
 | 
				
			||||||
 | 
					        colorize-store-file-name
 | 
				
			||||||
 | 
					        identity))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (let*-values (((build download)
 | 
					  (let*-values (((build download)
 | 
				
			||||||
                 (derivation-build-plan store inputs
 | 
					                 (derivation-build-plan store inputs
 | 
				
			||||||
                                        #:mode mode
 | 
					                                        #:mode mode
 | 
				
			||||||
| 
						 | 
					@ -935,7 +951,7 @@ check and report what is prerequisites are available for download."
 | 
				
			||||||
                  (N_ "~:[The following derivation would be built:~%~{   ~a~%~}~;~]"
 | 
					                  (N_ "~:[The following derivation would be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
 | 
					                      "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      (length build))
 | 
					                      (length build))
 | 
				
			||||||
                  (null? build) build)
 | 
					                  (null? build) (map colorized-store-item build))
 | 
				
			||||||
          (if display-download-size?
 | 
					          (if display-download-size?
 | 
				
			||||||
              (format (current-error-port)
 | 
					              (format (current-error-port)
 | 
				
			||||||
                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
 | 
					                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
 | 
				
			||||||
| 
						 | 
					@ -943,29 +959,31 @@ check and report what is prerequisites are available for download."
 | 
				
			||||||
                      (G_ "~:[~,1h MB would be downloaded:~%~{   ~a~%~}~;~]")
 | 
					                      (G_ "~:[~,1h MB would be downloaded:~%~{   ~a~%~}~;~]")
 | 
				
			||||||
                      (null? download)
 | 
					                      (null? download)
 | 
				
			||||||
                      download-size
 | 
					                      download-size
 | 
				
			||||||
                      (map substitutable-path download))
 | 
					                      (map (compose colorized-store-item substitutable-path)
 | 
				
			||||||
 | 
					                           download))
 | 
				
			||||||
              (format (current-error-port)
 | 
					              (format (current-error-port)
 | 
				
			||||||
                      (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
 | 
					                      (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                          "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
 | 
					                          "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                          (length download))
 | 
					                          (length download))
 | 
				
			||||||
                      (null? download)
 | 
					                      (null? download)
 | 
				
			||||||
                      (map substitutable-path download)))
 | 
					                      (map (compose colorized-store-item substitutable-path)
 | 
				
			||||||
 | 
					                           download)))
 | 
				
			||||||
          (format (current-error-port)
 | 
					          (format (current-error-port)
 | 
				
			||||||
                  (N_ "~:[The following graft would be made:~%~{   ~a~%~}~;~]"
 | 
					                  (N_ "~:[The following graft would be made:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      "~:[The following grafts would be made:~%~{   ~a~%~}~;~]"
 | 
					                      "~:[The following grafts would be made:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      (length graft))
 | 
					                      (length graft))
 | 
				
			||||||
                  (null? graft) graft)
 | 
					                  (null? graft) (map colorized-store-item graft))
 | 
				
			||||||
          (format (current-error-port)
 | 
					          (format (current-error-port)
 | 
				
			||||||
                  (N_ "~:[The following profile hook would be built:~%~{   ~a~%~}~;~]"
 | 
					                  (N_ "~:[The following profile hook would be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      "~:[The following profile hooks would be built:~%~{   ~a~%~}~;~]"
 | 
					                      "~:[The following profile hooks would be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      (length hook))
 | 
					                      (length hook))
 | 
				
			||||||
                  (null? hook) hook))
 | 
					                  (null? hook) (map colorized-store-item hook)))
 | 
				
			||||||
        (begin
 | 
					        (begin
 | 
				
			||||||
          (format (current-error-port)
 | 
					          (format (current-error-port)
 | 
				
			||||||
                  (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
 | 
					                  (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
 | 
					                      "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      (length build))
 | 
					                      (length build))
 | 
				
			||||||
                  (null? build) build)
 | 
					                  (null? build) (map colorized-store-item build))
 | 
				
			||||||
          (if display-download-size?
 | 
					          (if display-download-size?
 | 
				
			||||||
              (format (current-error-port)
 | 
					              (format (current-error-port)
 | 
				
			||||||
                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
 | 
					                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
 | 
				
			||||||
| 
						 | 
					@ -973,23 +991,25 @@ check and report what is prerequisites are available for download."
 | 
				
			||||||
                      (G_ "~:[~,1h MB will be downloaded:~%~{   ~a~%~}~;~]")
 | 
					                      (G_ "~:[~,1h MB will be downloaded:~%~{   ~a~%~}~;~]")
 | 
				
			||||||
                      (null? download)
 | 
					                      (null? download)
 | 
				
			||||||
                      download-size
 | 
					                      download-size
 | 
				
			||||||
                      (map substitutable-path download))
 | 
					                      (map (compose colorized-store-item substitutable-path)
 | 
				
			||||||
 | 
					                           download))
 | 
				
			||||||
              (format (current-error-port)
 | 
					              (format (current-error-port)
 | 
				
			||||||
                      (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
 | 
					                      (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                          "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
 | 
					                          "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                          (length download))
 | 
					                          (length download))
 | 
				
			||||||
                      (null? download)
 | 
					                      (null? download)
 | 
				
			||||||
                      (map substitutable-path download)))
 | 
					                      (map (compose colorized-store-item substitutable-path)
 | 
				
			||||||
 | 
					                           download)))
 | 
				
			||||||
          (format (current-error-port)
 | 
					          (format (current-error-port)
 | 
				
			||||||
                  (N_ "~:[The following graft will be made:~%~{   ~a~%~}~;~]"
 | 
					                  (N_ "~:[The following graft will be made:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      "~:[The following grafts will be made:~%~{   ~a~%~}~;~]"
 | 
					                      "~:[The following grafts will be made:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      (length graft))
 | 
					                      (length graft))
 | 
				
			||||||
                  (null? graft) graft)
 | 
					                  (null? graft) (map colorized-store-item graft))
 | 
				
			||||||
          (format (current-error-port)
 | 
					          (format (current-error-port)
 | 
				
			||||||
                  (N_ "~:[The following profile hook will be built:~%~{   ~a~%~}~;~]"
 | 
					                  (N_ "~:[The following profile hook will be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      "~:[The following profile hooks will be built:~%~{   ~a~%~}~;~]"
 | 
					                      "~:[The following profile hooks will be built:~%~{   ~a~%~}~;~]"
 | 
				
			||||||
                      (length hook))
 | 
					                      (length hook))
 | 
				
			||||||
                  (null? hook) hook)))
 | 
					                  (null? hook) (map colorized-store-item hook))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    (check-available-space installed-size)
 | 
					    (check-available-space installed-size)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue