(defpackage :cl-tty-input-test (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input) (:export #:run-tests)) (in-package :cl-tty-input-test) (def-suite input-suite :description "Text input and keybinding tests") (in-suite input-suite) (defun run-tests () (let ((result (run 'input-suite))) (fiveam:explain! result) (uiop:quit 0))) ;; ── Key Event Tests ───────────────────────────────────────────── (test key-event-construction "A key-event can be created and queried." (let ((e (make-key-event :key :a :ctrl t :alt nil))) (is (eql (key-event-key e) :a)) (is-true (key-event-ctrl e)) (is-false (key-event-alt e)))) (test key-event-defaults "Fields default to NIL/nil." (let ((e (make-key-event :key :space))) (is (eql (key-event-key e) :space)) (is-false (key-event-ctrl e)) (is-false (key-event-alt e)) (is-false (key-event-shift e)))) (test mouse-event-construction "A mouse-event can be created and queried." (let ((e (make-mouse-event :type :press :button :left :x 10 :y 5))) (is (eql (mouse-event-type e) :press)) (is (eql (mouse-event-button e) :left)) (is (= (mouse-event-x e) 10)) (is (= (mouse-event-y e) 5)))) ;; ── UTF-8 Decode Tests ────────────────────────────────────────── (test utf8-decode-latin1-supplement "0xC3 0xA9 (é) decodes to code point 233." (is (= (cl-tty.input:utf8-decode '(#xc3 #xa9)) 233))) (test utf8-decode-euro-sign "0xE2 0x82 0xAC (€) decodes to code point 8364." (is (= (cl-tty.input:utf8-decode '(#xe2 #x82 #xac)) 8364))) (test utf8-decode-emoji "0xF0 0x9F 0x92 0xA9 (💩) decodes to code point 128169." (is (= (cl-tty.input:utf8-decode '(#xf0 #x9f #x92 #xa9)) 128169))) (test utf8-decode-invalid-short "Invalid byte 0x80 alone returns nil." (is-false (cl-tty.input:utf8-decode '(#x80)))) (test utf8-decode-invalid-overlong "Overlong 2-byte sequence 0xC0 0x80 returns nil." (is-false (cl-tty.input:utf8-decode '(#xc0 #x80)))) ;; ── TextInput Tests ───────────────────────────────────────────── (test text-input-empty "A newly created text-input has empty value and cursor at 0." (let ((in (make-text-input))) (is (string= (text-input-value in) "")) (is (= (text-input-cursor in) 0)))) (test text-input-insert-char "Inserting a character appends and moves cursor." (let ((in (make-text-input))) (handle-text-input in (make-key-event :key :a :code (char-code #\a))) (is (string= (text-input-value in) "a")) (is (= (text-input-cursor in) 1)))) (test text-input-insert-multiple "Inserting multiple characters works left to right." (let ((in (make-text-input))) (handle-text-input in (make-key-event :key :h :code (char-code #\h))) (handle-text-input in (make-key-event :key :e :code (char-code #\e))) (handle-text-input in (make-key-event :key :l :code (char-code #\l))) (handle-text-input in (make-key-event :key :l :code (char-code #\l))) (handle-text-input in (make-key-event :key :o :code (char-code #\o))) (is (string= (text-input-value in) "hello")) (is (= (text-input-cursor in) 5)))) (test text-input-backspace "Backspace removes the character before the cursor." (let ((in (make-text-input :value "ab" :cursor 2))) (handle-text-input in (make-key-event :key :backspace)) (is (string= (text-input-value in) "a")) (is (= (text-input-cursor in) 1)))) (test text-input-backspace-at-start "Backspace at position 0 does nothing." (let ((in (make-text-input :value "ab" :cursor 0))) (handle-text-input in (make-key-event :key :backspace)) (is (string= (text-input-value in) "ab")) (is (= (text-input-cursor in) 0)))) (test text-input-delete "Delete removes the character at the cursor." (let ((in (make-text-input :value "abc" :cursor 1))) (handle-text-input in (make-key-event :key :delete)) (is (string= (text-input-value in) "ac")) (is (= (text-input-cursor in) 1)))) (test text-input-cursor-left-right "Cursor moves left and right." (let ((in (make-text-input :value "ab" :cursor 2))) (handle-text-input in (make-key-event :key :left)) (is (= (text-input-cursor in) 1)) (handle-text-input in (make-key-event :key :right)) (is (= (text-input-cursor in) 2)))) (test text-input-cursor-bounds "Cursor cannot move past start or end." (let ((in (make-text-input :value "ab" :cursor 0))) (handle-text-input in (make-key-event :key :left)) (is (= (text-input-cursor in) 0)) (setf (text-input-cursor in) 2) (handle-text-input in (make-key-event :key :right)) (is (= (text-input-cursor in) 2)))) (test text-input-home-end "Home moves to start, End moves to end." (let ((in (make-text-input :value "hello" :cursor 3))) (handle-text-input in (make-key-event :key :home)) (is (= (text-input-cursor in) 0)) (handle-text-input in (make-key-event :key :end)) (is (= (text-input-cursor in) 5)))) (test text-input-max-length "Max-length prevents inserting beyond the limit." (let ((in (make-text-input :max-length 3))) (handle-text-input in (make-key-event :key :a :code (char-code #\a))) (handle-text-input in (make-key-event :key :b :code (char-code #\b))) (handle-text-input in (make-key-event :key :c :code (char-code #\c))) (handle-text-input in (make-key-event :key :d :code (char-code #\d))) (is (string= (text-input-value in) "abc")))) (test text-input-placeholder "Placeholder is stored but does not affect value." (let ((in (make-text-input :placeholder "Type here..."))) (is (string= (text-input-placeholder in) "Type here...")) (is (string= (text-input-value in) "")))) (test text-input-on-submit "On-submit callback fires on Enter." (let ((result (list nil))) (let ((in (make-text-input :value "hello" :on-submit (lambda (v) (setf (car result) v))))) (handle-text-input in (make-key-event :key :enter)) (is (string= (car result) "hello"))))) (test text-input-ctrl-a-e "Ctrl+A moves to home, Ctrl+E moves to end." (let ((in (make-text-input :value "abc" :cursor 2))) (handle-text-input in (make-key-event :key :a :ctrl t)) (is (= (text-input-cursor in) 0)) (handle-text-input in (make-key-event :key :e :ctrl t)) (is (= (text-input-cursor in) 3)))) (test text-input-insert-in-middle "Inserting in the middle of text shifts rest right." (let ((in (make-text-input :value "ab" :cursor 1))) (handle-text-input in (make-key-event :key :x :code (char-code #\x))) (is (string= (text-input-value in) "axb")) (is (= (text-input-cursor in) 2)))) (test text-input-dirty-on-insert "Inserting marks the widget dirty." (let ((in (make-text-input))) (mark-clean in) (handle-text-input in (make-key-event :key :a :code (char-code #\a))) (is-true (dirty-p in)))) ;; ── Textarea Tests ────────────────────────────────────────────── (test textarea-empty "New textarea has empty value and cursor at (0,0)." (let ((a (make-textarea))) (is (string= (textarea-value a) "")) (is (= (textarea-cursor-row a) 0)) (is (= (textarea-cursor-col a) 0)))) (test textarea-newline "Enter inserts a newline." (let ((a (make-textarea))) (handle-textarea-input a (make-key-event :key :a :code (char-code #\a))) (handle-textarea-input a (make-key-event :key :enter)) (handle-textarea-input a (make-key-event :key :b :code (char-code #\b))) (is (string= (textarea-value a) "a b")))) (test textarea-cursor-up-down "Cursor moves between lines maintaining column position." (let ((a (make-textarea :value "abc de fghi"))) (setf (textarea-cursor-row a) 1) (setf (textarea-cursor-col a) 1) (handle-textarea-input a (make-key-event :key :up)) (is (= (textarea-cursor-row a) 0)) (is (= (textarea-cursor-col a) 1)) (handle-textarea-input a (make-key-event :key :down)) (is (= (textarea-cursor-row a) 1)) (is (= (textarea-cursor-col a) 1)))) (test textarea-cursor-up-down-bounds "Cursor cannot move past first or last line." (let ((a (make-textarea :value "a b"))) (handle-textarea-input a (make-key-event :key :up)) (is (= (textarea-cursor-row a) 0)) (setf (textarea-cursor-row a) 1) (handle-textarea-input a (make-key-event :key :down)) (is (= (textarea-cursor-row a) 1)))) (test textarea-backspace-joins-lines "Backspace at start of a line joins with previous." (let ((a (make-textarea :value "hello world"))) (setf (textarea-cursor-row a) 1) (setf (textarea-cursor-col a) 0) (handle-textarea-input a (make-key-event :key :backspace)) (is (string= (textarea-value a) "helloworld")))) (test textarea-undo "Ctrl+Z undoes the last edit." (let ((a (make-textarea))) (handle-textarea-input a (make-key-event :key :a :code (char-code #\a))) (handle-textarea-input a (make-key-event :key :z :ctrl t)) (is (string= (textarea-value a) "")))) (test textarea-undo-redo "Ctrl+Y redoes an undone edit." (let ((a (make-textarea))) (handle-textarea-input a (make-key-event :key :a :code (char-code #\a))) (handle-textarea-input a (make-key-event :key :z :ctrl t)) (handle-textarea-input a (make-key-event :key :y :ctrl t)) (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." (let ((called nil)) (setf (gethash :global *keymaps*) (make-keymap :name :global :bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)) (setf called t)))))) (is-true (dispatch-key-event (make-key-event :key :p :ctrl t))) (is-true called))) (test keymap-no-match "Non-matching event returns nil." (let ((called nil)) (setf (gethash :global *keymaps*) (make-keymap :name :global :bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)) (setf called t)))))) (is-false (dispatch-key-event (make-key-event :key :a))) (is-false called))) (test keymap-fallback "Event not in local falls through to global." (let ((global-called nil)) (setf (gethash :global *keymaps*) (make-keymap :name :global :bindings `((:ctrl+q . ,(lambda (e) (declare (ignore e)) (setf global-called t)))))) (dispatch-key-event (make-key-event :key :q :ctrl t)) (is-true global-called))) (test key-spec-simple "Keyword key-spec matches key+ctrl." (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))) (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)) (eval `(defkeymap :global (: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*)))