diff --git a/demo.lisp b/demo.lisp index 4b5f582..099721c 100644 --- a/demo.lisp +++ b/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)) - (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t) - ((eql key :left) - (decf (getf *app* :tab)) - (when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t) - ((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 + (incf (getf *app* :tab)) + (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t) + ;; Only arrow keys switch tabs when NOT on the Widgets tab. + ;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets + ;; for cursor navigation in text inputs. + ((and (not (= (getf *app* :tab) 1)) + (eql key :left)) + (decf (getf *app* :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)) diff --git a/src/components/input-tests.lisp b/src/components/input-tests.lisp index 1f3971f..3a82a4f 100644 --- a/src/components/input-tests.lisp +++ b/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*))) diff --git a/src/components/keybindings.lisp b/src/components/keybindings.lisp index 44e6d2f..54ef481 100644 --- a/src/components/keybindings.lisp +++ b/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 diff --git a/tests/input-tests.lisp b/tests/input-tests.lisp index 1f3971f..3a82a4f 100644 --- a/tests/input-tests.lisp +++ b/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*)))