-(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))))
-