Merge branch 'master' into core-updates

4 files changed, 37 insertions, 17 deletions

diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index c127456fd0..06ed57c9d7 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -169,11 +169,12 @@ BUILD-DIRECTORY, using up to WORKERS parallel workers.  The resulting object
 files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
   (define progress-lock (make-mutex))
   (define total (length files))
-  (define completed 0)
+  (define progress 0)
 
   (define (build file)
     (with-mutex progress-lock
-      (report-compilation file total completed))
+      (report-compilation file total progress)
+      (set! progress (+ 1 progress)))
 
     ;; Exit as soon as something goes wrong.
     (exit-on-exception
@@ -185,9 +186,7 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
                          #:output-file (string-append build-directory "/"
                                                       (scm->go relative))
                          #:opts (append warning-options
-                                        (optimization-options relative)))))))
-    (with-mutex progress-lock
-      (set! completed (+ 1 completed))))
+                                        (optimization-options relative))))))))
 
   (with-augmented-search-path %load-path source-directory
     (with-augmented-search-path %load-compiled-path build-directory
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 0c0dd9d516..bb307cefd1 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -243,7 +243,8 @@ instead of '~a' of type '~a'~%")
   ;; of these; if we fail, that means all the build slots are already taken.
   ;; Inspired by Nix's build-remote.pl.
   (string-append  (string-append %state-directory "/offload/"
-                                 (build-machine-name machine)
+                                 (build-machine-name machine) ":"
+                                 (number->string (build-machine-port machine))
                                  "/" (number->string slot))))
 
 (define (acquire-build-slot machine)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 0372278705..e018985469 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -304,7 +304,7 @@ to display."
                (new
                 (let ((count (length new)))
                   (format (current-error-port)
-                          (N_ "  ~*One new channel:~%"
+                          (N_ "  ~a new channel:~%"
                               "  ~a new channels:~%" count)
                           count)
                   (for-each display-channel new))))
diff --git a/guix/ui.scm b/guix/ui.scm
index 069d542131..3e4bd5787e 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -867,6 +867,17 @@ warning."
     ('profile-hook #t)
     (_ #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
                              #:key dry-run? (use-substitutes? #t)
                              (mode (build-mode normal)))
@@ -890,6 +901,11 @@ check and report what is prerequisites are available for download."
         (substitution-oracle store inputs #:mode mode)
         (const #f)))
 
+  (define colorized-store-item
+    (if (color-output? (current-error-port))
+        colorize-store-file-name
+        identity))
+
   (let*-values (((build download)
                  (derivation-build-plan store inputs
                                         #:mode mode
@@ -935,7 +951,7 @@ check and report what is prerequisites are available for download."
                   (N_ "~:[The following derivation would be built:~%~{   ~a~%~}~;~]"
                       "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
                       (length build))
-                  (null? build) build)
+                  (null? build) (map colorized-store-item build))
           (if display-download-size?
               (format (current-error-port)
                       ;; 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~%~}~;~]")
                       (null? download)
                       download-size
-                      (map substitutable-path download))
+                      (map (compose colorized-store-item substitutable-path)
+                           download))
               (format (current-error-port)
                       (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
                           "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
                           (length download))
                       (null? download)
-                      (map substitutable-path download)))
+                      (map (compose colorized-store-item substitutable-path)
+                           download)))
           (format (current-error-port)
                   (N_ "~:[The following graft would be made:~%~{   ~a~%~}~;~]"
                       "~:[The following grafts would be made:~%~{   ~a~%~}~;~]"
                       (length graft))
-                  (null? graft) graft)
+                  (null? graft) (map colorized-store-item graft))
           (format (current-error-port)
                   (N_ "~:[The following profile hook would be built:~%~{   ~a~%~}~;~]"
                       "~:[The following profile hooks would be built:~%~{   ~a~%~}~;~]"
                       (length hook))
-                  (null? hook) hook))
+                  (null? hook) (map colorized-store-item hook)))
         (begin
           (format (current-error-port)
                   (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
                       "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
                       (length build))
-                  (null? build) build)
+                  (null? build) (map colorized-store-item build))
           (if display-download-size?
               (format (current-error-port)
                       ;; 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~%~}~;~]")
                       (null? download)
                       download-size
-                      (map substitutable-path download))
+                      (map (compose colorized-store-item substitutable-path)
+                           download))
               (format (current-error-port)
                       (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
                           "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
                           (length download))
                       (null? download)
-                      (map substitutable-path download)))
+                      (map (compose colorized-store-item substitutable-path)
+                           download)))
           (format (current-error-port)
                   (N_ "~:[The following graft will be made:~%~{   ~a~%~}~;~]"
                       "~:[The following grafts will be made:~%~{   ~a~%~}~;~]"
                       (length graft))
-                  (null? graft) graft)
+                  (null? graft) (map colorized-store-item graft))
           (format (current-error-port)
                   (N_ "~:[The following profile hook will be built:~%~{   ~a~%~}~;~]"
                       "~:[The following profile hooks will be built:~%~{   ~a~%~}~;~]"
                       (length hook))
-                  (null? hook) hook)))
+                  (null? hook) (map colorized-store-item hook))))
 
     (check-available-space installed-size)