Rename cl-tui -> cl-tty, v0.9.0: Dialog System + Toast
Rename: cl-tty avoids naming collision with Quicklisp's cl-tui (naryl/cl-tui, a cl-charms-based ncurses library). Our project is pure escape-sequence CL. v0.9.0 adds: - Dialog base class: modal overlay with backdrop, centered panel, size variants (:small/:medium/:large), stack-based management - Dialog subclasses: alert, confirm, select-dialog, prompt-dialog - Toast notifications: transient, top-right corner, auto-dismiss, colored variants (info/success/warning/error) - 78 tests total, 100% passing ASDF: read-time package references (+fiveam:+) replaced with find-symbol so .asd loads without FiveAM pre-loaded
This commit is contained in:
@@ -1,7 +1,7 @@
|
||||
(defpackage :cl-tui-box-test
|
||||
(:use :cl :fiveam :cl-tui.backend :cl-tui.layout :cl-tui.box)
|
||||
(defpackage :cl-tty-box-test
|
||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
|
||||
(:export #:run-tests))
|
||||
(in-package :cl-tui-box-test)
|
||||
(in-package :cl-tty-box-test)
|
||||
|
||||
(def-suite box-suite :description "Box renderable tests")
|
||||
(in-suite box-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui.box)
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
(defclass box (dirty-mixin)
|
||||
((layout-node :initform (make-layout-node) :accessor box-layout-node
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
(defpackage :cl-tui.container
|
||||
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input)
|
||||
(defpackage :cl-tty.container
|
||||
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
||||
(:export
|
||||
#:scroll-box #:make-scroll-box
|
||||
#:scroll-box-scroll-y #:scroll-box-scroll-x
|
||||
|
||||
32
src/components/dialog-package.lisp
Normal file
32
src/components/dialog-package.lisp
Normal 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
123
src/components/dialog.lisp
Normal 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*)))
|
||||
@@ -1,5 +1,5 @@
|
||||
;; 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)
|
||||
|
||||
(test dirty-mixin-default-is-dirty
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui.box)
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
;; ── Dirty Tracking ─────────────────────────────────────────────
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
(defpackage :cl-tui.input
|
||||
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout)
|
||||
(defpackage :cl-tty.input
|
||||
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
|
||||
(:export
|
||||
;; Key events
|
||||
#:key-event #:make-key-event
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(defpackage :cl-tui-input-test
|
||||
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input)
|
||||
(defpackage :cl-tty-input-test
|
||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
||||
(: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")
|
||||
(in-suite input-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.input)
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Utility: split-string (avoids external dependency)
|
||||
@@ -301,7 +301,7 @@
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; 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))
|
||||
(when (probe-file "/dev/stdin")
|
||||
(%read-event :timeout timeout)))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.input)
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Key map struct
|
||||
|
||||
@@ -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)
|
||||
(:export
|
||||
;; Data structures
|
||||
|
||||
@@ -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 ────────────────────────────────────────────────────────
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
(defpackage :cl-tui.box
|
||||
(:use :cl :cl-tui.backend :cl-tui.layout)
|
||||
(defpackage :cl-tty.box
|
||||
(:use :cl :cl-tty.backend :cl-tty.layout)
|
||||
(:export
|
||||
;; Box
|
||||
#:box #:make-box
|
||||
@@ -28,4 +28,4 @@
|
||||
;; Theme engine
|
||||
#:theme #:make-theme #:theme-mode
|
||||
#:theme-color #:load-preset #:define-preset))
|
||||
(in-package :cl-tui.box)
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui-box-test)
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
|
||||
(defun make-capturing-backend ()
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui.box)
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
;; ── Component Protocol ────────────────────────────────────────
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.container)
|
||||
(in-package #:cl-tty.container)
|
||||
|
||||
(defclass scroll-box (dirty-mixin)
|
||||
((children :initform nil :initarg :children :accessor scroll-box-children :type list)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
(defpackage :cl-tui.select
|
||||
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input)
|
||||
(defpackage :cl-tty.select
|
||||
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
||||
(:export
|
||||
#:select #:make-select
|
||||
#:select-options #:select-filter
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.select)
|
||||
(in-package #:cl-tty.select)
|
||||
|
||||
(defclass select (dirty-mixin)
|
||||
((options :initform nil :initarg :options :accessor select-options :type list)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.container)
|
||||
(in-package #:cl-tty.container)
|
||||
|
||||
(defclass tab-bar (dirty-mixin)
|
||||
((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.input)
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; TextInput class
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui.box)
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
;; ── Text Renderable ────────────────────────────────────────────
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package #:cl-tui.input)
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Utility: split string (local copy for dependency-free operation)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui-box-test)
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
|
||||
(test theme-create-default
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(in-package :cl-tui.box)
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
;; ── Theme Engine ──────────────────────────────────────────────
|
||||
|
||||
|
||||
Reference in New Issue
Block a user