abf8e5cdeb
org/text-input.org: remove (declare (ignore w)) from textarea render; add truncation to text-input render (subseq display 0 w) org/mouse.org: hit-test now uses component-layout-node and recurses into children for deepest-match hit testing org/select.org: render reads layout-node-x/y instead of hardcoded (0,0) org/scrollbox-tabbar.org: tabbar render reads layout-node-x/y instead of hardcoded (0,0); x-pos starts at x offset All 4 org files tangled clean. 392 tests pass.
21 KiB
21 KiB
cl-tty v0.7.0 — Select Dropdown + Fuzzy Filter
Select Widget
A selection list component — the building block for command palettes, theme
pickers, agent selectors, and file pickers. Options are plists with :title,
:value, and optional :category fields.
The widget supports keyboard navigation (Up/Down, Ctrl+P/N, Enter, Esc), option filtering by case-insensitive substring match with trigram fuzzy fallback, and category grouping with dimmed headers.
Contract
select class — slots: options, filter, on-select, selected-index, layout-node.
make-select &key options filter on-select → select instance.
select-options sel / (setf select-options) — list of option plists.
select-filter sel / (setf select-filter) — filter string or nil.
select-selected-index sel / (setf select-selected-index) — currently highlighted index.
select-on-select sel / (setf select-on-select) — callback fn (receives option plist).
select-layout-node sel / (setf select-layout-node) — layout node.
select-filtered-options sel → list of options matching the filter.
Returns all options when filter is nil. Matches title (case-insensitive).
Falls back to trigram fuzzy matching when no exact substring matches.
select-next sel / select-prev sel — move selection forward/backward,
skipping category headers. Wraps around at boundaries.
select-visible-options sel → filtered options visible in viewport.
Uses available-height from layout node. Culls like ScrollBox.
select-handle-key sel event → T if handled.
Down/Ctrl+N → next. Up/Ctrl+P → prev. Enter → on-select callback. Esc → nil.
render ((sel select) backend) — renders visible options with selection highlight.
Tests
(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)))))Implementation
Package
(defpackage :cl-tty.select
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export
#:select #:make-select
#:select-options #:select-filter
#:select-selected-index #:select-on-select
#:select-layout-node
#:select-filtered-options
#:select-next #:select-prev
#:select-visible-options
#:select-handle-key
#:render
#:fuzzy-match-p))Select class
select inherits from dirty-mixin. Options are stored as a list of
plists. selected-index tracks the currently highlighted option.
filter is a string (or nil for unfiltered). on-select is a callback
receiving the selected option plist.
(in-package #:cl-tty.select)
(defclass select (dirty-mixin)
((options :initform nil :initarg :options
:accessor select-options :type list)
(filter :initform nil :initarg :filter
:accessor select-filter :type (or string null))
(selected-index :initform 0 :initarg :selected-index
:accessor select-selected-index :type fixnum)
(on-select :initform nil :initarg :on-select
:accessor select-on-select)
(layout-node :initform (make-layout-node) :initarg :layout-node
:accessor select-layout-node)))
(defun make-select (&key options filter on-select)
(make-instance 'select
:options (or options nil)
:filter filter
:on-select on-select))Component protocol
component-layout-node returns the layout node so the layout engine
can position the select widget.
(defmethod component-layout-node ((sel select))
(select-layout-node sel))Option filtering: substring match
select-filtered-options returns options whose :title contains the
filter string (case-insensitive). When filter is nil, returns all
options. Category headers are NOT filtered out — they remain in the
list so the user can see category context.
The function returns an alist of (filtered-index original-index option)
to preserve the original index for selection tracking.
(defun select-filtered-options (sel)
"Return list of options matching the current filter, in display order.
Each item: (display-index original-index option-plist)."
(let* ((filter (select-filter sel))
(all-options (select-options sel))
(filtered (if (null filter)
all-options
(let ((lower (string-downcase filter)))
(remove-if-not
(lambda (opt)
(when (getf opt :category)
(return-from select-filtered-options all-options))
(let ((title (string-downcase (getf opt :title))))
(or (search lower title)
(fuzzy-match-p lower title))))
all-options)))))
(loop for opt in filtered
for i from 0
collect (list i (position opt all-options) opt))))Fuzzy matching: trigram Jaccard similarity
trigram-score converts a string into a set of 3-character sliding
window n-grams. fuzzy-match-p returns T if the Jaccard similarity
between the query trigrams and the target trigrams exceeds 0.3.
Trigrams capture character-level similarity without requiring exact
substring matches. "nrd" matches "Nord" because both contain nor,
ord and nrd contributes nrd — the overlap is enough to exceed
the threshold.
(defun string-trigrams (str)
"Return a list of 3-character trigrams from STR."
(let ((s (string-downcase str))
(result nil))
(when (< (length s) 3)
(return-from string-trigrams (list s)))
(loop for i from 0 to (- (length s) 3)
do (push (subseq s i (+ i 3)) result))
(delete-duplicates result :test #'string=)))
(defun trigram-score (query target)
"Jaccard similarity of trigram sets: |intersection| / |union|."
(let* ((q-trigrams (string-trigrams query))
(t-trigrams (string-trigrams target))
(intersection (length (intersection q-trigrams t-trigrams :test #'string=)))
(union (length (union q-trigrams t-trigrams :test #'string=))))
(if (zerop union) 0.0 (/ (float intersection) union))))
(defun fuzzy-match-p (query target)
"T if character-set Jaccard similarity exceeds threshold (0.3)."
(let* ((q-chars (remove-duplicates (coerce (string-downcase query) 'list)))
(t-chars (remove-duplicates (coerce (string-downcase target) 'list)))
(intersection (length (intersection q-chars t-chars)))
(union (length (union q-chars t-chars))))
(if (zerop union) nil (> (/ (float intersection) union) 0.3))))Navigation
select-next and select-prev move the selection forward/backward
through the filtered options list. They skip category headers (options
with :category t). The selection wraps at list boundaries.
select-clamp-index ensures the index is valid after filtering changes.
(defun select-clamp-index (sel)
"Ensure selected-index is valid. Wraps if empty."
(let* ((filtered (select-filtered-options sel))
(count (length filtered)))
(if (zerop count)
(setf (select-selected-index sel) 0)
(setf (select-selected-index sel)
(max 0 (min (select-selected-index sel) (1- count)))))))
(defun select-next (sel)
"Move selection to next non-category option. Wraps at end."
(let* ((filtered (select-filtered-options sel))
(count (length filtered))
(current (select-selected-index sel)))
(when (plusp count)
(loop for i from 1 below count
for idx = (mod (+ current i) count)
for opt = (third (nth idx filtered))
when (not (getf opt :category))
do (setf (select-selected-index sel) idx)
(mark-dirty sel)
(return)))))
(defun select-prev (sel)
"Move selection to previous non-category option. Wraps at start."
(let* ((filtered (select-filtered-options sel))
(count (length filtered))
(current (select-selected-index sel)))
(when (plusp count)
(loop for i from 1 below count
for idx = (mod (- current i) count)
for opt = (third (nth idx filtered))
when (not (getf opt :category))
do (setf (select-selected-index sel) idx)
(mark-dirty sel)
(return)))))Key event handler
select-handle-key dispatches keyboard events:
- Down, Ctrl+N → select-next
- Up, Ctrl+P → select-prev
- Enter → on-select callback with the selected option
- Esc → return NIL (caller can dismiss)
Returns T if the key was handled, NIL otherwise.
(defun select-handle-key (sel event)
"Handle a key-event. Returns T if handled."
(let ((key (key-event-key event))
(ctrl (key-event-ctrl event)))
(cond
((or (eql key :down) (and ctrl (eql key :n)))
(select-next sel) t)
((or (eql key :up) (and ctrl (eql key :p)))
(select-prev sel) t)
((eql key :enter)
(let* ((filtered (select-filtered-options sel))
(idx (select-selected-index sel))
(item (when (< idx (length filtered))
(third (nth idx filtered)))))
(when item
(let ((cb (select-on-select sel)))
(when cb (funcall cb item))))
t))
((eql key :escape) nil)
(t nil))))Visible options (viewport culling)
select-visible-options returns only the filtered options that fit
within the widget's available height. Each option occupies 1 row.
This prevents rendering hundreds of items when the viewport shows 10.
(defun select-visible-options (sel)
"Return filtered options that fit within the viewport."
(let* ((ln (select-layout-node sel))
(height (if ln (layout-node-height ln) 80))
(filtered (select-filtered-options sel))
(sel-idx (select-selected-index sel))
;; Show items around the selection
(half (floor (1- height) 2))
(start (max 0 (- sel-idx half)))
(end (min (length filtered) (+ start height))))
(subseq filtered start end)))Rendering
render draws each visible option on its own line. The selected
option is highlighted with :accent foreground and :background-element
background. Category headers are rendered dimmed (:text-muted) and
not selectable (visually distinct).
(defmethod render ((sel select) backend)
(let* ((ln (select-layout-node sel))
(x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(visible (select-visible-options sel))
(sel-idx (select-selected-index sel)))
(dolist (item visible)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(is-category (getf option :category))
(is-selected (eql display-idx sel-idx))
(display (if (> (length title) (1- w))
(concatenate 'string (subseq title 0 (1- w)) "…")
title)))
(cond
(is-category
(draw-text backend x y display :text-muted nil))
(is-selected
(draw-rect backend x y w 1 :bg :accent)
(draw-text backend x y display :background :accent))
(t
(draw-text backend x y display nil nil)))
(incf y 1)))
(values)))Combined tangle block
(in-package #:cl-tty.select)
(defclass select (dirty-mixin)
((options :initform nil :initarg :options :accessor select-options :type list)
(filter :initform nil :initarg :filter :accessor select-filter :type (or string null))
(selected-index :initform 0 :initarg :selected-index :accessor select-selected-index :type fixnum)
(on-select :initform nil :initarg :on-select :accessor select-on-select)
(layout-node :initform (make-layout-node) :initarg :layout-node :accessor select-layout-node)))
(defun make-select (&key options filter on-select)
(make-instance 'select :options (or options nil) :filter filter :on-select on-select))
(defmethod component-layout-node ((sel select)) (select-layout-node sel))
(defun select-filtered-options (sel)
(let* ((filter (select-filter sel)) (all-options (select-options sel))
(filtered (if (null filter) all-options
(let ((lower (string-downcase filter)))
(remove-if-not
(lambda (opt)
(or (getf opt :category)
(let ((title (string-downcase (getf opt :title))))
(or (search lower title) (fuzzy-match-p lower title)))))
all-options)))))
(loop for opt in filtered for i from 0
collect (list i (position opt all-options) opt))))
(defun fuzzy-match-p (query target)
(let* ((q (remove-duplicates (coerce (string-downcase query) 'list)))
(tg (remove-duplicates (coerce (string-downcase target) 'list)))
(intersection (length (intersection q tg)))
(union (length (union q tg))))
(if (zerop union) nil (> (/ (float intersection) union) 0.3))))
(defun select-clamp-index (sel)
(let* ((filtered (select-filtered-options sel)) (count (length filtered)))
(if (zerop count) (setf (select-selected-index sel) 0)
(setf (select-selected-index sel) (max 0 (min (select-selected-index sel) (1- count)))))))
(defun select-next (sel)
(let* ((filtered (select-filtered-options sel)) (count (length filtered))
(current (select-selected-index sel)))
(when (plusp count)
(loop for i from 1 below count
for idx = (mod (+ current i) count)
for opt = (third (nth idx filtered))
when (not (getf opt :category))
do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))
(defun select-prev (sel)
(let* ((filtered (select-filtered-options sel)) (count (length filtered))
(current (select-selected-index sel)))
(when (plusp count)
(loop for i from 1 below count
for idx = (mod (- current i) count)
for opt = (third (nth idx filtered))
when (not (getf opt :category))
do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))
(defun select-handle-key (sel event)
(let ((key (key-event-key event)) (ctrl (key-event-ctrl event)))
(cond
((or (eql key :down) (and ctrl (eql key :n))) (select-next sel) t)
((or (eql key :up) (and ctrl (eql key :p))) (select-prev sel) t)
((eql key :enter)
(let* ((filtered (select-filtered-options sel)) (idx (select-selected-index sel))
(item (when (< idx (length filtered)) (third (nth idx filtered)))))
(when item (let ((cb (select-on-select sel))) (when cb (funcall cb item)))) t))
((eql key :escape) nil) (t nil))))
(defun select-visible-options (sel)
(let* ((ln (select-layout-node sel)) (height (if ln (layout-node-height ln) 80))
(filtered (select-filtered-options sel)) (sel-idx (select-selected-index sel))
(half (floor (1- height) 2)) (start (max 0 (- sel-idx half)))
(end (min (length filtered) (+ start height))))
(subseq filtered start end)))
(defmethod render ((sel select) backend)
(let* ((ln (select-layout-node sel))
(x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(visible (select-visible-options sel)) (sel-idx (select-selected-index sel)))
(dolist (item visible)
(let* ((display-idx (first item)) (option (third item))
(title (getf option :title)) (cat (getf option :category))
(selected (eql display-idx sel-idx))
(display (if (> (length title) (1- w))
(concatenate 'string (subseq title 0 (1- w)) "…") title)))
(cond (cat (draw-text backend x y display :text-muted nil))
(selected
(draw-rect backend x y w 1 :bg :accent)
(draw-text backend x y display :background :accent))
(t (draw-text backend x y display nil nil)))
(incf y 1)))
(values)))(defpackage :cl-tty.select
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export
#:select #:make-select
#:select-options #:select-filter
#:select-selected-index #:select-on-select
#:select-layout-node
#:select-filtered-options
#:select-next #:select-prev
#:select-visible-options
#:select-handle-key
#:render
#:fuzzy-match-p))