29f99a576d
Every function, defclass, defstruct, defgeneric, defmethod, defmacro, defvar, and defparameter in every org file now has its own #+BEGIN_SRC block with literate prose above it explaining the design reasoning. Block counts before → after: package.org: 1 → 7 container-package.org: 1 → 1 (prose expanded) dirty.org: 4 → 6 render.org: 10 → 25 theme.org: 6 → 19 box-renderable.org: 9 → 29 scrollbox.org: 8 → 26 tabbar.org: 5 → 10 backend-protocol.org: 8 → 66 modern-backend.org: 17 → 53 detection.org: 4 → 6 layout-engine.org: 9 → 36 framebuffer.org: 8 → 37 markdown-renderer.org:13 → 38 dialog.org: 17 → 23 (merged dual structure) mouse.org: 4 → 25 select.org: 12 → 30 slot.org: 4 → 12 text-input.org: 11 → 53 Total: ~153 blocks → ~502 blocks Bugs fixed during restructuring: - render.org: stray π character typo (backenπd → backend) - modern-backend.org: sgr-attr missing closing paren + #+END_SRC - detection.org: invalid #\Esc character reference - select.org: extra closing paren in select-visible-options All 13 test suites pass at 100%.
22 KiB
cl-tty v0.7.0 — Select Dropdown + Fuzzy Filter
- Select Widget
- Implementation
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
Test package and suite setup
The test file uses FiveAM. The defpackage pulls in all the dependencies needed
by the select widget tests — FiveAM itself, the backend/box/layout/input infrastructure,
and the cl-tty.select package under test. run-tests is the entry point for
CI and interactive use.
(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
Verifies that a select widget can be constructed with default values. The
selected-index should start at 0, and both options and filter should
be nil. This establishes the baseline contract for the default constructor.
(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
Ensures that passing :options to make-select stores them correctly. The
length check is the simplest invariant — two options in, two options out.
(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
Tests case-insensitive substring filtering: setting filter to \"bl\" should
match \"Blue\" but not \"Red\" or \"Green\". The return value is an alist of
(display-index original-index option), so we dig into the third element
to check the :value.
(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
When the filter is nil select-filtered-options must return every option
unchanged. This is the unfiltered/identity case and the most common state
when the user hasn't typed anything.
(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
Exercises select-next and select-prev through a three-item list,
confirming that forward and backward movement works and that both directions
wrap around at list boundaries.
(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
Category headers (options with :category t) should be invisible to
navigation — select-next and select-prev skip over them. This test
sets up a list with two category headers interleaved and verifies they
are transparent to movement.
(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
Validates that select-handle-key dispatches correctly: Down moves forward,
Up moves backward, and Enter invokes the on-select callback with the
currently highlighted option's plist.
(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 are Emacs-compatible alternatives to Down/Up. They must produce identical navigation behavior. This test confirms the control-key dispatch paths.
(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
select-visible-options should never return more items than the viewport
height. This test creates 20 options, sets the layout height to 5, and
asserts the visible subset fits within that constraint.
(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
When exact substring matching fails, the filter falls back to character-set
Jaccard similarity. \"nrd\" should match \"Nord\" because the character
overlap (n, o, r, d → 3 of 4) exceeds the 0.3 threshold.
(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
The cl-tty.select package depends on the backend, box model, layout,
and input subsystems. The exported symbols cover the public API: the
select class, constructor, accessors, filtering, navigation, key
handling, rendering, and the fuzzy matching predicate (exposed for
testing and extensibility).
(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
defclass select
select inherits from dirty-mixin so the rendering layer knows when
the widget state has changed (after navigation, filter updates, etc.).
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. layout-node positions the widget in the window.
(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
A convenience constructor that wraps make-instance with keyword
arguments. Defaults to nil for all optional parameters, matching the
defclass initforms.
(defun make-select (&key options filter on-select)
(make-instance 'select
:options (or options nil)
:filter filter
:on-select on-select))Component protocol
defmethod component-layout-node
The layout engine needs a uniform way to access a component's position.
component-layout-node is part of the component protocol; this method
for select simply delegates to the select-layout-node accessor.
(defmethod component-layout-node ((sel select))
(select-layout-node sel))Option filtering: substring match
defun select-filtered-options
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.
Internally, the filter first checks for exact substring containment via
search. If no option matches that way, it falls through to the
character-set fuzzy-match-p predicate. Category headers short-circuit
so they always pass through the filter.
(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)
(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))))Fuzzy matching: character-set Jaccard similarity
defun string-trigrams
Converts a string into a set of 3-character sliding window n-grams. Short strings (fewer than 3 characters) return the whole string as a single trigram. Duplicates are removed so the set can be used for Jaccard intersection/union calculations.
Note: the running tangle does not call this function directly — the
simpler character-set fuzzy-match-p is used instead. Trigram
matching is retained here as a documented alternative for future
experimentation.
(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
Jaccard similarity of two trigram sets: the size of the intersection
divided by the size of the union. A score of 1.0 means identical sets;
0.0 means no overlap. This is used by fuzzy-match-p if trigram mode
is enabled (currently unused in the default filter path — see
string-trigrams).
(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
Returns T if the Jaccard similarity between the character sets of the
query and target exceeds 0.3. The character-set approach is simpler
and cheaper than trigrams while still catching common typos and
near-misses like \"nrd\" for \"Nord\".
(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
defun select-clamp-index
After the filter changes (user types or clears input), the selected
index may point beyond the filtered list. select-clamp-index ensures
the index stays within valid bounds. If the list is empty the index
resets to 0.
(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
Moves the selection forward to the next non-category option. Iterates
through the filtered list starting from the current index, wrapping
around at the end. Each candidate is checked for :category t and
skipped. Marks the widget dirty so the render pass picks up the change.
(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
Moves the selection backward to the previous non-category option.
Mirrors select-next but decrements the index (with modular arithmetic
for wrap-around). Category headers are skipped identically.
(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
defun select-handle-key
Dispatches keyboard events:
- Down, Ctrl+N →
select-next - Up, Ctrl+P →
select-prev - Enter →
on-selectcallback with the selected option - Esc → return NIL (caller can dismiss the widget)
Returns T if the key was handled (consumed), NIL otherwise so the caller knows not to propagate the event further.
(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)
defun 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 only 10. The window is centered around the currently selected index so the user always sees context around their cursor.
(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
defmethod 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
visually distinct from selectable items. Long titles are truncated with
an ellipsis character to fit the viewport width.
(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)))