Amr Gharbeia
9a4d117eee
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%.
771 lines
26 KiB
Org Mode
771 lines
26 KiB
Org Mode
#+TITLE: Dialog System + Toast (v0.9.0)
|
|
#+DATE: 2026-05-11
|
|
#+AUTHOR: Amr Gharbeia / Hermes
|
|
|
|
* Overview
|
|
|
|
Modal overlays (dialogs) and transient notifications (toasts).
|
|
|
|
Dialogs are absolute-positioned panels centered on a dimmed backdrop.
|
|
They stack — a new dialog goes on top, Esc dismisses the top one.
|
|
|
|
Toasts are non-blocking notifications that auto-dismiss after a
|
|
duration. They stack in the top-right corner.
|
|
|
|
** Design decisions
|
|
|
|
1. /Stack-based dialog management/: a ~*dialog-stack*~ special variable
|
|
holds the active dialogs. Render walks the stack from bottom to top,
|
|
drawing each dialog's backdrop over the previous one. This means two
|
|
dialogs visible at once — the top one gets full interaction.
|
|
|
|
2. /Backdrop is a solid dim color, not semi-transparent/: true
|
|
transparency requires compositing pixel buffers, which is expensive
|
|
in the terminal. A solid dimmed color over the full screen width
|
|
communicates "modal" without the complexity.
|
|
|
|
3. /Dialogs are components, not separate windows/: they integrate into
|
|
the existing render tree. The dialog class inherits from the component
|
|
base and participates in dirty tracking, z-order, etc.
|
|
|
|
4. /Toast is fire-and-forget/: ~(toast ...)~ creates a toast component,
|
|
adds it to a toast list, and schedules auto-dismissal. No lifecycle
|
|
management needed from the caller.
|
|
|
|
** Contract
|
|
|
|
- ~dialog~ class — overlay component with backdrop, border, title
|
|
- ~*dialog-stack*~ — list of active dialogs (bound per-screen)
|
|
- ~push-dialog dialog~ — add dialog to stack, focus its first input
|
|
- ~pop-dialog~ — dismiss top dialog, fire :on-dismiss
|
|
- ~(alert-dialog title message)~ — OK-button alert
|
|
- ~(confirm-dialog title message &key on-yes on-no)~ — Yes/No/Cancel
|
|
- ~(select-dialog title options &key on-select)~ — modal Select
|
|
- ~(prompt-dialog title &key on-submit)~ — modal TextInput
|
|
- ~toast~ component — transient notification with variant color
|
|
- ~(toast message &key variant duration)~ — fire-and-forget toast
|
|
|
|
* Package definition
|
|
|
|
The ~cl-tty.dialog~ package uses the backend, input, and select
|
|
subsystems. All public symbols are exported for user convenience.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog-package.lisp
|
|
;;; dialog-package.lisp — Package definition for cl-tty.dialog
|
|
|
|
(defpackage :cl-tty.dialog
|
|
(:use :cl :cl-tty.backend :cl-tty.input :cl-tty.box :cl-tty.layout)
|
|
(:export
|
|
;; Dialog
|
|
#:dialog
|
|
#:dialog-title
|
|
#:dialog-content
|
|
#:dialog-on-dismiss
|
|
#:dialog-size
|
|
#:dialog-size-pixels
|
|
#:render-dialog
|
|
#:push-dialog
|
|
#:pop-dialog
|
|
#:*dialog-stack*
|
|
#:alert-dialog
|
|
#:confirm-dialog
|
|
#:select-dialog
|
|
#:prompt-dialog
|
|
;; Toast
|
|
#:toast
|
|
#:toast-message
|
|
#:toast-variant
|
|
#:render-toast
|
|
#:dismiss-toast
|
|
#:*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
|
|
|
|
** *dialog-stack*
|
|
|
|
The active dialog stack. ~push-dialog~ conses onto this list;
|
|
~pop-dialog~ pops it and fires the ~:on-dismiss~ callback. Each screen
|
|
should bind its own instance so multiple screens can have independent
|
|
dialog states.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(in-package :cl-tty.dialog)
|
|
|
|
(defvar *dialog-stack* nil
|
|
"Stack of active dialogs. (list) of dialog instances.")
|
|
#+END_SRC
|
|
|
|
** *toasts*
|
|
|
|
List of active toast notifications. ~toast~ pushes, ~dismiss-toast~
|
|
removes by identity. The render loop walks this list to draw toasts in
|
|
the top-right corner.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defvar *toasts* nil
|
|
"List of active toast notifications.")
|
|
#+END_SRC
|
|
|
|
* Dialog class
|
|
|
|
The core dialog class stores a title, a size preset, the content
|
|
component to render inside the panel, and an optional ~:on-dismiss~
|
|
callback invoked when the dialog is popped.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defclass dialog ()
|
|
((title :initarg :title :accessor dialog-title)
|
|
(size :initarg :size :initform :medium :accessor dialog-size)
|
|
(content :initarg :content :initform nil :accessor dialog-content)
|
|
(on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))
|
|
#+END_SRC
|
|
|
|
** dialog-size-pixels
|
|
|
|
Converts a size keyword (~:small~, ~:medium~, ~:large~) to pixel
|
|
dimensions. Accepts optional ~max-w~ / ~max-h~ to clamp the result to
|
|
terminal bounds, preventing off-screen overflow (fixed in v1.0.0).
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun dialog-size-pixels (size &optional (max-w 80) (max-h 24))
|
|
(multiple-value-bind (dw dh)
|
|
(case size
|
|
(:small (values 40 8))
|
|
(:medium (values 60 16))
|
|
(:large (values 88 24))
|
|
(t (values 60 16)))
|
|
(values (min dw max-w) (min dh max-h))))
|
|
#+END_SRC
|
|
|
|
** render-dialog
|
|
|
|
Renders a dialog: draws a dimmed full-screen backdrop using
|
|
~draw-rect~, then draws the bordered dialog panel centered on screen.
|
|
Content is rendered via ~draw-text~ inside the panel area.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun render-dialog (dialog screen w h)
|
|
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog) w h)
|
|
(let ((x (floor (- w dw) 2))
|
|
(y (floor (- h dh) 2)))
|
|
;; Backdrop — dim the full screen
|
|
(dotimes (row h)
|
|
(draw-rect screen 0 row w 1 :bg :bright-black))
|
|
;; Dialog panel
|
|
(draw-border screen x y dw dh :style :single :title (dialog-title dialog))
|
|
(when (dialog-content dialog)
|
|
;; Content rendering delegated to component system
|
|
(draw-text screen (1+ x) (1+ y)
|
|
(format nil "~a" (dialog-content dialog))
|
|
:white :default)))))
|
|
#+END_SRC
|
|
|
|
** push-dialog
|
|
|
|
Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun push-dialog (dialog)
|
|
(push dialog *dialog-stack*)
|
|
dialog)
|
|
#+END_SRC
|
|
|
|
** pop-dialog
|
|
|
|
Pops the top dialog from the stack. If an ~:on-dismiss~ callback is
|
|
set on the dialog, it is called before returning.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun pop-dialog ()
|
|
(when *dialog-stack*
|
|
(let ((dialog (pop *dialog-stack*)))
|
|
(when (dialog-on-dismiss dialog)
|
|
(funcall (dialog-on-dismiss dialog)))
|
|
dialog)))
|
|
#+END_SRC
|
|
|
|
* Dialog convenience constructors
|
|
|
|
These factory functions create common dialog variants by composing the
|
|
~dialog~ class with interactive components (~select~, ~text-input~).
|
|
|
|
** alert-dialog
|
|
|
|
Simple alert with title, message, and an OK button. The button is a
|
|
~select~ with a single "OK" option. Dismissing fires ~pop-dialog~ on
|
|
both selection and backdrop dismiss.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun alert-dialog (title message)
|
|
(make-instance 'dialog
|
|
:title title
|
|
:size :small
|
|
:content (make-instance 'select
|
|
:options (list (list :title "OK" :value :ok))
|
|
:on-select (lambda (opt) (declare (ignore opt)) (pop-dialog)))
|
|
:on-dismiss (lambda () (pop-dialog))))
|
|
#+END_SRC
|
|
|
|
** confirm-dialog
|
|
|
|
Confirm dialog with Yes/No buttons. Returns ~:yes~ or ~:no~ via the
|
|
~on-yes~/~on-no~ callbacks. The dialog auto-dismisses on selection.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun confirm-dialog (title message &key on-yes on-no)
|
|
(make-instance 'dialog
|
|
:title title
|
|
:size :small
|
|
:content (make-instance 'select
|
|
:options (list (list :title "Yes" :value :yes)
|
|
(list :title "No" :value :no))
|
|
:on-select (lambda (opt)
|
|
(pop-dialog)
|
|
(if (eql opt :yes)
|
|
(when on-yes (funcall on-yes))
|
|
(when on-no (funcall on-no)))))))
|
|
#+END_SRC
|
|
|
|
** select-dialog
|
|
|
|
Modal wrapper around the ~select~ component. Presents a list of options
|
|
and calls ~on-select~ with the chosen value after dismissing.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun select-dialog (title options &key on-select)
|
|
(make-instance 'dialog
|
|
:title title
|
|
:size :medium
|
|
:content (make-instance 'select
|
|
:options options
|
|
:on-select (lambda (opt)
|
|
(pop-dialog)
|
|
(when on-select (funcall on-select opt))))))
|
|
#+END_SRC
|
|
|
|
** prompt-dialog
|
|
|
|
Modal wrapper around ~text-input~. Shows a text input field inside the
|
|
dialog and calls ~on-submit~ with the entered value after dismissing.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun prompt-dialog (title &key on-submit)
|
|
(make-instance 'dialog
|
|
:title title
|
|
:size :small
|
|
:content (make-instance 'text-input
|
|
:on-submit (lambda (value)
|
|
(pop-dialog)
|
|
(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
|
|
has a message and a variant that determines its color (~:info~,
|
|
~:success~, ~:warning~, ~:error~).
|
|
|
|
** toast class
|
|
|
|
Lightweight class storing the message text and variant keyword.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defclass toast ()
|
|
((message :initarg :message :accessor toast-message)
|
|
(variant :initarg :variant :initform :info :accessor toast-variant)))
|
|
#+END_SRC
|
|
|
|
** render-toast
|
|
|
|
Draws a toast in the top-right corner of the screen. The message is
|
|
truncated to 60 columns with an ellipsis if necessary. The background
|
|
color reflects the variant.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun render-toast (toast screen w)
|
|
(let* ((msg (toast-message toast))
|
|
(variant (toast-variant toast))
|
|
(color (case variant
|
|
(:info :blue) (:success :green)
|
|
(:warning :yellow) (:error :red)))
|
|
(max-w (min 60 (1- w)))
|
|
(x (- w max-w 1))
|
|
(text (if (> (length msg) (- max-w 2))
|
|
(concatenate 'string (subseq msg 0 (- max-w 5)) "...")
|
|
msg)))
|
|
(draw-rect screen x 0 max-w 1 :bg color)
|
|
(draw-text screen (1+ x) 0 text :white color :bold t)))
|
|
#+END_SRC
|
|
|
|
** toast (function)
|
|
|
|
Fire-and-forget toast notification. Creates a ~toast~ instance, pushes
|
|
it onto =*toasts*~, and optionally schedules auto-dismissal via
|
|
~dismiss-toast~ when ~duration~ is positive.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun toast (message &key (variant :info) (duration 0))
|
|
(let ((toast (make-instance 'toast :message message :variant variant)))
|
|
(push toast *toasts*)
|
|
(when (plusp duration) (dismiss-toast toast))
|
|
toast))
|
|
#+END_SRC
|
|
|
|
** dismiss-toast
|
|
|
|
Removes a toast from =*toasts*~ by identity (~remove~ with default
|
|
~:test #'eql~ compares by pointer for CLOS objects).
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun dismiss-toast (toast)
|
|
(setf *toasts* (remove toast *toasts*)))
|
|
#+END_SRC
|
|
|
|
* Tests
|
|
|
|
Test suite using FiveAM. Each test exercises one function or
|
|
interaction.
|
|
|
|
** Test package and suite
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
;;; dialog-tests.lisp — Tests for cl-tty.dialog
|
|
|
|
(defpackage :cl-tty-dialog-test
|
|
(: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 + Select tests")
|
|
(in-suite dialog-suite)
|
|
|
|
(defun run-tests ()
|
|
(let ((result (run 'dialog-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
#+END_SRC
|
|
|
|
** dialog-create
|
|
|
|
Basic dialog instantiation — verifies ~make-instance~ and accessors.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
(def-test dialog-create ()
|
|
(let ((d (make-instance 'dialog :title "Test")))
|
|
(is-true (typep d 'dialog))
|
|
(is (equal "Test" (dialog-title d)))))
|
|
#+END_SRC
|
|
|
|
** dialog-size-small
|
|
|
|
~dialog-size-pixels~ returns the correct dimensions for ~:small~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
(def-test dialog-size-small ()
|
|
(multiple-value-bind (w h) (dialog-size-pixels :small)
|
|
(is (= 40 w))
|
|
(is (= 8 h))))
|
|
#+END_SRC
|
|
|
|
** dialog-size-medium
|
|
|
|
~dialog-size-pixels~ returns the correct dimensions for ~:medium~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
(def-test dialog-size-medium ()
|
|
(multiple-value-bind (w h) (dialog-size-pixels :medium)
|
|
(is (= 60 w))
|
|
(is (= 16 h))))
|
|
#+END_SRC
|
|
|
|
** dialog-push-pop
|
|
|
|
Verifies stack operations: push adds to =*dialog-stack*~, pop removes
|
|
the top element.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
(def-test dialog-push-pop ()
|
|
(let ((*dialog-stack* nil))
|
|
(push-dialog (make-instance 'dialog :title "D1"))
|
|
(is (= 1 (length *dialog-stack*)))
|
|
(push-dialog (make-instance 'dialog :title "D2"))
|
|
(is (= 2 (length *dialog-stack*)))
|
|
(pop-dialog)
|
|
(is (= 1 (length *dialog-stack*)))))
|
|
#+END_SRC
|
|
|
|
** toast-create
|
|
|
|
Verifies that ~toast~ pushes onto =*toasts*~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
(def-test toast-create ()
|
|
(let ((*toasts* nil))
|
|
(toast "Hello" :variant :info :duration 0)
|
|
(is (= 1 (length *toasts*)))))
|
|
#+END_SRC
|
|
|
|
** toast-dismiss
|
|
|
|
Verifies that ~dismiss-toast~ removes the toast from =*toasts*~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
|
(def-test toast-dismiss ()
|
|
(let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
|
|
(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
|