cl-tty/org/select.org

#+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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/tests/select-tests.lisp
(def-suite select-suite :description "Select widget tests")
(in-suite select-suite)
#+END_SRC

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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