Comments and docstrings
This commit is contained in:
parent
a904504a12
commit
a9ceb3d1e4
1 changed files with 20 additions and 5 deletions
|
@ -14,6 +14,7 @@
|
|||
|
||||
;; 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 '())
|
||||
|
||||
|
@ -21,7 +22,10 @@
|
|||
;; 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)
|
||||
|
@ -30,25 +34,32 @@
|
|||
;; rune by rune
|
||||
(define (put-char c)
|
||||
(cond
|
||||
;; If we see a marker, flag it and begin building the sequence list
|
||||
((equal? %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)
|
||||
;; Reset sequence, clear the saved sequence!
|
||||
(set! current-sequence-list '()))
|
||||
;; Is it a color code? Add it to the sequence!
|
||||
((equal? c #\m)
|
||||
;; color code, add the sequence
|
||||
(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
|
||||
|
@ -56,17 +67,19 @@
|
|||
(vector
|
||||
;; Char out
|
||||
(λ (c) (put-char c))
|
||||
;; String out
|
||||
;; String out, go char by char
|
||||
(λ (s) (string-for-each put-char s))
|
||||
;; Flush
|
||||
;; (question: do we want to force output work-in-progress sequences on flush? Probably not?)
|
||||
(λ () (flush-output-port o-port))
|
||||
;; Get char
|
||||
;; Get char - write-only, we ignore
|
||||
(λ () #f)
|
||||
;; Close port
|
||||
;; Close port - no work to do - we don't take ownership of the child port
|
||||
(λ () #f))
|
||||
"w"))
|
||||
|
||||
(define (current-sequence)
|
||||
"Returns the currently defined ansi sequence."
|
||||
(and
|
||||
(sequence?)
|
||||
(if (= 1 (length current-sequence-list))
|
||||
|
@ -77,10 +90,12 @@
|
|||
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))))
|
||||
|
|
Loading…
Reference in a new issue