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

 
(define (handle-string str)
    (let ((message  (or (and=> (string-match "^(starting phase)(.*)" str)
           (lambda (m)
             (string-append
               (colorize-string (match:substring m 1) 'BLUE)
               (colorize-string (match:substring m 2) 'GREEN))))

       (and=> (string-match "^(phase) (.*) (succeeded after) (.*) (seconds)" str)
          (lambda (m)
            (string-append
              (colorize-string (match:substring m 1) 'BLUE)
              (colorize-string (match:substring m 2) 'GREEN)
              (colorize-string (match:substring m 3) 'BLUE)
              (colorize-string (match:substring m 4) 'GREEN)
              (colorize-string (match:substring m 5) 'BLUE))))

       (and=> (string-match "^(phase)(.*) (failed after) (.*) (seconds)" str)
          (lambda (m)
            (string-append
              (colorize-string (match:substring m 1) 'RED)
              (colorize-string (match:substring m 2) 'GREEN)
              (colorize-string (match:substring m 3) 'RED)
              (colorize-string (match:substring m 4) 'GREEN)
              (colorize-string (match:substring m 5) 'RED))))

    ;; Didn’t match, so return unmodified string.
       str)))
    (display message (current-error-port))))

(define colorful-build-output-port
  (make-soft-port
   (vector
    (lambda (c) (write c (current-error-port)))
    handle-string
    (lambda () (display "." (current-error-port)))
    (lambda () (char-upcase (read-char)))
    (lambda () (display "@" (current-error-port))))
   "rw"))

;;; ui.scm ends here