9adefb5dbb
ScrollBox: - Container with vertical/horizontal scroll, viewport culling - Scroll offset (:scroll-y, :scroll-x) with clamp to valid bounds - Scrollbars rendered when content exceeds viewport - Sticky scroll (auto-scroll to bottom on content change) - Component protocol: component-children, component-layout-node TabBar: - Horizontal tab row with active/inactive styling - tab-bar-next/prev (wraps around), tab-bar-select, tab-bar-handle-key - Tab title rendering with overflow truncation (ellipsis) - Component protocol: component-layout-node 26 scrollbox+tabbar tests, 100% GREEN: 171 total (27 backend + 58 box + 60 input + 26 scrollbox) Review fixes applied: - Removed duplicate definitions (org per-function blocks are prose-only) - Fixed ASDF test path (../../tests/...) - Version bumped to 0.6.0 - Added clamp-scroll export - Added tab-bar-next/prev/select/handle-key tests - Added scroll clamp boundary tests
270 lines
11 KiB
Common Lisp
270 lines
11 KiB
Common Lisp
(defpackage :cl-tui-input-test
|
|
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input)
|
|
(:export #:run-tests))
|
|
(in-package :cl-tui-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)))
|