121 lines
4.6 KiB
Common Lisp
121 lines
4.6 KiB
Common Lisp
(defpackage :cl-tty-select-test
|
|
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.select)
|
|
(:export #:run-tests))
|
|
(in-package #:cl-tty-select-test)
|
|
|
|
(def-suite select-suite :description "Select widget tests")
|
|
(in-suite select-suite)
|
|
|
|
(defun run-tests ()
|
|
(let ((result (run 'select-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
|
|
(test select-creates
|
|
"A Select can be created with defaults."
|
|
(let ((sel (make-select)))
|
|
(is (typep sel 'select))
|
|
(is-false (select-options sel))
|
|
(is-false (select-filter sel))
|
|
(is (= (select-selected-index sel) 0))))
|
|
|
|
(test select-with-options
|
|
"A Select stores options."
|
|
(let ((sel (make-select :options '((:title "Red" :value :red)
|
|
(:title "Blue" :value :blue)))))
|
|
(is (= (length (select-options sel)) 2))))
|
|
|
|
(test select-filtered-exact
|
|
"Filter returns case-insensitive substring matches."
|
|
(let ((sel (make-select
|
|
:options '((:title "Red" :value :red)
|
|
(:title "Green" :value :green)
|
|
(:title "Blue" :value :blue)))))
|
|
(setf (select-filter sel) "bl")
|
|
(let ((filtered (select-filtered-options sel)))
|
|
(is (= (length filtered) 1))
|
|
(is (eql (getf (third (first filtered)) :value) :blue)))))
|
|
|
|
(test select-filtered-all
|
|
"Nil filter returns all options."
|
|
(let ((sel (make-select
|
|
:options '((:title "Red" :value :red)
|
|
(:title "Blue" :value :blue)))))
|
|
(let ((filtered (select-filtered-options sel)))
|
|
(is (= (length filtered) 2)))))
|
|
|
|
(test select-navigation
|
|
"Select-next and select-prev navigate through options."
|
|
(let ((sel (make-select
|
|
:options '((:title "A" :value :a)
|
|
(:title "B" :value :b)
|
|
(:title "C" :value :c)))))
|
|
(is (= (select-selected-index sel) 0))
|
|
(select-next sel)
|
|
(is (= (select-selected-index sel) 1))
|
|
(select-next sel)
|
|
(is (= (select-selected-index sel) 2))
|
|
(select-next sel)
|
|
(is (= (select-selected-index sel) 0) "wraps forward")
|
|
(select-prev sel)
|
|
(is (= (select-selected-index sel) 2) "wraps backward")))
|
|
|
|
(test select-navigation-skips-categories
|
|
"Navigation skips category header options."
|
|
(let ((sel (make-select
|
|
:options '((:title "Colors" :category t)
|
|
(:title "Red" :value :red)
|
|
(:title "Green" :value :green)
|
|
(:title "Shapes" :category t)
|
|
(:title "Circle" :value :circle)))))
|
|
(is (= (select-selected-index sel) 0))
|
|
(select-next sel)
|
|
(is (= (select-selected-index sel) 1) "skipped category header at 0")
|
|
(select-next sel)
|
|
(is (= (select-selected-index sel) 2))
|
|
(select-next sel)
|
|
(is (= (select-selected-index sel) 4) "skipped category header at 3")))
|
|
|
|
(test select-handle-key
|
|
"Select handle-key dispatches navigation and selection."
|
|
(let* ((result (list nil))
|
|
(sel (make-select
|
|
:options '((:title "A" :value :a) (:title "B" :value :b))
|
|
:on-select (lambda (opt) (setf (car result) (getf opt :value))))))
|
|
(select-handle-key sel (make-key-event :key :down))
|
|
(is (= (select-selected-index sel) 1))
|
|
(select-handle-key sel (make-key-event :key :up))
|
|
(is (= (select-selected-index sel) 0))
|
|
(select-handle-key sel (make-key-event :key :enter))
|
|
(is (eql (car result) :a))))
|
|
|
|
(test select-handle-key-ctrl
|
|
"Ctrl+N and Ctrl+P navigate like down/up."
|
|
(let ((sel (make-select
|
|
:options '((:title "A" :value :a) (:title "B" :value :b) (:title "C" :value :c)))))
|
|
(select-handle-key sel (make-key-event :key :n :ctrl t))
|
|
(is (= (select-selected-index sel) 1))
|
|
(select-handle-key sel (make-key-event :key :p :ctrl t))
|
|
(is (= (select-selected-index sel) 0))))
|
|
|
|
(test select-visible-count
|
|
"Visible options respects viewport height."
|
|
(let* ((ln (make-layout-node))
|
|
(sel (make-select
|
|
:options (loop for i below 20 collect (list :title (format nil "Item ~D" i) :value i)))))
|
|
(setf (select-layout-node sel) ln)
|
|
(setf (layout-node-height ln) 5)
|
|
(let ((visible (select-visible-options sel)))
|
|
(is (<= (length visible) 5)))))
|
|
|
|
(test select-fuzzy-fallback
|
|
"Fuzzy filter catches near-misses."
|
|
(let ((sel (make-select
|
|
:options '((:title "Nord" :value :nord)
|
|
(:title "Tokyo Night" :value :tokyo)
|
|
(:title "Catppuccin" :value :cat)))))
|
|
(setf (select-filter sel) "nrd")
|
|
(let ((filtered (select-filtered-options sel)))
|
|
(is (= (length filtered) 1))
|
|
(is (eql (getf (third (first filtered)) :value) :nord)))))
|