cl-tty.asd

@@ -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)))

demo.lisp

@@ -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")
+        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)
                                      :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)
+                (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
-          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
-               (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 "
                               (1+ active) (string-trim " " (nth active tabs)))
                       :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 ──────────────────────────────────────────────────────────────────
 

layout/layout.lisp

@@ -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 (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)
   (or (getf box edge) 0))

run-all-tests.lisp

@@ -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

src/components/container-package.lisp

@@ -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
+   #:tab-bar-select #:tab-bar-handle-key))
-   #:render))

src/components/dialog.lisp

@@ -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)
+        (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))
       (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)))

src/components/markdown.lisp

@@ -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)))
 

src/components/scrollbox.lisp

@@ -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)

src/components/select-package.lisp

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

src/components/textarea.lisp

@@ -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)
+      (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)
-    ;; Clear redo stack on new action
     (setf (fill-pointer (textarea-redo-stack ta)) 0)))
 
 (defun textarea-undo (ta)