(define-module (term ansi-color)
     #:export  (color
                colorize-string)
     #:use-module (srfi srfi-1))  ; for 'remove'

(define ansi-color-tables
  `((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)

"The allowed values for the attributes are listed below.  Unknown
attributes are ignored.

@table @asis
@item Reset Attributes
@samp{CLEAR} and @samp{RESET} are allowed and equivalent.

@item Non-Color Attributes
@samp{BOLD} makes text bold, and @samp{DARK} reverses this.
@samp{UNDERLINE} and @samp{UNDERSCORE} are equivalent.  @samp{BLINK}
makes the text blink.  @samp{REVERSE} invokes reverse video.
@samp{CONCEALED} hides output (as for getting passwords, etc.).

@item Foregrond Color Attributes
@samp{BLACK}, @samp{RED}, @samp{GREEN}, @samp{YELLOW}, @samp{BLUE},
@samp{MAGENTA}, @samp{CYAN}, @samp{WHITE}

@item Background Color Attributes
@samp{ON-BLACK}, @samp{ON-RED}, @samp{ON-GREEN}, @samp{ON-YELLOW},
@samp{ON-BLUE}, @samp{ON-MAGENTA}, @samp{ON-CYAN}, @samp{ON-WHITE}
@end table"

  (let ((color-list 
         (remove not 
                 (map (lambda (color) (assq-ref ansi-color-tables color))
                      lst))))
    (if (null? color-list)
        ""
        (string-append 
         (string #\esc #\[)
         (string-join color-list ";" 'infix)
         "m"))))
  
(define (colorize-string str . color-list)
"Returns a copy of @var{str} colorized using ANSI
escape sequences according to the attributes specified in
@var{color-list}.  At the end of the returned string, the color
attributes will be reset such that subsequent output will not
have any colors in effect.

The allowed values for the attributes are listed in the
documentation for the @code{color} function."
  (string-append
   (apply color color-list)
   str
   (color 'RESET)))

(display (colorize-string "Hello!\n" 'RED))

(for-each display
          (list (color 'RED)
                "Hello!"
                 (color 'RESET)))