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

fix: tangle.py write-once-then-append logic (was always-appending, triplicating files); confirm-dialog option plist comparison; mouse-event button type (or keyword null)

Browse Source
This commit is contained in:
Hermes Agent
2026-05-12 15:51:44 +00:00
parent a812955329
commit 5f07c1fd76
24 changed files with 9 additions and 4094 deletions
Download Patch File Download Diff File Expand all files Collapse all files

186
src/components/keybindings.lisp
View File

@@ -90,189 +90,3 @@
;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
(:method ((c t)) nil))
(in-package #:cl-tty.input)
;;; ---------------------------------------------------------------------------
;;; Key map struct
;;; ---------------------------------------------------------------------------
(defstruct keymap
(name nil :type (or keyword null))
(bindings nil :type list)
(parent nil :type (or keymap null)))
;;; ---------------------------------------------------------------------------
;;; Global keymap registry
;;; ---------------------------------------------------------------------------
(defparameter *keymaps* (make-hash-table :test #'equal))
(defparameter *chord-timeout* 0.5)
;;; ---------------------------------------------------------------------------
;;; Key spec matching
;;; ---------------------------------------------------------------------------
(defun key-match-p (spec event)
"T if SPEC matches EVENT. Spec is :ctrl+p (modifier+key keyword)
or (:ctrl+p) for single-spec in a list, or (:ctrl+x :ctrl+s) for chords."
(etypecase spec
;; Keyword like :ctrl+p, :alt+f, :enter, :space, :f1
(keyword
(let* ((name (string spec))
(plus (position #\+ name)))
(if plus
;; Modified key: :ctrl+p → mod-str="CTRL", key-str="P"
(let ((mod-str (subseq name 0 plus))
(key-str (subseq name (1+ plus))))
(and (eql (intern key-str :keyword)
(key-event-key event))
(cond
((string= mod-str "CTRL") (key-event-ctrl event))
((string= mod-str "ALT") (key-event-alt event))
((string= mod-str "SHIFT") (key-event-shift event))
(t t))))
;; Plain keyword: :enter, :escape, :f1, etc.
(eql spec (key-event-key event)))))
;; List: (:ctrl+p) or (:ctrl+x :ctrl+s)
(list
(when spec
(key-match-p (first spec) event)))))
;;; ---------------------------------------------------------------------------
;;; 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
(loop for (spec . handler) in (keymap-bindings km)
thereis (when (key-match-p spec event)
(funcall handler event)
t))))
(find-keymap (name)
(gethash name *keymaps*)))
(or (and component
(let ((km (component-keymap component)))
(when km (try-keymap km))))
(try-keymap (find-keymap :local))
(try-keymap (find-keymap :global)))))
;;; ---------------------------------------------------------------------------
;;; defkeymap macro
;;; ---------------------------------------------------------------------------
(defmacro defkeymap (name &body bindings)
`(setf (gethash ',name *keymaps*)
(make-keymap :name ',name
:bindings (list ,@(loop for b in bindings
collect (if (consp (cdr b))
`(cons ',(car b) ,(cadr b))
`(cons ',(car b) ,(cdr b))))))))
;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
(:method ((c t)) nil))
(in-package #:cl-tty.input)
;;; ---------------------------------------------------------------------------
;;; Key map struct
;;; ---------------------------------------------------------------------------
(defstruct keymap
(name nil :type (or keyword null))
(bindings nil :type list)
(parent nil :type (or keymap null)))
;;; ---------------------------------------------------------------------------
;;; Global keymap registry
;;; ---------------------------------------------------------------------------
(defparameter *keymaps* (make-hash-table :test #'equal))
(defparameter *chord-timeout* 0.5)
;;; ---------------------------------------------------------------------------
;;; Key spec matching
;;; ---------------------------------------------------------------------------
(defun key-match-p (spec event)
"T if SPEC matches EVENT. Spec is :ctrl+p (modifier+key keyword)
or (:ctrl+p) for single-spec in a list, or (:ctrl+x :ctrl+s) for chords."
(etypecase spec
;; Keyword like :ctrl+p, :alt+f, :enter, :space, :f1
(keyword
(let* ((name (string spec))
(plus (position #\+ name)))
(if plus
;; Modified key: :ctrl+p → mod-str="CTRL", key-str="P"
(let ((mod-str (subseq name 0 plus))
(key-str (subseq name (1+ plus))))
(and (eql (intern key-str :keyword)
(key-event-key event))
(cond
((string= mod-str "CTRL") (key-event-ctrl event))
((string= mod-str "ALT") (key-event-alt event))
((string= mod-str "SHIFT") (key-event-shift event))
(t t))))
;; Plain keyword: :enter, :escape, :f1, etc.
(eql spec (key-event-key event)))))
;; List: (:ctrl+p) or (:ctrl+x :ctrl+s)
(list
(when spec
(key-match-p (first spec) event)))))
;;; ---------------------------------------------------------------------------
;;; 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
(loop for (spec . handler) in (keymap-bindings km)
thereis (when (key-match-p spec event)
(funcall handler event)
t))))
(find-keymap (name)
(gethash name *keymaps*)))
(or (and component
(let ((km (component-keymap component)))
(when km (try-keymap km))))
(try-keymap (find-keymap :local))
(try-keymap (find-keymap :global)))))
;;; ---------------------------------------------------------------------------
;;; defkeymap macro
;;; ---------------------------------------------------------------------------
(defmacro defkeymap (name &body bindings)
`(setf (gethash ',name *keymaps*)
(make-keymap :name ',name
:bindings (list ,@(loop for b in bindings
collect (if (consp (cdr b))
`(cons ',(car b) ,(cadr b))
`(cons ',(car b) ,(cdr b))))))))
;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
(:method ((c t)) nil))