v0.15.0: Critical input/rendering fixes, subagent-reviewed #7

Merged
amr merged 36 commits from feature/v0.11.0-slots into main 2026-05-11 22:03:18 -04:00
51 changed files with 930 additions and 229 deletions
Showing only changes of commit 811d51a4f2 - Show all commits

View File

@@ -1,8 +1,8 @@
#+TITLE: cl-tui — Reusable Common Lisp Terminal UI Framework #+TITLE: cl-tty — Reusable Common Lisp Terminal UI Framework
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :project:cl-tui:readme: #+FILETAGS: :project:cl-tty:readme:
* cl-tui * cl-tty
A reusable Common Lisp framework for building rich terminal user interfaces. A reusable Common Lisp framework for building rich terminal user interfaces.
Built on croatoan (ncurses) with Yoga for Flexbox layout. Provides a component Built on croatoan (ncurses) with Yoga for Flexbox layout. Provides a component
@@ -15,24 +15,24 @@ quality of Claude Code and OpenCode from Common Lisp.
Common Lisp has no reusable terminal UI framework at the level of Python's Common Lisp has no reusable terminal UI framework at the level of Python's
Rich/prompt_toolkit or Go's Bubble Tea. Every CL project that wants a Rich/prompt_toolkit or Go's Bubble Tea. Every CL project that wants a
terminal UI either builds ncurses from scratch or uses a text-only REPL. terminal UI either builds ncurses from scratch or uses a text-only REPL.
cl-tui fills that gap — a component library with Flexbox layout, semantic cl-tty fills that gap — a component library with Flexbox layout, semantic
theming, layered keybinding, and full mouse support. Build a terminal UI once, theming, layered keybinding, and full mouse support. Build a terminal UI once,
reuse it everywhere. reuse it everywhere.
Terminal UIs also work over SSH. A Qt or browser-based UI requires a local Terminal UIs also work over SSH. A Qt or browser-based UI requires a local
display. A cl-tui application runs remotely — same code, same components, display. A cl-tty application runs remotely — same code, same components,
accessible from anywhere. accessible from anywhere.
** Architecture ** Architecture
``` ```
Application code (any CL project) Application code (any CL project)
└── cl-tui (layout, components, theme, events, dialogs) └── cl-tty (layout, components, theme, events, dialogs)
└── Yoga (Flexbox layout — C library via FFI) └── Yoga (Flexbox layout — C library via FFI)
└── croatoan (ncurses terminal rendering) └── croatoan (ncurses terminal rendering)
``` ```
cl-tui depends only on croatoan and Yoga. It is not tied to any application. cl-tty depends only on croatoan and Yoga. It is not tied to any application.
** Dependencies ** Dependencies

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.backend) (in-package :cl-tty.backend)
(defclass backend () ()) (defclass backend () ())

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-modern-backend-test (defpackage :cl-tty-modern-backend-test
(:use :cl :fiveam :cl-tui.backend) (:use :cl :fiveam :cl-tty.backend)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-modern-backend-test) (in-package :cl-tty-modern-backend-test)
(def-suite modern-backend-suite :description "Modern backend tests") (def-suite modern-backend-suite :description "Modern backend tests")
(in-suite modern-backend-suite) (in-suite modern-backend-suite)
@@ -16,72 +16,72 @@
(test make-modern-backend-creates (test make-modern-backend-creates
"make-modern-backend returns a modern-backend instance" "make-modern-backend returns a modern-backend instance"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (typep b 'cl-tui.backend::modern-backend)))) (is (typep b 'cl-tty.backend::modern-backend))))
;; ── Escape Generation ────────────────────────────────────────── ;; ── Escape Generation ──────────────────────────────────────────
(test sgr-truecolor-foreground (test sgr-truecolor-foreground
"SGR truecolor foreground escape is correct" "SGR truecolor foreground escape is correct"
(is (equal (cl-tui.backend::sgr-fg "#FFD700") (is (equal (cl-tty.backend::sgr-fg "#FFD700")
(format nil "~C[38;2;255;215;0m" #\Esc)))) (format nil "~C[38;2;255;215;0m" #\Esc))))
(test sgr-truecolor-background (test sgr-truecolor-background
"SGR truecolor background escape is correct" "SGR truecolor background escape is correct"
(is (equal (cl-tui.backend::sgr-bg "#1a1b26") (is (equal (cl-tty.backend::sgr-bg "#1a1b26")
(format nil "~C[48;2;26;27;38m" #\Esc)))) (format nil "~C[48;2;26;27;38m" #\Esc))))
(test sgr-named-colors (test sgr-named-colors
"SGR named colors resolve to 8-color codes" "SGR named colors resolve to 8-color codes"
(is (equal (cl-tui.backend::sgr-fg :red) (is (equal (cl-tty.backend::sgr-fg :red)
(format nil "~C[31m" #\Esc))) (format nil "~C[31m" #\Esc)))
(is (equal (cl-tui.backend::sgr-bg :blue) (is (equal (cl-tty.backend::sgr-bg :blue)
(format nil "~C[44m" #\Esc)))) (format nil "~C[44m" #\Esc))))
(test sgr-bold-italic (test sgr-bold-italic
"SGR attribute escapes are correct" "SGR attribute escapes are correct"
(is (equal (cl-tui.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc))) (is (equal (cl-tty.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
(is (equal (cl-tui.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc))) (is (equal (cl-tty.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc)))
(is (equal (cl-tui.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc))) (is (equal (cl-tty.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc)))
(is (equal (cl-tui.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc)))) (is (equal (cl-tty.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc))))
;; ── Cursor ───────────────────────────────────────────────────── ;; ── Cursor ─────────────────────────────────────────────────────
(test cursor-move-escape (test cursor-move-escape
"cursor-move generates correct CSI escape" "cursor-move generates correct CSI escape"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-move-escape 5 10) (is (equal (cl-tty.backend::cursor-move-escape 5 10)
(format nil "~C[11;6H" #\Esc))))) (format nil "~C[11;6H" #\Esc)))))
(test cursor-style-block (test cursor-style-block
"cursor-style :block generate correct escape" "cursor-style :block generate correct escape"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-style-escape :block nil) (is (equal (cl-tty.backend::cursor-style-escape :block nil)
(format nil "~C[2 q" #\Esc))))) (format nil "~C[2 q" #\Esc)))))
(test cursor-style-bar (test cursor-style-bar
"cursor-style :bar generate correct escape" "cursor-style :bar generate correct escape"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-style-escape :bar nil) (is (equal (cl-tty.backend::cursor-style-escape :bar nil)
(format nil "~C[6 q" #\Esc))))) (format nil "~C[6 q" #\Esc)))))
(test cursor-style-underline-blink (test cursor-style-underline-blink
"cursor-style :underline with blink" "cursor-style :underline with blink"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-style-escape :underline t) (is (equal (cl-tty.backend::cursor-style-escape :underline t)
(format nil "~C[5 q" #\Esc))))) (format nil "~C[5 q" #\Esc)))))
;; ── Synchronization ──────────────────────────────────────────── ;; ── Synchronization ────────────────────────────────────────────
(test decicm-escapes (test decicm-escapes
"DECICM synchronized update escapes" "DECICM synchronized update escapes"
(is (equal (cl-tui.backend::decicm-begin) (format nil "~C[?2026h" #\Esc))) (is (equal (cl-tty.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
(is (equal (cl-tui.backend::decicm-end) (format nil "~C[?2026l" #\Esc)))) (is (equal (cl-tty.backend::decicm-end) (format nil "~C[?2026l" #\Esc))))
;; ── OSC 8 Hyperlinks ────────────────────────────────────────── ;; ── OSC 8 Hyperlinks ──────────────────────────────────────────
(test osc8-escape (test osc8-escape
"OSC 8 hyperlink escape wraps text" "OSC 8 hyperlink escape wraps text"
(is (equal (cl-tui.backend::osc8-link "http://example.com" "click here") (is (equal (cl-tty.backend::osc8-link "http://example.com" "click here")
(format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\" (format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\"
#\Esc #\Esc #\Esc #\Esc)))) #\Esc #\Esc #\Esc #\Esc))))
@@ -89,21 +89,21 @@
(test hex-color-parsing (test hex-color-parsing
"hex-to-rgb parses valid hex colors" "hex-to-rgb parses valid hex colors"
(multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#FFD700") (multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#FFD700")
(is (= r 255)) (is (= r 255))
(is (= g 215)) (is (= g 215))
(is (= b 0)))) (is (= b 0))))
(test hex-color-black (test hex-color-black
"hex-to-rgb parses black" "hex-to-rgb parses black"
(multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#000000") (multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#000000")
(is (= r 0)) (is (= r 0))
(is (= g 0)) (is (= g 0))
(is (= b 0)))) (is (= b 0))))
(test hex-color-short-form (test hex-color-short-form
"hex-to-rgb parses 3-digit hex" "hex-to-rgb parses 3-digit hex"
(multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#F00") (multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#F00")
(is (= r 255)) (is (= r 255))
(is (= g 0)) (is (= g 0))
(is (= b 0)))) (is (= b 0))))
@@ -112,13 +112,13 @@
(test border-char-rounded (test border-char-rounded
"modern-border-char returns Unicode box-drawing for rounded style" "modern-border-char returns Unicode box-drawing for rounded style"
(is (equal (cl-tui.backend::border-char :rounded :top-left) "╭")) (is (equal (cl-tty.backend::border-char :rounded :top-left) "╭"))
(is (equal (cl-tui.backend::border-char :rounded :horizontal) "─")) (is (equal (cl-tty.backend::border-char :rounded :horizontal) "─"))
(is (equal (cl-tui.backend::border-char :rounded :vertical) "│")) (is (equal (cl-tty.backend::border-char :rounded :vertical) "│"))
(is (equal (cl-tui.backend::border-char :rounded :bottom-right) "╯"))) (is (equal (cl-tty.backend::border-char :rounded :bottom-right) "╯")))
(test border-char-double (test border-char-double
"modern-border-char returns double-line chars" "modern-border-char returns double-line chars"
(is (equal (cl-tui.backend::border-char :double :top-left) "╔")) (is (equal (cl-tty.backend::border-char :double :top-left) "╔"))
(is (equal (cl-tui.backend::border-char :double :horizontal) "═")) (is (equal (cl-tty.backend::border-char :double :horizontal) "═"))
(is (equal (cl-tui.backend::border-char :double :vertical) "║"))) (is (equal (cl-tty.backend::border-char :double :vertical) "║")))

View File

@@ -8,7 +8,7 @@
;; sgr-fg sgr-bg sgr-attr cursor-move-escape cursor-style-escape ;; sgr-fg sgr-bg sgr-attr cursor-move-escape cursor-style-escape
;; decicm-begin decicm-end osc8-link hex-to-rgb border-char ;; decicm-begin decicm-end osc8-link hex-to-rgb border-char
(in-package :cl-tui.backend) (in-package :cl-tty.backend)
(defun hex-to-rgb (hex) (defun hex-to-rgb (hex)
"Parse a hex color string like \"#FFD700\" into (values r g b). "Parse a hex color string like \"#FFD700\" into (values r g b).

View File

@@ -1,4 +1,4 @@
(defpackage :cl-tui.backend (defpackage :cl-tty.backend
(:use :cl) (:use :cl)
(:export (:export
;; Backend classes ;; Backend classes
@@ -26,4 +26,4 @@
#:cursor-move-escape #:cursor-style-escape #:cursor-move-escape #:cursor-style-escape
#:decicm-begin #:decicm-end #:osc8-link #:decicm-begin #:decicm-end #:osc8-link
#:hex-to-rgb #:border-char)) #:hex-to-rgb #:border-char))
(in-package :cl-tui.backend) (in-package :cl-tty.backend)

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.backend) (in-package :cl-tty.backend)
(defclass simple-backend (backend) (defclass simple-backend (backend)
((output-stream :initform *standard-output* ((output-stream :initform *standard-output*

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-backend-test (defpackage :cl-tty-backend-test
(:use :cl :fiveam :cl-tui.backend) (:use :cl :fiveam :cl-tty.backend)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-backend-test) (in-package :cl-tty-backend-test)
(def-suite backend-suite :description "Backend protocol tests") (def-suite backend-suite :description "Backend protocol tests")
(in-suite backend-suite) (in-suite backend-suite)

View File

@@ -1,8 +1,8 @@
;;; cl-tui.asd — Common Lisp Terminal UI Framework ;;; cl-tty.asd — Common Lisp Terminal UI Framework
(asdf:defsystem :cl-tui (asdf:defsystem :cl-tty
:description "Reusable Common Lisp Terminal UI Framework" :description "Reusable Common Lisp Terminal UI Framework"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.8.0" :version "0.9.0"
:license "TBD" :license "TBD"
:depends-on (:fiveam :sb-posix) :depends-on (:fiveam :sb-posix)
:components :components
@@ -38,12 +38,15 @@
(:file "select" :depends-on ("select-package" "dirty" "box")) (:file "select" :depends-on ("select-package" "dirty" "box"))
;; Markdown + Code + Diff rendering (v0.8.0) ;; Markdown + Code + Diff rendering (v0.8.0)
(:file "markdown-package" :depends-on ("package")) (:file "markdown-package" :depends-on ("package"))
(:file "markdown" :depends-on ("markdown-package")))) (:file "markdown" :depends-on ("markdown-package"))
:in-order-to ((test-op (test-op :cl-tui-tests)))) ;; Dialog + Toast (v0.9.0)
(:file "dialog-package" :depends-on ("package" "select-package" "input-package"))
(:file "dialog" :depends-on ("dialog-package" "dirty" "select" "text-input")))))
:in-order-to ((test-op (test-op :cl-tty-tests))))
(asdf:defsystem :cl-tui-tests (asdf:defsystem :cl-tty-tests
:description "Test suite for cl-tui" :description "Test suite for cl-tty"
:depends-on (:cl-tui :fiveam) :depends-on (:cl-tty :fiveam)
:components :components
((:module "backend" ((:module "backend"
:components :components
@@ -60,16 +63,20 @@
(:file "input-tests") (:file "input-tests")
(:file "scrollbox-tabbar-tests" :pathname "../../tests/scrollbox-tabbar-tests.lisp") (:file "scrollbox-tabbar-tests" :pathname "../../tests/scrollbox-tabbar-tests.lisp")
(:file "select-tests" :pathname "../../tests/select-tests.lisp") (:file "select-tests" :pathname "../../tests/select-tests.lisp")
(:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp")))) (:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp")
(:file "dialog-tests" :pathname "../../tests/dialog-tests.lisp"))))
:perform (test-op (o c) :perform (test-op (o c)
(dolist (suite '((:cl-tui-backend-test "BACKEND-SUITE") (let ((run (find-symbol "RUN" :fiveam))
(:cl-tui-box-test "BOX-SUITE") (explain (find-symbol "EXPLAIN!" :fiveam)))
(:cl-tui-input-test "INPUT-SUITE") (dolist (suite '((:cl-tty-backend-test "BACKEND-SUITE")
(:cl-tui-scrollbox-test "SCROLLBOX-SUITE") (:cl-tty-box-test "BOX-SUITE")
(:cl-tui-select-test "SELECT-SUITE") (:cl-tty-input-test "INPUT-SUITE")
(:cl-tui-markdown-test "MARKDOWN-SUITE"))) (:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
(let* ((pkg (find-package (first suite))) (:cl-tty-select-test "SELECT-SUITE")
(s (and pkg (find-symbol (second suite) pkg)))) (:cl-tty-markdown-test "MARKDOWN-SUITE")
(when s (:cl-tty-dialog-test "DIALOG-SUITE")))
(fiveam:explain! (fiveam:run s))))) (let* ((pkg (find-package (first suite)))
(uiop:quit 0))) (s (and pkg (find-symbol (second suite) pkg))))
(when s
(funcall explain (funcall run s))))))
(uiop:quit 0)))

View File

@@ -1,4 +1,4 @@
;; demo.lisp — minimal cl-tui demo ;; demo.lisp — minimal cl-tty demo
(load "/root/quicklisp/setup.lisp") (load "/root/quicklisp/setup.lisp")
(ql:quickload :fiveam :silent t) (ql:quickload :fiveam :silent t)
(load "backend/package.lisp") (load "backend/package.lisp")
@@ -11,7 +11,7 @@
(load "src/components/box.lisp") (load "src/components/box.lisp")
(load "src/components/text.lisp") (load "src/components/text.lisp")
(load "src/components/render.lisp") (load "src/components/render.lisp")
(in-package :cl-tui.box) (in-package :cl-tty.box)
;; Demo 1: Simple backend (ASCII) ;; Demo 1: Simple backend (ASCII)
(let* ((b (make-simple-backend)) (let* ((b (make-simple-backend))
@@ -21,7 +21,7 @@
;; Demo 2: Box with text inside ;; Demo 2: Box with text inside
(let* ((b (make-simple-backend)) (let* ((b (make-simple-backend))
(tx (make-text "This is cl-tui in action!" :width 28 :height 1))) (tx (make-text "This is cl-tty in action!" :width 28 :height 1)))
(setf (layout-node-direction (text-layout-node tx)) :column) (setf (layout-node-direction (text-layout-node tx)) :column)
(compute-layout (text-layout-node tx) 28 1) (compute-layout (text-layout-node tx) 28 1)
(render tx b) (render tx b)

View File

@@ -1,10 +1,10 @@
#+TITLE: cl-tui Architecture #+TITLE: cl-tty Architecture
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :project:cl-tui:architecture: #+FILETAGS: :project:cl-tty:architecture:
* Architecture * Architecture
cl-tui is a layered framework. Each layer has a single responsibility cl-tty is a layered framework. Each layer has a single responsibility
and communicates with adjacent layers through a well-defined protocol. and communicates with adjacent layers through a well-defined protocol.
** Layer Diagram ** Layer Diagram
@@ -264,9 +264,9 @@ reads terminal background color at startup.
** File Structure ** File Structure
#+BEGIN_SRC #+BEGIN_SRC
cl-tui/ cl-tty/
├── cl-tui.asd ├── cl-tty.asd
├── cl-tui-tests.asd ├── cl-tty-tests.asd
├── README.org ├── README.org
├── LICENSE ├── LICENSE
├── docs/ ├── docs/

View File

@@ -1,6 +1,6 @@
#+TITLE: cl-tui Roadmap #+TITLE: cl-tty Roadmap
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :docs:roadmap:cl-tui: #+FILETAGS: :docs:roadmap:cl-tty:
* The Roadmap * The Roadmap
@@ -87,7 +87,7 @@ the patch version (v0.X.Y).
When a version ships: When a version ships:
1. ~ROADMAP.org~ — mark item DONE, update LOGBOOK timestamp 1. ~ROADMAP.org~ — mark item DONE, update LOGBOOK timestamp
2. ~README.org~ — update Status line 2. ~README.org~ — update Status line
3. ~cl-tui.asd~ — update version string 3. ~cl-tty.asd~ — update version string
** v0.1.0: Layout Engine ** v0.1.0: Layout Engine
@@ -295,7 +295,7 @@ never hex values.
8 presets: default (gold), professional, minimal, nord, tokyonight, catppuccin, monokai, gruvbox 8 presets: default (gold), professional, minimal, nord, tokyonight, catppuccin, monokai, gruvbox
- Each preset is a plist: ~(:primary "#FFD700" :error "#BF616A" ...)~ - Each preset is a plist: ~(:primary "#FFD700" :error "#BF616A" ...)~
- ~(theme-load :nord)~ — activates a preset, re-renders dirty - ~(theme-load :nord)~ — activates a preset, re-renders dirty
- Load from ~/.config/cl-tui/themes/<name>.lisp~ for custom themes - Load from ~/.config/cl-tty/themes/<name>.lisp~ for custom themes
- ~80 lines - ~80 lines
*** TODO Dark/light variants *** TODO Dark/light variants

View File

@@ -1,6 +1,6 @@
;;; layout — Pure CL Flexbox layout engine ;;; layout — Pure CL Flexbox layout engine
(defpackage :cl-tui.layout (defpackage :cl-tty.layout
(:use :cl) (:use :cl)
(:export (:export
#:layout-node #:make-layout-node #:layout-node #:make-layout-node
@@ -16,7 +16,7 @@
#:layout-node-fixed-height #:normalize-box #:layout-node-fixed-height #:normalize-box
#:box-edge)) #:box-edge))
(in-package :cl-tui.layout) (in-package :cl-tty.layout)
(defun normalize-box (spec) (defun normalize-box (spec)
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0)) (cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0))

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-layout-test (defpackage :cl-tty-layout-test
(:use :cl :fiveam :cl-tui.layout) (:use :cl :fiveam :cl-tty.layout)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-layout-test) (in-package :cl-tty-layout-test)
(def-suite layout-suite :description "Layout engine tests") (def-suite layout-suite :description "Layout engine tests")
(in-suite layout-suite) (in-suite layout-suite)

View File

@@ -1,6 +1,6 @@
#+TITLE: cl-tui Backend Protocol — v0.0.1 #+TITLE: cl-tty Backend Protocol — v0.0.1
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tui:backend:v0.0.1: #+FILETAGS: :cl-tty:backend:v0.0.1:
#+OPTIONS: ^:nil #+OPTIONS: ^:nil
* Backend Protocol * Backend Protocol
@@ -119,10 +119,10 @@ Borders:
** Test Suite ** Test Suite
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui-backend-test (defpackage :cl-tty-backend-test
(:use :cl :fiveam) (:use :cl :fiveam)
(:export #:run!)) (:export #:run!))
(in-package :cl-tui-backend-test) (in-package :cl-tty-backend-test)
(def-suite backend-suite :description "Backend protocol tests") (def-suite backend-suite :description "Backend protocol tests")
(in-suite backend-suite) (in-suite backend-suite)
@@ -224,7 +224,7 @@ Borders:
*** Package *** Package
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui.backend (defpackage :cl-tty.backend
(:use :cl) (:use :cl)
(:export (:export
;; Backend classes ;; Backend classes
@@ -245,7 +245,7 @@ Borders:
#:capable-p #:capable-p
;; Constructors ;; Constructors
#:make-simple-backend)) #:make-simple-backend))
(in-package :cl-tui.backend) (in-package :cl-tty.backend)
#+END_SRC #+END_SRC
*** Backend Base Class *** Backend Base Class

View File

@@ -1,6 +1,6 @@
#+TITLE: cl-tui Box Renderable — v0.2.0 #+TITLE: cl-tty Box Renderable — v0.2.0
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tui:components:v0.2.0: #+FILETAGS: :cl-tty:components:v0.2.0:
#+OPTIONS: ^:nil #+OPTIONS: ^:nil
* Box Renderable * Box Renderable
@@ -27,10 +27,10 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
** Tests ** Tests
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui-box-test (defpackage :cl-tty-box-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.layout) (:use :cl :fiveam :cl-tty.backend :cl-tty.layout)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-box-test) (in-package :cl-tty-box-test)
(def-suite box-suite :description "Box renderable tests") (def-suite box-suite :description "Box renderable tests")
(in-suite box-suite) (in-suite box-suite)
@@ -116,7 +116,7 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
** Implementation ** Implementation
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package :cl-tui.box) (in-package :cl-tty.box)
(defclass box () (defclass box ()
((layout-node :initform (make-layout-node) :accessor box-layout-node ((layout-node :initform (make-layout-node) :accessor box-layout-node

496
org/dialog.org Normal file
View File

@@ -0,0 +1,496 @@
#+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
* 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.
#+BEGIN_SRC lisp :tangle no
(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)))
#+END_SRC
--- per-function: dialog-size-pixels
Helper to convert size keyword to pixel dimensions.
#+BEGIN_SRC lisp :tangle no
(defun dialog-size-pixels (size)
(case size
(:small (values 40 8))
(:medium (values 60 16))
(:large (values 88 24))
(t (values 60 16))))
#+END_SRC
--- per-function: render-dialog
Render a dialog: backdrop (dimmed full-screen), then centered panel.
#+BEGIN_SRC lisp :tangle no
(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))))))
#+END_SRC
--- per-function: push-dialog
Push a dialog onto the stack and give it focus.
#+BEGIN_SRC lisp :tangle no
(defun push-dialog (dialog)
(push dialog *dialog-stack*)
(when (typep (dialog-content dialog) 'focusable-mixin)
(focus (dialog-content dialog)))
dialog)
#+END_SRC
--- per-function: pop-dialog
Pop the top dialog, fire its on-dismiss callback.
#+BEGIN_SRC lisp :tangle no
(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 sub-classes
--- per-function: alert-dialog
Simple alert with title, message, and OK button. The button is a
Select with a single "OK" option.
#+BEGIN_SRC lisp :tangle no
(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
--- per-function: confirm-dialog
Confirm dialog with Yes/No/Cancel buttons. Returns :yes or :no
via the on-yes/on-no callbacks.
#+BEGIN_SRC lisp :tangle no
(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
--- per-function: select-dialog
Modal wrapper around the Select component.
#+BEGIN_SRC lisp :tangle 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))))))
#+END_SRC
--- per-function: prompt-dialog
Modal wrapper around TextInput.
#+BEGIN_SRC lisp :tangle no
(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
** Toast system
--- per-function: toast
Fire-and-forget toast notification. Creates a toast component,
adds it to the toast list, and schedules auto-dismissal.
#+BEGIN_SRC lisp :tangle no
(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))
#+END_SRC
--- per-function: toast-class
#+BEGIN_SRC lisp :tangle no
(defclass toast ()
((message :initarg :message :accessor toast-message)
(variant :initarg :variant :initform :info :accessor toast-variant)))
#+END_SRC
--- per-function: render-toast
Render toast in top-right corner. Max 60 cols. Shows colored
left border based on variant.
#+BEGIN_SRC lisp :tangle no
(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)))
#+END_SRC
--- per-function: dismiss-toast
Remove a toast from the list.
#+BEGIN_SRC lisp :tangle no
(defun dismiss-toast (toast)
(setf *toasts* (remove toast *toasts*)))
#+END_SRC
** Tests
#+BEGIN_SRC lisp :tangle no
(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*)))))
#+END_SRC
* Combined tangle blocks
#+BEGIN_SRC lisp :tangle ../src/components/dialog-package.lisp :noweb no
;;; 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))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp :noweb no
;;; 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*)))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp :noweb no
;;; 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*)))))
#+END_SRC

View File

@@ -1,6 +1,6 @@
#+TITLE: cl-tui Layout Engine — v0.0.3 #+TITLE: cl-tty Layout Engine — v0.0.3
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tui:layout:v0.0.3: #+FILETAGS: :cl-tty:layout:v0.0.3:
#+OPTIONS: ^:nil #+OPTIONS: ^:nil
* Layout Engine * Layout Engine
@@ -85,10 +85,10 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
** Test Suite ** Test Suite
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui-layout-test (defpackage :cl-tty-layout-test
(:use :cl :fiveam :cl-tui.layout) (:use :cl :fiveam :cl-tty.layout)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-layout-test) (in-package :cl-tty-layout-test)
(def-suite layout-suite :description "Layout engine tests") (def-suite layout-suite :description "Layout engine tests")
(in-suite layout-suite) (in-suite layout-suite)
@@ -288,7 +288,7 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
*** Package *** Package
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui.layout (defpackage :cl-tty.layout
(:use :cl) (:use :cl)
(:export (:export
;; Classes ;; Classes
@@ -306,7 +306,7 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
#:compute-layout #:compute-layout
;; Macros ;; Macros
#:vbox #:hbox #:spacer)) #:vbox #:hbox #:spacer))
(in-package :cl-tui.layout) (in-package :cl-tty.layout)
#+END_SRC #+END_SRC
*** Layout Node Class *** Layout Node Class

View File

@@ -1,6 +1,6 @@
#+TITLE: cl-tui Modern Backend — v0.0.2 #+TITLE: cl-tty Modern Backend — v0.0.2
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tui:backend:v0.0.2: #+FILETAGS: :cl-tty:backend:v0.0.2:
#+OPTIONS: ^:nil #+OPTIONS: ^:nil
* Modern Backend * Modern Backend
@@ -40,10 +40,10 @@ Colors are resolved through a palette before emission:
** Test Suite ** Test Suite
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui-modern-backend-test (defpackage :cl-tty-modern-backend-test
(:use :cl :fiveam :cl-tui.backend) (:use :cl :fiveam :cl-tty.backend)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-modern-backend-test) (in-package :cl-tty-modern-backend-test)
(def-suite modern-backend-suite :description "Modern backend tests") (def-suite modern-backend-suite :description "Modern backend tests")
(in-suite modern-backend-suite) (in-suite modern-backend-suite)
@@ -58,72 +58,72 @@ Colors are resolved through a palette before emission:
(test make-modern-backend-creates (test make-modern-backend-creates
"make-modern-backend returns a modern-backend instance" "make-modern-backend returns a modern-backend instance"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (typep b 'cl-tui.backend::modern-backend)))) (is (typep b 'cl-tty.backend::modern-backend))))
;; ── Escape Generation ────────────────────────────────────────── ;; ── Escape Generation ──────────────────────────────────────────
(test sgr-truecolor-foreground (test sgr-truecolor-foreground
"SGR truecolor foreground escape is correct" "SGR truecolor foreground escape is correct"
(is (equal (cl-tui.backend::sgr-fg "#FFD700") (is (equal (cl-tty.backend::sgr-fg "#FFD700")
(format nil "~C[38;2;255;215;0m" #\Esc)))) (format nil "~C[38;2;255;215;0m" #\Esc))))
(test sgr-truecolor-background (test sgr-truecolor-background
"SGR truecolor background escape is correct" "SGR truecolor background escape is correct"
(is (equal (cl-tui.backend::sgr-bg "#1a1b26") (is (equal (cl-tty.backend::sgr-bg "#1a1b26")
(format nil "~C[48;2;26;27;38m" #\Esc)))) (format nil "~C[48;2;26;27;38m" #\Esc))))
(test sgr-named-colors (test sgr-named-colors
"SGR named colors resolve to 8-color codes" "SGR named colors resolve to 8-color codes"
(is (equal (cl-tui.backend::sgr-fg :red) (is (equal (cl-tty.backend::sgr-fg :red)
(format nil "~C[31m" #\Esc))) (format nil "~C[31m" #\Esc)))
(is (equal (cl-tui.backend::sgr-bg :blue) (is (equal (cl-tty.backend::sgr-bg :blue)
(format nil "~C[44m" #\Esc)))) (format nil "~C[44m" #\Esc))))
(test sgr-bold-italic (test sgr-bold-italic
"SGR attribute escapes are correct" "SGR attribute escapes are correct"
(is (equal (cl-tui.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc))) (is (equal (cl-tty.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
(is (equal (cl-tui.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc))) (is (equal (cl-tty.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc)))
(is (equal (cl-tui.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc))) (is (equal (cl-tty.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc)))
(is (equal (cl-tui.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc)))) (is (equal (cl-tty.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc))))
;; ── Cursor ───────────────────────────────────────────────────── ;; ── Cursor ─────────────────────────────────────────────────────
(test cursor-move-escape (test cursor-move-escape
"cursor-move generates correct CSI escape" "cursor-move generates correct CSI escape"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-move-escape 5 10) (is (equal (cl-tty.backend::cursor-move-escape 5 10)
(format nil "~C[6;11H" #\Esc))))) (format nil "~C[6;11H" #\Esc)))))
(test cursor-style-block (test cursor-style-block
"cursor-style :block generate correct escape" "cursor-style :block generate correct escape"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-style-escape :block nil) (is (equal (cl-tty.backend::cursor-style-escape :block nil)
(format nil "~C[2 q" #\Esc))))) (format nil "~C[2 q" #\Esc)))))
(test cursor-style-bar (test cursor-style-bar
"cursor-style :bar generate correct escape" "cursor-style :bar generate correct escape"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-style-escape :bar nil) (is (equal (cl-tty.backend::cursor-style-escape :bar nil)
(format nil "~C[6 q" #\Esc))))) (format nil "~C[6 q" #\Esc)))))
(test cursor-style-underline-blink (test cursor-style-underline-blink
"cursor-style :underline with blink" "cursor-style :underline with blink"
(let ((b (make-modern-backend))) (let ((b (make-modern-backend)))
(is (equal (cl-tui.backend::cursor-style-escape :underline t) (is (equal (cl-tty.backend::cursor-style-escape :underline t)
(format nil "~C[5 q" #\Esc))))) (format nil "~C[5 q" #\Esc)))))
;; ── Synchronization ──────────────────────────────────────────── ;; ── Synchronization ────────────────────────────────────────────
(test decicm-escapes (test decicm-escapes
"DECICM synchronized update escapes" "DECICM synchronized update escapes"
(is (equal (cl-tui.backend::decicm-begin) (format nil "~C[?2026h" #\Esc))) (is (equal (cl-tty.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
(is (equal (cl-tui.backend::decicm-end) (format nil "~C[?2026l" #\Esc)))) (is (equal (cl-tty.backend::decicm-end) (format nil "~C[?2026l" #\Esc))))
;; ── OSC 8 Hyperlinks ────────────────────────────────────────── ;; ── OSC 8 Hyperlinks ──────────────────────────────────────────
(test osc8-escape (test osc8-escape
"OSC 8 hyperlink escape wraps text" "OSC 8 hyperlink escape wraps text"
(is (equal (cl-tui.backend::osc8-link "http://example.com" "click here") (is (equal (cl-tty.backend::osc8-link "http://example.com" "click here")
(format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\" (format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\"
#\Esc #\Esc #\Esc #\Esc)))) #\Esc #\Esc #\Esc #\Esc))))
@@ -131,21 +131,21 @@ Colors are resolved through a palette before emission:
(test hex-color-parsing (test hex-color-parsing
"hex-to-rgb parses valid hex colors" "hex-to-rgb parses valid hex colors"
(multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#FFD700") (multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#FFD700")
(is (= r 255)) (is (= r 255))
(is (= g 215)) (is (= g 215))
(is (= b 0)))) (is (= b 0))))
(test hex-color-black (test hex-color-black
"hex-to-rgb parses black" "hex-to-rgb parses black"
(multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#000000") (multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#000000")
(is (= r 0)) (is (= r 0))
(is (= g 0)) (is (= g 0))
(is (= b 0)))) (is (= b 0))))
(test hex-color-short-form (test hex-color-short-form
"hex-to-rgb parses 3-digit hex" "hex-to-rgb parses 3-digit hex"
(multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#F00") (multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#F00")
(is (= r 255)) (is (= r 255))
(is (= g 0)) (is (= g 0))
(is (= b 0)))) (is (= b 0))))
@@ -154,23 +154,23 @@ Colors are resolved through a palette before emission:
(test border-char-rounded (test border-char-rounded
"modern-border-char returns Unicode box-drawing for rounded style" "modern-border-char returns Unicode box-drawing for rounded style"
(is (equal (cl-tui.backend::border-char :rounded :top-left) "╭")) (is (equal (cl-tty.backend::border-char :rounded :top-left) "╭"))
(is (equal (cl-tui.backend::border-char :rounded :horizontal) "─")) (is (equal (cl-tty.backend::border-char :rounded :horizontal) "─"))
(is (equal (cl-tui.backend::border-char :rounded :vertical) "│")) (is (equal (cl-tty.backend::border-char :rounded :vertical) "│"))
(is (equal (cl-tui.backend::border-char :rounded :bottom-right) "╯"))) (is (equal (cl-tty.backend::border-char :rounded :bottom-right) "╯")))
(test border-char-double (test border-char-double
"modern-border-char returns double-line chars" "modern-border-char returns double-line chars"
(is (equal (cl-tui.backend::border-char :double :top-left) "╔")) (is (equal (cl-tty.backend::border-char :double :top-left) "╔"))
(is (equal (cl-tui.backend::border-char :double :horizontal) "═")) (is (equal (cl-tty.backend::border-char :double :horizontal) "═"))
(is (equal (cl-tui.backend::border-char :double :vertical) "║"))) (is (equal (cl-tty.backend::border-char :double :vertical) "║")))
#+END_SRC #+END_SRC
** Implementation ** Implementation
*** Package *** Package
Add to =cl-tui.backend= package: Add to =cl-tty.backend= package:
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
;; In package.lisp, add to :export: ;; In package.lisp, add to :export:
@@ -179,7 +179,7 @@ Add to =cl-tui.backend= package:
;; sgr-fg sgr-bg sgr-attr cursor-move-escape cursor-style-escape ;; sgr-fg sgr-bg sgr-attr cursor-move-escape cursor-style-escape
;; decicm-begin decicm-end osc8-link hex-to-rgb border-char ;; decicm-begin decicm-end osc8-link hex-to-rgb border-char
(in-package :cl-tui.backend) (in-package :cl-tty.backend)
#+END_SRC #+END_SRC
*** Color Resolution *** Color Resolution

View File

@@ -1,4 +1,4 @@
#+TITLE: cl-tui v0.6.0 — ScrollBox + TabBar #+TITLE: cl-tty v0.6.0 — ScrollBox + TabBar
#+STARTUP: content #+STARTUP: content
* ScrollBox and TabBar * ScrollBox and TabBar
@@ -47,10 +47,10 @@ TabBar:
** Tests ** Tests
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp #+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
(defpackage :cl-tui-scrollbox-test (defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input :cl-tui.container) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests)) (:export #:run-tests))
(in-package #:cl-tui-scrollbox-test) (in-package #:cl-tty-scrollbox-test)
(def-suite scrollbox-suite :description "ScrollBox + TabBar tests") (def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
(in-suite scrollbox-suite) (in-suite scrollbox-suite)
@@ -182,8 +182,8 @@ TabBar:
** Package ** Package
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui.container (defpackage :cl-tty.container
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
;; ScrollBox ;; ScrollBox
#:scroll-box #:make-scroll-box #:scroll-box #:make-scroll-box
@@ -209,7 +209,7 @@ The constructor accepts keyword arguments for initial offset and children.
~children~ defaults to an empty list. ~children~ defaults to an empty list.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.container) (in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin) (defclass scroll-box (dirty-mixin)
((children :initform nil :initarg :children ((children :initform nil :initarg :children
@@ -415,7 +415,7 @@ and the currently active tab id. ~tab-bar-add~ creates a new tab with
the given id and title, returns the id. the given id and title, returns the id.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.container) (in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin) (defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs ((tabs :initform nil :initarg :tabs
@@ -532,7 +532,7 @@ they are truncated with an ellipsis.
** Combined tangle blocks ** Combined tangle blocks
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp #+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(in-package #:cl-tui.container) (in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin) (defclass scroll-box (dirty-mixin)
((children :initform nil :initarg :children :accessor scroll-box-children :type list) ((children :initform nil :initarg :children :accessor scroll-box-children :type list)
@@ -616,7 +616,7 @@ they are truncated with an ellipsis.
#+END_SRC #+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp #+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
(in-package #:cl-tui.container) (in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin) (defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list) ((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list)
@@ -670,8 +670,8 @@ they are truncated with an ellipsis.
#+END_SRC #+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/container-package.lisp #+BEGIN_SRC lisp :tangle ../src/components/container-package.lisp
(defpackage :cl-tui.container (defpackage :cl-tty.container
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
#:scroll-box #:make-scroll-box #:scroll-box #:make-scroll-box
#:scroll-box-scroll-y #:scroll-box-scroll-x #:scroll-box-scroll-y #:scroll-box-scroll-x

View File

@@ -1,4 +1,4 @@
#+TITLE: cl-tui v0.7.0 — Select Dropdown + Fuzzy Filter #+TITLE: cl-tty v0.7.0 — Select Dropdown + Fuzzy Filter
#+STARTUP: content #+STARTUP: content
* Select Widget * Select Widget
@@ -41,10 +41,10 @@ fallback, and category grouping with dimmed headers.
** Tests ** Tests
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp #+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
(defpackage :cl-tui-select-test (defpackage :cl-tty-select-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input :cl-tui.select) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.select)
(:export #:run-tests)) (:export #:run-tests))
(in-package #:cl-tui-select-test) (in-package #:cl-tty-select-test)
(def-suite select-suite :description "Select widget tests") (def-suite select-suite :description "Select widget tests")
(in-suite select-suite) (in-suite select-suite)
@@ -168,8 +168,8 @@ fallback, and category grouping with dimmed headers.
** Package ** Package
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui.select (defpackage :cl-tty.select
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
#:select #:make-select #:select #:make-select
#:select-options #:select-filter #:select-options #:select-filter
@@ -191,7 +191,7 @@ plists. ~selected-index~ tracks the currently highlighted option.
receiving the selected option plist. receiving the selected option plist.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.select) (in-package #:cl-tty.select)
(defclass select (dirty-mixin) (defclass select (dirty-mixin)
((options :initform nil :initarg :options ((options :initform nil :initarg :options
@@ -430,7 +430,7 @@ not selectable (visually distinct).
** Combined tangle block ** Combined tangle block
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp #+BEGIN_SRC lisp :tangle ../src/components/select.lisp
(in-package #:cl-tui.select) (in-package #:cl-tty.select)
(defclass select (dirty-mixin) (defclass select (dirty-mixin)
((options :initform nil :initarg :options :accessor select-options :type list) ((options :initform nil :initarg :options :accessor select-options :type list)
@@ -527,8 +527,8 @@ not selectable (visually distinct).
#+END_SRC #+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/select-package.lisp #+BEGIN_SRC lisp :tangle ../src/components/select-package.lisp
(defpackage :cl-tui.select (defpackage :cl-tty.select
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
#:select #:make-select #:select #:make-select
#:select-options #:select-filter #:select-options #:select-filter

View File

@@ -1,4 +1,4 @@
#+TITLE: cl-tui v0.5.0 — Text Input + Keybinding System #+TITLE: cl-tty v0.5.0 — Text Input + Keybinding System
#+STARTUP: content #+STARTUP: content
* Text Input System * Text Input System
@@ -140,7 +140,7 @@ SBCL's ~sb-posix~ provides the POSIX terminal APIs (~tcgetattr~,
** Tests ** Tests
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui-input-test) (in-package #:cl-tty-input-test)
(def-suite input-suite :description "Text input and keybinding tests") (def-suite input-suite :description "Text input and keybinding tests")
(in-suite input-suite) (in-suite input-suite)
@@ -407,16 +407,16 @@ SBCL's ~sb-posix~ provides the POSIX terminal APIs (~tcgetattr~,
** Package ** Package
The package uses ~:cl-tui.backend~ for backend protocol (draw-text, etc.), The package uses ~:cl-tty.backend~ for backend protocol (draw-text, etc.),
~:cl-tui.box~ for dirty-mixin and rendering pipeline, ~:cl-tty.box~ for dirty-mixin and rendering pipeline,
and ~:cl-tui.layout~ for layout-node. and ~:cl-tty.layout~ for layout-node.
I export everything users of the input system need: key events, mouse events, I export everything users of the input system need: key events, mouse events,
terminal raw mode, TextInput, Textarea, and the keybinding system. terminal raw mode, TextInput, Textarea, and the keybinding system.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defpackage :cl-tui.input (defpackage :cl-tty.input
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
(:export (:export
;; Key events ;; Key events
#:key-event #:make-key-event #:key-event #:make-key-event
@@ -463,7 +463,7 @@ this returns ~("")~ (one empty string), which is the correct behavior for
textarea line splitting — a blank document has one empty line. textarea line splitting — a blank document has one empty line.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
(defun %split-string (string separator) (defun %split-string (string separator)
"Split STRING at each occurrence of SEPARATOR. Returns list of strings." "Split STRING at each occurrence of SEPARATOR. Returns list of strings."
@@ -881,7 +881,7 @@ providing real terminal input via our parser. The ~probe-file~ guard
handles the case where stdin is not a terminal (piped input). handles the case where stdin is not a terminal (piped input).
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defmethod read-event ((b cl-tui.backend:backend) &key timeout) (defmethod read-event ((b cl-tty.backend:backend) &key timeout)
(declare (ignore b)) (declare (ignore b))
(when (probe-file "/dev/stdin") (when (probe-file "/dev/stdin")
(%read-event :timeout timeout))) (%read-event :timeout timeout)))
@@ -900,7 +900,7 @@ The ~value~ and ~cursor~ slots are directly accessible for testing
without going through the event handler. without going through the event handler.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
(defclass text-input (dirty-mixin) (defclass text-input (dirty-mixin)
((value :initform "" :initarg :value :accessor text-input-value :type string) ((value :initform "" :initarg :value :accessor text-input-value :type string)
@@ -1109,7 +1109,7 @@ selection (not yet implemented in the handler). ~on-submit~ fires
on Ctrl+Enter when set. on Ctrl+Enter when set.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
(defclass textarea (dirty-mixin) (defclass textarea (dirty-mixin)
((value :initform "" :initarg :value :accessor textarea-value :type string) ((value :initform "" :initarg :value :accessor textarea-value :type string)
@@ -1445,7 +1445,7 @@ A keymap has a ~name~ for debugging, ~bindings~ as an alist (ordered
for priority), and an optional ~parent~ for inheritance chains. for priority), and an optional ~parent~ for inheritance chains.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
(defstruct keymap (defstruct keymap
(name nil :type (or keyword null)) (name nil :type (or keyword null))
@@ -1568,7 +1568,7 @@ experience; this section is what actually generates the compilable code.
** input.lisp ** input.lisp
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp #+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Utility: split-string (avoids external dependency) ;;; Utility: split-string (avoids external dependency)
@@ -1871,7 +1871,7 @@ experience; this section is what actually generates the compilable code.
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Backend integration ;;; Backend integration
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
(defmethod read-event ((b cl-tui.backend:backend) &key timeout) (defmethod read-event ((b cl-tty.backend:backend) &key timeout)
(declare (ignore b)) (declare (ignore b))
(when (probe-file "/dev/stdin") (when (probe-file "/dev/stdin")
(%read-event :timeout timeout))) (%read-event :timeout timeout)))
@@ -1880,7 +1880,7 @@ experience; this section is what actually generates the compilable code.
** text-input.lisp ** text-input.lisp
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp #+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; TextInput class ;;; TextInput class
@@ -2048,7 +2048,7 @@ experience; this section is what actually generates the compilable code.
** textarea.lisp ** textarea.lisp
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp #+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Utility: split string (local copy for dependency-free operation) ;;; Utility: split string (local copy for dependency-free operation)
@@ -2311,7 +2311,7 @@ experience; this section is what actually generates the compilable code.
** keybindings.lisp ** keybindings.lisp
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp #+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Key map struct ;;; Key map struct
@@ -2393,8 +2393,8 @@ experience; this section is what actually generates the compilable code.
** input-package.lisp ** input-package.lisp
#+BEGIN_SRC lisp :tangle ../src/components/input-package.lisp #+BEGIN_SRC lisp :tangle ../src/components/input-package.lisp
(defpackage :cl-tui.input (defpackage :cl-tty.input
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
(:export (:export
;; Key events ;; Key events
#:key-event #:make-key-event #:key-event #:make-key-event
@@ -2432,10 +2432,10 @@ experience; this section is what actually generates the compilable code.
** input-tests.lisp ** input-tests.lisp
#+BEGIN_SRC lisp :tangle ../tests/input-tests.lisp #+BEGIN_SRC lisp :tangle ../tests/input-tests.lisp
(defpackage :cl-tui-input-test (defpackage :cl-tty-input-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-input-test) (in-package :cl-tty-input-test)
(def-suite input-suite :description "Text input and keybinding tests") (def-suite input-suite :description "Text input and keybinding tests")
(in-suite input-suite) (in-suite input-suite)

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-box-test (defpackage :cl-tty-box-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.layout :cl-tui.box) (:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-box-test) (in-package :cl-tty-box-test)
(def-suite box-suite :description "Box renderable tests") (def-suite box-suite :description "Box renderable tests")
(in-suite box-suite) (in-suite box-suite)

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.box) (in-package :cl-tty.box)
(defclass box (dirty-mixin) (defclass box (dirty-mixin)
((layout-node :initform (make-layout-node) :accessor box-layout-node ((layout-node :initform (make-layout-node) :accessor box-layout-node

View File

@@ -1,5 +1,5 @@
(defpackage :cl-tui.container (defpackage :cl-tty.container
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
#:scroll-box #:make-scroll-box #:scroll-box #:make-scroll-box
#:scroll-box-scroll-y #:scroll-box-scroll-x #:scroll-box-scroll-y #:scroll-box-scroll-x

View File

@@ -0,0 +1,32 @@
;;; dialog-package.lisp — Package definition for cl-tty.dialog
(defpackage :cl-tty.dialog
(:use :cl :cl-tty.input :cl-tty.select)
(: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))

123
src/components/dialog.lisp Normal file
View File

@@ -0,0 +1,123 @@
;;; 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 :initform nil :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*)
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*)))

View File

@@ -1,5 +1,5 @@
;; Dirty tracking tests are in box-tests.lisp (same test suite) ;; Dirty tracking tests are in box-tests.lisp (same test suite)
(in-package :cl-tui-box-test) (in-package :cl-tty-box-test)
(in-suite box-suite) (in-suite box-suite)
(test dirty-mixin-default-is-dirty (test dirty-mixin-default-is-dirty

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.box) (in-package :cl-tty.box)
;; ── Dirty Tracking ───────────────────────────────────────────── ;; ── Dirty Tracking ─────────────────────────────────────────────

View File

@@ -1,5 +1,5 @@
(defpackage :cl-tui.input (defpackage :cl-tty.input
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
(:export (:export
;; Key events ;; Key events
#:key-event #:make-key-event #:key-event #:make-key-event

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-input-test (defpackage :cl-tty-input-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-input-test) (in-package :cl-tty-input-test)
(def-suite input-suite :description "Text input and keybinding tests") (def-suite input-suite :description "Text input and keybinding tests")
(in-suite input-suite) (in-suite input-suite)

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Utility: split-string (avoids external dependency) ;;; Utility: split-string (avoids external dependency)
@@ -301,7 +301,7 @@
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Backend integration ;;; Backend integration
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
(defmethod read-event ((b cl-tui.backend:backend) &key timeout) (defmethod read-event ((b cl-tty.backend:backend) &key timeout)
(declare (ignore b)) (declare (ignore b))
(when (probe-file "/dev/stdin") (when (probe-file "/dev/stdin")
(%read-event :timeout timeout))) (%read-event :timeout timeout)))

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Key map struct ;;; Key map struct

View File

@@ -1,6 +1,6 @@
;;; markdown-package.lisp — Package definition for cl-tui.markdown ;;; markdown-package.lisp — Package definition for cl-tty.markdown
(defpackage :cl-tui.markdown (defpackage :cl-tty.markdown
(:use :cl :fiveam) (:use :cl :fiveam)
(:export (:export
;; Data structures ;; Data structures

View File

@@ -1,6 +1,6 @@
;;; markdown.lisp — Markdown + Code + Diff rendering for cl-tui ;;; markdown.lisp — Markdown + Code + Diff rendering for cl-tty
(in-package :cl-tui.markdown) (in-package :cl-tty.markdown)
;; ─── Node constructors ──────────────────────────────────────────────────────── ;; ─── Node constructors ────────────────────────────────────────────────────────

View File

@@ -1,5 +1,5 @@
(defpackage :cl-tui.box (defpackage :cl-tty.box
(:use :cl :cl-tui.backend :cl-tui.layout) (:use :cl :cl-tty.backend :cl-tty.layout)
(:export (:export
;; Box ;; Box
#:box #:make-box #:box #:make-box
@@ -28,4 +28,4 @@
;; Theme engine ;; Theme engine
#:theme #:make-theme #:theme-mode #:theme #:make-theme #:theme-mode
#:theme-color #:load-preset #:define-preset)) #:theme-color #:load-preset #:define-preset))
(in-package :cl-tui.box) (in-package :cl-tty.box)

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui-box-test) (in-package :cl-tty-box-test)
(in-suite box-suite) (in-suite box-suite)
(defun make-capturing-backend () (defun make-capturing-backend ()

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.box) (in-package :cl-tty.box)
;; ── Component Protocol ──────────────────────────────────────── ;; ── Component Protocol ────────────────────────────────────────

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.container) (in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin) (defclass scroll-box (dirty-mixin)
((children :initform nil :initarg :children :accessor scroll-box-children :type list) ((children :initform nil :initarg :children :accessor scroll-box-children :type list)

View File

@@ -1,5 +1,5 @@
(defpackage :cl-tui.select (defpackage :cl-tty.select
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
#:select #:make-select #:select #:make-select
#:select-options #:select-filter #:select-options #:select-filter

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.select) (in-package #:cl-tty.select)
(defclass select (dirty-mixin) (defclass select (dirty-mixin)
((options :initform nil :initarg :options :accessor select-options :type list) ((options :initform nil :initarg :options :accessor select-options :type list)

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.container) (in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin) (defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list) ((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list)

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; TextInput class ;;; TextInput class

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.box) (in-package :cl-tty.box)
;; ── Text Renderable ──────────────────────────────────────────── ;; ── Text Renderable ────────────────────────────────────────────

View File

@@ -1,4 +1,4 @@
(in-package #:cl-tui.input) (in-package #:cl-tty.input)
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Utility: split string (local copy for dependency-free operation) ;;; Utility: split string (local copy for dependency-free operation)

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui-box-test) (in-package :cl-tty-box-test)
(in-suite box-suite) (in-suite box-suite)
(test theme-create-default (test theme-create-default

View File

@@ -1,4 +1,4 @@
(in-package :cl-tui.box) (in-package :cl-tty.box)
;; ── Theme Engine ────────────────────────────────────────────── ;; ── Theme Engine ──────────────────────────────────────────────

43
tests/dialog-tests.lisp Normal file
View File

@@ -0,0 +1,43 @@
;;; 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*)))))

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-input-test (defpackage :cl-tty-input-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tui-input-test) (in-package :cl-tty-input-test)
(def-suite input-suite :description "Text input and keybinding tests") (def-suite input-suite :description "Text input and keybinding tests")
(in-suite input-suite) (in-suite input-suite)

View File

@@ -1,15 +1,15 @@
;;; markdown-tests.lisp — Tests for cl-tui.markdown ;;; markdown-tests.lisp — Tests for cl-tty.markdown
(defpackage :cl-tui-markdown-test (defpackage :cl-tty-markdown-test
(:use :cl :cl-tui.markdown :fiveam)) (:use :cl :cl-tty.markdown :fiveam))
(in-package :cl-tui-markdown-test) (in-package :cl-tty-markdown-test)
;; Test suite ;; Test suite
(def-suite :cl-tui-markdown-test (def-suite :cl-tty-markdown-test
:description "Markdown parser/renderer tests for cl-tui.markdown") :description "Markdown parser/renderer tests for cl-tty.markdown")
(in-suite :cl-tui-markdown-test) (in-suite :cl-tty-markdown-test)
;; ─── Parser tests ───────────────────────────────────────────────────────────── ;; ─── Parser tests ─────────────────────────────────────────────────────────────

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-scrollbox-test (defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input :cl-tui.container) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests)) (:export #:run-tests))
(in-package #:cl-tui-scrollbox-test) (in-package #:cl-tty-scrollbox-test)
(def-suite scrollbox-suite :description "ScrollBox + TabBar tests") (def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
(in-suite scrollbox-suite) (in-suite scrollbox-suite)

View File

@@ -1,7 +1,7 @@
(defpackage :cl-tui-select-test (defpackage :cl-tty-select-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input :cl-tui.select) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.select)
(:export #:run-tests)) (:export #:run-tests))
(in-package #:cl-tui-select-test) (in-package #:cl-tty-select-test)
(def-suite select-suite :description "Select widget tests") (def-suite select-suite :description "Select widget tests")
(in-suite select-suite) (in-suite select-suite)