amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

v1.0.0: merge select → dialog — eliminate cl-tty.select package

Browse Source 
The select widget (filtered option list) was only used by the dialog
system. Merging removes an entire package boundary, simplifies the
dependency chain, and reduces the library from 12 packages to 11.

Changes:
- absorb select class, accessors, filter, navigation, key handling,
  rendering, fuzzy matching, and all tests into dialog.org
- update cl-tty.dialog package to use cl-tty.box (for dirty-mixin)
  and cl-tty.layout (for layout-node)
- remove select.org, select-package.lisp, select.lisp, select-tests
- update ASDF, run-all-tests.lisp, scripts to drop select references
- update integration tests to use cl-tty.dialog instead of cl-tty.select

All 13 test suites pass at 100%.
This commit is contained in:
Amr Gharbeia
2026-05-18 16:12:43 -04:00
parent ff7eb4d6e1
commit 9a4d117eee
8 changed files with 386 additions and 636 deletions
Download Patch File Download Diff File Expand all files Collapse all files

367
org/dialog.org
View File

@@ -54,8 +54,9 @@ subsystems. All public symbols are exported for user convenience.
;;; dialog-package.lisp — Package definition for cl-tty.dialog
(defpackage :cl-tty.dialog
(:use :cl :cl-tty.backend :cl-tty.input :cl-tty.select)
(:use :cl :cl-tty.backend :cl-tty.input :cl-tty.box :cl-tty.layout)
(:export
;; Dialog
#:dialog
#:dialog-title
#:dialog-content
@@ -70,12 +71,24 @@ subsystems. All public symbols are exported for user convenience.
#:confirm-dialog
#:select-dialog
#:prompt-dialog
;; Toast
#:toast
#:toast-message
#:toast-variant
#:render-toast
#:dismiss-toast
#:*toasts*))
#:*toasts*
;; Select widget (merged from cl-tty.select)
#: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
* Special variables
@@ -258,6 +271,196 @@ dialog and calls ~on-submit~ with the entered value after dismissing.
(when on-submit (funcall on-submit value))))))
#+END_SRC
* Select widget (absorbed from cl-tty.select)
A selection list component — the building block for command palettes, theme
pickers, and file pickers. Options are plists with ~:title~, ~:value~, and
optional ~:category~ fields.
** Select class
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(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
** make-select
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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-layout-node
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defmethod component-layout-node ((sel select))
(select-layout-node sel))
#+END_SRC
** select-filtered-options
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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-match-p
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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
** select-clamp-index
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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
** select-next / select-prev
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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)))))
(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
** select-handle-key
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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
** select-visible-options
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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))
(half (floor (1- height) 2))
(start (max 0 (- sel-idx half)))
(end (min (length filtered) (+ start height))))
(subseq filtered start end)))
#+END_SRC
** Render method for select
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.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
* Toast system
Transient notifications that appear in the top-right corner. Each toast
@@ -331,12 +534,18 @@ interaction.
;;; dialog-tests.lisp — Tests for cl-tty.dialog
(defpackage :cl-tty-dialog-test
(:use :cl :cl-tty.dialog :fiveam))
(:use :cl :cl-tty.dialog :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.input)
(:export #:run-tests))
(in-package :cl-tty-dialog-test)
(def-suite dialog-suite :description "Dialog + Toast tests for cl-tty.dialog")
(def-suite dialog-suite :description "Dialog + Toast + Select tests")
(in-suite dialog-suite)
(defun run-tests ()
(let ((result (run 'dialog-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
#+END_SRC
** dialog-create
@@ -409,3 +618,153 @@ Verifies that ~dismiss-toast~ removes the toast from =*toasts*~.
(dismiss-toast (first *toasts*))
(is (= 0 (length *toasts*)))))
#+END_SRC
** Select tests (merged from cl-tty.select)
*** select-creates
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-with-options
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-filtered-exact
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-filtered-all
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-navigation
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-navigation-skips-categories
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-handle-key
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-handle-key-ctrl
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-visible-count
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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
*** select-fuzzy-fallback
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-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