amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: org tangle — fix END_SRC boundaries in mouse.org/slot.org (prose inside code blocks), replace emacs tangle with Python script that handles all blocks

Browse Source
This commit is contained in:
Hermes Agent
2026-05-12 15:22:29 +00:00
parent 4bb9160f8d
commit 5930e17b57
29 changed files with 2359 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files

155
org/text-input.org
View File

@@ -445,11 +445,11 @@ terminal raw mode, TextInput, Textarea, and the keybinding system.
;; Textarea
#:textarea #:make-textarea
#:textarea-value #:textarea-cursor-row #:textarea-cursor-col
#:textarea-lines
#:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
#:textarea-layout-node
#:handle-textarea-input #:render-textarea
;; Keybindings
#:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent
#:*keymaps* #:*chord-timeout*
#:defkeymap #:dispatch-key-event #:key-match-p
#:component-keymap))
@@ -656,7 +656,8 @@ debugging argument mismatches — avoid that trap.
(max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
(let ((line-len (length (nth (textarea-cursor-row ta) lines))))
(setf (textarea-cursor-col ta)
(max 0 (min (textarea-cursor-col ta) line-len))))))
(max 0 (min (textarea-cursor-col ta) line-len)))))
(mark-dirty ta))
;;; ---------------------------------------------------------------------------
;;; Utility: join strings with newline
@@ -824,11 +825,13 @@ debugging argument mismatches — avoid that trap.
(textarea-ensure-cursor ta))
(:up (textarea-move-up ta))
(:down (textarea-move-down ta))
(:home (setf (textarea-cursor-col ta) 0))
(:end (let ((lines (textarea-lines ta)))
(when (< (textarea-cursor-row ta) (length lines))
(setf (textarea-cursor-col ta)
(length (nth (textarea-cursor-row ta) lines))))))
(:home (setf (textarea-cursor-col ta) 0)
(textarea-ensure-cursor ta))
(:end (let ((lines (textarea-lines ta)))
(when (< (textarea-cursor-row ta) (length lines))
(setf (textarea-cursor-col ta)
(length (nth (textarea-cursor-row ta) lines))))
(textarea-ensure-cursor ta)))
(:enter (let ((cb (textarea-on-submit ta)))
(if cb
(funcall cb (textarea-value ta))
@@ -923,6 +926,21 @@ debugging argument mismatches — avoid that trap.
;;; ---------------------------------------------------------------------------
;;; Dispatch
;;; ---------------------------------------------------------------------------
;;; dispatch-key-event — main entry point for keymap-based dispatch.
;;;
;;; IMPORTANT: This function is NOT called by the demo's event loop
;;; or by any built-in widget event handlers. Users who want to use
;;; the keymap system MUST call dispatch-key-event explicitly in their
;;; own event loops, e.g.:
;;;
;;; (defun handle-event (event)
;;; (or (dispatch-key-event event)
;;; (handle-text-input my-input event)
;;; ...))
;;;
;;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
;;; key specs work. The *chord-timeout* and list-of-lists syntax
;;; are reserved for future implementation.
(defun dispatch-key-event (event &key component)
(labels ((try-keymap (km)
(when km
@@ -974,6 +992,8 @@ debugging argument mismatches — avoid that trap.
#:with-raw-terminal
;; Event reading
#:read-event
;; UTF-8 input support
#:utf8-decode
;; TextInput
#:text-input #:make-text-input
#:text-input-value #:text-input-cursor
@@ -983,6 +1003,7 @@ debugging argument mismatches — avoid that trap.
;; Textarea
#:textarea #:make-textarea
#:textarea-value #:textarea-cursor-row #:textarea-cursor-col
#:textarea-lines
#:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
#:textarea-layout-node
#:handle-textarea-input #:render-textarea
@@ -1034,6 +1055,28 @@ debugging argument mismatches — avoid that trap.
(is (= (mouse-event-x e) 10))
(is (= (mouse-event-y e) 5))))
;; ── UTF-8 Decode Tests ──────────────────────────────────────────
(test utf8-decode-latin1-supplement
"0xC3 0xA9 (é) decodes to code point 233."
(is (= (cl-tty.input:utf8-decode '(#xc3 #xa9)) 233)))
(test utf8-decode-euro-sign
"0xE2 0x82 0xAC (€) decodes to code point 8364."
(is (= (cl-tty.input:utf8-decode '(#xe2 #x82 #xac)) 8364)))
(test utf8-decode-emoji
"0xF0 0x9F 0x92 0xA9 (💩) decodes to code point 128169."
(is (= (cl-tty.input:utf8-decode '(#xf0 #x9f #x92 #xa9)) 128169)))
(test utf8-decode-invalid-short
"Invalid byte 0x80 alone returns nil."
(is-false (cl-tty.input:utf8-decode '(#x80))))
(test utf8-decode-invalid-overlong
"Overlong 2-byte sequence 0xC0 0x80 returns nil."
(is-false (cl-tty.input:utf8-decode '(#xc0 #x80))))
;; ── TextInput Tests ─────────────────────────────────────────────
(test text-input-empty
@@ -1218,6 +1261,15 @@ world")))
(is (string= (textarea-value a) "a"))))
;; ── Keybinding Tests ────────────────────────────────────────────
;; These tests verify the keymap dispatch system works correctly
;; when wired up. Note: dispatch-key-event is NOT called by the
;; demo's event loop — users MUST call it explicitly in their own
;; event loops if they want to use the defkeymap/dispatch-key-event
;; system. See src/components/keybindings.lisp for details.
;;
;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
;; key specs work. The *chord-timeout* variable and list-of-lists
;; syntax are reserved for future implementation.
(test keymap-simple
"A keymap dispatches to its handler on matching event."
@@ -1258,6 +1310,78 @@ world")))
(is-false (key-match-p :ctrl+p (make-key-event :key :a :ctrl t)))
(is-false (key-match-p :ctrl+p (make-key-event :key :p))))
(test key-spec-alt-modifier
"Alt modifier is matched correctly."
(is-true (key-match-p :alt+x (make-key-event :key :x :alt t)))
(is-false (key-match-p :alt+x (make-key-event :key :x)))
(is-false (key-match-p :alt+x (make-key-event :key :x :ctrl t))))
(test key-spec-shift-modifier
"Shift modifier is matched correctly."
(is-true (key-match-p :shift+tab (make-key-event :key :tab :shift t)))
(is-false (key-match-p :shift+tab (make-key-event :key :tab))))
(test key-spec-plain
"Plain key spec matches unmodified keys."
(is-true (key-match-p :enter (make-key-event :key :enter)))
(is-true (key-match-p :escape (make-key-event :key :escape)))
(is-false (key-match-p :enter (make-key-event :key :escape))))
(test key-spec-list-form
"List-form spec (:ctrl+p) matches same as keyword :ctrl+p."
(is-true (key-match-p '(:ctrl+p) (make-key-event :key :p :ctrl t)))
(is-false (key-match-p '(:ctrl+p) (make-key-event :key :a :ctrl t))))
(test dispatch-return-value-match
"dispatch-key-event returns T on matching binding."
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
(is-true (dispatch-key-event (make-key-event :key :p :ctrl t))))
(test dispatch-return-value-no-match
"dispatch-key-event returns NIL when no binding matches."
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
(is-false (dispatch-key-event (make-key-event :key :a))))
(test dispatch-empty-keymap
"dispatch-key-event returns NIL on empty keymap."
(setf (gethash :global *keymaps*) (make-keymap :name :global))
(is-false (dispatch-key-event (make-key-event :key :a))))
(test dispatch-local-overrides-global
"Local keymap takes priority over global."
(let ((local-called nil) (global-called nil))
(setf (gethash :local *keymaps*)
(make-keymap :name :local
:bindings `((:ctrl+p . ,(lambda (e)
(declare (ignore e))
(setf local-called t))))))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e)
(declare (ignore e))
(setf global-called t))))))
(is-true (dispatch-key-event (make-key-event :key :p :ctrl t)))
(is-true local-called)
(is-false global-called)))
(test dispatch-multiple-bindings
"dispatch-key-event finds the right binding among many."
(let ((called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+a . (lambda (e) (declare (ignore e))))
(:ctrl+b . (lambda (e) (declare (ignore e))))
(:ctrl+c . ,(lambda (e)
(declare (ignore e))
(setf called t)))
(:ctrl+d . (lambda (e) (declare (ignore e)))))))
(is-true (dispatch-key-event (make-key-event :key :c :ctrl t)))
(is-true called)))
(test defkeymap-macro
"defkeymap macro registers a keymap."
(let ((called nil))
@@ -1265,4 +1389,21 @@ world")))
(:ctrl+q ,(lambda (e) (declare (ignore e)) (setf called t)))))
(dispatch-key-event (make-key-event :key :q :ctrl t))
(is-true called)))
(test defkeymap-macro-with-list-spec
"defkeymap macro works with list-form specs."
(let ((called nil))
(eval `(defkeymap :global
((:ctrl+w) ,(lambda (e) (declare (ignore e)) (setf called t)))))
(dispatch-key-event (make-key-event :key :w :ctrl t))
(is-true called)))
;; cleanup after keybinding tests
(test keybinding-cleanup-global
"Clean up global keymap after testing."
(remhash :global *keymaps*)
(remhash :local *keymaps*)
(is-false (gethash :global *keymaps*))
(is-false (gethash :local *keymaps*)))
#+END_SRC