amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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
Conversation 0 Commits 36 Files Changed 76 +79 -101
10 changed files with 79 additions and 101 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit d63ba69fb7 - Show all commits

14
cl-tty.asd
View File

@@ -56,7 +56,8 @@
:components
((:module "backend"
:components
((:file "tests")))
((:file "tests")
(:file "modern-tests" :depends-on ("tests"))))
(:module "layout"
:components
((:file "tests")))
@@ -81,12 +82,17 @@
(:cl-tty-input-test "INPUT-SUITE")
(:cl-tty-scrollbox-test "SCROLLBOX-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-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)))
(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
(funcall explain (funcall run s))))))
(uiop:quit 0)))

97
demo.lisp
View File

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

6
layout/layout.lisp
View File

@@ -21,8 +21,10 @@
(defun normalize-box (spec)
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec))
((getf spec :top) spec)
(t '(:top 0 :right 0 :bottom 0 :left 0))))
(t (loop with result = '(: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)
(or (getf box edge) 0))

6
run-all-tests.lisp
View File

@@ -27,11 +27,13 @@
(:cl-tty-markdown-test :cl-tty-markdown-test)
(:cl-tty-dialog-test "DIALOG-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)))
(suite-name (second suite))
(s (etypecase suite-name
(keyword (find-symbol (string suite-name) pkg))
(keyword (find-symbol (string suite-name) :keyword))
(string (find-symbol suite-name pkg)))))
(format t "~&=== ~a ===~%" (first suite))
(if s

3
src/components/container-package.lisp
View File

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

12
src/components/dialog.lisp
View File

@@ -29,12 +29,16 @@
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
(let ((x (floor (- w dw) 2))
(y (floor (- h dh) 2)))
;; Backdrop — dim the full screen
(dotimes (row h)
(dotimes (col w)
(backend-write screen col row " " :bg :dim)))
(draw-rect screen 0 row w 1 :bg :bright-black))
;; Dialog panel
(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))))))
;; 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)
(push dialog *dialog-stack*)
@@ -108,7 +112,7 @@
(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)))
(draw-text screen (1+ x) 0 text :white color :bold t)))
(defun toast (message &key (variant :info) (duration 5000))
(let ((toast (make-instance 'toast :message message :variant variant)))

6
src/components/markdown.lisp
View File

@@ -518,7 +518,7 @@
(:keyword "33") (:builtin "36")
(:function "34") (:comment "2") (:string "32") (:number "35")
(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)
(coerce char-vector 'string))
@@ -568,7 +568,7 @@
((string= style "blue") "34") ((string= style "magenta") "35")
((string= style "white") "37") ((string= style "black") "30")
(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)
(if (null children) ""
@@ -641,7 +641,7 @@
(:added "32") (:removed "31")
(:hunk-header "36") (:file-header "1;36") (t nil))))
(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))))
(nreverse result)))

4
src/components/scrollbox.lisp
View File

@@ -64,12 +64,12 @@
(when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-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)))
(when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-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)))))
(defun update-sticky-scroll (sb)

1
src/components/select-package.lisp
View File

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

17
src/components/textarea.lisp
View File

@@ -1,16 +1,5 @@
(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
;;; ---------------------------------------------------------------------------
@@ -169,10 +158,10 @@
"Save current value on undo stack."
(let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack))
(setf (textarea-undo-stack ta)
(make-array 100 :fill-pointer 0)))
(loop for i from 1 below (length stack)
do (setf (aref stack (1- i)) (aref stack i)))
(decf (fill-pointer stack)))
(vector-push (textarea-value ta) stack)
;; Clear redo stack on new action
(setf (fill-pointer (textarea-redo-stack ta)) 0)))
(defun textarea-undo (ta)