diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-04-11 17:17:38 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-04-11 18:18:13 +0200 |
commit | 544265acba89a41691c6be5b4af8e3c2237cd5c6 (patch) | |
tree | 609472e31a33226f85fb70eac3a17bfd7b9c7570 /guix | |
parent | 2569ef9dab4f796a75b8cdddd57d3be37b142036 (diff) |
colors: Add 'colorize-matches'.
* guix/colors.scm (colorize-matches): New procedure.
(color-rules): Rewrite in terms of 'colorize-matches'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/colors.scm | 55 |
1 files changed, 34 insertions, 21 deletions
diff --git a/guix/colors.scm b/guix/colors.scm index b7d3f6d4ec..30ad231dfe 100644 --- a/guix/colors.scm +++ b/guix/colors.scm @@ -132,34 +132,47 @@ that subsequent output will not have any colors in effect." (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: +(define (colorize-matches rules) + "Return a procedure that, when passed a string, returns that string +colorized according to RULES. RULES must be a list of tuples like: (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)) + (lambda (str) + (if (string-index str #\nul) + str + (let loop ((rules rules)) + (match rules + (() + str) + (((regexp . colors) . rest) + (match (regexp-exec regexp str) + (#f (loop rest)) (m (let loop ((n 1) - (c (list (color colors) ...)) - (result '())) - (match c + (colors colors) + (result (list (match:prefix m)))) + (match colors (() - (string-concatenate-reverse result)) + (string-concatenate-reverse + (cons (match:suffix m) result))) ((first . tail) - (loop (+ n 1) tail + (loop (+ n 1) + tail (cons (colorize-string (match:substring m n) first) - result))))))))))) - ((_) - (lambda (str) - str)))) + result))))))))))))) + +(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 ...) ...) + (colorize-matches `((,(make-regexp regexp) ,(color colors) ...) + ...))))) |