(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)))) ;; ── 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 ──────────────────────────────────────────── (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 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)))