AtlatestRepositorysigil-ansi

sigil-ansi / tree / src / sigilansi.sgl

1;;; (sigil ansi) - ANSI Terminal Escape Codes
2;;;
3;;; Colored and styled terminal output using ANSI escape codes.
4;;; All functions are prefixed with `a:` to avoid naming conflicts.
5;;;
6;;; ## Basic Usage
7;;;
8;;; ```scheme
9;;; (import (sigil ansi))
10;;;
11;;; (display (a:green "PASS"))
12;;; (display (a:bold (a:red "FAIL")))
13;;; (display (a:dim "at test.sgl:42"))
14;;; ```
15;;;
16;;; ## Composing Styles
17;;;
18;;; Styles can be nested for combined effects:
19;;;
20;;; ```scheme
21;;; (display (a:bold (a:underline (a:cyan "Important"))))
22;;; ```
23;;;
24;;; ## Cursor Control
25;;;
26;;; ```scheme
27;;; (display (a:clear-screen))
28;;; (display (a:cursor-position 10 20)) ; row 10, column 20
29;;; ```
30;;;
31;;; ## Disabling Colors
32;;;
33;;; For non-TTY output, disable ANSI codes:
34;;;
35;;; ```scheme
36;;; (with-ansi-disabled
37;;; (lambda ()
38;;; (display (a:red "This won't have color"))))
39;;; ```
41(define-library (sigil ansi)
42 (import (sigil string))
44 (export
45 ;; Colors (foreground)
46 a:black a:red a:green a:yellow a:blue a:magenta a:cyan a:white
47 a:bright-black a:bright-red a:bright-green a:bright-yellow
48 a:bright-blue a:bright-magenta a:bright-cyan a:bright-white
50 ;; Background colors
51 a:bg-black a:bg-red a:bg-green a:bg-yellow
52 a:bg-blue a:bg-magenta a:bg-cyan a:bg-white
54 ;; Styles
55 a:bold a:dim a:italic a:underline a:blink a:inverse a:hidden a:strikethrough
57 ;; Reset
58 a:reset
60 ;; Control
61 a:clear-screen a:clear-line
62 a:cursor-up a:cursor-down a:cursor-forward a:cursor-back
63 a:cursor-home a:cursor-position
64 a:hide-cursor a:show-cursor
65 a:save-cursor a:restore-cursor
67 ;; Utilities
68 strip-ansi
69 ansi-enabled?
70 with-ansi-disabled)
72 (begin
74 ;; ========== Escape Sequences ==========
76 ;; ESC character (ASCII 27) followed by '['
77 (define esc (string-append (string (integer->char 27)) "["))
79 ;; Whether ANSI codes are enabled (can be disabled for non-TTY output)
80 (define *ansi-enabled* #t)
82 ;;; Check if ANSI codes are currently enabled.
83 ;;;
84 ;;; ```scheme
85 ;;; (ansi-enabled?) ; => #t
86 ;;; ```
87 (define (ansi-enabled?)
88 (: -> boolean?)
89 *ansi-enabled*)
91 ;;; Execute a thunk with ANSI codes disabled.
92 ;;;
93 ;;; Useful when outputting to files or non-TTY streams.
94 ;;;
95 ;;; ```scheme
96 ;;; (with-ansi-disabled
97 ;;; (lambda ()
98 ;;; (a:red "text"))) ; => "text" (no escape codes)
99 ;;; ```
100 (define (with-ansi-disabled thunk)
101 (: procedure? -> any?)
102 (let ((was-enabled *ansi-enabled*))
103 (set! *ansi-enabled* #f)
104 (let ((result (thunk)))
105 (set! *ansi-enabled* was-enabled)
106 result)))
108 ;;; Wrap text with ANSI code, or return plain text if disabled
109 (define (ansi-wrap code-start code-end text)
110 (if *ansi-enabled*
111 (string-append esc code-start "m" text esc code-end "m")
112 text))
114 ;; ========== Foreground Colors ==========
116 ;;; Apply black foreground color.
117 (define (a:black text) (: string? -> string?) (ansi-wrap "30" "39" text))
119 ;;; Apply red foreground color.
120 (define (a:red text) (: string? -> string?) (ansi-wrap "31" "39" text))
122 ;;; Apply green foreground color.
123 (define (a:green text) (: string? -> string?) (ansi-wrap "32" "39" text))
125 ;;; Apply yellow foreground color.
126 (define (a:yellow text) (: string? -> string?) (ansi-wrap "33" "39" text))
128 ;;; Apply blue foreground color.
129 (define (a:blue text) (: string? -> string?) (ansi-wrap "34" "39" text))
131 ;;; Apply magenta foreground color.
132 (define (a:magenta text) (: string? -> string?) (ansi-wrap "35" "39" text))
134 ;;; Apply cyan foreground color.
135 (define (a:cyan text) (: string? -> string?) (ansi-wrap "36" "39" text))
137 ;;; Apply white foreground color.
138 (define (a:white text) (: string? -> string?) (ansi-wrap "37" "39" text))
140 ;;; Apply bright black (gray) foreground color.
141 (define (a:bright-black text) (: string? -> string?) (ansi-wrap "90" "39" text))
143 ;;; Apply bright red foreground color.
144 (define (a:bright-red text) (: string? -> string?) (ansi-wrap "91" "39" text))
146 ;;; Apply bright green foreground color.
147 (define (a:bright-green text) (: string? -> string?) (ansi-wrap "92" "39" text))
149 ;;; Apply bright yellow foreground color.
150 (define (a:bright-yellow text) (: string? -> string?) (ansi-wrap "93" "39" text))
152 ;;; Apply bright blue foreground color.
153 (define (a:bright-blue text) (: string? -> string?) (ansi-wrap "94" "39" text))
155 ;;; Apply bright magenta foreground color.
156 (define (a:bright-magenta text) (: string? -> string?) (ansi-wrap "95" "39" text))
158 ;;; Apply bright cyan foreground color.
159 (define (a:bright-cyan text) (: string? -> string?) (ansi-wrap "96" "39" text))
161 ;;; Apply bright white foreground color.
162 (define (a:bright-white text) (: string? -> string?) (ansi-wrap "97" "39" text))
164 ;; ========== Background Colors ==========
166 ;;; Apply black background color.
167 (define (a:bg-black text) (: string? -> string?) (ansi-wrap "40" "49" text))
169 ;;; Apply red background color.
170 (define (a:bg-red text) (: string? -> string?) (ansi-wrap "41" "49" text))
172 ;;; Apply green background color.
173 (define (a:bg-green text) (: string? -> string?) (ansi-wrap "42" "49" text))
175 ;;; Apply yellow background color.
176 (define (a:bg-yellow text) (: string? -> string?) (ansi-wrap "43" "49" text))
178 ;;; Apply blue background color.
179 (define (a:bg-blue text) (: string? -> string?) (ansi-wrap "44" "49" text))
181 ;;; Apply magenta background color.
182 (define (a:bg-magenta text) (: string? -> string?) (ansi-wrap "45" "49" text))
184 ;;; Apply cyan background color.
185 (define (a:bg-cyan text) (: string? -> string?) (ansi-wrap "46" "49" text))
187 ;;; Apply white background color.
188 (define (a:bg-white text) (: string? -> string?) (ansi-wrap "47" "49" text))
190 ;; ========== Text Styles ==========
192 ;;; Apply bold text style.
193 (define (a:bold text) (: string? -> string?) (ansi-wrap "1" "22" text))
195 ;;; Apply dim (faint) text style.
196 (define (a:dim text) (: string? -> string?) (ansi-wrap "2" "22" text))
198 ;;; Apply italic text style.
199 (define (a:italic text) (: string? -> string?) (ansi-wrap "3" "23" text))
201 ;;; Apply underline text style.
202 (define (a:underline text) (: string? -> string?) (ansi-wrap "4" "24" text))
204 ;;; Apply blinking text style.
205 (define (a:blink text) (: string? -> string?) (ansi-wrap "5" "25" text))
207 ;;; Apply inverse (swap foreground/background) text style.
208 (define (a:inverse text) (: string? -> string?) (ansi-wrap "7" "27" text))
210 ;;; Apply hidden text style.
211 (define (a:hidden text) (: string? -> string?) (ansi-wrap "8" "28" text))
213 ;;; Apply strikethrough text style.
214 (define (a:strikethrough text) (: string? -> string?) (ansi-wrap "9" "29" text))
216 ;;; Reset all text attributes.
217 (define (a:reset text)
218 (: string? -> string?)
219 (if *ansi-enabled*
220 (string-append esc "0m" text esc "0m")
221 text))
223 ;; ========== Cursor and Screen Control ==========
225 ;;; Clear the entire screen and move cursor to home position.
226 ;;;
227 ;;; ```scheme
228 ;;; (display (a:clear-screen))
229 ;;; ```
230 (define (a:clear-screen)
231 (: -> string?)
232 (if *ansi-enabled*
233 (string-append esc "2J" esc "H")
234 ""))
236 ;;; Clear current line
237 (define (a:clear-line)
238 (: -> string?)
239 (if *ansi-enabled*
240 (string-append esc "2K")
241 ""))
243 ;;; Move cursor up N lines
244 (define (a:cursor-up n)
245 (: integer? -> string?)
246 (if *ansi-enabled*
247 (string-append esc (number->string n) "A")
248 ""))
250 ;;; Move cursor down N lines
251 (define (a:cursor-down n)
252 (: integer? -> string?)
253 (if *ansi-enabled*
254 (string-append esc (number->string n) "B")
255 ""))
257 ;;; Move cursor forward N columns
258 (define (a:cursor-forward n)
259 (: integer? -> string?)
260 (if *ansi-enabled*
261 (string-append esc (number->string n) "C")
262 ""))
264 ;;; Move cursor back N columns
265 (define (a:cursor-back n)
266 (: integer? -> string?)
267 (if *ansi-enabled*
268 (string-append esc (number->string n) "D")
269 ""))
271 ;;; Move cursor to home position (1,1)
272 (define (a:cursor-home)
273 (: -> string?)
274 (if *ansi-enabled*
275 (string-append esc "H")
276 ""))
278 ;;; Move cursor to specific position (row, col) - 1-indexed
279 (define (a:cursor-position row col)
280 (: integer? integer? -> string?)
281 (if *ansi-enabled*
282 (string-append esc (number->string row) ";" (number->string col) "H")
283 ""))
285 ;;; Hide cursor
286 (define (a:hide-cursor)
287 (: -> string?)
288 (if *ansi-enabled*
289 (string-append esc "?25l")
290 ""))
292 ;;; Show cursor
293 (define (a:show-cursor)
294 (: -> string?)
295 (if *ansi-enabled*
296 (string-append esc "?25h")
297 ""))
299 ;;; Save cursor position
300 (define (a:save-cursor)
301 (: -> string?)
302 (if *ansi-enabled*
303 (string-append esc "s")
304 ""))
306 ;;; Restore cursor position
307 (define (a:restore-cursor)
308 (: -> string?)
309 (if *ansi-enabled*
310 (string-append esc "u")
311 ""))
313 ;; ========== Utilities ==========
315 ;;; Remove all ANSI escape codes from a string.
316 ;;;
317 ;;; Useful for computing display width or writing to files.
318 ;;;
319 ;;; ```scheme
320 ;;; (strip-ansi (a:red "hello")) ; => "hello"
321 ;;; ```
322 (define (strip-ansi text)
323 (: string? -> string?)
324 (let ((esc-char (integer->char 27)))
325 (let loop ((chars (string->list text))
326 (result '())
327 (in-escape #f))
328 (cond
329 ((null? chars)
330 (list->string (reverse result)))
331 (in-escape
332 (if (char=? (car chars) #\m)
333 (loop (cdr chars) result #f)
334 (loop (cdr chars) result #t)))
335 ((and (char=? (car chars) esc-char)
336 (not (null? (cdr chars)))
337 (char=? (car (cdr chars)) #\[))
338 (loop (cdr (cdr chars)) result #t))
339 (else
340 (loop (cdr chars) (cons (car chars) result) #f))))))))