83 lines
2.5 KiB
Scheme
83 lines
2.5 KiB
Scheme
(define-module (termenv style)
|
|
#:use-module (termenv)
|
|
#:use-module (termenv unix)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module (srfi srfi-9 gnu)
|
|
#:export (make-style
|
|
styled
|
|
foreground
|
|
background
|
|
bold
|
|
faint
|
|
italic
|
|
underline
|
|
overline
|
|
blink
|
|
reverse
|
|
cross-out
|
|
;; get-width
|
|
))
|
|
|
|
(define %RESET "0")
|
|
(define %BOLD "1")
|
|
(define %FAINT "2")
|
|
(define %ITALIC "3")
|
|
(define %UNDERLINE "4")
|
|
(define %BLINK "5")
|
|
(define %REVERSE "7")
|
|
(define %CROSS-OUT "9")
|
|
(define %OVERLINE "53")
|
|
|
|
(define-immutable-record-type <style>
|
|
(_make-style profile string sequences)
|
|
style?
|
|
(profile style-profile)
|
|
(string style-string set-style-string)
|
|
(sequences style-sequences set-style-sequences))
|
|
|
|
;; Unsure if there's a simpler way to do set-record-type-printer! semantics on just a list?
|
|
(define-immutable-record-type <stylelist>
|
|
(make-stylelist list)
|
|
stylelist?
|
|
(list stylelist-list set-stylelist-list))
|
|
|
|
(define (stylelist-styled stylelist port)
|
|
(map (cut styled <> port) (stylelist-list stylelist)))
|
|
|
|
(set-record-type-printer! <stylelist> stylelist-styled)
|
|
|
|
(define (make-style str)
|
|
(_make-style 'ansi str '()))
|
|
|
|
(define (styled style port)
|
|
(define str (style-string style))
|
|
(define (just-str) (format port "~a" str))
|
|
(cond
|
|
((eq? 'ascii (style-profile style)) (just-str))
|
|
((eq? 0 (length (style-sequences style))) (just-str))
|
|
(else
|
|
(let ((seq (string-join (style-sequences style) ";")))
|
|
(if (equal? seq "")
|
|
(just-str)
|
|
(format port "~a~am~a~a~am" %CSI seq str %CSI %RESET))))))
|
|
|
|
(set-record-type-printer! <style> styled)
|
|
|
|
(define (cons-seq stylish sequence)
|
|
(match stylish
|
|
((style) (cons-seq style sequence))
|
|
((? list? l) (make-stylelist (map (cut cons-seq <> sequence) l)))
|
|
((? style? style) (set-style-sequences style (cons* sequence (style-sequences style))))
|
|
((? stylelist? stylelist) (map (cut cons-seq <> sequence) (stylelist-list stylelist)))
|
|
((? string? str) (_make-style 'ansi str (list sequence)))))
|
|
|
|
(define (bold . s) (cons-seq s %BOLD))
|
|
(define (faint . s) (cons-seq s %FAINT))
|
|
(define (italic . s) (cons-seq s %ITALIC))
|
|
(define (underline . s) (cons-seq s %UNDERLINE))
|
|
(define (overline . s) (cons-seq s %OVERLINE))
|
|
(define (blink . s) (cons-seq s %BLINK))
|
|
(define (reverse . s) (cons-seq s %REVERSE))
|
|
(define (cross-out . s) (cons-seq s %CROSS-OUT))
|