cl-tty/org/dialog.org

Dialog System + Toast (v0.9.0)

• Overview
  • Design decisions
  • Contract
• Code structure
  • Dialog class
  • Dialog sub-classes
  • Toast system
  • Tests
• Combined tangle blocks

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

Code structure

Dialog class

— per-function: dialog-class

The dialog class stores the dialog's content (a component to render inside the dialog panel), its size preset, title, and callbacks.

(defclass dialog ()
  ((title :initarg :title :accessor dialog-title)
   (size :initarg :size :initform :medium :accessor dialog-size)
   (content :initarg :content :accessor dialog-content)
   (on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))

— per-function: dialog-size-pixels

Helper to convert size keyword to pixel dimensions.

(defun dialog-size-pixels (size)
  (case size
    (:small (values 40 8))
    (:medium (values 60 16))
    (:large (values 88 24))
    (t (values 60 16))))

— per-function: render-dialog

Render a dialog: backdrop (dimmed full-screen), then centered panel.

(defun render-dialog (dialog screen w h)
  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
    (let ((x (floor (- w dw) 2))
          (y (floor (- h dh) 2)))
      ;; Backdrop — draw dim characters over full screen
      (dotimes (row h)
        (dotimes (col w)
          (backend-write screen col row " " :bg :dim)))
      ;; Panel border
      (draw-border screen x y dw dh :single :title (dialog-title dialog))
      ;; Content area (inset by 1 on each side)
      (when (dialog-content dialog)
        (render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2))))))

— per-function: push-dialog

Push a dialog onto the stack and give it focus.

(defun push-dialog (dialog)
  (push dialog *dialog-stack*)
  (when (typep (dialog-content dialog) 'focusable-mixin)
    (focus (dialog-content dialog)))
  dialog)

— per-function: pop-dialog

Pop the top dialog, fire its on-dismiss callback.

(defun pop-dialog ()
  (when *dialog-stack*
    (let ((dialog (pop *dialog-stack*)))
      (when (dialog-on-dismiss dialog)
        (funcall (dialog-on-dismiss dialog)))
      dialog)))

Dialog sub-classes

— per-function: alert-dialog

Simple alert with title, message, and OK button. The button is a Select with a single "OK" option.

(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))))

— per-function: confirm-dialog

Confirm dialog with Yes/No/Cancel buttons. Returns :yes or :no via the on-yes/on-no callbacks.

(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)))))))

— per-function: select-dialog

Modal wrapper around the Select component.

(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))))))

— per-function: prompt-dialog

Modal wrapper around TextInput.

(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))))))

Toast system

— per-function: toast

Fire-and-forget toast notification. Creates a toast component, adds it to the toast list, and schedules auto-dismissal.

(defun toast (message &key (variant :info) (duration 5000))
  (let ((toast (make-instance 'toast :message message :variant variant)))
    (push toast *toasts*)
    ;; Schedule auto-dismiss
    (when (plusp duration)
      (schedule-event (+ (get-internal-real-time)
                        (* duration 1000))
                      (lambda () (dismiss-toast toast))))
    toast))

— per-function: toast-class

(defclass toast ()
  ((message :initarg :message :accessor toast-message)
   (variant :initarg :variant :initform :info :accessor toast-variant)))

— per-function: render-toast

Render toast in top-right corner. Max 60 cols. Shows colored left border based on variant.

(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)
    (backend-write screen (1+ x) 0 text :fg :white :bold t)))

— per-function: dismiss-toast

Remove a toast from the list.

(defun dismiss-toast (toast)
  (setf *toasts* (remove toast *toasts*)))

Tests

(def-test dialog-create ()
  (let ((d (make-instance 'dialog :title "Test")))
    (is-true (typep d 'dialog))
    (is (equal "Test" (dialog-title d)))))

(def-test dialog-size-small ()
  (multiple-value-bind (w h) (dialog-size-pixels :small)
    (is (= 40 w))
    (is (= 8 h))))

(def-test dialog-size-medium ()
  (multiple-value-bind (w h) (dialog-size-pixels :medium)
    (is (= 60 w))
    (is (= 16 h))))

(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*)))))

(def-test toast-create ()
  (let ((*toasts* nil))
    (toast "Hello" :variant :info :duration 0)
    (is (= 1 (length *toasts*)))))

(def-test toast-dismiss ()
  (let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
    (dismiss-toast (first *toasts*))
    (is (= 0 (length *toasts*)))))

Combined tangle blocks

;;; dialog-package.lisp — Package definition for cl-tty.dialog

(defpackage :cl-tty.dialog
  (:use :cl :cl-tty :cl-tty.select :cl-tty.input)
  (:export
   #: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-message
   #:toast-variant
   #:render-toast
   #:dismiss-toast
   #:*toasts*
   ;; Tests
   #:dialog-create
   #:dialog-size-small
   #:dialog-size-medium
   #:dialog-push-pop
   #:toast-create
   #:toast-dismiss))

;;; dialog.lisp — Dialog System + Toast for cl-tty

(in-package :cl-tty.dialog)

;; ─── Special variables ────────────────────────────────────────────────────────

(defvar *dialog-stack* nil
  "Stack of active dialogs. (list) of dialog instances.")

(defvar *toasts* nil
  "List of active toast notifications.")

;; ─── Dialog class ─────────────────────────────────────────────────────────────

(defclass dialog ()
  ((title :initarg :title :accessor dialog-title)
   (size :initarg :size :initform :medium :accessor dialog-size)
   (content :initarg :content :accessor dialog-content)
   (on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))

(defun dialog-size-pixels (size)
  (case size
    (:small (values 40 8))
    (:medium (values 60 16))
    (:large (values 88 24))
    (t (values 60 16))))

(defun render-dialog (dialog screen w h)
  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
    (let ((x (floor (- w dw) 2))
          (y (floor (- h dh) 2)))
      (dotimes (row h)
        (dotimes (col w)
          (backend-write screen col row " " :bg :dim)))
      (draw-border screen x y dw dh :single :title (dialog-title dialog))
      (when (dialog-content dialog)
        (render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2))))))

(defun push-dialog (dialog)
  (push dialog *dialog-stack*)
  (when (typep (dialog-content dialog) 'focusable-mixin)
    (focus (dialog-content dialog)))
  dialog)

(defun pop-dialog ()
  (when *dialog-stack*
    (let ((dialog (pop *dialog-stack*)))
      (when (dialog-on-dismiss dialog)
        (funcall (dialog-on-dismiss dialog)))
      dialog)))

;; ─── Dialog sub-classes ──────────────────────────────────────────────────────

(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))))

(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)))))))

(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))))))

(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))))))

;; ─── Toast system ─────────────────────────────────────────────────────────────

(defclass toast ()
  ((message :initarg :message :accessor toast-message)
   (variant :initarg :variant :initform :info :accessor toast-variant)))

(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)
    (backend-write screen (1+ x) 0 text :fg :white :bold t)))

(defun toast (message &key (variant :info) (duration 5000))
  (let ((toast (make-instance 'toast :message message :variant variant)))
    (push toast *toasts*)
    (when (plusp duration)
      (schedule-event (+ (get-internal-real-time)
                        (* duration 1000))
                      (lambda () (dismiss-toast toast))))
    toast))

(defun dismiss-toast (toast)
  (setf *toasts* (remove toast *toasts*)))

;;; dialog-tests.lisp — Tests for cl-tty.dialog

(defpackage :cl-tty-dialog-test
  (:use :cl :cl-tty.dialog :fiveam))

(in-package :cl-tty-dialog-test)

(def-suite :dialog-suite :description "Dialog + Toast tests for cl-tty.dialog")
(in-suite :dialog-suite)

(def-test dialog-create ()
  (let ((d (make-instance 'dialog :title "Test")))
    (is-true (typep d 'dialog))
    (is (equal "Test" (dialog-title d)))))

(def-test dialog-size-small ()
  (multiple-value-bind (w h) (dialog-size-pixels :small)
    (is (= 40 w))
    (is (= 8 h))))

(def-test dialog-size-medium ()
  (multiple-value-bind (w h) (dialog-size-pixels :medium)
    (is (= 60 w))
    (is (= 16 h))))

(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*)))))

(def-test toast-create ()
  (let ((*toasts* nil))
    (toast "Hello" :variant :info :duration 0)
    (is (= 1 (length *toasts*)))))

(def-test toast-dismiss ()
  (let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
    (dismiss-toast (first *toasts*))
    (is (= 0 (length *toasts*)))))