diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/compile.scm | 9 | ||||
-rw-r--r-- | guix/scripts/offload.scm | 3 | ||||
-rw-r--r-- | guix/scripts/pull.scm | 2 | ||||
-rw-r--r-- | guix/ui.scm | 40 |
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) |