summaryrefslogtreecommitdiff
path: root/guix/colors.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-04-11 16:57:38 +0200
committerLudovic Courtès <ludo@gnu.org>2019-04-11 18:18:13 +0200
commit2569ef9dab4f796a75b8cdddd57d3be37b142036 (patch)
tree34b527c015552944c1a6fd1bb855dd45e36084bc /guix/colors.scm
parentc1df77e215b6e69dccbe781307836a3b962c5968 (diff)
colors: Introduce a disjoint type and pre-compute ANSI escapes.
* guix/colors.scm (color-table, color): Remove. (<color>): New record type. (print-color): New procedure. (define-color-table, color): New macros. (color-codes->ansi): New procedure. (%reset): New variable. (colorize-string): Rewrite accordingly. (color-rules): Adjust accordingly. * guix/status.scm (print-build-event): Adjust to new 'colorize-string' interface. * guix/ui.scm (%highlight-argument): Likewise. (%warning-colors, %info-colors, %error-colors, %hint-colors) (%highlight-colors): Remove. (%warning-color, %info-color, %error-color, %hint-color) (%highlight-color): New variables.
Diffstat (limited to 'guix/colors.scm')
-rw-r--r--guix/colors.scm138
1 files changed, 87 insertions, 51 deletions
diff --git a/guix/colors.scm b/guix/colors.scm
index fad0bd2ab9..b7d3f6d4ec 100644
--- a/guix/colors.scm
+++ b/guix/colors.scm
@@ -22,9 +22,14 @@
(define-module (guix colors)
#:use-module (guix memoization)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
- #:export (colorize-string
+ #:export (color
+ color?
+
+ colorize-string
color-rules
color-output?
isatty?*))
@@ -35,55 +40,86 @@
;;;
;;; Code:
-(define color-table
- `((CLEAR . "0")
- (RESET . "0")
- (BOLD . "1")
- (DARK . "2")
- (UNDERLINE . "4")
- (UNDERSCORE . "4")
- (BLINK . "5")
- (REVERSE . "6")
- (CONCEALED . "8")
- (BLACK . "30")
- (RED . "31")
- (GREEN . "32")
- (YELLOW . "33")
- (BLUE . "34")
- (MAGENTA . "35")
- (CYAN . "36")
- (WHITE . "37")
- (ON-BLACK . "40")
- (ON-RED . "41")
- (ON-GREEN . "42")
- (ON-YELLOW . "43")
- (ON-BLUE . "44")
- (ON-MAGENTA . "45")
- (ON-CYAN . "46")
- (ON-WHITE . "47")))
-
-(define (color . lst)
- "Return a string containing the ANSI escape sequence for producing the
-requested set of attributes in LST. Unknown attributes are ignored."
- (let ((color-list
- (remove not
- (map (lambda (color) (assq-ref color-table color))
- lst))))
- (if (null? color-list)
- ""
- (string-append
- (string #\esc #\[)
- (string-join color-list ";" 'infix)
- "m"))))
-
-(define (colorize-string str . color-list)
- "Return a copy of STR colorized using ANSI escape sequences according to the
-attributes STR. At the end of the returned string, the color attributes will
-be reset such that subsequent output will not have any colors in effect."
- (string-append
- (apply color color-list)
- str
- (color 'RESET)))
+;; Record type for "colors", which are actually lists of color attributes.
+(define-record-type <color>
+ (make-color symbols ansi)
+ color?
+ (symbols color-symbols)
+ (ansi color-ansi))
+
+(define (print-color color port)
+ (format port "#<color ~a>"
+ (string-join (map symbol->string
+ (color-symbols color)))))
+
+(set-record-type-printer! <color> print-color)
+
+(define-syntax define-color-table
+ (syntax-rules ()
+ "Define NAME as a macro that builds a list of color attributes."
+ ((_ name (color escape) ...)
+ (begin
+ (define-syntax color-codes
+ (syntax-rules (color ...)
+ ((_)
+ '())
+ ((_ color rest (... ...))
+ `(escape ,@(color-codes rest (... ...))))
+ ...))
+
+ (define-syntax-rule (name colors (... ...))
+ "Return a list of color attributes that can be passed to
+'colorize-string'."
+ (make-color '(colors (... ...))
+ (color-codes->ansi (color-codes colors (... ...)))))))))
+
+(define-color-table color
+ (CLEAR "0")
+ (RESET "0")
+ (BOLD "1")
+ (DARK "2")
+ (UNDERLINE "4")
+ (UNDERSCORE "4")
+ (BLINK "5")
+ (REVERSE "6")
+ (CONCEALED "8")
+ (BLACK "30")
+ (RED "31")
+ (GREEN "32")
+ (YELLOW "33")
+ (BLUE "34")
+ (MAGENTA "35")
+ (CYAN "36")
+ (WHITE "37")
+ (ON-BLACK "40")
+ (ON-RED "41")
+ (ON-GREEN "42")
+ (ON-YELLOW "43")
+ (ON-BLUE "44")
+ (ON-MAGENTA "45")
+ (ON-CYAN "46")
+ (ON-WHITE "47"))
+
+(define (color-codes->ansi codes)
+ "Convert CODES, a list of color attribute codes, to a ANSI escape string."
+ (match codes
+ (()
+ "")
+ (_
+ (string-append (string #\esc #\[)
+ (string-join codes ";" 'infix)
+ "m"))))
+
+(define %reset
+ (color RESET))
+
+(define (colorize-string str color)
+ "Return a copy of STR colorized using ANSI escape sequences according to
+COLOR. At the end of the returned string, the color attributes are reset such
+that subsequent output will not have any colors in effect."
+ (string-append (color-ansi color)
+ str
+ (color-ansi %reset)))
(define isatty?*
(mlambdaq (port)
@@ -114,7 +150,7 @@ on."
(match (regexp-exec rx str)
(#f (next str))
(m (let loop ((n 1)
- (c '(colors ...))
+ (c (list (color colors) ...))
(result '()))
(match c
(()