gaucheでterminalに色のついた文字を出力する

ansi-colorを利用した色のついた文字列を作成するライブラリを書いてみました。

e.g.

(add-load-path ".")
(use ansi-color)
(ansi-color-list)

(let1 rc (ansi-color 'red)
  (print "foo" (rc "foo") "bar" (rc "bar")))

(use text.tree)
(print 
 (tree->string
  (list ((ansi-color* 'magenta 'on-green) "foo" "bar")
	((ansi-color* 'yellow) 1 2 3)
	((ansi-color* 'cyan) 'fooo)
	"end")))

code

(define-module ansi-color
  (use util.match)
  (use text.tree)
  (export ansi-color-list ansi-color ansi-color*))
(select-module ansi-color)

(define-constant +ansi-colors-table+
  (let* ((colors
	  '(clear reset bold dark italic underline underscore blink rapid-blink
		  negative concealed strikethrough 
		  black red green yellow blue magenta cyan white 
		  on-black on-red on-green on-yellow on-blue on-magenta on-cyan on-white))
	 (values
	  (map (lambda (n) (let1 cs (string->list (number->string n))
			     (apply string `(#\escape #\[ ,@cs #\m))))
	       '(0 0 1 2 3 4 4 5 6 7 8 9 30 31 32 33 34 35 36 37 40 41 42 43 44 45 46 47))))
    (rlet1 ht (make-hash-table 'eq?)
      (for-each (cut hash-table-put! ht <> <>) colors values))))

(define-constant +ansi-color-clear+ (hash-table-get +ansi-colors-table+ 'clear))

(define (ansi-color-get symbol)
  (if (hash-table-exists? +ansi-colors-table+ symbol)
      (hash-table-get +ansi-colors-table+ symbol)
      (error "this color is not defined. eval (ansi-color-list)")))

(define (ansi-color-list) 
  (hash-table-keys +ansi-colors-table+))

(define (ansi-color . cs)
  (compose tree->string (apply ansi-color* cs)))

(define (ansi-color* . cs)
  (let1 colors (map ansi-color-get cs)
    (lambda x
      `(,colors ,x ,+ansi-color-clear+))))

(provide "ansi-color")