gnu: emacs-org: Update to 9.4.

[jackhill/guix/guix.git] / guix / status.scm

diff --git a/guix/status.scm b/guix/status.scm
index bddaa00..f40d5d5 100644 (file)
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,7 +20,7 @@
 (define-module (guix status)
   #:use-module (guix records)
   #:use-module (guix i18n)
-  #:use-module ((guix ui) #:select (colorize-string))
+  #:use-module (guix colors)
   #:use-module (guix progress)
   #:autoload   (guix build syscalls) (terminal-columns)
   #:use-module ((guix build download)
@@ -339,10 +339,6 @@ build-log\" traces."
   (and (current-store-protocol-version)
        (>= (current-store-protocol-version) #x163)))
 
-(define isatty?*
-  (mlambdaq (port)
-    (isatty? port)))
-
 (define spin!
   (let ((steps (circular-list "\\" "|" "/" "-")))
     (lambda (phase port)
@@ -362,44 +358,6 @@ the current build phase."
              (format port (G_ "'~a' phase") phase))
            (force-output port)))))))
 
-(define (color-output? port)
-  "Return true if we should write colored output to PORT."
-  (and (not (getenv "INSIDE_EMACS"))
-       (not (getenv "NO_COLOR"))
-       (isatty?* port)))
-
-(define-syntax color-rules
-  (syntax-rules ()
-    "Return a procedure that colorizes the string it is passed according to
-the given rules.  Each rule has the form:
-
-  (REGEXP COLOR1 COLOR2 ...)
-
-where COLOR1 specifies how to colorize the first submatch of REGEXP, and so
-on."
-    ((_ (regexp colors ...) rest ...)
-     (let ((next (color-rules rest ...))
-           (rx   (make-regexp regexp)))
-       (lambda (str)
-         (if (string-index str #\nul)
-             str
-             (match (regexp-exec rx str)
-               (#f (next str))
-               (m  (let loop ((n 1)
-                              (c '(colors ...))
-                              (result '()))
-                     (match c
-                       (()
-                        (string-concatenate-reverse result))
-                       ((first . tail)
-                        (loop (+ n 1) tail
-                              (cons (colorize-string (match:substring m n)
-                                                     first)
-                                    result)))))))))))
-    ((_)
-     (lambda (str)
-       str))))
-
 (define colorize-log-line
   ;; Take a string and return a possibly colorized string according to the
   ;; rules below.
@@ -452,17 +410,17 @@ produce colorful output.  When PRINT-LOG? is true, display the build log in
 addition to build events."
   (define info
     (if colorize?
-        (cut colorize-string <> 'BOLD)
+        (cute colorize-string <> (color BOLD))
         identity))
 
   (define success
     (if colorize?
-        (cut colorize-string <> 'GREEN 'BOLD)
+        (cute colorize-string <> (color GREEN BOLD))
         identity))
 
   (define failure
     (if colorize?
-        (cut colorize-string <> 'RED 'BOLD)
+        (cute colorize-string <> (color RED BOLD))
         identity))
 
   (define (report-build-progress phase %)
@@ -514,10 +472,18 @@ addition to build events."
            (let ((count (match (assq-ref properties 'graft)
                           (#f  0)
                           (lst (or (assq-ref lst 'count) 0)))))
-             (format port (info (N_ "applying ~a graft for ~a..."
-                                    "applying ~a grafts for ~a..."
+             (format port (info (N_ "applying ~a graft for ~a ..."
+                                    "applying ~a grafts for ~a ..."
                                     count))
                      count drv)))
+         ('profile
+          (let ((count (match (assq-ref properties 'profile)
+                         (#f  0)
+                         (lst (or (assq-ref lst 'count) 0)))))
+            (format port (info (N_ "building profile with ~a package..."
+                                   "building profile with ~a packages..."
+                                   count))
+                    count)))
          ('profile-hook
           (let ((hook-type (assq-ref properties 'hook)))
             (or (and=> (hook-message hook-type)
@@ -559,7 +525,7 @@ addition to build events."
        (newline port)))
     (('download-started item uri _ ...)
      (erase-current-line*)
-     (format port (info (G_ "downloading from ~a...")) uri)
+     (format port (info (G_ "downloading from ~a ...")) uri)
      (newline port))
     (('download-progress item uri
                          (= string->number size)