89 lines
2.5 KiB
Scheme
89 lines
2.5 KiB
Scheme
(define-module (reflow ansi)
|
|
#:use-module (rnrs io ports)
|
|
#:use-module (ice-9 binary-ports)
|
|
#:export (make-ansi-port-tuple))
|
|
|
|
(define %MARKER #\x1b)
|
|
(define %RESET "[0m")
|
|
(define %RESET-SEQ
|
|
(string-append (string %MARKER) %RESET))
|
|
|
|
(define (ansi-terminator? char)
|
|
(let ((c (char->integer char)))
|
|
(or (and (>= c #x40) (<= c #x5a)) (and (>= c #x61) (<= c #x7a)))))
|
|
|
|
;; TODO: create helpers that allow the reflow to operate properly.
|
|
(define (make-ansi-port-tuple o-port)
|
|
;; The sequence we are currently building up, a list of characters (reversed).
|
|
(define wip-sequence-list '())
|
|
|
|
;; The current sequence, a list of strings (reversed).
|
|
;; These will be compressed into a single string upon reading.
|
|
(define current-sequence-list '())
|
|
|
|
(define in-escape-sequence? #f)
|
|
(define (sequence?) (not (null? current-sequence-list)))
|
|
|
|
(define-syntax-rule (cons! item lst)
|
|
(set! lst (cons item lst)))
|
|
|
|
;; rune by rune
|
|
(define (put-char c)
|
|
(cond
|
|
((equal? %MARKER c)
|
|
(set! in-escape-sequence? #t)
|
|
(cons! c wip-sequence-list))
|
|
(in-escape-sequence?
|
|
(cons! c wip-sequence-list)
|
|
(when (ansi-terminator? c)
|
|
(set! in-escape-sequence? #f)
|
|
(let ((sequence (reverse-list->string wip-sequence-list)))
|
|
(cond
|
|
((string-suffix? %RESET sequence)
|
|
;; Reset sequence, clear the saved sequence!
|
|
(set! current-sequence-list '()))
|
|
((equal? c #\m)
|
|
;; color code, add the sequence
|
|
(cons! sequence current-sequence-list)))
|
|
|
|
(display sequence o-port)
|
|
(set! wip-sequence-list '()))))
|
|
(else
|
|
(display c o-port))))
|
|
|
|
(define port
|
|
(make-soft-port
|
|
(vector
|
|
;; Char out
|
|
(λ (c) (put-char c))
|
|
;; String out
|
|
(λ (s) (string-for-each put-char s))
|
|
;; Flush
|
|
(λ () (flush-output-port o-port))
|
|
;; Get char
|
|
(λ () #f)
|
|
;; Close port
|
|
(λ () #f))
|
|
"w"))
|
|
|
|
(define (last-sequence)
|
|
(and
|
|
(sequence?)
|
|
(if (= 1 (length current-sequence-list))
|
|
(car current-sequence-list)
|
|
;; On read, compress the list of strings to a single string for safekeeping
|
|
(let ((str (string-concatenate-reverse/shared current-sequence-list)))
|
|
(set! current-sequence-list (list str))
|
|
str))))
|
|
|
|
(define (reset-ansi)
|
|
(when (sequence?)
|
|
(display %RESET-SEQ o-port)))
|
|
|
|
(define (restore-ansi)
|
|
(let ((seq (last-sequence)))
|
|
(when seq
|
|
(display seq o-port))))
|
|
|
|
(values port last-sequence reset-ansi restore-ansi))
|