66 lines
1.7 KiB
Scheme
66 lines
1.7 KiB
Scheme
(define-module (reflow ports)
|
|
#:use-module (rnrs io ports)
|
|
#:export (create-reflowing-output-port))
|
|
|
|
(define %MARKER "\x1B")
|
|
|
|
(define (ansi-terminator? char)
|
|
(let ((c (char->integer char)))
|
|
(pk c)
|
|
(or (and (>= c #x40) (<= c #x5a)) (and (>= c #x61) (<= c #x7a)))))
|
|
|
|
;; TODO: create helpers that allow the reflow to operate properly.
|
|
|
|
(define (create-reflowing-output-port o-port)
|
|
;; The current ansi sequence gets constructed slowly
|
|
;; need to reset this after we write it out
|
|
(define-values (sequence-port sequence-port-get-bv)
|
|
(open-bytevector-output-port))
|
|
|
|
;; The previous ansi sequence is stored as bytevector
|
|
(define last-seq #f)
|
|
|
|
(define in-escape-sequence? #f)
|
|
(define sequence-changed? #f)
|
|
|
|
;; rune by rune
|
|
(define (put-char c)
|
|
(cond
|
|
((equal? %MARKER c)
|
|
(set! in-escape-sequence? #t)
|
|
(set! sequence-changed? #t)
|
|
(display c sequence-port))
|
|
(in-escape-sequence?
|
|
(display c sequence-port)
|
|
(when (ansi-terminator? c)
|
|
(in-escape-sequence? #f)
|
|
(let* ((bv (sequence-port-get-bv))
|
|
(str (bytevector->string bv (native-transcoder))))
|
|
|
|
(cond
|
|
((string-suffix? "[0m" str)
|
|
(set! last-seq #f)
|
|
(set! sequence-changed? #f))
|
|
((equal? c #\m)
|
|
;; color code
|
|
(set! last-seq str)))
|
|
|
|
;; need to reset the sequence port and such here
|
|
(display str o-port))))
|
|
(else
|
|
(display c o-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"))
|