fix: demo arrow keys on Widgets tab move cursor instead of switching tabs; +12 keybinding dispatch tests

demo.lisp

@@ -100,15 +100,20 @@
          ((or (and ctrl (eql key :|C|)) (eql key :escape))
           (setf (getf *app* :running) nil) t)
          ((eql key :tab)
-          (incf (getf *app* :tab))
+         (incf (getf *app* :tab))
-          (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
+         (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
-         ((eql key :left)
+        ;; Only arrow keys switch tabs when NOT on the Widgets tab.
-          (decf (getf *app* :tab))
+        ;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets
-          (when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
+        ;; for cursor navigation in text inputs.
-         ((eql key :right)
+        ((and (not (= (getf *app* :tab) 1))
-          (incf (getf *app* :tab))
+              (eql key :left))
-          (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
+         (decf (getf *app* :tab))
-        ;; Forward key to widgets only when on the Widgets tab
+         (when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
+        ((and (not (= (getf *app* :tab) 1))
+              (eql key :right))
+         (incf (getf *app* :tab))
+         (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
+       ;; Forward key to widgets only when on the Widgets tab
         (t (when (= (getf *app* :tab) 1)
              (handle-text-input (getf *app* :input) event)
              (handle-textarea-input (getf *app* :textarea) event))

src/components/input-tests.lisp

@@ -220,6 +220,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."
@@ -260,6 +269,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))
@@ -267,3 +348,19 @@ 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*)))

src/components/keybindings.lisp

@@ -46,6 +46,21 @@
 ;;; ---------------------------------------------------------------------------
 ;;; 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

tests/input-tests.lisp

@@ -220,6 +220,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."
@@ -260,6 +269,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))
@@ -267,3 +348,19 @@ 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*)))