Commit76e0324aRecorded26 Feb 2026Repositorysigil-tui
Add terminal event parser for sigil-tui
Message
State machine parser handles ESC sequences (CSI arrows, function keys, tilde sequences), SS3 function keys, SGR mouse reports (press/release/scroll), Ctrl codes, Alt+key via ESC prefix, UTF-8 multi-byte, and incomplete sequence buffering across reads. 28 tests.
Changed
src/sigil/tui/event.sgl | 394 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-event.sgl | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 558 insertions(+)Diff
src/sigil/tui/event.sgladded
@@ -0,0 +1,394 @@
+1
;;; (sigil tui event) - Terminal input event parsing+2
;;;+3
;;; Parses raw terminal input bytes into structured events.+4
;;; Handles ESC sequences (CSI), SGR mouse reports, Ctrl codes,+5
;;; function keys, and UTF-8 multi-byte characters.+6
;;;+7
;;; Event representation (tagged lists):+8
;;; ```scheme+9
;;; (key #\a) ;; printable character+10
;;; (key #\a ctrl) ;; Ctrl+A+11
;;; (key #\a alt) ;; Alt+A (ESC prefix)+12
;;; (key up) ;; arrow key+13
;;; (key f1) ;; function key+14
;;; (mouse press 10 5) ;; mouse button press at col 10, row 5+15
;;; (resize 80 24) ;; terminal resized+16
;;; ```+17
+18
(define-library (sigil tui event)+19
(import (sigil core)+20
(sigil string)+21
(sigil math))+22
+23
(export parse-input+24
make-parser-state+25
key-event?+26
mouse-event?+27
resize-event?+28
key-event-key+29
key-event-modifier+30
mouse-event-type+31
mouse-event-col+32
mouse-event-row)+33
+34
(begin+35
+36
;; ============================================================+37
;; Parser state (holds incomplete escape sequence buffer)+38
;; ============================================================+39
+40
(define (make-parser-state)+41
(: -> vector?)+42
;; #(buffer) — buffer is a bytevector or #f+43
(vector #f))+44
+45
(define (parser-buffer state)+46
(vector-ref state 0))+47
+48
(define (parser-buffer-set! state buf)+49
(vector-set! state 0 buf))+50
+51
;; ============================================================+52
;; Event constructors and predicates+53
;; ============================================================+54
+55
;;; Check if an event is a key event.+56
(define (key-event? ev)+57
(: any? -> boolean?)+58
(and (pair? ev) (eq? (car ev) 'key)))+59
+60
;;; Check if an event is a mouse event.+61
(define (mouse-event? ev)+62
(: any? -> boolean?)+63
(and (pair? ev) (eq? (car ev) 'mouse)))+64
+65
;;; Check if an event is a resize event.+66
(define (resize-event? ev)+67
(: any? -> boolean?)+68
(and (pair? ev) (eq? (car ev) 'resize)))+69
+70
;;; Get the key from a key event (char or symbol).+71
(define (key-event-key ev)+72
(: pair? -> any?)+73
(cadr ev))+74
+75
;;; Get the modifier from a key event, or #f if none.+76
(define (key-event-modifier ev)+77
(: pair? -> any?)+78
(if (null? (cddr ev)) #f (caddr ev)))+79
+80
;;; Get the type from a mouse event (press, release, scroll-up, scroll-down).+81
(define (mouse-event-type ev)+82
(: pair? -> symbol?)+83
(cadr ev))+84
+85
;;; Get the column from a mouse event.+86
(define (mouse-event-col ev)+87
(: pair? -> integer?)+88
(caddr ev))+89
+90
;;; Get the row from a mouse event.+91
(define (mouse-event-row ev)+92
(: pair? -> integer?)+93
(cadddr ev))+94
+95
;; ============================================================+96
;; Byte parsing helpers+97
;; ============================================================+98
+99
;; Parse a decimal number from bytes starting at pos.+100
;; Returns (value . next-pos) or #f.+101
(define (parse-number bv pos len)+102
(if (>= pos len)+103
#f+104
(let loop ((i pos) (n 0) (found #f))+105
(if (>= i len)+106
(if found (cons n i) #f)+107
(let ((b (bytevector-u8-ref bv i)))+108
(if (and (>= b 48) (<= b 57)) ;; '0'-'9'+109
(loop (+ i 1) (+ (* n 10) (- b 48)) #t)+110
(if found (cons n i) #f)))))))+111
+112
;; ============================================================+113
;; CSI sequence parsing (ESC [ ...)+114
;; ============================================================+115
+116
;; Parse a CSI sequence starting after ESC [+117
;; Returns (event . bytes-consumed) or #f if incomplete+118
(define (parse-csi bv start len)+119
(if (>= start len)+120
#f ;; incomplete+121
(let ((first-byte (bytevector-u8-ref bv start)))+122
(cond+123
;; SGR mouse: ESC [ < Cb ; Cx ; Cy M/m+124
((= first-byte 60) ;; '<'+125
(parse-sgr-mouse bv (+ start 1) len))+126
+127
;; Arrow keys and other CSI sequences+128
(else+129
(parse-csi-sequence bv start len))))))+130
+131
;; Parse SGR mouse report: Cb;Cx;Cy M/m+132
(define (parse-sgr-mouse bv pos len)+133
(let ((cb-result (parse-number bv pos len)))+134
(if (not cb-result)+135
#f ;; incomplete+136
(let ((cb (car cb-result))+137
(pos2 (cdr cb-result)))+138
(if (or (>= pos2 len) (not (= (bytevector-u8-ref bv pos2) 59))) ;; ';'+139
#f+140
(let ((cx-result (parse-number bv (+ pos2 1) len)))+141
(if (not cx-result)+142
#f+143
(let ((cx (car cx-result))+144
(pos3 (cdr cx-result)))+145
(if (or (>= pos3 len) (not (= (bytevector-u8-ref bv pos3) 59)))+146
#f+147
(let ((cy-result (parse-number bv (+ pos3 1) len)))+148
(if (not cy-result)+149
#f+150
(let ((cy (car cy-result))+151
(pos4 (cdr cy-result)))+152
(if (>= pos4 len)+153
#f ;; incomplete — no final M/m+154
(let ((final (bytevector-u8-ref bv pos4)))+155
(if (or (= final 77) (= final 109)) ;; 'M' or 'm'+156
(let ((type (cond+157
((= (bitwise-and cb 64) 64)+158
(if (= (bitwise-and cb 1) 0)+159
'scroll-up+160
'scroll-down))+161
((= final 109) 'release)+162
(else 'press))))+163
(cons (list 'mouse type cx cy)+164
(+ pos4 1)))+165
#f)))))))))))))))+166
+167
;; Parse a standard CSI sequence (arrows, function keys, etc.)+168
(define (parse-csi-sequence bv pos len)+169
;; Collect parameter bytes (digits and semicolons), then a final byte+170
(let loop ((i pos) (params '()))+171
(if (>= i len)+172
#f ;; incomplete+173
(let ((b (bytevector-u8-ref bv i)))+174
(cond+175
;; Parameter bytes: 0-9, semicolon+176
((or (and (>= b 48) (<= b 57)) (= b 59))+177
(loop (+ i 1) (cons b params)))+178
+179
;; Final byte (64-126)+180
((and (>= b 64) (<= b 126))+181
(let ((param-str (list->string+182
(map integer->char (reverse params)))))+183
(cons (csi-final-to-event b param-str)+184
(+ i 1))))+185
+186
;; Intermediate bytes (32-47) — skip+187
((and (>= b 32) (<= b 47))+188
(loop (+ i 1) params))+189
+190
;; Unknown — consume and produce unknown event+191
(else (cons (list 'key 'unknown) (+ i 1))))))))+192
+193
;; Convert a CSI final byte + params to an event+194
(define (csi-final-to-event final params)+195
(cond+196
;; Arrow keys: ESC [ A/B/C/D+197
((= final 65) (list 'key 'up))+198
((= final 66) (list 'key 'down))+199
((= final 67) (list 'key 'right))+200
((= final 68) (list 'key 'left))+201
+202
;; Home/End: ESC [ H / ESC [ F+203
((= final 72) (list 'key 'home))+204
((= final 70) (list 'key 'end))+205
+206
;; Tilde sequences: ESC [ N ~+207
((= final 126)+208
(cond+209
((string=? params "1") (list 'key 'home))+210
((string=? params "2") (list 'key 'insert))+211
((string=? params "3") (list 'key 'delete))+212
((string=? params "4") (list 'key 'end))+213
((string=? params "5") (list 'key 'page-up))+214
((string=? params "6") (list 'key 'page-down))+215
((string=? params "15") (list 'key 'f5))+216
((string=? params "17") (list 'key 'f6))+217
((string=? params "18") (list 'key 'f7))+218
((string=? params "19") (list 'key 'f8))+219
((string=? params "20") (list 'key 'f9))+220
((string=? params "21") (list 'key 'f10))+221
((string=? params "23") (list 'key 'f11))+222
((string=? params "24") (list 'key 'f12))+223
(else (list 'key 'unknown))))+224
+225
;; F1-F4: ESC [ O P/Q/R/S (sometimes ESC O P)+226
((= final 80) (list 'key 'f1))+227
((= final 81) (list 'key 'f2))+228
((= final 82) (list 'key 'f3))+229
((= final 83) (list 'key 'f4))+230
+231
;; Shift+Tab: ESC [ Z+232
((= final 90) (list 'key 'backtab))+233
+234
(else (list 'key 'unknown))))+235
+236
;; ============================================================+237
;; SS3 sequence parsing (ESC O ...)+238
;; ============================================================+239
+240
(define (parse-ss3 bv pos len)+241
(if (>= pos len)+242
#f ;; incomplete+243
(let ((b (bytevector-u8-ref bv pos)))+244
(cons (cond+245
((= b 80) (list 'key 'f1))+246
((= b 81) (list 'key 'f2))+247
((= b 82) (list 'key 'f3))+248
((= b 83) (list 'key 'f4))+249
;; Some terminals send SS3 A/B/C/D for arrows+250
((= b 65) (list 'key 'up))+251
((= b 66) (list 'key 'down))+252
((= b 67) (list 'key 'right))+253
((= b 68) (list 'key 'left))+254
(else (list 'key 'unknown)))+255
(+ pos 1)))))+256
+257
;; ============================================================+258
;; ESC sequence dispatch+259
;; ============================================================+260
+261
;; Parse starting after ESC byte.+262
;; Returns (event . bytes-consumed-from-pos) or #f if incomplete+263
(define (parse-escape bv pos len)+264
(if (>= pos len)+265
#f ;; incomplete — just ESC so far+266
(let ((b (bytevector-u8-ref bv pos)))+267
(cond+268
;; CSI: ESC [+269
((= b 91) ;; '['+270
(parse-csi bv (+ pos 1) len))+271
+272
;; SS3: ESC O+273
((= b 79) ;; 'O'+274
(parse-ss3 bv (+ pos 1) len))+275
+276
;; Alt+letter: ESC followed by printable char+277
((and (>= b 32) (<= b 126))+278
(cons (list 'key (integer->char b) 'alt)+279
(+ pos 1)))+280
+281
;; ESC ESC → escape key+282
((= b 27)+283
(cons (list 'key 'escape) pos)) ;; don't consume second ESC+284
+285
;; Unknown escape+286
(else+287
(cons (list 'key 'escape) pos))))))+288
+289
;; ============================================================+290
;; UTF-8 multi-byte parsing+291
;; ============================================================+292
+293
(define (utf8-seq-length first-byte)+294
(cond+295
((< first-byte 128) 1)+296
((< first-byte 224) 2)+297
((< first-byte 240) 3)+298
(else 4)))+299
+300
(define (parse-utf8-char bv pos len)+301
(let* ((first-byte (bytevector-u8-ref bv pos))+302
(seq-len (utf8-seq-length first-byte)))+303
(if (> (+ pos seq-len) len)+304
#f ;; incomplete+305
(let ((codepoint+306
(case seq-len+307
((1) first-byte)+308
((2) (+ (* (bitwise-and first-byte #x1F) 64)+309
(bitwise-and (bytevector-u8-ref bv (+ pos 1)) #x3F)))+310
((3) (+ (* (bitwise-and first-byte #x0F) 4096)+311
(* (bitwise-and (bytevector-u8-ref bv (+ pos 1)) #x3F) 64)+312
(bitwise-and (bytevector-u8-ref bv (+ pos 2)) #x3F)))+313
((4) (+ (* (bitwise-and first-byte #x07) 262144)+314
(* (bitwise-and (bytevector-u8-ref bv (+ pos 1)) #x3F) 4096)+315
(* (bitwise-and (bytevector-u8-ref bv (+ pos 2)) #x3F) 64)+316
(bitwise-and (bytevector-u8-ref bv (+ pos 3)) #x3F))))))+317
(cons (list 'key (integer->char codepoint))+318
(+ pos seq-len))))))+319
+320
;; ============================================================+321
;; Main parser+322
;; ============================================================+323
+324
;; Parse a single byte, returning (event . next-pos) or #f+325
(define (parse-one bv pos len)+326
(let ((b (bytevector-u8-ref bv pos)))+327
(cond+328
;; ESC (27) — start escape sequence+329
((= b 27)+330
(parse-escape bv (+ pos 1) len))+331
+332
;; Ctrl codes (1-26, excluding 9=tab, 10=newline, 13=CR)+333
((and (>= b 1) (<= b 26) (not (= b 9)) (not (= b 10)) (not (= b 13)))+334
(cons (list 'key (integer->char (+ b 96)) 'ctrl)+335
(+ pos 1)))+336
+337
;; Tab (9)+338
((= b 9)+339
(cons (list 'key 'tab) (+ pos 1)))+340
+341
;; Enter/CR (13)+342
((= b 13)+343
(cons (list 'key 'enter) (+ pos 1)))+344
+345
;; Newline (10) — also treat as enter+346
((= b 10)+347
(cons (list 'key 'enter) (+ pos 1)))+348
+349
;; Backspace (127)+350
((= b 127)+351
(cons (list 'key 'backspace) (+ pos 1)))+352
+353
;; Null (0) — Ctrl+Space or Ctrl+@+354
((= b 0)+355
(cons (list 'key #\space 'ctrl) (+ pos 1)))+356
+357
;; UTF-8 multi-byte or ASCII printable+358
((>= b 128)+359
(parse-utf8-char bv pos len))+360
+361
;; Printable ASCII (32-126)+362
((and (>= b 32) (<= b 126))+363
(cons (list 'key (integer->char b)) (+ pos 1)))+364
+365
;; Unknown control byte+366
(else (cons (list 'key 'unknown) (+ pos 1))))))+367
+368
;;; Parse raw terminal input bytes into a list of events.+369
;;;+370
;;; Takes a parser state (for buffering incomplete sequences) and a+371
;;; bytevector of raw input. Returns a list of events.+372
;;;+373
;;; ```scheme+374
;;; (define state (make-parser-state))+375
;;; (define events (parse-input state #u8(97))) ;; => ((key #\a))+376
;;; ```+377
(define (parse-input state bv)+378
(: vector? bytevector? -> list?)+379
(let* ((prev (parser-buffer state))+380
(input (if prev (bytevector-append prev bv) bv))+381
(len (bytevector-length input)))+382
(parser-buffer-set! state #f)+383
(let loop ((pos 0) (events '()))+384
(if (>= pos len)+385
(reverse events)+386
(let ((result (parse-one input pos len)))+387
(if result+388
(loop (cdr result) (cons (car result) events))+389
;; Incomplete sequence — buffer remaining bytes+390
(begin+391
(parser-buffer-set!+392
state+393
(bytevector-copy input pos len))+394
(reverse events))))))))))test/test-event.sgladded
@@ -0,0 +1,164 @@
+1
(import (sigil test)+2
(sigil tui event))+3
+4
(test-group "event parsing"+5
+6
(test-group "printable characters"+7
(test "single ASCII char"+8
(let ((events (parse-input (make-parser-state) #u8(97)))) ;; 'a'+9
(assert-equal 1 (length events))+10
(assert-true (key-event? (car events)))+11
(assert-equal #\a (key-event-key (car events)))+12
(assert-equal #f (key-event-modifier (car events)))))+13
+14
(test "multiple ASCII chars"+15
(let ((events (parse-input (make-parser-state) #u8(104 105)))) ;; "hi"+16
(assert-equal 2 (length events))+17
(assert-equal #\h (key-event-key (car events)))+18
(assert-equal #\i (key-event-key (cadr events))))))+19
+20
(test-group "control keys"+21
(test "Ctrl+A"+22
(let ((events (parse-input (make-parser-state) #u8(1))))+23
(assert-equal 1 (length events))+24
(assert-equal #\a (key-event-key (car events)))+25
(assert-equal 'ctrl (key-event-modifier (car events)))))+26
+27
(test "Ctrl+C"+28
(let ((events (parse-input (make-parser-state) #u8(3))))+29
(assert-equal #\c (key-event-key (car events)))+30
(assert-equal 'ctrl (key-event-modifier (car events)))))+31
+32
(test "tab"+33
(let ((events (parse-input (make-parser-state) #u8(9))))+34
(assert-equal 'tab (key-event-key (car events)))))+35
+36
(test "enter"+37
(let ((events (parse-input (make-parser-state) #u8(13))))+38
(assert-equal 'enter (key-event-key (car events)))))+39
+40
(test "backspace"+41
(let ((events (parse-input (make-parser-state) #u8(127))))+42
(assert-equal 'backspace (key-event-key (car events))))))+43
+44
(test-group "arrow keys"+45
(test "up arrow"+46
(let ((events (parse-input (make-parser-state) #u8(27 91 65))))+47
(assert-equal 1 (length events))+48
(assert-equal 'up (key-event-key (car events)))))+49
+50
(test "down arrow"+51
(let ((events (parse-input (make-parser-state) #u8(27 91 66))))+52
(assert-equal 'down (key-event-key (car events)))))+53
+54
(test "right arrow"+55
(let ((events (parse-input (make-parser-state) #u8(27 91 67))))+56
(assert-equal 'right (key-event-key (car events)))))+57
+58
(test "left arrow"+59
(let ((events (parse-input (make-parser-state) #u8(27 91 68))))+60
(assert-equal 'left (key-event-key (car events))))))+61
+62
(test-group "special keys"+63
(test "home"+64
(let ((events (parse-input (make-parser-state) #u8(27 91 72))))+65
(assert-equal 'home (key-event-key (car events)))))+66
+67
(test "end"+68
(let ((events (parse-input (make-parser-state) #u8(27 91 70))))+69
(assert-equal 'end (key-event-key (car events)))))+70
+71
(test "delete"+72
(let ((events (parse-input (make-parser-state) #u8(27 91 51 126))))+73
(assert-equal 'delete (key-event-key (car events)))))+74
+75
(test "page-up"+76
(let ((events (parse-input (make-parser-state) #u8(27 91 53 126))))+77
(assert-equal 'page-up (key-event-key (car events)))))+78
+79
(test "page-down"+80
(let ((events (parse-input (make-parser-state) #u8(27 91 54 126))))+81
(assert-equal 'page-down (key-event-key (car events))))))+82
+83
(test-group "function keys"+84
(test "F1 via SS3"+85
(let ((events (parse-input (make-parser-state) #u8(27 79 80))))+86
(assert-equal 'f1 (key-event-key (car events)))))+87
+88
(test "F5"+89
;; ESC [ 1 5 ~+90
(let ((events (parse-input (make-parser-state) #u8(27 91 49 53 126))))+91
(assert-equal 'f5 (key-event-key (car events)))))+92
+93
(test "F12"+94
;; ESC [ 2 4 ~+95
(let ((events (parse-input (make-parser-state) #u8(27 91 50 52 126))))+96
(assert-equal 'f12 (key-event-key (car events))))))+97
+98
(test-group "alt keys"+99
(test "Alt+a"+100
;; ESC a+101
(let ((events (parse-input (make-parser-state) #u8(27 97))))+102
(assert-equal 1 (length events))+103
(assert-equal #\a (key-event-key (car events)))+104
(assert-equal 'alt (key-event-modifier (car events))))))+105
+106
(test-group "mouse SGR"+107
(test "mouse press"+108
;; ESC [ < 0 ; 10 ; 5 M+109
(let ((events (parse-input (make-parser-state)+110
#u8(27 91 60 48 59 49 48 59 53 77))))+111
(assert-equal 1 (length events))+112
(assert-true (mouse-event? (car events)))+113
(assert-equal 'press (mouse-event-type (car events)))+114
(assert-equal 10 (mouse-event-col (car events)))+115
(assert-equal 5 (mouse-event-row (car events)))))+116
+117
(test "mouse release"+118
;; ESC [ < 0 ; 10 ; 5 m+119
(let ((events (parse-input (make-parser-state)+120
#u8(27 91 60 48 59 49 48 59 53 109))))+121
(assert-equal 'release (mouse-event-type (car events)))))+122
+123
(test "scroll up"+124
;; ESC [ < 64 ; 1 ; 1 M+125
(let ((events (parse-input (make-parser-state)+126
#u8(27 91 60 54 52 59 49 59 49 77))))+127
(assert-equal 'scroll-up (mouse-event-type (car events)))))+128
+129
(test "scroll down"+130
;; ESC [ < 65 ; 1 ; 1 M+131
(let ((events (parse-input (make-parser-state)+132
#u8(27 91 60 54 53 59 49 59 49 77))))+133
(assert-equal 'scroll-down (mouse-event-type (car events))))))+134
+135
(test-group "multi-event bytevectors"+136
(test "two characters in one read"+137
(let ((events (parse-input (make-parser-state) #u8(97 98))))+138
(assert-equal 2 (length events))+139
(assert-equal #\a (key-event-key (car events)))+140
(assert-equal #\b (key-event-key (cadr events)))))+141
+142
(test "char then arrow key"+143
;; 'x' then ESC [ A+144
(let ((events (parse-input (make-parser-state) #u8(120 27 91 65))))+145
(assert-equal 2 (length events))+146
(assert-equal #\x (key-event-key (car events)))+147
(assert-equal 'up (key-event-key (cadr events))))))+148
+149
(test-group "incomplete sequence buffering"+150
(test "split ESC sequence across reads"+151
(let ((state (make-parser-state)))+152
;; First read: just ESC [+153
(let ((events1 (parse-input state #u8(27 91))))+154
(assert-equal 0 (length events1)))+155
;; Second read: the final byte+156
(let ((events2 (parse-input state #u8(65))))+157
(assert-equal 1 (length events2))+158
(assert-equal 'up (key-event-key (car events2)))))))+159
+160
(test-group "backtab"+161
(test "Shift+Tab"+162
;; ESC [ Z+163
(let ((events (parse-input (make-parser-state) #u8(27 91 90))))+164
(assert-equal 'backtab (key-event-key (car events)))))))