guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: User-Friendlyness of Guix and non-scaryness, printing messages


From: Danny Milosavljevic
Subject: Re: User-Friendlyness of Guix and non-scaryness, printing messages
Date: Sun, 28 May 2017 22:58:23 +0200

And also the spinner integrated:

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f050fad97..d9ac61122 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -46,6 +46,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
+  #:use-module (rnrs io ports)
   #:use-module (gnu packages)
   #:autoload   (gnu packages base) (canonical-package)
   #:autoload   (gnu packages guile) (guile-2.0)
@@ -187,6 +188,27 @@ denote ranges as interpreted by 'matching-generations'."
           (else
            (leave (G_ "invalid syntax: ~a~%") pattern)))))
 
+(define previous-output-port (current-error-port))
+
+(define spinner-port
+  (let ((index 0)
+        (spinner-chars "|\\-/"))
+    (define (spin)
+      (set! index (+ index 1))
+      (if (>= index (string-length spinner-chars))
+        (set! index 0))
+      (display (array-ref spinner-chars index) previous-output-port)
+      (display #\backspace previous-output-port)
+      (flush-output-port previous-output-port))
+    (make-soft-port
+           (vector
+            (lambda (c) (if (char=? c #\newline) (spin))) ; putc
+            (lambda (s) (if (string-contains s "\n") (spin))) ; puts
+            (lambda () #t) ; flush
+            (lambda () #f) ; getc
+            (lambda () #t)) ; close
+           "w")))
+
 (define* (build-and-use-profile store profile manifest
                                 #:key
                                 bootstrap? use-substitutes?
@@ -196,6 +218,7 @@ specified in MANIFEST, a manifest object."
   (when (equal? profile %current-profile)
     (ensure-default-profile))
 
+  (parameterize ((current-build-output-port spinner-port))
   (let* ((prof-drv (run-with-store store
                      (profile-derivation manifest
                                          #:hooks (if bootstrap?
@@ -230,7 +253,7 @@ specified in MANIFEST, a manifest object."
                               count)
                        count)
                (display-search-paths entries (list profile)
-                                     #:kind 'prefix))))))))
+                                     #:kind 'prefix)))))))))
 
 ^L
 ;;;



reply via email to

[Prev in Thread] Current Thread [Next in Thread]