amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

v0.8.0: guard key dispatch with (when (characterp ch) ...) to prevent ctrl-byte keywords matching defkeymap keymaps

Browse Source 
Maps known navigation keywords (:up :down :left :right :enter :backspace :tab
:escape :home :end :ppage :npage) explicitly in the case to bypass the guard,
so only non-keyword, non-navigation values are filtered. This prevents :CTRL-A
(byte 1/SOH) from ever reaching on-key or dispatch-key-event and resetting
cursor-pos to 0 via the :ctrl+a keymap binding.
This commit is contained in:
Amr Gharbeia
2026-05-18 14:54:21 -04:00
parent a65374e120
commit 8c29c228cd
1 changed files with 37 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
org/channel-tui-main.org
View File

@@ -948,7 +948,10 @@ Returns T on success, nil on failure. Does NOT wait or retry."
(:hidden :auto))) (:hidden :auto)))
(setf (st :dirty) (list t t t))) (setf (st :dirty) (list t t t)))
(:CTRL-L (setf (st :dirty) (list t t t))) (:CTRL-L (setf (st :dirty) (list t t t)))
(t (if cl-tty.dialog:*dialog-stack* ;; v0.8.0: dispatch known navigation keywords
((:up :down :left :right :enter :backspace :tab :escape
:home :end :ppage :npage)
(if cl-tty.dialog:*dialog-stack*
(let* ((dlg (car cl-tty.dialog:*dialog-stack*)) (let* ((dlg (car cl-tty.dialog:*dialog-stack*))
(sel (cl-tty.dialog:dialog-content dlg))) (sel (cl-tty.dialog:dialog-content dlg)))
(cond (cond
@@ -959,7 +962,7 @@ Returns T on success, nil on failure. Does NOT wait or retry."
(if (eql ch :up) (if (eql ch :up)
(cl-tty.select:select-prev sel) (cl-tty.select:select-prev sel)
(cl-tty.select:select-next sel))) (cl-tty.select:select-next sel)))
((member ch '(:enter 13 10)) ((member ch '(:enter))
(let* ((filtered (cl-tty.select:select-filtered-options sel)) (let* ((filtered (cl-tty.select:select-filtered-options sel))
(idx (cl-tty.select:select-selected-index sel)) (idx (cl-tty.select:select-selected-index sel))
(item (when (< idx (length filtered)) (item (when (< idx (length filtered))
@@ -967,20 +970,25 @@ Returns T on success, nil on failure. Does NOT wait or retry."
(when item (when item
(let ((cb (cl-tty.select:select-on-select sel))) (let ((cb (cl-tty.select:select-on-select sel)))
(when cb (funcall cb item)))))) (when cb (funcall cb item))))))
((let ((chr (if (characterp ch) ch ((member ch '(:backspace))
(and (integerp ch) (<= 32 ch 126)
(code-char ch)))))
(and chr (graphic-char-p chr))
(setf (cl-tty.select:select-filter sel)
(concatenate 'string
(or (cl-tty.select:select-filter sel) "")
(string chr)))))
((member ch '(:backspace 127 8))
(let ((f (cl-tty.select:select-filter sel))) (let ((f (cl-tty.select:select-filter sel)))
(when (> (length f) 0) (when (> (length f) 0)
(setf (cl-tty.select:select-filter sel) (setf (cl-tty.select:select-filter sel)
(subseq f 0 (1- f)))))))) (subseq f 0 (1- f))))))
(on-key ch)))))))) (t nil)))
(on-key ch)))
;; v0.8.0: only printable characters reach on-key; prevents
;; ctrl-byte keywords (e.g. :CTRL-A) from matching keymaps
(t (when (characterp ch)
(if cl-tty.dialog:*dialog-stack*
(let* ((dlg (car cl-tty.dialog:*dialog-stack*))
(sel (cl-tty.dialog:dialog-content dlg)))
(when (graphic-char-p ch)
(setf (cl-tty.select:select-filter sel)
(concatenate 'string
(or (cl-tty.select:select-filter sel) "")
(string ch)))))
(on-key ch :code (char-code ch))))))))))
;; Keyboard reader via read-raw-byte (proven CSI detection) ;; Keyboard reader via read-raw-byte (proven CSI detection)
(handler-case (handler-case
(let* ((b (cl-tty.input::read-raw-byte :timeout 0.1)) (let* ((b (cl-tty.input::read-raw-byte :timeout 0.1))