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

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

@@ -938,28 +938,31 @@ Returns T on success, nil on failure. Does NOT wait or retry."
((eq (getf ev :type) :key)
(let* ((payload (getf ev :payload))
(ch (getf payload :ch)))
(case ch
(:CTRL-Q (setf (st :running) nil))
(:CTRL-P (unified-menu-show))
(:CTRL-B (setf (st :sidebar-mode)
(case (st :sidebar-mode)
(:auto :visible)
(:visible :hidden)
(:hidden :auto)))
(setf (st :dirty) (list t t t)))
(:CTRL-L (setf (st :dirty) (list t t t)))
(t (if cl-tty.dialog:*dialog-stack*
(let* ((dlg (car cl-tty.dialog:*dialog-stack*))
(sel (cl-tty.dialog:dialog-content dlg)))
(cond
((eql ch :escape)
(cl-tty.dialog:pop-dialog)
(setf (st :dirty) (list t t nil)))
(case ch
(:CTRL-Q (setf (st :running) nil))
(:CTRL-P (unified-menu-show))
(:CTRL-B (setf (st :sidebar-mode)
(case (st :sidebar-mode)
(:auto :visible)
(:visible :hidden)
(:hidden :auto)))
(setf (st :dirty) (list t t t)))
(:CTRL-L (setf (st :dirty) (list t t t)))
;; 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*))
(sel (cl-tty.dialog:dialog-content dlg)))
(cond
((eql ch :escape)
(cl-tty.dialog:pop-dialog)
(setf (st :dirty) (list t t nil)))
((member ch '(:up :down))
(if (eql ch :up)
(cl-tty.select:select-prev sel)
(cl-tty.select:select-next sel)))
((member ch '(:enter 13 10))
((member ch '(:enter))
(let* ((filtered (cl-tty.select:select-filtered-options sel))
(idx (cl-tty.select:select-selected-index sel))
(item (when (< idx (length filtered))
@@ -967,20 +970,25 @@ Returns T on success, nil on failure. Does NOT wait or retry."
(when item
(let ((cb (cl-tty.select:select-on-select sel)))
(when cb (funcall cb item))))))
((let ((chr (if (characterp ch) ch
(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))
((member ch '(:backspace))
(let ((f (cl-tty.select:select-filter sel)))
(when (> (length f) 0)
(setf (cl-tty.select:select-filter sel)
(subseq f 0 (1- f))))))))
(on-key ch))))))))
(subseq f 0 (1- f))))))
(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)
(handler-case
(let* ((b (cl-tty.input::read-raw-byte :timeout 0.1))