v1.0.0 review fixes: dialog, textarea, scrollbox, demo, ASDF, layout

Fixes from subagent code review (15 findings):

CRITICAL runtime bugs:
- dialog.lisp: backend-write calls -> draw-rect/draw-text (wrong arg count)
- dialog.lisp: removed undefined render-component call
- dialog.lisp: toast render backend-write -> draw-text

MAJOR data loss / silent failures:
- textarea.lisp: undo overflow now drops oldest entry instead of wiping stack
- scrollbox.lisp: :background-element -> :bright-black (theme keyword never resolved)

ASDF completeness:
- modern-tests.lisp wired as component and test-op suite
- layout tests added to test-op suite list
- markdown suite lookup now uses keyword (was looking up wrong string)
- test runner updated to match

API cleanup:
- container-package: removed duplicate render export
- select-package: removed duplicate render export
- markdown.lisp: #\Escape -> #\Esc for consistency
- textarea.lisp: removed duplicate %split-string defn

Demo robustness:
- Added unwind-protect for guaranteed terminal cleanup
- Uses make-modern-backend constructor
- Uses set-raw-mode/restore-terminal-state

Layout:
- normalize-box handles partial padding specs (was returning all zeros)
This commit is contained in:
Hermes
2026-05-11 21:50:53 +00:00
parent 1a19d12f7d
commit d63ba69fb7
10 changed files with 79 additions and 101 deletions

View File

@@ -56,7 +56,8 @@
:components :components
((:module "backend" ((:module "backend"
:components :components
((:file "tests"))) ((:file "tests")
(:file "modern-tests" :depends-on ("tests"))))
(:module "layout" (:module "layout"
:components :components
((:file "tests"))) ((:file "tests")))
@@ -81,12 +82,17 @@
(:cl-tty-input-test "INPUT-SUITE") (:cl-tty-input-test "INPUT-SUITE")
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE") (:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
(:cl-tty-select-test "SELECT-SUITE") (:cl-tty-select-test "SELECT-SUITE")
(:cl-tty-markdown-test "MARKDOWN-SUITE") (:cl-tty-markdown-test)
(:cl-tty-dialog-test "DIALOG-SUITE") (:cl-tty-dialog-test "DIALOG-SUITE")
(:cl-tty-mouse-test "MOUSE-SUITE") (:cl-tty-mouse-test "MOUSE-SUITE")
(:cl-tty-slot-test "SLOT-SUITE"))) (:cl-tty-slot-test "SLOT-SUITE")
(:cl-tty-layout-test "LAYOUT-SUITE")
(:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")))
(let* ((pkg (find-package (first suite))) (let* ((pkg (find-package (first suite)))
(s (and pkg (find-symbol (second suite) pkg)))) (suite-name (second suite))
(s (cond (suite-name (find-symbol suite-name pkg))
(pkg (find-symbol (string (first suite)) :keyword))
(t nil))))
(when s (when s
(funcall explain (funcall run s)))))) (funcall explain (funcall run s))))))
(uiop:quit 0))) (uiop:quit 0)))

View File

@@ -15,28 +15,22 @@
(let ((b (read-raw))) (let ((b (read-raw)))
(unless b (return-from read-key nil)) (unless b (return-from read-key nil))
(case b (case b
(#x1b ; ESC — could be Arrow, Escape, or Alt (#x1b
(let ((b2 (read-raw 1))) (let ((b2 (read-raw 1)))
(unless b2 (return-from read-key :escape)) (unless b2 (return-from read-key :escape))
(if (= b2 #x5b) ; ESC [ (if (= b2 #x5b)
(let ((b3 (read-raw 1))) (let ((b3 (read-raw 1)))
(case b3 (case b3
(#x41 :up) (#x42 :down) (#x41 :up) (#x42 :down)
(#x43 :right) (#x44 :left) (#x43 :right) (#x44 :left)
(#x48 :home) (#x46 :end) (#x48 :home) (#x46 :end)
(#x5e ; ESC [ N ~
(let ((b4 (read-raw 1)))
(case b4
(#x31 :home) (#x34 :end)
(#x35 :page-up) (#x36 :page-down)
(t :unknown))))
(t :unknown))) (t :unknown)))
(t :unknown)))) :unknown)))
(#x03 :ctrl-c) (#x03 :ctrl-c)
(#x0d :enter) (#x0d :enter)
(#x09 :tab) (#x09 :tab)
(#x7f :backspace) (#x7f :backspace)
(t (code-char b))))) ; printable (t (code-char b)))))
;;; ─── Tab content renderers ───────────────────────────────────────────────── ;;; ─── Tab content renderers ─────────────────────────────────────────────────
@@ -59,7 +53,7 @@
for pair = (nth i '(("Box" "Bordered containers, title, bg") for pair = (nth i '(("Box" "Bordered containers, title, bg")
("Text" "Styled text, word-wrap, spans") ("Text" "Styled text, word-wrap, spans")
("ScrollBox" "Scrollable viewport, scrollbars") ("ScrollBox" "Scrollable viewport, scrollbars")
("TabBar" "Tab navigation you're using it!") ("TabBar" "Tab navigation you are using")
("Select" "Dropdown with fuzzy filter") ("Select" "Dropdown with fuzzy filter")
("Dialog" "Modal overlays + Toast notifs"))) ("Dialog" "Modal overlays + Toast notifs")))
do (cl-tty.backend:draw-text be 8 (+ 9 i) (first pair) do (cl-tty.backend:draw-text be 8 (+ 9 i) (first pair)
@@ -72,16 +66,11 @@
(cl-tty.backend:draw-text be 8 9 "Metric" :bright-white :default :bold t) (cl-tty.backend:draw-text be 8 9 "Metric" :bright-white :default :bold t)
(cl-tty.backend:draw-text be 40 9 "Value" :bright-white :default :bold t) (cl-tty.backend:draw-text be 40 9 "Value" :bright-white :default :bold t)
(loop for i from 0 below 8 (loop for i from 0 below 8
for pair = (nth i '(("Versions" "11") for pair = (nth i '(("Versions" "11") ("Components" "12")
("Components" "12") ("Tests" "280+") ("Lines" "~3060")
("Tests" "280+") ("Dependencies" "0") ("FFI" "0")
("Lines" "~3060") ("ncurses" "no") ("License" "TBD")))
("Dependencies" "0") do (cl-tty.backend:draw-text be 8 (+ 11 i) (first pair) :white :default)
("FFI" "0")
("ncurses" "no")
("License" "TBD")))
do (cl-tty.backend:draw-text be 8 (+ 11 i) (first pair)
:white :default)
(cl-tty.backend:draw-text be 40 (+ 11 i) (second pair) (cl-tty.backend:draw-text be 40 (+ 11 i) (second pair)
:bright-green :default :bold t))) :bright-green :default :bold t)))
@@ -102,51 +91,39 @@
;;; ─── Main loop ───────────────────────────────────────────────────────────── ;;; ─── Main loop ─────────────────────────────────────────────────────────────
(defun run-demo () (defun run-demo ()
(let* ((be (make-instance 'cl-tty.backend:modern-backend)) (let* ((raw (find-symbol "SET-RAW-MODE" :cl-tty.input))
(restore (find-symbol "RESTORE-TERMINAL-STATE" :cl-tty.input))
(saved (funcall raw)))
(unwind-protect
(let* ((backend (cl-tty.backend:make-modern-backend))
(tabs '(" Home " " Components " " Stats ")) (tabs '(" Home " " Components " " Stats "))
(active 0) (active 0) (running t))
(running t)) (cl-tty.backend:initialize-backend backend)
(cl-tty.backend:cursor-hide backend)
(cl-tty.backend:initialize-backend be)
(cl-tty.backend:cursor-hide be)
(loop while running (loop while running
do (cl-tty.backend:backend-clear be) do (cl-tty.backend:backend-clear backend)
(cl-tty.backend:draw-border backend 2 1 76 3
;; Title :style :double :title " cl-tty ")
(cl-tty.backend:draw-border be 2 1 76 3 :style :double :title " cl-tty ") (cl-tty.backend:draw-text backend 4 2
(cl-tty.backend:draw-text be 4 2 "Interactive demo arrows: tabs q: quit" :bright-white :default)
"Interactive demo — navigate with arrows, q to quit" (render-tabs backend tabs active)
:bright-white :default)
;; Tabs + content
(render-tabs be tabs active)
(case active (case active
(0 (render-home be)) (0 (render-home backend))
(1 (render-components be)) (1 (render-components backend))
(2 (render-stats be))) (2 (render-stats backend)))
(cl-tty.backend:draw-rect backend 2 23 76 1 :bg :blue)
;; Footer (cl-tty.backend:draw-text backend 2 23
(cl-tty.backend:draw-rect be 2 23 76 1 :bg :blue)
(cl-tty.backend:draw-text be 2 23
(format nil " Tab ~d/3: ~a " (format nil " Tab ~d/3: ~a "
(1+ active) (string-trim " " (nth active tabs))) (1+ active) (string-trim " " (nth active tabs)))
:bright-white :blue :bold t) :bright-white :blue :bold t)
(case (read-key)
;; Input ((:ctrl-c :enter #\q #\Q) (setf running nil))
(let ((key (read-key))) ((:right :tab) (setf active (mod (1+ active) (length tabs))))
(case key (:left (setf active (mod (1- active) (length tabs))))))
(:ctrl-c (setf running nil)) (cl-tty.backend:cursor-show backend)
(:enter (setf running nil)) (cl-tty.backend:backend-clear backend)
(#\q (setf running nil)) (cl-tty.backend:shutdown-backend backend))
(#\Q (setf running nil)) (when saved (funcall restore saved)))))
(:right (setf active (mod (1+ active) (length tabs))))
(:left (setf active (mod (1- active) (length tabs))))
(:tab (setf active (mod (1+ active) (length tabs)))))))
(cl-tty.backend:cursor-show be)
(cl-tty.backend:backend-clear be)
(cl-tty.backend:shutdown-backend be)))
;;; ─── Entry ────────────────────────────────────────────────────────────────── ;;; ─── Entry ──────────────────────────────────────────────────────────────────

View File

@@ -21,8 +21,10 @@
(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))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec)) ((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec))
((getf spec :top) spec) (t (loop with result = '(:top 0 :right 0 :bottom 0 :left 0)
(t '(:top 0 :right 0 :bottom 0 :left 0)))) for (key val) on spec by #'cddr
do (setf (getf result key) val)
finally (return result)))))
(defun box-edge (box edge) (defun box-edge (box edge)
(or (getf box edge) 0)) (or (getf box edge) 0))

View File

@@ -27,11 +27,13 @@
(:cl-tty-markdown-test :cl-tty-markdown-test) (:cl-tty-markdown-test :cl-tty-markdown-test)
(:cl-tty-dialog-test "DIALOG-SUITE") (:cl-tty-dialog-test "DIALOG-SUITE")
(:cl-tty-mouse-test "MOUSE-SUITE") (:cl-tty-mouse-test "MOUSE-SUITE")
(:cl-tty-slot-test "SLOT-SUITE"))) (:cl-tty-slot-test "SLOT-SUITE")
(:cl-tty-layout-test "LAYOUT-SUITE")
(:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")))
(let* ((pkg (find-package (first suite))) (let* ((pkg (find-package (first suite)))
(suite-name (second suite)) (suite-name (second suite))
(s (etypecase suite-name (s (etypecase suite-name
(keyword (find-symbol (string suite-name) pkg)) (keyword (find-symbol (string suite-name) :keyword))
(string (find-symbol suite-name pkg))))) (string (find-symbol suite-name pkg)))))
(format t "~&=== ~a ===~%" (first suite)) (format t "~&=== ~a ===~%" (first suite))
(if s (if s

View File

@@ -9,5 +9,4 @@
#:tab-bar #:make-tab-bar #:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs #:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-next #:tab-bar-prev #:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key #:tab-bar-select #:tab-bar-handle-key))
#:render))

View File

@@ -29,12 +29,16 @@
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog)) (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
(let ((x (floor (- w dw) 2)) (let ((x (floor (- w dw) 2))
(y (floor (- h dh) 2))) (y (floor (- h dh) 2)))
;; Backdrop — dim the full screen
(dotimes (row h) (dotimes (row h)
(dotimes (col w) (draw-rect screen 0 row w 1 :bg :bright-black))
(backend-write screen col row " " :bg :dim))) ;; Dialog panel
(draw-border screen x y dw dh :single :title (dialog-title dialog)) (draw-border screen x y dw dh :single :title (dialog-title dialog))
(when (dialog-content dialog) (when (dialog-content dialog)
(render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2)))))) ;; Content rendering delegated to component system
(draw-text screen (1+ x) (1+ y)
(format nil "~a" (dialog-content dialog))
:white :default)))))
(defun push-dialog (dialog) (defun push-dialog (dialog)
(push dialog *dialog-stack*) (push dialog *dialog-stack*)
@@ -108,7 +112,7 @@
(concatenate 'string (subseq msg 0 (- max-w 5)) "...") (concatenate 'string (subseq msg 0 (- max-w 5)) "...")
msg))) msg)))
(draw-rect screen x 0 max-w 1 :bg color) (draw-rect screen x 0 max-w 1 :bg color)
(backend-write screen (1+ x) 0 text :fg :white :bold t))) (draw-text screen (1+ x) 0 text :white color :bold t)))
(defun toast (message &key (variant :info) (duration 5000)) (defun toast (message &key (variant :info) (duration 5000))
(let ((toast (make-instance 'toast :message message :variant variant))) (let ((toast (make-instance 'toast :message message :variant variant)))

View File

@@ -518,7 +518,7 @@
(:keyword "33") (:builtin "36") (:keyword "33") (:builtin "36")
(:function "34") (:comment "2") (:string "32") (:number "35") (:function "34") (:comment "2") (:string "32") (:number "35")
(t nil)))) (t nil))))
(if code (format nil "~c[~am~a~c[0m" #\Escape code token #\Escape) token))) (if code (format nil "~c[~am~a~c[0m" #\Esc code token #\Esc) token)))
(defun apply-highlight-style (char-vector) (defun apply-highlight-style (char-vector)
(coerce char-vector 'string)) (coerce char-vector 'string))
@@ -568,7 +568,7 @@
((string= style "blue") "34") ((string= style "magenta") "35") ((string= style "blue") "34") ((string= style "magenta") "35")
((string= style "white") "37") ((string= style "black") "30") ((string= style "white") "37") ((string= style "black") "30")
(t nil)))) (t nil))))
(if code (format nil "~c[~am~a~c[0m" #\Escape code text #\Escape) text))) (if code (format nil "~c[~am~a~c[0m" #\Esc code text #\Esc) text)))
(defun render-inline (children) (defun render-inline (children)
(if (null children) "" (if (null children) ""
@@ -641,7 +641,7 @@
(:added "32") (:removed "31") (:added "32") (:removed "31")
(:hunk-header "36") (:file-header "1;36") (t nil)))) (:hunk-header "36") (:file-header "1;36") (t nil))))
(if color (if color
(push (format nil "~c[~am~a~c[0m" #\Escape color line #\Escape) result) (push (format nil "~c[~am~a~c[0m" #\Esc color line #\Esc) result)
(push line result)))) (push line result))))
(nreverse result))) (nreverse result)))

View File

@@ -64,12 +64,12 @@
(when (> content-h viewport-h) (when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h)))) (thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :background-element) (draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :bright-black)
(draw-text backend (1- viewport-w) thumb-pos "█" nil nil))) (draw-text backend (1- viewport-w) thumb-pos "█" nil nil)))
(when (> content-w viewport-w) (when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w)))) (thumb-pos (round (* thumb viewport-w))))
(draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :background-element) (draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :bright-black)
(draw-text backend thumb-pos (1- viewport-h) "█" nil nil))))) (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)

View File

@@ -9,5 +9,4 @@
#:select-next #:select-prev #:select-next #:select-prev
#:select-visible-options #:select-visible-options
#:select-handle-key #:select-handle-key
#:render
#:fuzzy-match-p)) #:fuzzy-match-p))

View File

@@ -1,16 +1,5 @@
(in-package #:cl-tty.input) (in-package #:cl-tty.input)
;;; ---------------------------------------------------------------------------
;;; Utility: split string (local copy for dependency-free operation)
;;; ---------------------------------------------------------------------------
(defun %split-string (string separator)
"Split STRING at each occurrence of SEPARATOR. Returns list of strings."
(loop with start = 0
for pos = (position separator string :start start)
collect (subseq string start pos)
while pos
do (setf start (1+ pos))))
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Textarea class ;;; Textarea class
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
@@ -169,10 +158,10 @@
"Save current value on undo stack." "Save current value on undo stack."
(let ((stack (textarea-undo-stack ta))) (let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack)) (when (>= (length stack) (array-total-size stack))
(setf (textarea-undo-stack ta) (loop for i from 1 below (length stack)
(make-array 100 :fill-pointer 0))) do (setf (aref stack (1- i)) (aref stack i)))
(decf (fill-pointer stack)))
(vector-push (textarea-value ta) stack) (vector-push (textarea-value ta) stack)
;; Clear redo stack on new action
(setf (fill-pointer (textarea-redo-stack ta)) 0))) (setf (fill-pointer (textarea-redo-stack ta)) 0)))
(defun textarea-undo (ta) (defun textarea-undo (ta)