v0.12.0: Terminal capability detection, GPL 3.0 license, roadmap rewrite

LICENSE: - Added GNU General Public License v3.0 - Updated README.org to reflect GPL 3.0 ROADMAP: - Complete rewrite to reflect actual project state - Removed croatoan/ncurses/Yoga FFI references - Marked all 11 existing versions DONE - Added v0.12.0-0.14.0 for new features (detection, pipeline, mouse) DETECTION (v0.12.0): - detect-backend: auto-detect modern vs simple backend - detect-backend-by-env: check COLORTERM env var - detect-backend-by-tty: check interactive-stream-p - detect-backend-by-da1: query terminal via ESC[c (best-effort) - *detected-backend* cache for zero-cost subsequent calls - Added detection.lisp to ASDF and package exports - Added 2 new tests (360 total, all passing) - demo.lisp updated to use detect-backend ORG BACKPORT (pre-existing fixes synced): - dialog.org: render-dialog/render-toast fixes, class initforms - scrollbox-tabbar.org: background-element -> bright-black, remove duplicate render - select.org: remove duplicate render export - text-input.org: remove duplicate %split-string, undo overflow fix - layout-engine.org: quoted-literal -> list constructors, normalize-box rewrite - mouse.org: add missing exports, fix test
2026-05-11 22:25:42 +00:00
parent 3ce7f9949c
commit b7df68c436
16 changed files with 1281 additions and 595 deletions
--- a/org/detection.org
+++ b/org/detection.org
@@ -0,0 +1,155 @@
+#+TITLE: Terminal Capability Detection (v0.12.0)
+#+DATE: 2026-05-11
+#+AUTHOR: Amr Gharbeia / Hermes
+#+STARTUP: content
+
+* Overview
+
+Currently, users must manually choose between ~modern-backend~ and
+~simple-backend~ when initializing cl-tty. This module adds auto-detection:
+
+1. Check if stdout is a real TTY (not piped/redirected)
+2. Check the =COLORTERM= environment variable for truecolor support
+3. Optionally query the terminal via DA1/DA3 escape sequences
+4. Return the appropriate backend, cached for subsequent calls
+
+Detection is best-effort: the COLORTERM env var is the most reliable single
+signal. DA1 queries are asynchronous and many terminals don't respond.
+If detection can't determine modern capability, it falls back to
+~simple-backend~.
+
+** Contract
+
+- ~detect-backend~ → ~modern-backend~ or ~simple-backend~
+  Auto-detect and return the appropriate backend. Results are cached
+  in ~*detected-backend*~.
+
+- ~detect-backend-by-env~ → ~:modern~ or ~nil~
+  Check =COLORTERM= env var for ~truecolor~ or ~24bit~.
+
+- ~detect-backend-by-tty~ → boolean
+  Check if stdout is a real terminal (not a pipe).
+
+- ~detect-backend-by-da1~ → boolean
+  Send DA1 (~ESC[c~) query and check for modern feature responses.
+
+- ~*detected-backend*~ — variable
+  Cache for detection result. ~nil~ = not yet detected.
+
+* Plan
+
+See =docs/plans/2026-05-11-terminal-detection.md= for implementation tasks.
+
+1. Create ~detection.lisp~ with all detection functions
+2. Wire into ASDF
+3. Update ~demo.lisp~ to use ~detect-backend~
+4. Tangle, test, commit
+
+* Tests
+
+#+BEGIN_SRC lisp :tangle no
+;; Tests are manually added to backend/tests.lisp
+(def-test detection-returns-backend-instance ()
+  (let ((be (cl-tty.backend:detect-backend)))
+    (is-true (typep be 'cl-tty.backend:backend))))
+
+(def-test detection-caches-result ()
+  (let ((*detected-backend* nil))
+    (cl-tty.backend:detect-backend)
+    (is-true (not (null cl-tty.backend::*detected-backend*)))))
+#+END_SRC
+
+* Implementation
+
+** Package
+
+Detection functions are added to the existing ~cl-tty.backend~ package.
+No new package definition needed.
+
+** Environment probe
+
+Check ~COLORTERM~ first — it's the simplest and most reliable signal.
+
+#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
+(in-package :cl-tty.backend)
+
+;;; ─── Detection cache ────────────────────────────────────────────────────────
+
+(defvar *detected-backend* nil
+  "Cached backend instance from detect-backend. Nil = not yet detected.")
+
+;;; ─── Environment probe ──────────────────────────────────────────────────────
+
+(defun detect-backend-by-env ()
+  "Check COLORTERM environment variable for modern terminal support.
+Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
+  (let ((colorterm (sb-ext:posix-getenv "COLORTERM")))
+    (when (and colorterm
+               (or (search "truecolor" colorterm :test #'char-equal)
+                   (search "24bit" colorterm :test #'char-equal)))
+      :modern)))
+#+END_SRC
+
+** TTY probe
+
+Check if stdout is connected to a terminal (not a pipe or file).
+
+#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
+;;; ─── TTY probe ──────────────────────────────────────────────────────────────
+
+(defun detect-backend-by-tty ()
+  "Check if stdout is a real terminal (not a pipe/redirect).
+Returns T if stdout is interactive, nil otherwise."
+  (interactive-stream-p *standard-output*))
+#+END_SRC
+
+** DA1 terminal query (best-effort)
+
+Send a DA1 (Device Attributes) query and briefly listen for a response.
+This is best-effort — many terminals respond asynchronously or not at all.
+
+#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
+;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
+
+(defun query-terminal (query &optional (timeout 0.1))
+  "Send QUERY string to terminal and return any response received within
+TIMEOUT seconds. Returns the response string, or nil if no response."
+  (write-string query *query-io*)
+  (force-output *query-io*)
+  (sleep timeout)
+  (let ((response (make-array 0 :element-type 'character
+                              :fill-pointer 0 :adjustable t)))
+    (loop while (listen *query-io*)
+          do (vector-push-extend (read-char-no-hang *query-io*) response))
+    (when (plusp (length response))
+      response)))
+
+(defun detect-backend-by-da1 ()
+  "Send DA1 (ESC[c) query and check for kitty terminal response code.
+Returns T if terminal reports kitty compatibility codes."
+  (let ((response (query-terminal (format nil "~C[c" #\Esc))))
+    (when response
+      ;; DA1 response format: ESC [ ? digits ; digits c
+      ;; Kitty reports code 62 in the response
+      (search "?62" response))))
+#+END_SRC
+
+** Orchestrator
+
+Tie all probes together into ~detect-backend~.
+
+#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
+;;; ─── Orchestrator ───────────────────────────────────────────────────────────
+
+(defun detect-backend ()
+  "Auto-detect the appropriate backend for the current terminal.
+Returns a backend instance (modern-backend or simple-backend).
+Result is cached in *detected-backend* for subsequent calls."
+  (or *detected-backend*
+      (setf *detected-backend*
+            (if (and (detect-backend-by-tty)
+                     (or (eql (detect-backend-by-env) :modern)
+                         (detect-backend-by-da1)))
+                (make-modern-backend)
+                (make-simple-backend)))))
+#+END_SRC
--- a/org/dialog.org
+++ b/org/dialog.org
@@ -94,16 +94,14 @@ Render a dialog: backdrop (dimmed full-screen), then centered panel.
      (when (dialog-content dialog)
        (render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2))))))
 #+END_SRC
+*** push-dialog / pop-dialog

--- per-function: push-dialog
-
-Push a dialog onto the stack and give it focus.
+~push-dialog~ pushes a dialog onto =*dialog-stack*=. ~pop-dialog~ pops the
+top dialog and calls its ~:on-dismiss~ callback if set.

 #+BEGIN_SRC lisp :tangle no
 (defun push-dialog (dialog)
  (push dialog *dialog-stack*)
-  (when (typep (dialog-content dialog) 'focusable-mixin)
-    (focus (dialog-content dialog)))
  dialog)
 #+END_SRC

@@ -290,7 +288,7 @@ Remove a toast from the list.
 ;;; dialog-package.lisp — Package definition for cl-tty.dialog

 (defpackage :cl-tty.dialog
-  (:use :cl :cl-tty :cl-tty.select :cl-tty.input)
+  (:use :cl :cl-tty.input :cl-tty.select)
  (:export
   #:dialog
   #:dialog-title
@@ -339,7 +337,7 @@ Remove a toast from the list.
 (defclass dialog ()
  ((title :initarg :title :accessor dialog-title)
   (size :initarg :size :initform :medium :accessor dialog-size)
-   (content :initarg :content :accessor dialog-content)
+   (content :initarg :content :initform nil :accessor dialog-content)
   (on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))

 (defun dialog-size-pixels (size)
@@ -353,17 +351,19 @@ Remove a toast from the list.
  (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*)
-  (when (typep (dialog-content dialog) 'focusable-mixin)
-    (focus (dialog-content dialog)))
  dialog)

 (defun pop-dialog ()
@@ -434,7 +434,7 @@ Remove a toast from the list.
                   (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)))
@@ -457,8 +457,8 @@ Remove a toast from the list.

 (in-package :cl-tty-dialog-test)

-(def-suite :dialog-suite :description "Dialog + Toast tests for cl-tty.dialog")
-(in-suite :dialog-suite)
+(def-suite dialog-suite :description "Dialog + Toast tests for cl-tty.dialog")
+(in-suite dialog-suite)

 (def-test dialog-create ()
  (let ((d (make-instance 'dialog :title "Test")))
--- a/org/layout-engine.org
+++ b/org/layout-engine.org
@@ -337,11 +337,11 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
   (justify-content :initform :flex-start :initarg :justify-content
                    :accessor layout-node-justify-content)
   ;; Box model
-   (padding  :initform '(:top 0 :right 0 :bottom 0 :left 0)
+  (padding  :initform (list :top 0 :right 0 :bottom 0 :left 0)
             :initarg :padding :accessor layout-node-padding)
-   (margin   :initform '(:top 0 :right 0 :bottom 0 :left 0)
+  (margin   :initform (list :top 0 :right 0 :bottom 0 :left 0)
             :initarg :margin :accessor layout-node-margin)
-   (border   :initform '(:top 0 :right 0 :bottom 0 :left 0)
+  (border   :initform (list :top 0 :right 0 :bottom 0 :left 0)
             :initarg :border :accessor layout-node-border)
   (gap      :initform 0 :initarg :gap :accessor layout-node-gap)
   ;; Position
@@ -383,10 +383,12 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.

 (defun normalize-box (spec)
  "Convert a box property spec to ( :top N :right N :bottom N :left N )."
-  (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))))
+  (cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
+        ((numberp spec) (list :top spec :right spec :bottom spec :left spec))
+        (t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0)
+                 for (key val) on spec by #'cddr
+                 do (setf (getf result key) val)
+                 finally (return result)))))
 #+END_SRC

 *** Tree Manipulation
--- a/org/mouse.org
+++ b/org/mouse.org
@@ -33,7 +33,8 @@ module adds:
   #:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
   #:handle-mouse-event
   #:hit-test
-   #:selection #:get-selection #:copy-to-clipboard))
+   #:selection #:get-selection #:copy-to-clipboard
+   #:make-selection #:selection-p))
 #+END_SRC

 #+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
@@ -98,6 +99,6 @@ module adds:
    (is-true t)))  ;; placeholder

 (def-test selection-set-and-get ()
-  (let ((*selection* (make-selection :text "hello")))
-    (is (equal "hello" (get-selection)))))
+  (setf cl-tty.mouse::*selection* (make-selection :text "hello"))
+  (is (equal "hello" (get-selection))))
 #+END_SRC
--- a/org/scrollbox-tabbar.org
+++ b/org/scrollbox-tabbar.org
@@ -598,12 +598,12 @@ they are truncated with an ellipsis.
    (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)
@@ -681,6 +681,5 @@ they are truncated with an ellipsis.
   #: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))
 #+END_SRC
--- a/org/text-input.org
+++ b/org/text-input.org
@@ -1307,14 +1307,15 @@ onto the redo stack, and restores the old value. ~textarea-redo~ does
 the reverse.

 The ~(>= (length stack) (array-total-size stack))~ guard prevents the
-stack from growing beyond 100 entries by resetting it.
+stack from growing beyond 100 entries by dropping the oldest entry.

 #+BEGIN_SRC lisp
 (defun textarea-push-undo (ta)
  (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)
    (setf (fill-pointer (textarea-redo-stack ta)) 0)))

@@ -2050,17 +2051,6 @@ experience; this section is what actually generates the compilable code.
 #+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
 (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
 ;;; ---------------------------------------------------------------------------
@@ -2219,10 +2209,10 @@ experience; this section is what actually generates the compilable code.
  "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)