Amr Gharbeia
94df17a7b9
- render-select-minibuffer: new function for bottom-anchored dialog panel (minibuffer style), accepts colors plist for theme integration - handle-text-input: guard code-char against nil key-event-code to prevent crash on CSI escape sequences (arrow keys)
824 lines
28 KiB
Org Mode
824 lines
28 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
|
|
#:render-select-minibuffer
|
|
#: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
|
|
|
|
** render-select-minibuffer
|
|
|
|
Renders a ~select~ widget as a bottom-anchored minibuffer panel at the
|
|
given position. The panel fills a rectangular area, draws a separator
|
|
line with the title at the top, the filtered options in the middle,
|
|
and a filter input line (>= ~...~) at the bottom. ~colors~ is a plist
|
|
with keys ~:bg-panel~, ~:separator~, ~:accent~, ~:text-muted~,
|
|
~:agent-fg~, ~:input-fg~, ~:bg-input~, ~:input-prompt~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
|
(defun render-select-minibuffer (be x y width height select title colors)
|
|
(let* ((filtered (select-filtered-options select))
|
|
(sel-idx (or (select-selected-index select) 0))
|
|
(filter (select-filter select))
|
|
(bg-p (getf colors :bg-panel))
|
|
(sep-c (getf colors :separator)))
|
|
(dotimes (r height)
|
|
(draw-rect be x (+ y r) width 1 :bg bg-p))
|
|
(draw-text be x y (make-string width :initial-element #\─) sep-c bg-p)
|
|
(draw-text be (1+ x) y title (getf colors :accent) bg-p)
|
|
(loop for item in filtered
|
|
for i from 1
|
|
for display-idx = (first item)
|
|
for option = (third item)
|
|
for opt-title = (getf option :title)
|
|
for cat = (getf option :category)
|
|
for sel-p = (eql display-idx sel-idx)
|
|
for row = (+ y i)
|
|
while (< row (+ y (min height (length filtered))))
|
|
do (cond
|
|
(sel-p
|
|
(draw-rect be (1+ x) row (1- width) 1
|
|
:bg (getf colors :input-fg))
|
|
(draw-text be (1+ x) row
|
|
(format nil " >> ~a" opt-title)
|
|
(getf colors :bg-input)
|
|
(getf colors :input-fg)))
|
|
(cat
|
|
(draw-text be (1+ x) row
|
|
(format nil " ~a" opt-title)
|
|
(getf colors :text-muted) bg-p))
|
|
(t
|
|
(draw-text be (1+ x) row
|
|
(format nil " ~a" opt-title)
|
|
(getf colors :agent-fg) bg-p))))
|
|
(let ((filter-y (+ y (- height 3))))
|
|
(draw-rect be x filter-y width 1 :bg bg-p)
|
|
(draw-text be x filter-y
|
|
(format nil "> ~a" (or filter ""))
|
|
(getf colors :input-prompt) bg-p))))
|
|
#+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
|