29f99a576d
Every function, defclass, defstruct, defgeneric, defmethod, defmacro, defvar, and defparameter in every org file now has its own #+BEGIN_SRC block with literate prose above it explaining the design reasoning. Block counts before → after: package.org: 1 → 7 container-package.org: 1 → 1 (prose expanded) dirty.org: 4 → 6 render.org: 10 → 25 theme.org: 6 → 19 box-renderable.org: 9 → 29 scrollbox.org: 8 → 26 tabbar.org: 5 → 10 backend-protocol.org: 8 → 66 modern-backend.org: 17 → 53 detection.org: 4 → 6 layout-engine.org: 9 → 36 framebuffer.org: 8 → 37 markdown-renderer.org:13 → 38 dialog.org: 17 → 23 (merged dual structure) mouse.org: 4 → 25 select.org: 12 → 30 slot.org: 4 → 12 text-input.org: 11 → 53 Total: ~153 blocks → ~502 blocks Bugs fixed during restructuring: - render.org: stray π character typo (backenπd → backend) - modern-backend.org: sgr-attr missing closing paren + #+END_SRC - detection.org: invalid #\Esc character reference - select.org: extra closing paren in select-visible-options All 13 test suites pass at 100%.
64 lines
2.4 KiB
Common Lisp
64 lines
2.4 KiB
Common Lisp
(in-package #:cl-tty.input)
|
|
|
|
(defstruct keymap
|
|
(name nil :type (or keyword null))
|
|
(bindings nil :type list)
|
|
(parent nil :type (or keymap null)))
|
|
|
|
(defparameter *keymaps* (make-hash-table :test #'equal))
|
|
|
|
(defparameter *chord-timeout* 0.5)
|
|
|
|
(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)))))
|
|
|
|
(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)))))
|
|
|
|
(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))
|