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:
14
cl-tty.asd
14
cl-tty.asd
@@ -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)))
|
||||||
|
|||||||
97
demo.lisp
97
demo.lisp
@@ -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 ──────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
|||||||
@@ -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))
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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))
|
|
||||||
|
|||||||
@@ -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)))
|
||||||
|
|||||||
@@ -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)))
|
||||||
|
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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))
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user