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%.
600 lines
22 KiB
Org Mode
600 lines
22 KiB
Org Mode
#+TITLE: cl-tty v0.7.0 — Select Dropdown + Fuzzy Filter
|
|
#+STARTUP: content
|
|
|
|
* 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.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)
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(def-suite select-suite :description "Select widget tests")
|
|
(in-suite select-suite)
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(defun run-tests ()
|
|
(let ((result (run 'select-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
*** 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~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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")))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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")))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
* 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).
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select-package.lisp
|
|
(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))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
*** defun make-select
|
|
|
|
A convenience constructor that wraps ~make-instance~ with keyword
|
|
arguments. Defaults to nil for all optional parameters, matching the
|
|
~defclass~ initforms.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(defun make-select (&key options filter on-select)
|
|
(make-instance 'select
|
|
:options (or options nil)
|
|
:filter filter
|
|
:on-select on-select))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(defmethod component-layout-node ((sel select))
|
|
(select-layout-node sel))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp
|
|
(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=)))
|
|
#+END_SRC
|
|
|
|
*** 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~).
|
|
|
|
#+BEGIN_SRC lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
*** 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\"~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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)))))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
*** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** Key event handler
|
|
|
|
*** defun 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 the widget)
|
|
|
|
Returns T if the key was handled (consumed), NIL otherwise so the
|
|
caller knows not to propagate the event further.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
|
(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)))
|
|
#+END_SRC
|