101 lines
3.6 KiB
Scheme
101 lines
3.6 KiB
Scheme
(define-module (reflow ansi)
|
|
#:use-module (rnrs io ports)
|
|
#:export (%ansi-marker
|
|
%reset
|
|
%reset-seq
|
|
ansi-terminator?
|
|
make-ansi-port-tuple))
|
|
|
|
(define %ansi-marker #\x1b)
|
|
(define %reset "[0m")
|
|
(define %reset-seq
|
|
(string-append (string %ansi-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)
|
|
"Return the wrapping port and 3 functions acting on it: `current-sequence', `reset-sequence', `restore-sequence'. `current-sequence': Returns the current, complete sequence applied to the port. `reset-sequence': Sends a reset sequence to the port if necessary (if there is currently a sequence). `restore-sequence': If there is a sequence, send it to the 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 '())
|
|
|
|
;; #t if we are currently defining an escape sequence
|
|
(define in-escape-sequence? #f)
|
|
|
|
;; #t if there is a sequence stored.
|
|
(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
|
|
;; If we see a marker, flag it and begin building the sequence list
|
|
((equal? %ansi-marker c)
|
|
(set! in-escape-sequence? #t)
|
|
(cons! c wip-sequence-list))
|
|
(in-escape-sequence?
|
|
;; If we are still in an escape sequence continue building
|
|
(cons! c wip-sequence-list)
|
|
(when (ansi-terminator? c)
|
|
;; If we reach a terminator char, we have completed building the sequence
|
|
(set! in-escape-sequence? #f)
|
|
;; Convert it to a string (reverse, because we used cons)
|
|
(let ((sequence (reverse-list->string wip-sequence-list)))
|
|
(cond
|
|
;; Is it a reset sequence? Clear it
|
|
((string-suffix? %reset sequence)
|
|
(set! current-sequence-list '()))
|
|
;; Is it a color code? Add it to the sequence!
|
|
((equal? c #\m)
|
|
(cons! sequence current-sequence-list)))
|
|
|
|
;; Now we can output the full sequence in one go
|
|
;; and clear the work-in-progress list
|
|
(display sequence o-port)
|
|
(set! wip-sequence-list '()))))
|
|
(else
|
|
;; Just display the text right away
|
|
(display c o-port))))
|
|
|
|
(define port
|
|
(make-soft-port
|
|
(vector
|
|
;; Char out
|
|
put-char
|
|
;; String out, go char by char
|
|
(λ (s) (string-for-each put-char s))
|
|
#f #f #f)
|
|
"w"))
|
|
|
|
(define (current-sequence)
|
|
"Returns the currently defined ansi 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)
|
|
"Reset the current ansi sequence if needed by outputting to the wrapped port."
|
|
(when (sequence?)
|
|
(display %reset-seq o-port)))
|
|
|
|
(define (restore-ansi)
|
|
"Restore the current ansi sequence by outputting to the wrapped port."
|
|
(let ((seq (current-sequence)))
|
|
(when seq
|
|
(display seq o-port))))
|
|
|
|
(values port current-sequence reset-ansi restore-ansi))
|