v0.8.0: tangle to XDG (~/.local/share/cl-tty/), remove stale memex .lisp files
This commit is contained in:
@@ -107,7 +107,7 @@ FiveAM requires a test package with :use of :fiveam and the system
|
||||
under test. The suite name ~backend-suite~ is referenced by the
|
||||
multi-suite runner in ~run-all-tests.lisp~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(defpackage :cl-tty-backend-test
|
||||
(:use :cl :fiveam :cl-tty.backend)
|
||||
(:export #:run-tests))
|
||||
@@ -124,7 +124,7 @@ creates a simple-backend pointed at a string output stream and
|
||||
returns both the backend and the stream. The test can then call
|
||||
~get-output-stream-string~ after the operation.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(defun make-capturing-backend ()
|
||||
"Create a simple-backend that writes to a string stream."
|
||||
(let* ((s (make-string-output-stream))
|
||||
@@ -138,7 +138,7 @@ The ~run-tests~ function is an alternative entry point for
|
||||
interactive use or for downstream scripts that want to run only the
|
||||
backend suite. It prints results with FiveAM's explainer.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(defun run-tests ()
|
||||
"Run all backend tests."
|
||||
(let ((result (run 'backend-suite)))
|
||||
@@ -153,7 +153,7 @@ shut down without errors. Also confirms that the capability query
|
||||
returns nil for truecolor — the defining characteristic of the
|
||||
simple backend.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test simple-backend-lifecycle
|
||||
"simple-backend can be created and shut down"
|
||||
(let ((b (make-simple-backend)))
|
||||
@@ -172,7 +172,7 @@ and position. It merely appends the text string to the output stream.
|
||||
This test confirms that passing style keywords does not change the
|
||||
output — the captured stream should contain exactly the string "hello".
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test simple-backend-draw-text
|
||||
"simple-backend renders text at position, ignoring style"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -190,7 +190,7 @@ Border rendering on the simple backend uses ASCII characters:
|
||||
This test checks that the top edge contains "+---+" and a middle
|
||||
row shows "| |" with pipe-separated empty space.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test simple-backend-draw-border
|
||||
"simple-backend draws ASCII border with +-| characters"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -209,7 +209,7 @@ falls back to the same ASCII characters. This test verifies that
|
||||
requesting ~:rounded~ produces the same output as ~:single~,
|
||||
confirming the graceful fallback.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test simple-backend-draw-rounded
|
||||
"simple-backend falls back to straight edges for rounded style"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -227,7 +227,7 @@ Hyperlinks are meaningless on a simple terminal output. The simple
|
||||
backend's ~draw-link~ should output only the visible text and
|
||||
completely ignore the URL parameter.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test simple-backend-draw-link
|
||||
"simple-backend renders link as plain text"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -244,7 +244,7 @@ Truncation markers are rendered as three literal dots on the simple
|
||||
backend. This test checks that ~draw-ellipsis~ outputs exactly "..."
|
||||
at the specified position.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test simple-backend-draw-ellipsis
|
||||
"simple-backend renders ... for ellipsis"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -262,7 +262,7 @@ backend. This comprehensive check iterates every feature keyword
|
||||
to ensure the simple backend makes no false claims about its
|
||||
capabilities.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test capable-p-known-features
|
||||
"capable-p returns nil for all features on simple-backend"
|
||||
(let ((b (make-simple-backend)))
|
||||
@@ -281,7 +281,7 @@ representing columns and lines. This test verifies the return types
|
||||
and a minimum size threshold (10 columns, 3 lines) for any
|
||||
terminal-like environment.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test backend-size-returns-integers
|
||||
"backend-size returns two integer values"
|
||||
(let ((b (make-simple-backend)))
|
||||
@@ -302,7 +302,7 @@ test calls ~cursor-hide~, ~cursor-show~, ~cursor-style~,
|
||||
~begin-sync~, and ~end-sync~ and confirms none of them produce
|
||||
multiple return values.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test default-methods-are-no-ops
|
||||
"Default backend methods don't error"
|
||||
(let ((b (make-simple-backend)))
|
||||
@@ -322,7 +322,7 @@ output. This test verifies that wrapping a draw-text call between
|
||||
~begin-sync~ and ~end-sync~ produces exactly the same output as
|
||||
draw-text alone — no extra escape sequences are emitted.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test sync-is-noop-on-simple
|
||||
"begin-sync and end-sync produce no output on simple-backend"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -342,7 +342,7 @@ colors. Since the simple backend emits no escape sequences,
|
||||
~draw-rect~ should produce zero output regardless of the fill
|
||||
color requested.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test draw-rect-fills-area-correctly
|
||||
"draw-rect with background writes nothing to output (simple-backend no-op)"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -359,7 +359,7 @@ The ~detect-backend~ function must return a backend instance
|
||||
suitable for the current environment. This test verifies that the
|
||||
returned value is of type ~backend~ (satisfying the protocol).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test detection-returns-backend-instance
|
||||
"detect-backend returns a valid backend instance"
|
||||
(let ((be (cl-tty.backend:detect-backend)))
|
||||
@@ -373,7 +373,7 @@ subsequent calls are cheap. This test clears the cache, calls
|
||||
detect-backend, and verifies that the special variable is no longer
|
||||
nil.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
|
||||
(test detection-caches-result
|
||||
"detect-backend caches the result in *detected-backend*"
|
||||
(let ((*detected-backend* nil))
|
||||
@@ -395,7 +395,7 @@ The package also exports internal symbols (~sgr-fg~, ~hex-to-24bit~,
|
||||
etc.) for testing. These let the test suite verify escape sequence
|
||||
construction without actually rendering to a terminal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/package.lisp
|
||||
(defpackage :cl-tty.backend
|
||||
(:use :cl)
|
||||
(:export
|
||||
@@ -445,7 +445,7 @@ actually support.
|
||||
An empty base class. There are no slots because backends manage
|
||||
their own state (e.g., output streams) directly.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
(defclass backend () ())
|
||||
@@ -457,7 +457,7 @@ Sets up terminal raw mode and enables features. The default method
|
||||
returns the backend instance unchanged — subclasses that need setup
|
||||
override this.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric initialize-backend (backend)
|
||||
(:method ((b backend)) b))
|
||||
#+END_SRC
|
||||
@@ -468,7 +468,7 @@ Restores terminal to cooked mode, resets colors, shows cursor.
|
||||
Must be called on exit. The default method is a no-op returning
|
||||
multiple values; subclasses with terminal state override this.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric shutdown-backend (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -478,7 +478,7 @@ multiple values; subclasses with terminal state override this.
|
||||
Returns terminal dimensions as two values: columns and lines.
|
||||
The default of 80x24 is a safe fallback that works everywhere.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric backend-size (backend)
|
||||
(:method ((b backend))
|
||||
(values 80 24)))
|
||||
@@ -490,7 +490,7 @@ Writes a raw string to the terminal output. Has no default method
|
||||
because every backend must provide its own output mechanism — there
|
||||
is no reasonable universal behavior.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric backend-write (backend string))
|
||||
#+END_SRC
|
||||
|
||||
@@ -500,7 +500,7 @@ Clears the entire screen and resets the cursor to (0,0). The default
|
||||
method sends the ANSI escape sequence ~ESC[2J~ (clear entire screen)
|
||||
followed by ~ESC[H~ (cursor home).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric backend-clear (backend)
|
||||
(:method ((b backend))
|
||||
(backend-write b (format nil "~C[2J~C[H" #\Esc #\Esc))))
|
||||
@@ -514,7 +514,7 @@ it lets individual backend methods accept keyword arguments they
|
||||
don't use without signaling an error. The simple backend ignores
|
||||
styles; the modern backend processes them.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric draw-text (backend x y string fg bg &key
|
||||
bold italic underline reverse dim blink
|
||||
&allow-other-keys))
|
||||
@@ -526,7 +526,7 @@ Draws a border rectangle with optional title. Style is one of
|
||||
~:single~, ~:double~, or ~:rounded~. The default method has no
|
||||
implementation — each backend provides its own border rendering.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric draw-border (backend x y width height
|
||||
&key style fg bg title title-align))
|
||||
#+END_SRC
|
||||
@@ -537,7 +537,7 @@ Fills a rectangular area with a background color. On the simple
|
||||
backend this is a no-op; on the modern backend it writes space
|
||||
characters with the appropriate SGR background color.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric draw-rect (backend x y width height &key bg))
|
||||
#+END_SRC
|
||||
|
||||
@@ -547,7 +547,7 @@ Renders a clickable hyperlink using OSC 8 escape sequences. The
|
||||
default is a protocol declaration only — modern-backend implements
|
||||
the actual escape sequences, simple-backend falls back to plain text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric draw-link (backend x y string url &key fg bg))
|
||||
#+END_SRC
|
||||
|
||||
@@ -557,7 +557,7 @@ Renders a "..." truncation marker at position (x, y). This is used
|
||||
when text exceeds the available width. Each backend positions the
|
||||
marker according to its own coordinate system.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric draw-ellipsis (backend x y width &key fg bg))
|
||||
#+END_SRC
|
||||
|
||||
@@ -566,7 +566,7 @@ marker according to its own coordinate system.
|
||||
Moves the cursor to absolute position (x, y). The default method
|
||||
is a no-op — backends that support cursor positioning override this.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric cursor-move (backend x y)
|
||||
(:method ((b backend) x y) (declare (ignore x y)) (values)))
|
||||
#+END_SRC
|
||||
@@ -576,7 +576,7 @@ is a no-op — backends that support cursor positioning override this.
|
||||
Hides the terminal cursor. The default method is a no-op so that
|
||||
backends that lack cursor control still work safely.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric cursor-hide (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -586,7 +586,7 @@ backends that lack cursor control still work safely.
|
||||
Shows the terminal cursor after a hide. Always paired with
|
||||
~cursor-hide~. Default is a no-op.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric cursor-show (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -597,7 +597,7 @@ Sets the cursor shape and blink behavior. Shape is ~:block~,
|
||||
~:bar~, or ~:underline~. Default is a no-op for backends that
|
||||
don't support cursor styling.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric cursor-style (backend shape &key blink)
|
||||
(:method ((b backend) shape &key blink) (values)))
|
||||
#+END_SRC
|
||||
@@ -607,7 +607,7 @@ don't support cursor styling.
|
||||
Starts a synchronized update (DECICM). All subsequent output is
|
||||
buffered by the terminal until ~end-sync~. Default is a no-op.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric begin-sync (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -617,7 +617,7 @@ buffered by the terminal until ~end-sync~. Default is a no-op.
|
||||
Flushes the synchronized update buffer so the entire frame appears
|
||||
at once. Always paired with ~begin-sync~. Default is a no-op.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric end-sync (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -628,7 +628,7 @@ Reads the next input event from the terminal. Blocks until an event
|
||||
arrives or the timeout expires. Returns (values keyword event-data).
|
||||
The default method returns ~(values nil nil)~ — no events available.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric read-event (backend &key timeout)
|
||||
(:method ((b backend) &key timeout) (values nil nil)))
|
||||
#+END_SRC
|
||||
@@ -639,7 +639,7 @@ Enables SGR mouse tracking so mouse click and motion events are
|
||||
reported as input. Default is a no-op on backends that don't
|
||||
support mouse input.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric enable-mouse (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -649,7 +649,7 @@ support mouse input.
|
||||
Enables bracketed paste mode so the application can distinguish
|
||||
pasted text from typed input. Default is a no-op.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric enable-bracketed-paste (backend)
|
||||
(:method ((b backend)) (values)))
|
||||
#+END_SRC
|
||||
@@ -661,7 +661,7 @@ keywords include ~:truecolor~, ~:osc8~, ~:sync~, ~:mouse~,
|
||||
~:bracketed-paste~, ~:kitty-keyboard~, ~:sixel~, and
|
||||
~:cursor-style~. The default method returns ~nil~ for all features.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(defgeneric capable-p (backend feature)
|
||||
(:method ((b backend) feature)
|
||||
(declare (ignore feature))
|
||||
@@ -675,7 +675,7 @@ application receives SIGTSTP (suspend) or SIGCONT (resume) signals.
|
||||
The default methods are no-ops; backends with terminal state override
|
||||
these to restore cooked mode on suspend and raw mode on resume.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
(defgeneric suspend-backend (backend)
|
||||
@@ -705,7 +705,7 @@ Arguments:
|
||||
lines captured after initialization.
|
||||
- ~&body body~ — executed with the above bindings.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
(defmacro with-terminal ((backend-var &optional cols-var rows-var)
|
||||
@@ -754,7 +754,7 @@ the ~:output-stream~ initarg — the key extensibility point. Tests
|
||||
use ~make-string-output-stream~ to capture output, while production
|
||||
uses ~*standard-output*~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
(defclass simple-backend (backend)
|
||||
@@ -770,7 +770,7 @@ Constructor function that creates a ~simple-backend~ instance. Uses
|
||||
~*standard-output*~. This function is exported rather than exposing
|
||||
~make-instance~ directly to provide a stable API surface.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defun make-simple-backend (&key output-stream)
|
||||
(make-instance 'simple-backend
|
||||
:output-stream (or output-stream *standard-output*)))
|
||||
@@ -782,7 +782,7 @@ Simple backend initialization is a no-op — there is no terminal
|
||||
state to configure. Returns the backend instance to satisfy the
|
||||
protocol contract.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod initialize-backend ((b simple-backend))
|
||||
b)
|
||||
#+END_SRC
|
||||
@@ -792,7 +792,7 @@ protocol contract.
|
||||
Simple backend shutdown is a no-op — there is no terminal state to
|
||||
restore. Returns multiple values to satisfy the protocol contract.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod shutdown-backend ((b simple-backend))
|
||||
(values))
|
||||
#+END_SRC
|
||||
@@ -801,7 +801,7 @@ restore. Returns multiple values to satisfy the protocol contract.
|
||||
|
||||
No-op — simple backend has no terminal state to save.
|
||||
|
||||
#+begin_src lisp :tangle ../src/backend/simple.lisp
|
||||
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod suspend-backend ((b simple-backend))
|
||||
(values))
|
||||
#+end_src
|
||||
@@ -810,7 +810,7 @@ No-op — simple backend has no terminal state to save.
|
||||
|
||||
No-op — simple backend has no terminal state to restore.
|
||||
|
||||
#+begin_src lisp :tangle ../src/backend/simple.lisp
|
||||
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod resume-backend ((b simple-backend))
|
||||
(values))
|
||||
#+end_src
|
||||
@@ -825,7 +825,7 @@ a hard-coded 80x24 at the end:
|
||||
3. **ioctl on ~/dev/tty~** — fallback when stdin/stdout are pipes.
|
||||
4. **~(values 80 24)~** — last resort.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod backend-size ((b simple-backend))
|
||||
;; Try ioctl on fd 0 (stdin), then stdout, then /dev/tty, then 80x24.
|
||||
;; Use multiple-value-bind/values to preserve both cols and rows
|
||||
@@ -883,7 +883,7 @@ Writes a string to the backend's output stream and returns its length.
|
||||
Does NOT flush — explicit sync points (~initialize-backend~,
|
||||
~end-sync~, etc.) call ~finish-output~ as needed.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod backend-write ((b simple-backend) string)
|
||||
(let ((stream (backend-output-stream b)))
|
||||
(write-string string stream)
|
||||
@@ -897,7 +897,7 @@ completely. It appends only the string content to the output stream.
|
||||
This means simple backends are always a "scroll and dump" mode —
|
||||
no cursor positioning, no escape sequences.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod draw-text ((b simple-backend) x y string fg bg
|
||||
&key bold italic underline reverse dim blink
|
||||
&allow-other-keys)
|
||||
@@ -912,7 +912,7 @@ corners use ~#\+~, horizontal edges use ~#\-~, and vertical edges
|
||||
use ~#\|~. No style distinction — single, double, and rounded are
|
||||
identical in ASCII output.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defun %simple-border-char (pos)
|
||||
"Return ASCII border character at POS.
|
||||
POS is :top-left, :top-right, :bottom-left, :bottom-right,
|
||||
@@ -931,7 +931,7 @@ The title rendering supports ~:left~ and ~:center~ alignment,
|
||||
placing the title inside the top border line with horizontal
|
||||
dashes filling the remaining space.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod draw-border ((b simple-backend) x y width height
|
||||
&key style fg bg title title-align)
|
||||
(declare (ignore style fg bg))
|
||||
@@ -987,7 +987,7 @@ dashes filling the remaining space.
|
||||
Background fill is impossible without escape sequences. This method
|
||||
is a no-op — it discards all arguments and returns ~(values)~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod draw-rect ((b simple-backend) x y width height
|
||||
&key bg)
|
||||
(declare (ignore x y width height bg))
|
||||
@@ -1001,7 +1001,7 @@ Hyperlinks fall back to plain text on the simple backend. The URL
|
||||
parameter is discarded entirely; the visible text is rendered via
|
||||
~draw-text~ with no styling.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod draw-link ((b simple-backend) x y string url
|
||||
&key fg bg)
|
||||
(declare (ignore url fg bg))
|
||||
@@ -1014,7 +1014,7 @@ Renders "..." using the simple backend's positioning pattern:
|
||||
newlines to reach the target row, spaces to reach the target column,
|
||||
then the literal three dots. No escape sequences are used.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
|
||||
(defmethod draw-ellipsis ((b simple-backend) x y width
|
||||
&key fg bg)
|
||||
(declare (ignore width fg bg))
|
||||
|
||||
@@ -43,7 +43,7 @@ The test package exports ~run-tests~ so it can be invoked from the
|
||||
top-level test runner. ~fiveam~ imports directly for declarative
|
||||
~test~ and ~is~ forms. The ~box-suite~ collects all box/text tests.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(defpackage :cl-tty-box-test
|
||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
|
||||
(:export #:run-tests))
|
||||
@@ -59,7 +59,7 @@ top-level test runner. ~fiveam~ imports directly for declarative
|
||||
~run-all-tests.lisp~. It runs the ~box-suite~, explains results to
|
||||
stdout, and exits cleanly with ~uiop:quit~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(defun run-tests ()
|
||||
(let ((result (run 'box-suite)))
|
||||
(fiveam:explain! result)
|
||||
@@ -73,7 +73,7 @@ stdout, and exits cleanly with ~uiop:quit~.
|
||||
actual terminal I/O. Returns the backend and stream as multiple
|
||||
values.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(defun make-capturing-backend ()
|
||||
(let* ((s (make-string-output-stream))
|
||||
(b (make-modern-backend :output-stream s)))
|
||||
@@ -85,7 +85,7 @@ values.
|
||||
Verify that a bare ~make-box~ returns a ~box~ instance and
|
||||
automatically creates a ~layout-node~ through inheritance.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-creates-with-defaults
|
||||
"A box created with no arguments has reasonable defaults"
|
||||
(let ((b (make-box)))
|
||||
@@ -98,7 +98,7 @@ automatically creates a ~layout-node~ through inheritance.
|
||||
Verify that a box with ~:border-style :single~ draws the four corner
|
||||
characters (┌ ┐ └ ┘) in the output stream.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-renders-border
|
||||
"A box with border draws border characters"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -117,7 +117,7 @@ characters (┌ ┐ └ ┘) in the output stream.
|
||||
Verify that a box with ~:bg :red~ emits SGR background color codes
|
||||
(41m) in the output stream.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-renders-background
|
||||
"A box with background color fills interior"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -134,7 +134,7 @@ Verify that a box with ~:bg :red~ emits SGR background color codes
|
||||
Verify that a title string appears in the rendered output stream
|
||||
when ~:title~ is provided.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-renders-title
|
||||
"A box with title renders the title text"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -150,7 +150,7 @@ when ~:title~ is provided.
|
||||
Verify that ~:border-style nil~ suppresses corner characters but
|
||||
background fill rendering continues to work.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-without-border
|
||||
"A box with border-style nil draws no border"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -167,7 +167,7 @@ background fill rendering continues to work.
|
||||
Verify that a box with zero width and height produces no output
|
||||
(triggers the early-return guard in ~render-box~).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-zero-size
|
||||
"A box with any zero dimension renders nothing"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -183,7 +183,7 @@ Verify that a box with zero width and height produces no output
|
||||
Verify that a box with width 1 produces no output — ~draw-border~
|
||||
requires at least 2 columns to draw corner and edge characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-single-column
|
||||
"A box with width 1 renders nothing (needs min 2 for border)"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -199,7 +199,7 @@ requires at least 2 columns to draw corner and edge characters.
|
||||
Verify that a 2x2 box (the minimum viable size for border rendering)
|
||||
still produces corner characters in the output.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test box-minimum-size
|
||||
"A box with minimum non-zero size still renders"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -215,7 +215,7 @@ still produces corner characters in the output.
|
||||
Verify that ~make-text~ with an empty string returns a ~text~
|
||||
instance and creates a ~layout-node~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test text-creates-with-defaults
|
||||
"A text created with no arguments has reasonable defaults"
|
||||
(let ((txt (make-text "")))
|
||||
@@ -228,7 +228,7 @@ instance and creates a ~layout-node~.
|
||||
Verify that text content appears in the captured output stream after
|
||||
rendering.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test text-renders-content
|
||||
"A text renders its content at position"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -244,7 +244,7 @@ rendering.
|
||||
Verify that an empty string produces no output (triggers the
|
||||
early-return guard in ~render-text~).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test text-empty-string
|
||||
"Empty text produces no output"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -260,7 +260,7 @@ early-return guard in ~render-text~).
|
||||
Verify that ~:wrap-mode :none~ truncates the content string to fit
|
||||
within the available width, producing only the first N characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test text-truncates-when-no-wrap
|
||||
"Text with wrap-mode :none truncates at width"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -277,7 +277,7 @@ within the available width, producing only the first N characters.
|
||||
Verify that ~:wrap-mode :word~ breaks lines at word boundaries,
|
||||
distributing words across successive rows.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test text-word-wraps
|
||||
"Text with wrap-mode :word wraps at word boundaries"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -295,7 +295,7 @@ distributing words across successive rows.
|
||||
Verify that a single word longer than the available width is
|
||||
hard-broken at character boundaries into ~max-width~-sized chunks.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test text-word-wrap-single-word
|
||||
"A word longer than width is hard-broken at max-width"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -312,7 +312,7 @@ hard-broken at character boundaries into ~max-width~-sized chunks.
|
||||
Verify that ~span~ stores its text content and style attributes
|
||||
correctly, with unset attributes defaulting to ~nil~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test span-creates-with-attributes
|
||||
"A span has text and optional style attributes"
|
||||
(let ((s (span "bold text" :bold t)))
|
||||
@@ -326,7 +326,7 @@ correctly, with unset attributes defaulting to ~nil~.
|
||||
Verify that ~make-text~ with ~:spans~ stores the provided span
|
||||
objects and they are accessible via ~text-spans~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
||||
(test make-text-with-spans
|
||||
"Text with spans stores span objects"
|
||||
(let* ((sp (list (span "Hello" :bold t)
|
||||
@@ -346,7 +346,7 @@ color change) trigger incremental re-render. The ~layout-node~ slot
|
||||
holds the computed position and size from the layout engine. Border
|
||||
style, title, alignment, and colors are all configurable slots.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
(defclass box (dirty-mixin)
|
||||
@@ -367,7 +367,7 @@ The constructor wraps ~make-instance~ and passes layout parameters
|
||||
through to the layout node. Width and height are optional; when
|
||||
omitted the layout engine will compute them from parent constraints.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
|
||||
(defun make-box (&key (border-style :single) title
|
||||
(title-align :left) fg bg
|
||||
width height)
|
||||
@@ -393,7 +393,7 @@ Title rendering supports ~:left~, ~:center~, and ~:right~ alignment
|
||||
with automatic truncation when the title is wider than available
|
||||
content area (width-4 when border is present).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
|
||||
(defun render-box (box backend)
|
||||
"Render BOX at its computed layout position using BACKEND."
|
||||
(let ((ln (box-layout-node box))
|
||||
@@ -430,7 +430,7 @@ Multiple spans let a single Text contain bold, colored, or italicized
|
||||
runs. Each style attribute is a separate slot so consumers can
|
||||
inspect and apply them individually.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
(defclass span ()
|
||||
@@ -450,7 +450,7 @@ inspect and apply them individually.
|
||||
keyword arguments for all style attributes. A ~nil~ default means
|
||||
"inherit/no-change" when merged with parent styling context.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(defun span (text &key bold italic underline reverse dim fg bg)
|
||||
(make-instance 'span
|
||||
:text text :bold bold :italic italic
|
||||
@@ -465,7 +465,7 @@ Spans are stored for future per-run styling but the current
|
||||
implementation renders all content as plain text. It inherits from
|
||||
~dirty-mixin~ so content, color, or size changes trigger re-render.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(defclass text (dirty-mixin)
|
||||
((layout-node :initform (make-layout-node) :accessor text-layout-node
|
||||
:initarg :layout-node)
|
||||
@@ -483,7 +483,7 @@ dimensions and content parameters. It defaults ~wrap-mode~ to ~:word~
|
||||
so text wraps by default, and creates a ~:column~-oriented layout
|
||||
node.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(defun make-text (content &key fg bg wrap-mode width height spans)
|
||||
(make-instance 'text
|
||||
:content content
|
||||
@@ -502,7 +502,7 @@ at successive row positions. For ~:none~, it truncates the content to
|
||||
fit the width in a single line. Empty content or zero dimensions
|
||||
triggers an early return.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(defun render-text (text-object backend)
|
||||
"Render TEXT-OBJECT at its computed layout position using BACKEND."
|
||||
(let ((ln (text-layout-node text-object))
|
||||
@@ -535,7 +535,7 @@ input into words, then packs them into lines respecting ~max-width~.
|
||||
Words that exceed ~max-width~ are hard-broken at character boundaries
|
||||
in chunks of ~max-width~ to ensure no line exceeds the limit.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(defun word-wrap (text max-width)
|
||||
"Split TEXT into lines, each <= MAX-WIDTH chars."
|
||||
(if (or (zerop max-width) (zerop (length text)))
|
||||
@@ -572,7 +572,7 @@ newline). It uses ~position-if~ to find delimiters and builds the
|
||||
word list iteratively. Consecutive delimiters are collapsed
|
||||
(only one advance per delimiter character).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
||||
(defun split-string (string)
|
||||
"Split STRING into words separated by whitespace."
|
||||
(loop with words = nil
|
||||
|
||||
@@ -107,7 +107,7 @@ that point. The current scope favors simplicity and co-location.
|
||||
|
||||
* Package Definition
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/container-package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/container-package.lisp
|
||||
(defpackage :cl-tty.container
|
||||
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
||||
(:export
|
||||
|
||||
@@ -80,7 +80,7 @@ Using a global variable rather than a closure or class slot keeps the detection
|
||||
path stateless and trivially resettable for testing: binding ~*detected-backend*~
|
||||
to ~nil~ forces a fresh detection run.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
(defvar *detected-backend* nil
|
||||
@@ -98,7 +98,7 @@ sequence queries.
|
||||
Case-insensitive matching via ~char-equal~ handles variances across platforms
|
||||
(GNOME Terminal uses ~truecolor~, some Windows builds use ~24bit~).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
|
||||
(defun detect-backend-by-env ()
|
||||
"Check COLORTERM environment variable for modern terminal support.
|
||||
Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
|
||||
@@ -119,7 +119,7 @@ further (I/O-dependent) probes. Must happen before ~detect-backend-by-da1~.
|
||||
Testing this predicate first also avoids wasting time on DA1 queries when the
|
||||
output is consumed by a test runner, CI pipeline, or pipe.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
|
||||
(defun detect-backend-by-tty ()
|
||||
"Check if stdout is a real terminal (not a pipe/redirect).
|
||||
Returns T if stdout is interactive, nil otherwise."
|
||||
@@ -140,7 +140,7 @@ bytes arrive within the timeout without blocking. The ~0.1~ second default
|
||||
strikes a balance between responsiveness and reliability: fast enough to avoid
|
||||
noticeable delay in interactive use, long enough for most terminals to reply.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
|
||||
(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."
|
||||
@@ -168,7 +168,7 @@ This probe is best-effort: many terminals do not respond within the timeout,
|
||||
and some return different codes for the same capabilities. A ~nil~ result from
|
||||
this function should never prevent fallback detection via environment variables.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
|
||||
(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."
|
||||
@@ -193,7 +193,7 @@ returns nil, the expensive DA1 query never runs. If ~detect-backend-by-env~
|
||||
returns ~:modern~, the DA1 query is skipped. The result is cached in
|
||||
~*detected-backend*~ so subsequent calls are effectively free.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
|
||||
(defun detect-backend ()
|
||||
"Auto-detect the appropriate backend for the current terminal.
|
||||
Returns a backend instance (modern-backend or simple-backend).
|
||||
|
||||
@@ -50,7 +50,7 @@ duration. They stack in the top-right corner.
|
||||
The ~cl-tty.dialog~ package uses the backend, input, and select
|
||||
subsystems. All public symbols are exported for user convenience.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog-package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog-package.lisp
|
||||
;;; dialog-package.lisp — Package definition for cl-tty.dialog
|
||||
|
||||
(defpackage :cl-tty.dialog
|
||||
@@ -87,7 +87,7 @@ The active dialog stack. ~push-dialog~ conses onto this list;
|
||||
should bind its own instance so multiple screens can have independent
|
||||
dialog states.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(in-package :cl-tty.dialog)
|
||||
|
||||
(defvar *dialog-stack* nil
|
||||
@@ -100,7 +100,7 @@ List of active toast notifications. ~toast~ pushes, ~dismiss-toast~
|
||||
removes by identity. The render loop walks this list to draw toasts in
|
||||
the top-right corner.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defvar *toasts* nil
|
||||
"List of active toast notifications.")
|
||||
#+END_SRC
|
||||
@@ -111,7 +111,7 @@ The core dialog class stores a title, a size preset, the content
|
||||
component to render inside the panel, and an optional ~:on-dismiss~
|
||||
callback invoked when the dialog is popped.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defclass dialog ()
|
||||
((title :initarg :title :accessor dialog-title)
|
||||
(size :initarg :size :initform :medium :accessor dialog-size)
|
||||
@@ -125,7 +125,7 @@ Converts a size keyword (~:small~, ~:medium~, ~:large~) to pixel
|
||||
dimensions. Accepts optional ~max-w~ / ~max-h~ to clamp the result to
|
||||
terminal bounds, preventing off-screen overflow (fixed in v1.0.0).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun dialog-size-pixels (size &optional (max-w 80) (max-h 24))
|
||||
(multiple-value-bind (dw dh)
|
||||
(case size
|
||||
@@ -142,7 +142,7 @@ Renders a dialog: draws a dimmed full-screen backdrop using
|
||||
~draw-rect~, then draws the bordered dialog panel centered on screen.
|
||||
Content is rendered via ~draw-text~ inside the panel area.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun render-dialog (dialog screen w h)
|
||||
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog) w h)
|
||||
(let ((x (floor (- w dw) 2))
|
||||
@@ -163,7 +163,7 @@ Content is rendered via ~draw-text~ inside the panel area.
|
||||
|
||||
Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun push-dialog (dialog)
|
||||
(push dialog *dialog-stack*)
|
||||
dialog)
|
||||
@@ -174,7 +174,7 @@ Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining.
|
||||
Pops the top dialog from the stack. If an ~:on-dismiss~ callback is
|
||||
set on the dialog, it is called before returning.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun pop-dialog ()
|
||||
(when *dialog-stack*
|
||||
(let ((dialog (pop *dialog-stack*)))
|
||||
@@ -194,7 +194,7 @@ Simple alert with title, message, and an OK button. The button is a
|
||||
~select~ with a single "OK" option. Dismissing fires ~pop-dialog~ on
|
||||
both selection and backdrop dismiss.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun alert-dialog (title message)
|
||||
(make-instance 'dialog
|
||||
:title title
|
||||
@@ -210,7 +210,7 @@ both selection and backdrop dismiss.
|
||||
Confirm dialog with Yes/No buttons. Returns ~:yes~ or ~:no~ via the
|
||||
~on-yes~/~on-no~ callbacks. The dialog auto-dismisses on selection.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun confirm-dialog (title message &key on-yes on-no)
|
||||
(make-instance 'dialog
|
||||
:title title
|
||||
@@ -230,7 +230,7 @@ Confirm dialog with Yes/No buttons. Returns ~:yes~ or ~:no~ via the
|
||||
Modal wrapper around the ~select~ component. Presents a list of options
|
||||
and calls ~on-select~ with the chosen value after dismissing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun select-dialog (title options &key on-select)
|
||||
(make-instance 'dialog
|
||||
:title title
|
||||
@@ -247,7 +247,7 @@ and calls ~on-select~ with the chosen value after dismissing.
|
||||
Modal wrapper around ~text-input~. Shows a text input field inside the
|
||||
dialog and calls ~on-submit~ with the entered value after dismissing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun prompt-dialog (title &key on-submit)
|
||||
(make-instance 'dialog
|
||||
:title title
|
||||
@@ -268,7 +268,7 @@ has a message and a variant that determines its color (~:info~,
|
||||
|
||||
Lightweight class storing the message text and variant keyword.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defclass toast ()
|
||||
((message :initarg :message :accessor toast-message)
|
||||
(variant :initarg :variant :initform :info :accessor toast-variant)))
|
||||
@@ -280,7 +280,7 @@ Draws a toast in the top-right corner of the screen. The message is
|
||||
truncated to 60 columns with an ellipsis if necessary. The background
|
||||
color reflects the variant.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun render-toast (toast screen w)
|
||||
(let* ((msg (toast-message toast))
|
||||
(variant (toast-variant toast))
|
||||
@@ -302,7 +302,7 @@ Fire-and-forget toast notification. Creates a ~toast~ instance, pushes
|
||||
it onto =*toasts*~, and optionally schedules auto-dismissal via
|
||||
~dismiss-toast~ when ~duration~ is positive.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun toast (message &key (variant :info) (duration 0))
|
||||
(let ((toast (make-instance 'toast :message message :variant variant)))
|
||||
(push toast *toasts*)
|
||||
@@ -315,7 +315,7 @@ it onto =*toasts*~, and optionally schedules auto-dismissal via
|
||||
Removes a toast from =*toasts*~ by identity (~remove~ with default
|
||||
~:test #'eql~ compares by pointer for CLOS objects).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
|
||||
(defun dismiss-toast (toast)
|
||||
(setf *toasts* (remove toast *toasts*)))
|
||||
#+END_SRC
|
||||
@@ -327,7 +327,7 @@ interaction.
|
||||
|
||||
** Test package and suite
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
;;; dialog-tests.lisp — Tests for cl-tty.dialog
|
||||
|
||||
(defpackage :cl-tty-dialog-test
|
||||
@@ -343,7 +343,7 @@ interaction.
|
||||
|
||||
Basic dialog instantiation — verifies ~make-instance~ and accessors.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
(def-test dialog-create ()
|
||||
(let ((d (make-instance 'dialog :title "Test")))
|
||||
(is-true (typep d 'dialog))
|
||||
@@ -354,7 +354,7 @@ Basic dialog instantiation — verifies ~make-instance~ and accessors.
|
||||
|
||||
~dialog-size-pixels~ returns the correct dimensions for ~:small~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
(def-test dialog-size-small ()
|
||||
(multiple-value-bind (w h) (dialog-size-pixels :small)
|
||||
(is (= 40 w))
|
||||
@@ -365,7 +365,7 @@ Basic dialog instantiation — verifies ~make-instance~ and accessors.
|
||||
|
||||
~dialog-size-pixels~ returns the correct dimensions for ~:medium~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
(def-test dialog-size-medium ()
|
||||
(multiple-value-bind (w h) (dialog-size-pixels :medium)
|
||||
(is (= 60 w))
|
||||
@@ -377,7 +377,7 @@ Basic dialog instantiation — verifies ~make-instance~ and accessors.
|
||||
Verifies stack operations: push adds to =*dialog-stack*~, pop removes
|
||||
the top element.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
(def-test dialog-push-pop ()
|
||||
(let ((*dialog-stack* nil))
|
||||
(push-dialog (make-instance 'dialog :title "D1"))
|
||||
@@ -392,7 +392,7 @@ the top element.
|
||||
|
||||
Verifies that ~toast~ pushes onto =*toasts*~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
(def-test toast-create ()
|
||||
(let ((*toasts* nil))
|
||||
(toast "Hello" :variant :info :duration 0)
|
||||
@@ -403,7 +403,7 @@ Verifies that ~toast~ pushes onto =*toasts*~.
|
||||
|
||||
Verifies that ~dismiss-toast~ removes the toast from =*toasts*~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
|
||||
(def-test toast-dismiss ()
|
||||
(let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
|
||||
(dismiss-toast (first *toasts*))
|
||||
|
||||
@@ -47,7 +47,7 @@ with ~dirty~ set to ~t~. This is the core invariant of the dirty tracking
|
||||
system — without this, the first render pass would skip new components,
|
||||
making them invisible until something explicitly marked them dirty.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dirty-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty-tests.lisp
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
|
||||
@@ -65,7 +65,7 @@ signaling that it is up-to-date and does not need re-render until the
|
||||
next change. Without this, every component would be re-rendered every
|
||||
frame.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dirty-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty-tests.lisp
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
|
||||
@@ -83,7 +83,7 @@ re-marked as dirty via ~mark-dirty~. This exercises the full lifecycle:
|
||||
new (dirty) → render (mark-clean) → state change (mark-dirty) → render
|
||||
again. It ensures the dirty flag is not a one-shot toggle.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dirty-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty-tests.lisp
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
|
||||
@@ -102,7 +102,7 @@ choice: make this a separate mixin rather than part of the base
|
||||
~component~ class. This lets non-UI objects (layout nodes, render
|
||||
commands) opt into dirty tracking without inheriting from component.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dirty.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty.lisp
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
;; ── Dirty Tracking ─────────────────────────────────────────────
|
||||
@@ -116,7 +116,7 @@ the first render pass doesn't skip them. If this default were ~nil~,
|
||||
new components would be invisible until something explicitly marked
|
||||
them dirty.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dirty.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty.lisp
|
||||
(defgeneric mark-clean (component)
|
||||
(:method ((c dirty-mixin))
|
||||
(setf (dirty-p c) nil)))
|
||||
@@ -126,7 +126,7 @@ them dirty.
|
||||
method (for non-dirty-mixin components) is a no-op — they have no
|
||||
dirty state to clear.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/dirty.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty.lisp
|
||||
(defgeneric mark-dirty (component)
|
||||
(:method ((c dirty-mixin))
|
||||
(setf (dirty-p c) t)))
|
||||
|
||||
@@ -188,7 +188,7 @@ framebuffer backend class, constructor, diff/flush utilities, scissor macro,
|
||||
and frame-inspection functions. It depends on ~:cl-tty.backend~ for the
|
||||
~backend~ base class and protocol methods.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defpackage :cl-tty.rendering
|
||||
(:use :cl :cl-tty.backend)
|
||||
(:export
|
||||
@@ -206,7 +206,7 @@ and frame-inspection functions. It depends on ~:cl-tty.backend~ for the
|
||||
|
||||
Switch to the ~cl-tty.rendering~ package for all subsequent definitions.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(in-package :cl-tty.rendering)
|
||||
#+END_SRC
|
||||
|
||||
@@ -218,7 +218,7 @@ compared by value during diffing. All fields have sensible defaults so that
|
||||
~make-cell~ with no arguments produces a blank space cell. The ~link-url~
|
||||
slot enables OSC-8 hyperlink support for clickable text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defstruct cell
|
||||
"A single terminal cell — character, colors, and attributes."
|
||||
(char #\space :type character)
|
||||
@@ -239,7 +239,7 @@ columns. Using ~:initial-element (make-cell)~ ensures every cell is a fresh
|
||||
struct instance (not shared). The ~:element-type~ declaration is a hint for
|
||||
potential optimizations.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun make-framebuffer (width height)
|
||||
"Create a 2D array of CELL with dimensions HEIGHT x WIDTH."
|
||||
(make-array (list height width)
|
||||
@@ -253,13 +253,13 @@ Accessors that return the dimensions of a framebuffer array. These guard
|
||||
against non-array values (returning 0) so that callers don't crash on nil or
|
||||
uninitialized framebuffer slots.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun framebuffer-width (fb)
|
||||
"Return the width (columns) of framebuffer FB."
|
||||
(if (arrayp fb) (array-dimension fb 1) 0))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun framebuffer-height (fb)
|
||||
"Return the height (rows) of framebuffer FB."
|
||||
(if (arrayp fb) (array-dimension fb 0) 0))
|
||||
@@ -274,7 +274,7 @@ plus scissor-clipping state. All drawing methods on this backend write to the
|
||||
cell array instead of emitting escape sequences. The scissor coordinates are
|
||||
used by ~%in-scissor-p~ to clip drawing during component rendering.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defclass framebuffer-backend (backend)
|
||||
((framebuffer :initform nil :accessor fb-framebuffer)
|
||||
(scissor-x :initform 0 :accessor fb-scissor-x)
|
||||
@@ -289,7 +289,7 @@ Constructor that creates a ~framebuffer-backend~ instance and initializes its
|
||||
framebuffer array to the given dimensions (defaulting to 80x24, a common
|
||||
terminal size).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun make-framebuffer-backend (&key (width 80) (height 24))
|
||||
"Create a framebuffer-backend with a fresh framebuffer."
|
||||
(let ((fb (make-instance 'framebuffer-backend)))
|
||||
@@ -306,7 +306,7 @@ scissor rectangle. If either scissor dimension is nil (meaning no scissor is
|
||||
set), the corresponding axis check is skipped, effectively treating the entire
|
||||
framebuffer as the drawable area.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun %in-scissor-p (fb cx cy)
|
||||
"Check if (CX, CY) falls within the current scissor rectangle."
|
||||
(let ((sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
|
||||
@@ -323,7 +323,7 @@ ultimately lands, ensuring consistent clipping behavior across all drawing
|
||||
operations. Only cells within both the framebuffer dimensions and the active
|
||||
scissor rectangle are written.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun %set-cell (fb x y char &key fg bg bold italic underline link-url)
|
||||
"Set cell (X, Y) if within bounds and scissor."
|
||||
(let ((cells (fb-framebuffer fb)))
|
||||
@@ -346,7 +346,7 @@ clipping apply automatically. The ~&allow-other-keys~ permits passing
|
||||
style-related keyword arguments that other backends may use but the framebuffer
|
||||
does not need (e.g., reverse, dim, blink).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod draw-text ((fb framebuffer-backend) x y string fg bg
|
||||
&key bold italic underline reverse dim blink
|
||||
(link-url nil link-url-p)
|
||||
@@ -365,7 +365,7 @@ Direct rendering onto a raw 2D framebuffer array (the type returned by
|
||||
~make-framebuffer~). This lets application code call ~draw-text~ directly on a
|
||||
framebuffer without wrapping it in a ~framebuffer-backend~.
|
||||
|
||||
#+begin_src lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod draw-text ((fb array) x y string fg bg
|
||||
&key bold italic underline reverse dim blink
|
||||
&allow-other-keys)
|
||||
@@ -387,7 +387,7 @@ framebuffer without wrapping it in a ~framebuffer-backend~.
|
||||
Allow clearing a raw 2D framebuffer array directly (same type as returned by
|
||||
~make-framebuffer~). Resets all cells to blank defaults.
|
||||
|
||||
#+begin_src lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod backend-clear ((fb array))
|
||||
(dotimes (y (array-dimension fb 0))
|
||||
(dotimes (x (array-dimension fb 1))
|
||||
@@ -401,7 +401,7 @@ color. This is used for clearing areas and rendering background fills for
|
||||
panels and widgets. Iterates row by row, column by column, using ~%set-cell~ so
|
||||
scissor clipping is respected.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg)
|
||||
(dotimes (row h)
|
||||
(dotimes (col w)
|
||||
@@ -415,7 +415,7 @@ string at the top edge. Supports three border styles: :single, :double, and
|
||||
:rounded, each using different corner and line characters. The title is drawn
|
||||
starting two cells from the left edge, overwriting top-edge characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
|
||||
(let* ((chars (case style
|
||||
(:single '(#\+ #\- #\|))
|
||||
@@ -447,7 +447,7 @@ Clears every cell in the framebuffer to a fresh default cell (space, no style).
|
||||
This is the ~backend-clear~ protocol method specialized on ~framebuffer-backend~,
|
||||
providing a full-frame reset used between render passes.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod backend-clear ((fb framebuffer-backend))
|
||||
(let ((cells (fb-framebuffer fb)))
|
||||
(dotimes (y (framebuffer-height cells))
|
||||
@@ -464,7 +464,7 @@ stores the URL in the cell's ~link-url~ slot for later retrieval (e.g., on
|
||||
mouse click). The actual OSC-8 escape sequence rendering is deferred to the
|
||||
real backend during flush.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod draw-link ((fb framebuffer-backend) x y string url &key fg bg)
|
||||
;; OSC 8 links are not rendered in framebuffer — store as text
|
||||
(draw-text fb x y string fg bg :link-url url))
|
||||
@@ -475,7 +475,7 @@ real backend during flush.
|
||||
Renders a horizontal ellipsis (up to 3 periods) starting at position (X, Y).
|
||||
Width is capped at 3 characters to prevent overflow into adjacent cells.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmethod draw-ellipsis ((fb framebuffer-backend) x y width &key fg bg)
|
||||
(dotimes (i (min 3 width))
|
||||
(%set-cell fb (+ x i) y #\. :fg fg :bg bg)))
|
||||
@@ -490,7 +490,7 @@ same visual output. Uses ~eql~ for characters, symbols, and booleans, and
|
||||
~equal~ for string comparison of ~link-url~. This predicate drives the diff
|
||||
algorithm — only cells that differ are flushed.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun cells-equal-p (a b)
|
||||
"Return T if two cells have identical content and style."
|
||||
(and (eql (cell-char a) (cell-char b))
|
||||
@@ -509,7 +509,7 @@ framebuffers and collect a list of (X Y CELL) triples for every cell that
|
||||
changed. Using ~nreverse~ at the end ensures stable ordering (top-to-bottom,
|
||||
left-to-right) without consing during accumulation.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun diff-framebuffers (prev curr)
|
||||
"Compare PREV and CURR framebuffers. Return list of (X Y CELL) for changes."
|
||||
(let ((changes nil)
|
||||
@@ -533,7 +533,7 @@ minimal cursor movement (tracking the current row to avoid redundant cursor
|
||||
positioning). Returns the count of changed cells so callers can monitor
|
||||
rendering overhead.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun flush-framebuffer (prev-fb curr-fb backend)
|
||||
"Diff PREV-FB and CURR-FB and flush changes to BACKEND.
|
||||
Returns the number of changed cells."
|
||||
@@ -564,7 +564,7 @@ Retrieves the hyperlink URL stored at cell position (X, Y) in a framebuffer
|
||||
array. Returns nil if the cell is out of bounds or has no link. This enables
|
||||
click-to-open-link functionality in the TUI.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun fb-cell-link-url (fb x y)
|
||||
"Return the link URL at (X Y) in framebuffer FB, or nil."
|
||||
(when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
|
||||
@@ -580,7 +580,7 @@ mouse selection and clipboard operations. Normalizes coordinate order (so the
|
||||
user can drag in any direction) and appends newlines between rows for natural
|
||||
multi-line text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defun extract-text (fb x1 y1 x2 y2)
|
||||
"Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)."
|
||||
(let ((x-min (max 0 (min x1 x2))) (x-max (max 0 (max x1 x2)))
|
||||
@@ -604,7 +604,7 @@ for the duration of BODY. Saves and restores previous scissor state via
|
||||
~unwind-protect~ for proper cleanup even on non-local exits. Using gensyms for
|
||||
the state variables ensures no variable capture issues.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
|
||||
(defmacro with-scissor ((fb x y w h) &body body)
|
||||
"Clip all drawing on FB to rectangle (X Y W H)."
|
||||
(let ((old-x (gensym)) (old-y (gensym))
|
||||
@@ -632,7 +632,7 @@ Setting up the test package with FiveAM, importing the rendering and backend
|
||||
packages for use in all subsequent tests. This block tangles to the test file
|
||||
that is loaded by the test runner.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(defpackage :cl-tty-framebuffer-test
|
||||
(:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
|
||||
(in-package :cl-tty-framebuffer-test)
|
||||
@@ -647,7 +647,7 @@ Verify that the framebuffer constructor produces an array with the expected
|
||||
dimensions. Height should match the first dimension (rows), width the second
|
||||
dimension (columns).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test make-framebuffer-creates-correct-size
|
||||
(let ((fb (make-framebuffer 80 24)))
|
||||
(is (= 24 (framebuffer-height fb)))
|
||||
@@ -659,7 +659,7 @@ dimension (columns).
|
||||
Cells created via MAKE-CELL with no arguments should default to a space
|
||||
character with nil foreground and background — a blank, unstyled cell.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test cell-defaults-are-space
|
||||
(let ((cell (aref (make-framebuffer 10 10) 0 0)))
|
||||
(is (eql #\space (cell-char cell)))
|
||||
@@ -673,7 +673,7 @@ Drawing a string into the framebuffer backend should set the character and
|
||||
foreground color at each cell position. Characters should appear at the expected
|
||||
(x, y) offsets.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test draw-text-on-fb-sets-cells
|
||||
(let ((fb (make-framebuffer-backend)))
|
||||
(draw-text fb 2 3 "abc" :red nil)
|
||||
@@ -690,7 +690,7 @@ When drawing text that extends past the right edge of the framebuffer, cells
|
||||
beyond the width should remain unchanged (space characters). This prevents
|
||||
buffer overflow and undefined memory access.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test draw-text-clips-at-bounds
|
||||
(let ((fb (make-framebuffer-backend :width 10 :height 5)))
|
||||
(draw-text fb 8 2 "hello" nil nil)
|
||||
@@ -705,7 +705,7 @@ buffer overflow and undefined memory access.
|
||||
Two framebuffers with identical cells should produce no changes. The diff
|
||||
engine must short-circuit when no cells differ.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test diff-identical-fbs-returns-empty
|
||||
(let ((fb1 (make-framebuffer 80 24))
|
||||
(fb2 (make-framebuffer 80 24)))
|
||||
@@ -717,7 +717,7 @@ engine must short-circuit when no cells differ.
|
||||
After modifying a single cell in one framebuffer, the diff engine should return
|
||||
exactly one change with the correct coordinates and cell data.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test diff-changed-fb-returns-changes
|
||||
(let* ((fb1 (make-framebuffer 10 10))
|
||||
(fb2 (make-framebuffer 10 10)))
|
||||
@@ -735,7 +735,7 @@ exactly one change with the correct coordinates and cell data.
|
||||
When a scissor rectangle is active, drawing operations outside the rectangle
|
||||
should be clipped away. Operations inside the rectangle should proceed normally.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test with-scissor-clips-drawing
|
||||
(let ((fb (make-framebuffer-backend :width 20 :height 10)))
|
||||
(with-scissor (fb 5 5 3 3)
|
||||
@@ -753,7 +753,7 @@ should be diffed. This test verifies correct behavior at both the smaller and
|
||||
larger end of the size mismatch — ensuring edge cells in the non-overlapping
|
||||
region are ignored.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test flush-different-sized-fbs-handles-edge-cells
|
||||
(let* ((small-fb (make-framebuffer 5 5))
|
||||
(large-fb (make-framebuffer 10 10))
|
||||
@@ -775,7 +775,7 @@ region are ignored.
|
||||
After drawing on a framebuffer backend and flushing to a real backend, at least
|
||||
one cell change should be detected and forwarded to the output backend.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test flush-fb-copies-to-backend
|
||||
(let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
|
||||
(fb (make-framebuffer-backend)))
|
||||
@@ -789,7 +789,7 @@ one cell change should be detected and forwarded to the output backend.
|
||||
A cell without a hyperlink should return nil from ~fb-cell-link-url~, ensuring
|
||||
the default state is correct and no spurious URL is reported.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test fb-cell-link-url-returns-nil-for-blank-cell
|
||||
(let ((fb (make-framebuffer 10 10)))
|
||||
(is (null (fb-cell-link-url fb 5 5)))))
|
||||
@@ -801,7 +801,7 @@ After drawing text with a link-url, the corresponding cell should return that
|
||||
URL. Cells at other positions should still return nil. This validates that
|
||||
link metadata is stored per-cell and correctly retrievable.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test fb-cell-link-url-finds-link-url
|
||||
(let ((fb (make-framebuffer-backend)))
|
||||
(draw-text fb 0 0 "click" nil nil :link-url "https://example.com")
|
||||
@@ -815,7 +815,7 @@ Querying a cell position outside the framebuffer dimensions should gracefully
|
||||
return nil rather than erroring, which prevents crashes during mouse event
|
||||
processing at the edges of the terminal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test fb-cell-link-url-out-of-bounds-returns-nil
|
||||
(let ((fb (make-framebuffer 5 5)))
|
||||
(is (null (fb-cell-link-url fb 10 10)))))
|
||||
@@ -827,7 +827,7 @@ Extracting text from a single row of the framebuffer should return the
|
||||
characters in that row as a contiguous string, preserving order and including
|
||||
only visible characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test extract-text-single-row
|
||||
(let ((fb (make-framebuffer-backend)))
|
||||
(draw-text fb 0 0 "hello" nil nil)
|
||||
@@ -841,7 +841,7 @@ Extracting text from a rectangle spanning multiple rows should concatenate
|
||||
rows with newline separators. This matches the expected behavior for clipboard
|
||||
copy of rectangular selections in the TUI.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
|
||||
(test extract-text-multi-row
|
||||
(let ((fb (make-framebuffer-backend)))
|
||||
(draw-text fb 0 0 "abc" nil nil)
|
||||
|
||||
@@ -39,7 +39,7 @@ The run-all-tests.lisp loader references this suite by name
|
||||
(~\"INTEGRATION-SUITE\"~) and looks it up via ~find-symbol~ in the
|
||||
package, so the symbol must be interned and accessible.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
;;; integration-tests.lisp — Full pipeline integration tests for cl-tty
|
||||
;;;
|
||||
;;; Composes all major components through the rendering pipeline onto a
|
||||
@@ -75,7 +75,7 @@ The framebuffer stores cells in a 2D array indexed as ~(aref cells y x)~.
|
||||
Cells are structs with a ~cell-char~ slot holding the character. We
|
||||
iterate horizontally and collect each ~cell-char~ into a string.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(defun fb-string (fb x y &optional (len 1))
|
||||
"Read a string of LEN characters from framebuffer FB starting at (X,Y)."
|
||||
(let* ((cells (fb-framebuffer fb))
|
||||
@@ -95,7 +95,7 @@ Extracts all rows from the framebuffer as a list of strings. Each row is
|
||||
the full width of the framebuffer converted via ~fb-string~. Optional
|
||||
~start-row~ and ~end-row~ keywords let callers inspect a sub-region.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(defun fb-lines (fb &key (start-row 0) (end-row nil))
|
||||
"Extract all lines from framebuffer FB as a list of strings."
|
||||
(let* ((cells (fb-framebuffer fb))
|
||||
@@ -116,7 +116,7 @@ newlines and runs ~search~.
|
||||
This is the most commonly used assertion helper — it lets tests check for
|
||||
the presence of rendered text without specifying exact coordinates.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(defun fb-contains (fb text)
|
||||
"Return T if framebuffer FB contains TEXT anywhere."
|
||||
(let ((all-text (format nil "~{~a~^~%~}" (fb-lines fb))))
|
||||
@@ -135,7 +135,7 @@ The title is rendered starting at column 2 of row 1 (just inside the
|
||||
top border). We check ~fb-string~ at those exact coordinates for the
|
||||
title text, and ~fb-contains~ for the border characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test box-title-renders-on-fb
|
||||
"A Box with a title draws border and title text on framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||
@@ -160,7 +160,7 @@ Word-wrap mode ~:word~ preserves word boundaries — it only wraps between
|
||||
words, never in the middle of one. The framebuffer is 20 columns wide, so
|
||||
each row holds roughly 2-3 words.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test text-component-on-fb
|
||||
"Text component renders word-wrapped content on framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 20 :height 6))
|
||||
@@ -186,7 +186,7 @@ Direct cell access (~aref~ on the framebuffer array) is necessary because
|
||||
the cursor block is a single character that ~fb-contains~ could match
|
||||
ambiguously.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test textinput-value-on-fb
|
||||
"TextInput renders its value and cursor on framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||
@@ -213,7 +213,7 @@ The placeholder must disappear once a value is set — that behavior is
|
||||
tested indirectly here by verifying the placeholder text appears on an
|
||||
empty input.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test textinput-placeholder-on-fb
|
||||
"TextInput with empty value shows placeholder text."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||
@@ -236,7 +236,7 @@ with ~scroll-y=2~ and a viewport height of 8. Lines 1-2 should be
|
||||
scrolled out, while Lines 3-8 should be visible. We check both presence
|
||||
(visible lines) and absence (scrolled-out lines).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test scrollbox-children-on-fb
|
||||
"ScrollBox renders visible children offset by scroll position."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||
@@ -276,7 +276,7 @@ The ~make-select~ function takes a list of plists with ~:title~ and
|
||||
~:value~ keys. The render method iterates over options and draws each
|
||||
title.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test select-options-on-fb
|
||||
"Select renders option titles on framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||
@@ -304,7 +304,7 @@ global stack, renders it, and checks for the title and ASCII border
|
||||
characters. The backdrop is a dimming overlay applied across the full
|
||||
framebuffer area.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test dialog-appears-on-fb
|
||||
"Dialog renders a dimmed backdrop and dialog panel with title."
|
||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||
@@ -331,7 +331,7 @@ verifies that only the top dialog (\"Dialog Two\") renders, then pops it
|
||||
and verifies that \"Dialog One\" appears after clearing and re-rendering.
|
||||
This exercises the full push-pop-render cycle.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test dialog-push-pop-render
|
||||
"Dialog push/pop cycle works with rendering."
|
||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||
@@ -359,7 +359,7 @@ in the list, verifies the message text appears, and then dismisses it to
|
||||
clean up. The ~duration~ is set to 0 so the toast does not auto-dismiss
|
||||
during the test.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test toast-appears-on-fb
|
||||
"Toast notification renders with colored background."
|
||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24)))
|
||||
@@ -380,7 +380,7 @@ This test creates a simple tree with a single Box, calls
|
||||
appear. This validates that the pipeline dispatches correctly from root
|
||||
through the component hierarchy.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test render-screen-pipeline
|
||||
"render-screen processes a component tree through the full pipeline."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 12))
|
||||
@@ -410,7 +410,7 @@ Each component is positioned manually via ~layout-node-x~ and
|
||||
~layout-node-y~ to simulate a composed screen. All components must coexist
|
||||
without overwriting each other's output.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
|
||||
(test full-composition-via-fb
|
||||
"All components compose correctly on a single framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 60 :height 24)))
|
||||
|
||||
@@ -47,7 +47,7 @@ unnecessary — ~200 lines of CL math suffices.
|
||||
The test package uses ~:fiveam~ for the test framework and imports
|
||||
all exported symbols from ~cl-tty.layout~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(defpackage :cl-tty-layout-test
|
||||
(:use :cl :fiveam :cl-tty.layout)
|
||||
(:export #:run-tests))
|
||||
@@ -59,7 +59,7 @@ all exported symbols from ~cl-tty.layout~.
|
||||
~fiveam~ suites collect related tests under a descriptive name for
|
||||
batch execution.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(def-suite layout-suite :description "Layout engine tests")
|
||||
(in-suite layout-suite)
|
||||
#+END_SRC
|
||||
@@ -69,7 +69,7 @@ batch execution.
|
||||
~run-tests~ provides a convenient entry point that prints results and
|
||||
exits cleanly for CI or batch runs.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(defun run-tests ()
|
||||
(let ((result (run 'layout-suite)))
|
||||
(fiveam:explain! result)
|
||||
@@ -81,7 +81,7 @@ exits cleanly for CI or batch runs.
|
||||
Verify that a node created with no arguments has the correct default
|
||||
direction ~:column~ and is of type ~layout-node~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test make-layout-node-defaults
|
||||
(let ((n (make-layout-node)))
|
||||
(is (typep n 'layout-node))
|
||||
@@ -93,7 +93,7 @@ direction ~:column~ and is of type ~layout-node~.
|
||||
Verify that passing ~:direction :row~ produces a node whose direction
|
||||
slot reflects that choice.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test make-layout-node-row
|
||||
(let ((n (make-layout-node :direction :row)))
|
||||
(is (eql (layout-node-direction n) :row))))
|
||||
@@ -104,7 +104,7 @@ slot reflects that choice.
|
||||
Children must have their ~parent~ back-pointer set when added, and
|
||||
the parent's ~children~ list must contain the child.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test add-child-sets-parent
|
||||
(let ((parent (make-layout-node)) (child (make-layout-node)))
|
||||
(layout-node-add-child parent child)
|
||||
@@ -117,7 +117,7 @@ the parent's ~children~ list must contain the child.
|
||||
Removing a child should clear its parent reference and remove it
|
||||
from the parent's ~children~ list.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test remove-child-clears-parent
|
||||
(let ((parent (make-layout-node)) (child (make-layout-node)))
|
||||
(layout-node-add-child parent child)
|
||||
@@ -131,7 +131,7 @@ from the parent's ~children~ list.
|
||||
In a column layout, children stack top-to-bottom. The first child
|
||||
starts at y=0; the second starts below the first.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test column-two-children-vertical
|
||||
(let* ((root (make-layout-node :direction :column))
|
||||
(c1 (make-layout-node :height 3))
|
||||
@@ -147,7 +147,7 @@ starts at y=0; the second starts below the first.
|
||||
In a row layout, children stack left-to-right. The first child starts
|
||||
at x=0; the second starts to the right of the first.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test row-two-children-horizontal
|
||||
(let* ((root (make-layout-node :direction :row))
|
||||
(c1 (make-layout-node :width 10))
|
||||
@@ -164,7 +164,7 @@ When children have different ~grow~ values, remaining space is
|
||||
divided in proportion to those values. A child with grow=2 gets
|
||||
twice as much extra space as a child with grow=1.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test flex-grow-distributes-space
|
||||
(let* ((root (make-layout-node :direction :row :width 20))
|
||||
(c1 (make-layout-node :width 4 :grow 1))
|
||||
@@ -179,7 +179,7 @@ twice as much extra space as a child with grow=1.
|
||||
A single flexible child with ~grow~ set should expand to fill all
|
||||
available space in the container.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test flex-grow-single-child
|
||||
(let* ((root (make-layout-node :direction :row :width 20))
|
||||
(c (make-layout-node :width 5 :grow 1)))
|
||||
@@ -193,7 +193,7 @@ available space in the container.
|
||||
When children exceed the container size, each child shrinks in
|
||||
proportion to its ~shrink~ value.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test flex-shrink-reduces-overflow
|
||||
(let* ((root (make-layout-node :direction :row :width 10))
|
||||
(c1 (make-layout-node :width 8 :shrink 1))
|
||||
@@ -208,7 +208,7 @@ proportion to its ~shrink~ value.
|
||||
Padding insets the child rendering area. Children are offset by the
|
||||
padding values and sized to the remaining space.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test padding-reduces-content-area
|
||||
(let* ((root (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
|
||||
(c (make-layout-node :height 3)))
|
||||
@@ -223,7 +223,7 @@ padding values and sized to the remaining space.
|
||||
The ~gap~ property inserts spacing between consecutive children
|
||||
without adding space before the first or after the last.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test gap-between-children
|
||||
(let* ((root (make-layout-node :direction :column :gap 2))
|
||||
(c1 (make-layout-node :height 3))
|
||||
@@ -239,7 +239,7 @@ The ~vbox~ macro creates a column-direction container and adds
|
||||
children in one expression. The second child's y-offset should be
|
||||
the sum of the first child's height plus gap.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test vbox-macro
|
||||
(let ((r (vbox () (make-layout-node :height 3) (make-layout-node :height 5))))
|
||||
(compute-layout r 20 20)
|
||||
@@ -252,7 +252,7 @@ the sum of the first child's height plus gap.
|
||||
The ~hbox~ macro creates a row-direction container. The second
|
||||
child's x-offset should equal the first child's width.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test hbox-macro
|
||||
(let ((r (hbox () (make-layout-node :width 5) (make-layout-node :width 3))))
|
||||
(compute-layout r 20 10)
|
||||
@@ -266,7 +266,7 @@ The ~spacer~ macro creates a flexible node that pushes siblings
|
||||
apart. With two fixed-width children and a spacer between them, the
|
||||
spacer absorbs all remaining width.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test spacer-takes-grow
|
||||
(let ((r (hbox (:width 20) (make-layout-node :width 5) (spacer :grow 1) (make-layout-node :width 5))))
|
||||
(compute-layout r 20 10)
|
||||
@@ -279,7 +279,7 @@ spacer absorbs all remaining width.
|
||||
Nesting a column layout inside a row layout exercises the recursive
|
||||
solver. Sidebar gets fixed width; main content stretches.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test nested-vbox-in-hbox
|
||||
(let* ((sidebar (vbox (:width 5 :height 10) (make-layout-node :height 3) (make-layout-node :height 7)))
|
||||
(main (vbox (:grow 1 :height 10) (make-layout-node :height 2) (make-layout-node :grow 1)))
|
||||
@@ -297,7 +297,7 @@ solver. Sidebar gets fixed width; main content stretches.
|
||||
Layout must gracefully handle containers with no children, returning
|
||||
valid integer dimensions.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test empty-container-does-not-crash
|
||||
(let ((r (make-layout-node)))
|
||||
(compute-layout r 20 20)
|
||||
@@ -310,7 +310,7 @@ valid integer dimensions.
|
||||
A column with one child positions it at the origin and sizes it to
|
||||
its requested height. Width is inherited from the container.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test single-child-in-column
|
||||
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
|
||||
(c (make-layout-node :height 5)))
|
||||
@@ -325,7 +325,7 @@ its requested height. Width is inherited from the container.
|
||||
When available space is zero, the solver must still produce valid
|
||||
integer coordinates without crashing or producing NaN/infinite values.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test zero-size-container
|
||||
(let* ((r (make-layout-node :direction :column))
|
||||
(c (make-layout-node :height 5)))
|
||||
@@ -340,7 +340,7 @@ integer coordinates without crashing or producing NaN/infinite values.
|
||||
Three levels of nested vboxes ensure that layout is computed
|
||||
correctly for deeply nested subtrees.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test deep-nesting-three-levels
|
||||
(let* ((out (vbox ()
|
||||
(vbox (:grow 1)
|
||||
@@ -356,7 +356,7 @@ correctly for deeply nested subtrees.
|
||||
Substantial padding on all sides should offset children inward by the
|
||||
full padding amount.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test large-padding-leaves-room
|
||||
(let* ((r (make-layout-node :direction :column
|
||||
:padding '(:top 5 :left 5 :bottom 5 :right 5)))
|
||||
@@ -372,7 +372,7 @@ full padding amount.
|
||||
A negative ~grow~ value should not cause layout errors. The solver
|
||||
treats it as zero for distribution purposes and produces valid output.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
|
||||
(test negative-grow-is-clamped
|
||||
(let* ((r (make-layout-node :direction :row :width 10))
|
||||
(c (make-layout-node :width 5 :grow -1)))
|
||||
@@ -390,7 +390,7 @@ and manipulating layout trees. Internal accessors like
|
||||
~layout-node-parent~ and helpers like ~normalize-box~ are also
|
||||
exported for testing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defpackage :cl-tty.layout
|
||||
(:use :cl)
|
||||
(:export
|
||||
@@ -417,7 +417,7 @@ exported for testing.
|
||||
plist. This normalisation layer means users can pass ~:padding 2~ or
|
||||
~:padding '(:top 1 :left 2)~ interchangeably throughout the API.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun normalize-box (spec)
|
||||
(cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
|
||||
((numberp spec) (list :top spec :right spec :bottom spec :left spec))
|
||||
@@ -432,7 +432,7 @@ plist. This normalisation layer means users can pass ~:padding 2~ or
|
||||
~box-edge~ extracts the value for a specific edge keyword from a
|
||||
canonical box plist, defaulting to zero if the key is not present.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun box-edge (box edge)
|
||||
(or (getf box edge) 0))
|
||||
#+END_SRC
|
||||
@@ -446,7 +446,7 @@ and input constraints (~direction~, ~grow~, ~shrink~, ~padding~,
|
||||
~margin~, ~gap~, ~position-type~, ~position-offset~, ~fixed-width~,
|
||||
~fixed-height~).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defclass layout-node ()
|
||||
((parent :initform nil :accessor layout-node-parent)
|
||||
(children :initform nil :accessor layout-node-children)
|
||||
@@ -472,7 +472,7 @@ and input constraints (~direction~, ~grow~, ~shrink~, ~padding~,
|
||||
keyword arguments through ~normalize-box~ for padding/margin, fills
|
||||
defaults for missing values, and delegates to ~make-instance~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun make-layout-node (&key direction grow shrink padding margin gap
|
||||
position-type position-offset width height)
|
||||
(make-instance 'layout-node
|
||||
@@ -493,7 +493,7 @@ defaults for missing values, and delegates to ~make-instance~.
|
||||
child's parent back-pointer and appending to the parent's children
|
||||
list. Returns the child for convenience in chaining or ~let~ forms.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun layout-node-add-child (parent child)
|
||||
(setf (layout-node-parent child) parent)
|
||||
(setf (layout-node-children parent)
|
||||
@@ -507,7 +507,7 @@ list. Returns the child for convenience in chaining or ~let~ forms.
|
||||
back-pointer and removing it from the parent's children list.
|
||||
Returns the child.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun layout-node-remove-child (parent child)
|
||||
(setf (layout-node-parent child) nil)
|
||||
(setf (layout-node-children parent)
|
||||
@@ -524,7 +524,7 @@ gap. Each child starts from its fixed size. Remaining space is
|
||||
distributed by grow ratio; overflow is reduced by shrink ratio.
|
||||
Rounding errors are amortized across the first N children.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun distribute-sizes (children avail gap horizontal)
|
||||
(let* ((n (length children))
|
||||
(gap-total (* gap (max 0 (1- n))))
|
||||
@@ -563,7 +563,7 @@ within given dimensions. It positions each child at the correct
|
||||
inner ~labels~ form ~place-children~ handles the recursive descent,
|
||||
adjusting for padding and direction at each level.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defun compute-layout (root available-width available-height)
|
||||
(labels ((place-children (node x y max-w max-h)
|
||||
(let* ((children (layout-node-children node))
|
||||
@@ -628,7 +628,7 @@ adjusting for padding and direction at each level.
|
||||
properties and adds all children via ~layout-node-add-child~. The
|
||||
~gensym~ ensures no variable capture in the expansion.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defmacro vbox ((&key grow shrink padding margin gap width height) &body children)
|
||||
(let ((n (gensym)))
|
||||
`(let ((,n (make-layout-node :direction :column
|
||||
@@ -648,7 +648,7 @@ properties and adds all children via ~layout-node-add-child~. The
|
||||
~hbox~ creates a row-direction container, structurally identical to
|
||||
~vbox~ except the ~:direction~ is ~:row~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defmacro hbox ((&key grow shrink padding margin gap width height) &body children)
|
||||
(let ((n (gensym)))
|
||||
`(let ((,n (make-layout-node :direction :row
|
||||
@@ -668,7 +668,7 @@ properties and adds all children via ~layout-node-add-child~. The
|
||||
~spacer~ creates a minimal flex-grow node that fills remaining space,
|
||||
defaulting to ~grow 1~ when no keyword is given.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
|
||||
(defmacro spacer (&key grow)
|
||||
`(make-layout-node :grow ,(or grow 1)))
|
||||
#+END_SRC
|
||||
|
||||
@@ -11,7 +11,7 @@ and diff rendering. Self-contained in ~cl-tty.markdown~ package.
|
||||
|
||||
** Package
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown-package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown-package.lisp
|
||||
(defpackage :cl-tty.markdown
|
||||
(:use :cl)
|
||||
(:export
|
||||
@@ -30,7 +30,7 @@ comment indicating the file's purpose. This block is the first to
|
||||
target ~markdown.lisp~ and thus overwrites any previous content;
|
||||
all subsequent blocks append.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
;;; markdown.lisp — Markdown + Code + Diff rendering for cl-tty
|
||||
|
||||
(in-package :cl-tty.markdown)
|
||||
@@ -51,7 +51,7 @@ symbol and optional keyword arguments for ~children~, ~properties~,
|
||||
~content~, and ~url~. Only non-nil slots are stored, keeping the
|
||||
plist compact.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun make-md-node (type &key children properties content url)
|
||||
(let ((node (list :type type)))
|
||||
(when children (setf (getf node :children) children))
|
||||
@@ -67,7 +67,7 @@ Predicate that checks whether a value is an AST node by verifying it
|
||||
is a list and has a ~:type~ property. This uses plist access which
|
||||
bypasses the need for ~typep~ or class-based dispatch.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun md-node-p (thing)
|
||||
(and (listp thing) (getf thing :type)))
|
||||
#+END_SRC
|
||||
@@ -80,7 +80,7 @@ node tree. The ~:link~ type formats as ~text (url)~; ~:text~ and
|
||||
concatenate their children's text. This is useful for summarisation
|
||||
and testing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun md-node-text (node)
|
||||
(let ((type (getf node :type)))
|
||||
(cond ((eql type :text) (or (getf node :content) ""))
|
||||
@@ -107,7 +107,7 @@ Handles ~CRLF~, ~LF~, and missing trailing newline uniformly.
|
||||
Returns a ~vector~ for fast indexed access by line number during
|
||||
parsing. Returns an empty vector for ~nil~ input.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun split-string-into-lines (string)
|
||||
(unless string (return-from split-string-into-lines (coerce nil 'vector)))
|
||||
(let ((result nil) (start 0))
|
||||
@@ -130,7 +130,7 @@ markers, unordered/ordered list items, diff headers, diff lines, and
|
||||
fenced code-block starts — and returns a ~(cons type data)~ pair.
|
||||
Everything else is treated as a paragraph continuation line.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun classify-line (line)
|
||||
(cond
|
||||
((string= line "") (cons :blank nil))
|
||||
@@ -188,7 +188,7 @@ Scans for a literal marker string starting from position ~start~,
|
||||
escaping backslash-escaped markers. This is shared by inline
|
||||
emphasis, code span, and link parsing. Returns the position or ~nil~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun find-closing-marker (text start marker)
|
||||
(let ((marker-len (length marker)) (len (length text)))
|
||||
(loop for j from start to (- len marker-len)
|
||||
@@ -206,7 +206,7 @@ into a single ~:paragraph~ node. Stops at a blank line or any
|
||||
non-paragraph classification. Lines are joined with spaces before
|
||||
inline parsing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-paragraph (lines start)
|
||||
(let ((text-parts nil) (i start))
|
||||
(loop while (< i (length lines))
|
||||
@@ -233,7 +233,7 @@ Like ~parse-paragraph~ but collects ~:blockquote~ lines and strips the
|
||||
leading ~>~ marker. The collected text is then inline-parsed to
|
||||
support bold, italic, code, and links inside quotes.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-blockquote (lines start)
|
||||
(let ((text-parts nil) (i start))
|
||||
(loop while (< i (length lines))
|
||||
@@ -262,7 +262,7 @@ loose lists), but a blank line followed by a non-list line terminates
|
||||
the list. Returns multiple nodes because each top-level list item
|
||||
becomes its own ~:list-item~ or ~:ordered-item~ node.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-list (lines start)
|
||||
(let ((items nil) (i start))
|
||||
(loop while (< i (length lines))
|
||||
@@ -297,7 +297,7 @@ match in character and be at least as long. The language (if any) is
|
||||
taken from the info string on the opening fence. Produces a single
|
||||
~:code-block~ node.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-code-block (lines start lang)
|
||||
(let ((code-lines nil)
|
||||
(i (1+ start))
|
||||
@@ -333,7 +333,7 @@ single ~:diff-block~ node. The raw lines are preserved in a ~:lines~
|
||||
property for coloured rendering later. Diff blocks are delimited by
|
||||
blank lines.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-diff-block (lines start)
|
||||
(let ((diff-lines nil) (i start))
|
||||
(loop while (< i (length lines))
|
||||
@@ -363,7 +363,7 @@ Handles blank lines, thematic breaks, headings, paragraphs,
|
||||
blockquotes, lists, code blocks, and diff blocks. Returns ~nil~ for
|
||||
~nil~ input.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-blocks (text)
|
||||
(unless text (return-from parse-blocks nil))
|
||||
(let ((lines (split-string-into-lines text)) (nodes nil) (i 0))
|
||||
@@ -416,7 +416,7 @@ triggers inline code; ~[~ triggers links; everything else is
|
||||
accumulated as plain ~:text~ nodes. Consecutive plain text is merged
|
||||
into single nodes for efficiency.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-inline (text)
|
||||
(unless (and text (> (length text) 0)) (return-from parse-inline nil))
|
||||
(let ((nodes nil) (i 0) (len (length text)))
|
||||
@@ -462,7 +462,7 @@ node, otherwise it falls back to single-star ~:italic~. If neither
|
||||
closes, returns ~nil~ to let the caller treat the character as literal
|
||||
text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-star-emphasis (text i len)
|
||||
(when (>= i len) (return-from parse-star-emphasis (values nil i)))
|
||||
(if (and (< (1+ i) len) (char= (char text (1+ i)) #\*))
|
||||
@@ -486,7 +486,7 @@ opens after whitespace or at the start of text, and single-underscore
|
||||
italic only closes before whitespace or punctuation. This avoids false
|
||||
positives in identifiers like ~foo_bar~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-underscore-emphasis (text i len)
|
||||
(when (>= i len) (return-from parse-underscore-emphasis (values nil i)))
|
||||
(when (and (> i 0) (not (find (char text (1- i)) " \t\n\r")))
|
||||
@@ -512,7 +512,7 @@ Parses backtick-delimited inline code spans. Supports up to three
|
||||
backticks as delimiters (so single backticks inside double-backtick
|
||||
spans work). The matched pair's backtick count must be equal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-inline-code (text i len)
|
||||
(when (or (>= i len) (not (char= (char text i) #\`)))
|
||||
(return-from parse-inline-code (values nil i)))
|
||||
@@ -534,7 +534,7 @@ matching via ~find-closing-marker~. The text portion is inline-parsed
|
||||
to support formatting inside link text. Returns ~nil~ if the syntax
|
||||
is incomplete, letting the caller render the ~[~ as literal text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun parse-link (text i len)
|
||||
(when (or (>= i len) (not (char= (char text i) #\[)))
|
||||
(return-from parse-link (values nil i)))
|
||||
@@ -568,7 +568,7 @@ the caller to fall back to plain rendering. The assoc list uses
|
||||
~string=~ for matching on the language tag, and each entry uses a
|
||||
dotted-pair format ~(\"language\" . plist)~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun get-highlighter (lang)
|
||||
(cdr (assoc lang
|
||||
'(("lisp" . (:comment (";" "#|" ";;") :string ("\"")
|
||||
@@ -665,7 +665,7 @@ provides the patterns for comment delimiters, string delimiters,
|
||||
keywords, and builtins. Words immediately followed by ~(~ are
|
||||
classified as ~:function~ calls.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun tokenize-line (line highlighter)
|
||||
(let ((tokens nil) (i 0) (len (length line))
|
||||
(comment-chars (getf highlighter :comment))
|
||||
@@ -742,7 +742,7 @@ returns a flat list of ~(token . category)~ pairs with newline
|
||||
separators between lines. Returns ~nil~ for empty input or a single
|
||||
~:plain~ pair if no highlighter is found for the language.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun highlight-code (code language)
|
||||
(unless code (return-from highlight-code nil))
|
||||
(let ((highlighter (get-highlighter (and language (string-downcase language)))))
|
||||
@@ -763,7 +763,7 @@ category. Keywords get colour 33 (yellow), builtins 36 (cyan),
|
||||
functions 34 (blue), comments 2 (dim), strings 32 (green), numbers
|
||||
35 (magenta). Unrecognised categories render as plain text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun apply-highlight-token (token category)
|
||||
(let ((code (case category
|
||||
(:keyword "33") (:builtin "36")
|
||||
@@ -778,7 +778,7 @@ Coerces an adjustable character vector (accumulated during line
|
||||
rendering) back into a string. This is a thin wrapper that exists
|
||||
for potential future customisation of style application.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun apply-highlight-style (char-vector)
|
||||
(coerce char-vector 'string))
|
||||
#+END_SRC
|
||||
@@ -793,7 +793,7 @@ colourised output.
|
||||
Utility predicate that checks whether ~string~ starts with ~prefix~.
|
||||
Avoids reimplementing this inline in multiple diff classifiers.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun string-prefix-p (prefix string)
|
||||
(and (>= (length string) (length prefix))
|
||||
(string= prefix (subseq string 0 (length prefix)))))
|
||||
@@ -806,7 +806,7 @@ Classifies a single diff line into a semantic category: ~:file-header~
|
||||
(for ~+~ lines), ~:removed~ (for ~-~ lines), or ~:context~ (for
|
||||
everything else). This powers colourised diff rendering.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun classify-diff-line (line)
|
||||
(cond ((string-prefix-p "+++ " line) :file-header)
|
||||
((string-prefix-p "--- " line) :file-header)
|
||||
@@ -830,7 +830,7 @@ string. Supports both keyword (e.g. ~:bold~) and string (e.g.
|
||||
bold, italic, dim, code, link, underline, and the full set of 16
|
||||
terminal colours. Unrecognised styles return the text unchanged.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun apply-style (style text)
|
||||
(let ((code (cond
|
||||
((eql style :bold) "1") ((eql style :italic) "3")
|
||||
@@ -870,7 +870,7 @@ Renders a list of inline child nodes into a single string. Handles
|
||||
types. Links render the text styled as link followed by the URL in
|
||||
parentheses styled as url.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-inline (children)
|
||||
(if (null children) ""
|
||||
(with-output-to-string (s)
|
||||
@@ -897,7 +897,7 @@ level determines the number of ~#~ characters (capped at 6) and the
|
||||
colour: level 1 uses bright-cyan, level 2 uses bright-yellow, and
|
||||
deeper levels use bright-white.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-heading (node)
|
||||
(let* ((level (or (getf (getf node :properties) :level) 1))
|
||||
(prefix (make-string (min level 6) :initial-element #\#))
|
||||
@@ -912,7 +912,7 @@ deeper levels use bright-white.
|
||||
Renders a paragraph node by inline-rendering its children. The
|
||||
result is a single-element list containing the rendered text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-paragraph (node)
|
||||
(list (render-inline (getf node :children))))
|
||||
#+END_SRC
|
||||
@@ -922,7 +922,7 @@ result is a single-element list containing the rendered text.
|
||||
Renders a blockquote node with a dimmed ~> ~ prefix before the
|
||||
inline-rendered content.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-blockquote (node)
|
||||
(list (apply-style :dim (concatenate 'string "> " (render-inline (getf node :children))))))
|
||||
#+END_SRC
|
||||
@@ -934,7 +934,7 @@ highlighter supports it, the code is syntax-highlighted with ANSI
|
||||
colours. Otherwise it is rendered in plain ~:code~ style. A dimmed
|
||||
language header line is shown when a language is present.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-code-block (node)
|
||||
(let* ((language (or (getf (getf node :properties) :language) ""))
|
||||
(content (or (getf node :content) ""))
|
||||
@@ -971,7 +971,7 @@ colour: added lines in green (32), removed in red (31), hunk headers
|
||||
in cyan (36), file headers in bold-cyan (1;36), and context lines
|
||||
unstyled.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-diff-block (node)
|
||||
(let* ((lines (getf (getf node :properties) :lines)) (result nil))
|
||||
(dolist (line (or lines
|
||||
@@ -993,7 +993,7 @@ unstyled.
|
||||
Renders a thematic break as a dimmed horizontal rule using
|
||||
Unicode box-drawing characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-thematic-break (node)
|
||||
(declare (ignore node))
|
||||
(list (apply-style :dim "──────────────────────────────────────────────")))
|
||||
@@ -1004,7 +1004,7 @@ Unicode box-drawing characters.
|
||||
Renders a list item node. Ordered items get ~ 1.~ prefix,
|
||||
unordered items get ~ * ~ prefix. The content is inline-rendered.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-list-item (node)
|
||||
(list (concatenate 'string
|
||||
(if (eql (getf node :type) :ordered-item) " 1." " * ")
|
||||
@@ -1017,7 +1017,7 @@ Dispatcher function that routes a single AST node to the correct
|
||||
renderer based on its ~:type~. Each type-specific renderer returns a
|
||||
list of strings (multiple lines), which ~render-md~ concatenates.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-md-node (node)
|
||||
(let ((type (getf node :type)))
|
||||
(case type
|
||||
@@ -1038,7 +1038,7 @@ Renders a list of AST nodes (the output of ~parse-blocks~) into a
|
||||
flat list of output lines by calling ~render-md-node~ on each node
|
||||
and concatenating the results.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-md (nodes)
|
||||
(let ((lines nil))
|
||||
(dolist (node nodes) (setf lines (nconc lines (render-md-node node))))
|
||||
@@ -1051,7 +1051,7 @@ Top-level convenience function that parses a Markdown string and
|
||||
renders it to a single output string with newline-separated lines.
|
||||
Returns an empty string for ~nil~ input.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
|
||||
(defun render-markdown (text)
|
||||
(unless text (return-from render-markdown ""))
|
||||
(let ((nodes (parse-blocks text)) (parts nil))
|
||||
@@ -1077,7 +1077,7 @@ This block must be first because ~tests/markdown-tests.lisp~ does not
|
||||
exist yet — the tangle script creates it by writing this block's content.
|
||||
All later blocks append.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
;;; markdown-tests.lisp — Tests for cl-tty.markdown
|
||||
|
||||
(defpackage :cl-tty-markdown-test
|
||||
@@ -1098,7 +1098,7 @@ Edge cases guard against crashes on ~nil~ input, very long lines, blank-only
|
||||
input, and unclosed fenced blocks. These come first because they exercise the
|
||||
defensive gate checks at the top of each parsing function.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Parser edge cases ─────────────────────────────────────────
|
||||
|
||||
@@ -1183,7 +1183,7 @@ defensive gate checks at the top of each parsing function.
|
||||
ATX headings from level 1 through 6, including headings with inline
|
||||
formatting inside the heading text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Parser tests ─────────────────────────────────────────────────────────────
|
||||
|
||||
@@ -1215,7 +1215,7 @@ formatting inside the heading text.
|
||||
Single-line and multi-line paragraphs. Multi-line paragraphs are joined
|
||||
with spaces before inline parsing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
(def-test paragraph-parsing ( )
|
||||
(let* ((result (parse-blocks "This is a paragraph.")) (node (first result)))
|
||||
@@ -1231,7 +1231,7 @@ with spaces before inline parsing.
|
||||
Bold, italic, combined bold+italic, inline code, and link parsing. Each
|
||||
test verifies both structure (node types) and content (text/url values).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
(def-test bold-parsing ( )
|
||||
(let* ((children (parse-inline "hello **world** here"))
|
||||
@@ -1275,7 +1275,7 @@ test verifies both structure (node types) and content (text/url values).
|
||||
Fenced code blocks with and without a language annotation. Verifies the
|
||||
presence/absence of the ~:language~ property on the resulting node.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
(def-test code-block-parsing ( )
|
||||
(let* ((lines '("```lisp" "(defun hello ())" " (print \"hi\")" "```"))
|
||||
@@ -1299,7 +1299,7 @@ Verifies that blockquote markers, unordered list items, ordered list
|
||||
items, and thematic breaks (---) are correctly classified and produce
|
||||
the expected node types.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
(def-test blockquote-parsing ( )
|
||||
(let* ((result (parse-blocks "> This is a quote")) (node (first result)))
|
||||
@@ -1323,7 +1323,7 @@ the expected node types.
|
||||
Tests ~classify-diff-line~ with each diff line variant: added (+),
|
||||
removed (-), hunk header (@@), and context (neither).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Diff tests ───────────────────────────────────────────────────────────────
|
||||
|
||||
@@ -1346,7 +1346,7 @@ Verifies that ~highlight-code~ returns categorised tokens for Lisp
|
||||
keywords, builtins, comments, and falls back to plain tokens for
|
||||
unknown languages.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Syntax highlighting tests ────────────────────────────────────────────────
|
||||
(def-test highlight-lisp-keyword ( )
|
||||
@@ -1377,7 +1377,7 @@ Verifies that each node type produces output via ~render-md-node~.
|
||||
Heading, paragraph, thematic-break, code-block, and diff-block are
|
||||
all exercised to ensure the render dispatcher routes correctly.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Render tests ─────────────────────────────────────────────────────────────
|
||||
|
||||
@@ -1422,7 +1422,7 @@ A full parse-and-render integration test exercises the pipeline end-to-end.
|
||||
The ~md-node-text~ utility tests verify both simple and nested node
|
||||
traversal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Integration tests ────────────────────────────────────────────────────────
|
||||
|
||||
|
||||
@@ -53,7 +53,7 @@ covers one logical behavior.
|
||||
The test package uses =cl-tty.backend= to access internal symbols for
|
||||
white-box testing of escape generation.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(defpackage :cl-tty-modern-backend-test
|
||||
(:use :cl :fiveam :cl-tty.backend)
|
||||
(:export #:run-tests))
|
||||
@@ -64,7 +64,7 @@ white-box testing of escape generation.
|
||||
|
||||
A single suite groups all modern backend tests.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(def-suite modern-backend-suite :description "Modern backend tests")
|
||||
(in-suite modern-backend-suite)
|
||||
#+END_SRC
|
||||
@@ -73,7 +73,7 @@ A single suite groups all modern backend tests.
|
||||
|
||||
The =run-tests= entry point is called by the CI test harness.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(defun run-tests ()
|
||||
(let ((result (run 'modern-backend-suite)))
|
||||
(fiveam:explain! result)
|
||||
@@ -85,7 +85,7 @@ The =run-tests= entry point is called by the CI test harness.
|
||||
Verifies that =make-modern-backend= returns an instance of the correct
|
||||
class. This is the most basic smoke test for the backend factory.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test make-modern-backend-creates
|
||||
"make-modern-backend returns a modern-backend instance"
|
||||
(let ((b (make-modern-backend)))
|
||||
@@ -97,7 +97,7 @@ class. This is the most basic smoke test for the backend factory.
|
||||
Ensures a 6-digit hex string produces the correct 24-bit foreground
|
||||
escape sequence with red, green, and blue components in the right order.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test sgr-truecolor-foreground
|
||||
"SGR truecolor foreground escape is correct"
|
||||
(is (equal (cl-tty.backend::sgr-fg "#FFD700")
|
||||
@@ -108,7 +108,7 @@ escape sequence with red, green, and blue components in the right order.
|
||||
|
||||
Same as foreground but uses the =48= background prefix instead of =38=.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test sgr-truecolor-background
|
||||
"SGR truecolor background escape is correct"
|
||||
(is (equal (cl-tty.backend::sgr-bg "#1a1b26")
|
||||
@@ -120,7 +120,7 @@ Same as foreground but uses the =48= background prefix instead of =38=.
|
||||
Verifies that keyword symbols like =:red= and =:blue= resolve to the
|
||||
standard 8-color SGR codes (=31= foreground, =44= background).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test sgr-named-colors
|
||||
"SGR named colors resolve to 8-color codes"
|
||||
(is (equal (cl-tty.backend::sgr-fg :red)
|
||||
@@ -134,7 +134,7 @@ standard 8-color SGR codes (=31= foreground, =44= background).
|
||||
Each attribute keyword (=:bold=, =:italic=, =:underline=, =:reset=)
|
||||
should map to the correct SGR number.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test sgr-bold-italic
|
||||
"SGR attribute escapes are correct"
|
||||
(is (equal (cl-tty.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
|
||||
@@ -148,7 +148,7 @@ should map to the correct SGR number.
|
||||
Verifies that =cursor-move-escape= produces a CSI =H= sequence with
|
||||
1-indexed row and column.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test cursor-move-escape
|
||||
"cursor-move generates correct CSI escape"
|
||||
(let ((b (make-modern-backend)))
|
||||
@@ -160,7 +160,7 @@ Verifies that =cursor-move-escape= produces a CSI =H= sequence with
|
||||
|
||||
Verifies the DECSTR escape for a block cursor without blinking (code 2).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test cursor-style-block
|
||||
"cursor-style :block generate correct escape"
|
||||
(let ((b (make-modern-backend)))
|
||||
@@ -172,7 +172,7 @@ Verifies the DECSTR escape for a block cursor without blinking (code 2).
|
||||
|
||||
Verifies the DECSTR escape for a bar cursor without blinking (code 6).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test cursor-style-bar
|
||||
"cursor-style :bar generate correct escape"
|
||||
(let ((b (make-modern-backend)))
|
||||
@@ -185,7 +185,7 @@ Verifies the DECSTR escape for a bar cursor without blinking (code 6).
|
||||
Verifies that =:underline= with =blink=t= produces code 5 (underline
|
||||
blinking), which is base 4 + blink offset 1.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test cursor-style-underline-blink
|
||||
"cursor-style :underline with blink"
|
||||
(let ((b (make-modern-backend)))
|
||||
@@ -198,7 +198,7 @@ blinking), which is base 4 + blink offset 1.
|
||||
Confirms that =decicm-begin= and =decicm-end= produce =?2026h= and
|
||||
=?2026l= respectively.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test decicm-escapes
|
||||
"DECICM synchronized update escapes"
|
||||
(is (equal (cl-tty.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
|
||||
@@ -211,7 +211,7 @@ Verifies the full OSC 8 wrapping: opening sequence with URL, the text,
|
||||
and the closing sequence. The FORMAT string uses ~~ for literal tilde
|
||||
and ~\\ for literal backslash.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test osc8-escape
|
||||
"OSC 8 hyperlink escape wraps text"
|
||||
(is (equal (cl-tty.backend::osc8-link "http://example.com" "click here")
|
||||
@@ -223,7 +223,7 @@ and ~\\ for literal backslash.
|
||||
|
||||
Verifies that ="#FFD700"= parses to (255, 215, 0).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test hex-color-parsing
|
||||
"hex-to-rgb parses valid hex colors"
|
||||
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#FFD700")
|
||||
@@ -236,7 +236,7 @@ Verifies that ="#FFD700"= parses to (255, 215, 0).
|
||||
|
||||
Verifies all-zero parsing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test hex-color-black
|
||||
"hex-to-rgb parses black"
|
||||
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#000000")
|
||||
@@ -249,7 +249,7 @@ Verifies all-zero parsing.
|
||||
|
||||
Verifies that ="#F00"= expands to ="#FF0000"= = (255, 0, 0).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test hex-color-short-form
|
||||
"hex-to-rgb parses 3-digit hex"
|
||||
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#F00")
|
||||
@@ -263,7 +263,7 @@ Verifies that ="#F00"= expands to ="#FF0000"= = (255, 0, 0).
|
||||
Confirms that =:rounded= style maps to the Unicode box-drawing
|
||||
characters for the four corners and edges.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test border-char-rounded
|
||||
"modern-border-char returns Unicode box-drawing for rounded style"
|
||||
(is (equal (cl-tty.backend::border-char :rounded :top-left) "╭"))
|
||||
@@ -276,7 +276,7 @@ characters for the four corners and edges.
|
||||
|
||||
Confirms that =:double= style maps to double-line box-drawing characters.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test border-char-double
|
||||
"modern-border-char returns double-line chars"
|
||||
(is (equal (cl-tty.backend::border-char :double :top-left) "╔"))
|
||||
@@ -289,7 +289,7 @@ Confirms that =:double= style maps to double-line box-drawing characters.
|
||||
Verifies that suspend-backend and resume-backend are no-ops when called
|
||||
on a backend not attached to a real terminal (no errors, return nil).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
|
||||
(test suspend-resume-noop
|
||||
"suspend-backend and resume-backend are no-ops in test context"
|
||||
(let ((b (make-modern-backend)))
|
||||
@@ -307,7 +307,7 @@ on a backend not attached to a real terminal (no errors, return nil).
|
||||
both 6-digit (fully specified) and 3-digit (shorthand) formats. The
|
||||
3-digit form expands each hexit by duplicating it (=#F00= => =#FF0000=).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
(defun hex-to-rgb (hex)
|
||||
@@ -331,7 +331,7 @@ Maps keyword color names to 8-color SGR index values. Used as the
|
||||
primary lookup in =sgr-fg= and =sgr-bg= before falling back to the
|
||||
theme colors hash table.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defparameter *named-colors*
|
||||
'((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
|
||||
(:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))
|
||||
@@ -344,7 +344,7 @@ Populated by the theme system's =load-preset=. When a keyword is not in
|
||||
=*named-colors*=, =sgr-fg= and =sgr-bg= consult this table as a
|
||||
fallback, enabling user themes to define custom color roles.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defvar *theme-colors* (make-hash-table :test 'eq)
|
||||
"Hash table mapping theme keywords to hex color strings.
|
||||
Populated by the theme system's load-preset. Checked by sgr-fg/sgr-bg
|
||||
@@ -357,7 +357,7 @@ as a fallback when a keyword is not in *named-colors*.")
|
||||
hex string => named color => semantic theme role => empty string if
|
||||
unresolved. Truecolor uses =38;2;R;G;B=, named colors use =3n=.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun sgr-fg (color)
|
||||
"Return SGR foreground escape for COLOR."
|
||||
(if (null color) ""
|
||||
@@ -381,7 +381,7 @@ unresolved. Truecolor uses =38;2;R;G;B=, named colors use =3n=.
|
||||
~sgr-bg~ produces the SGR background escape. Same resolution chain as
|
||||
=sgr-fg= but uses =48;2;R;G;B= for truecolor and =4n= for named colors.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun sgr-bg (color)
|
||||
"Return SGR background escape for COLOR."
|
||||
(if (null color) ""
|
||||
@@ -405,7 +405,7 @@ unresolved. Truecolor uses =38;2;R;G;B=, named colors use =3n=.
|
||||
Maps attribute keywords to SGR parameter numbers. Covers bold, dim,
|
||||
italic, underline, blink, reverse video, and reset.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defparameter *sgr-attr-codes*
|
||||
'((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
|
||||
(:blink . 5) (:reverse . 7) (:reset . 0)))
|
||||
@@ -416,7 +416,7 @@ italic, underline, blink, reverse video, and reset.
|
||||
~sgr-attr~ looks up the keyword in =*sgr-attr-codes*= and produces the
|
||||
matching SGR escape.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun sgr-attr (attr)
|
||||
"Return SGR attribute escape for ATTR keyword."
|
||||
(let ((code (cdr (assoc attr *sgr-attr-codes*))))
|
||||
@@ -432,7 +432,7 @@ matching SGR escape.
|
||||
Produces a CSI =H= (CUP) sequence to position the cursor. Coordinates
|
||||
are 1-indexed: =cursor-move-escape 0 0= moves to row 1, column 1.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun cursor-move-escape (x y)
|
||||
"Return CSI escape to move cursor to (x, y), 1-indexed."
|
||||
(format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))
|
||||
@@ -444,7 +444,7 @@ Produces a DECSTR sequence (=CSI Ps q=) to set the cursor shape.
|
||||
Base codes: block=2, underline=4, bar=6. When =blink= is true the code
|
||||
is incremented by 1 (e.g. blinking block = code 3).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun cursor-style-escape (shape blink)
|
||||
"Return DECSTR escape for cursor shape."
|
||||
(let* ((base (case shape
|
||||
@@ -462,7 +462,7 @@ Enables DEC private mode 2026 (synchronized updates). All output
|
||||
between =begin= and =end= is buffered by the terminal and rendered
|
||||
atomically.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun decicm-begin ()
|
||||
"Return escape to enable synchronized updates."
|
||||
(format nil "~C[?2026h" #\Esc))
|
||||
@@ -473,7 +473,7 @@ atomically.
|
||||
Disables DEC private mode 2026, flushing the buffered frame to the
|
||||
display.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun decicm-end ()
|
||||
"Return escape to disable synchronized updates."
|
||||
(format nil "~C[?2026l" #\Esc))
|
||||
@@ -485,7 +485,7 @@ Wraps text in an OSC 8 hyperlink. The opening sequence carries the URL,
|
||||
the closing sequence (=ESC]8;;ESC\)=) terminates the link. This
|
||||
allows clickable text in terminals that support the protocol.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun osc8-link (url text)
|
||||
"Wrap TEXT in an OSC 8 hyperlink to URL."
|
||||
(format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
|
||||
@@ -500,7 +500,7 @@ Lookup alist mapping =(style position)= pairs to Unicode box-drawing
|
||||
characters. Covers single, double, and rounded styles with all four
|
||||
corners plus horizontal and vertical connectors.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defparameter *border-chars*
|
||||
'(((:single :top-left) . "┌") ((:single :top-right) . "┐")
|
||||
((:single :bottom-left) . "└") ((:single :bottom-right) . "┘")
|
||||
@@ -520,7 +520,7 @@ horizontal/vertical lines (=U+2500=, =U+2502=) if the style is unknown
|
||||
for edge positions, or =+= for corners --- ensuring the UI never shows
|
||||
a blank gap.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun border-char (style pos)
|
||||
"Return the Unicode box-drawing character for STYLE at POS."
|
||||
(let ((char (cdr (assoc (list style pos) *border-chars* :test #'equal))))
|
||||
@@ -537,7 +537,7 @@ Subclasses the abstract =backend= class. =output-stream= is where escape
|
||||
sequences are written; =in-sync-p= tracks whether we are inside a
|
||||
DECICM synchronized update block.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defclass modern-backend (backend)
|
||||
((output-stream :initform *standard-output*
|
||||
:initarg :output-stream
|
||||
@@ -552,7 +552,7 @@ optional =output-stream=; defaults to =*standard-output*=. The
|
||||
=color-palette= argument is ignored in favor of the dynamic
|
||||
=*theme-colors*= hash table.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defun make-modern-backend (&key color-palette output-stream)
|
||||
(declare (ignore color-palette))
|
||||
(make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))
|
||||
@@ -567,7 +567,7 @@ drag + SGR), bracketed paste mode, and the Kitty keyboard protocol.
|
||||
Hides the cursor and flushes the stream. Returns the backend instance
|
||||
for chaining.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod initialize-backend ((b modern-backend))
|
||||
(backend-write b (format nil "~C[?1049h" #\Esc)) ; alt screen
|
||||
(backend-write b (format nil "~C[?1000h" #\Esc)) ; mouse basic
|
||||
@@ -586,7 +586,7 @@ Restores the terminal: shows the cursor, disables the Kitty keyboard
|
||||
protocol, bracketed paste, SGR mouse, drag, basic mouse, and finally
|
||||
leaves the alternate screen. Returns =nil= (via =(values)=).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod shutdown-backend ((b modern-backend))
|
||||
(cursor-show b)
|
||||
(backend-write b (format nil "~C[?u" #\Esc))
|
||||
@@ -611,7 +611,7 @@ kitty keyboard — those would add ~100ms of overhead on every
|
||||
suspend/resume cycle and are harmless while suspended (the terminal
|
||||
just ignores the escape sequences).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod suspend-backend ((b modern-backend))
|
||||
(cursor-show b)
|
||||
(backend-write b (format nil "~C[?1049l" #\Esc)) ; normal screen
|
||||
@@ -629,7 +629,7 @@ Re-enters the alternate screen buffer and re-enables all input
|
||||
features (mouse, bracketed paste, kitty keyboard). The application
|
||||
is responsible for redrawing the full screen after resume.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod resume-backend ((b modern-backend))
|
||||
(backend-write b (format nil "~C[?1049h" #\Esc)) ; alt screen
|
||||
(backend-write b (format nil "~C[?1000h" #\Esc)) ; mouse basic
|
||||
@@ -649,7 +649,7 @@ is responsible for redrawing the full screen after resume.
|
||||
Uses ioctl (TIOCGWINSZ = 21523) to query actual terminal dimensions
|
||||
from the kernel, with a ~/dev/tty~ fallback and 80x24 last resort.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod backend-size ((b modern-backend))
|
||||
;; Try ioctl on stdout, fall back to /dev/tty, then 80x24.
|
||||
;; Each arm uses multiple-value-bind/values to preserve both cols and rows
|
||||
@@ -695,7 +695,7 @@ caller is responsible for calling ~finish-output~ at appropriate sync
|
||||
points (frame boundaries via ~end-sync~, initialization, shutdown).
|
||||
Returns the string length for protocol compatibility.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod backend-write ((b modern-backend) string)
|
||||
(let ((stream (backend-output-stream b)))
|
||||
(write-string string stream)
|
||||
@@ -708,7 +708,7 @@ Advertises which features this backend supports. =modern-backend=
|
||||
supports truecolor, OSC 8 hyperlinks, DECICM sync, SGR mouse,
|
||||
bracketed paste, cursor style control, and the Kitty keyboard protocol.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod capable-p ((b modern-backend) feature)
|
||||
(member feature '(:truecolor :osc8 :sync :mouse
|
||||
:bracketed-paste :cursor-style
|
||||
@@ -724,7 +724,7 @@ itself, and a reset into a single concatenated string. Minimizes output
|
||||
calls --- one =backend-write= per draw operation --- by packing everything
|
||||
into one buffer.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod draw-text ((b modern-backend) x y string fg bg
|
||||
&key bold italic underline reverse dim blink
|
||||
&allow-other-keys)
|
||||
@@ -748,7 +748,7 @@ title, repeated mid sections, bottom) and writes them with minimal
|
||||
output calls. The title can be left-aligned or centered within the top
|
||||
border line. Uses the border character lookup for the chosen style.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod draw-border ((b modern-backend) x y width height
|
||||
&key style fg bg title title-align)
|
||||
(let* ((s (or style :single))
|
||||
@@ -810,7 +810,7 @@ the cursor and writes a filled line. This is simpler than =draw-border=
|
||||
because it has no border characters --- just spaces with a background
|
||||
color.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod draw-rect ((b modern-backend) x y width height &key bg)
|
||||
(let* ((bg-esc (sgr-bg bg))
|
||||
(reset (sgr-attr :reset))
|
||||
@@ -830,7 +830,7 @@ positioning, optional fg/bg colors, the OSC 8 link wrapper around the
|
||||
text, and a reset. This lets the user click the text to open the URL
|
||||
in terminals that support OSC 8.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod draw-link ((b modern-backend) x y string url
|
||||
&key fg bg)
|
||||
(let ((parts (list (cursor-move-escape x y)
|
||||
@@ -846,7 +846,7 @@ Draws a three-dot ellipsis at the given position. The =width= parameter
|
||||
is ignored since dots have a fixed visual length; delegates to
|
||||
=draw-text= for uniform rendering.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod draw-ellipsis ((b modern-backend) x y width
|
||||
&key fg bg)
|
||||
(declare (ignore width))
|
||||
@@ -861,7 +861,7 @@ is ignored since dots have a fixed visual length; delegates to
|
||||
Delegates to =cursor-move-escape= and writes the resulting CSI sequence
|
||||
to the output stream.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod cursor-move ((b modern-backend) x y)
|
||||
(backend-write b (cursor-move-escape x y)))
|
||||
#+END_SRC
|
||||
@@ -870,7 +870,7 @@ to the output stream.
|
||||
|
||||
Sends the DECTCEM private mode =?25l= to hide the cursor.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod cursor-hide ((b modern-backend))
|
||||
(backend-write b (format nil "~C[?25l" #\Esc)))
|
||||
#+END_SRC
|
||||
@@ -879,7 +879,7 @@ Sends the DECTCEM private mode =?25l= to hide the cursor.
|
||||
|
||||
Sends =?25h= to restore the cursor visibility.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod cursor-show ((b modern-backend))
|
||||
(backend-write b (format nil "~C[?25h" #\Esc)))
|
||||
#+END_SRC
|
||||
@@ -889,7 +889,7 @@ Sends =?25h= to restore the cursor visibility.
|
||||
Sets the cursor shape (block/underline/bar, optionally blinking) by
|
||||
delegating to =cursor-style-escape=.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod cursor-style ((b modern-backend) shape &key blink)
|
||||
(backend-write b (cursor-style-escape shape blink)))
|
||||
#+END_SRC
|
||||
@@ -900,7 +900,7 @@ Enables basic mouse tracking, button-event tracking (drag), and SGR
|
||||
extended mouse mode. These three modes together give full mouse
|
||||
support while staying compatible with modern terminal emulators.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod enable-mouse ((b modern-backend))
|
||||
(backend-write b (format nil "~C[?1000h" #\Esc))
|
||||
(backend-write b (format nil "~C[?1002h" #\Esc))
|
||||
@@ -914,7 +914,7 @@ Enables bracketed paste mode, where the terminal wraps pasted text in
|
||||
=ESC[200~= and =ESC[201~= delimiters. This allows the application to
|
||||
distinguish user input from pasted content.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod enable-bracketed-paste ((b modern-backend))
|
||||
(backend-write b (format nil "~C[?2004h" #\Esc))
|
||||
(finish-output (backend-output-stream b)))
|
||||
@@ -925,7 +925,7 @@ distinguish user input from pasted content.
|
||||
Begins a synchronized update frame using DECICM. Sets the =in-sync-p=
|
||||
slot so other methods can check whether we are inside a sync block.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod begin-sync ((b modern-backend))
|
||||
(setf (in-sync-p b) t)
|
||||
(backend-write b (decicm-begin)))
|
||||
@@ -936,7 +936,7 @@ slot so other methods can check whether we are inside a sync block.
|
||||
Ends the synchronized update frame and flushes the output, causing the
|
||||
terminal to render the buffered changes atomically.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
|
||||
(defmethod end-sync ((b modern-backend))
|
||||
(setf (in-sync-p b) nil)
|
||||
(backend-write b (decicm-end))
|
||||
|
||||
@@ -32,7 +32,7 @@ implementation. It re-exports the public API symbols that consumers
|
||||
(~cl-tty.core~, user applications) rely on without pulling in
|
||||
implementation details.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse-package.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse-package.lisp :noweb no
|
||||
(defpackage :cl-tty.mouse
|
||||
(:use :cl :cl-tty.layout :cl-tty.input :cl-tty.box :cl-tty.rendering)
|
||||
(:export
|
||||
@@ -51,7 +51,7 @@ implementation details.
|
||||
|
||||
Standard boilerplate to enter the package defined above.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(in-package :cl-tty.mouse)
|
||||
#+END_SRC
|
||||
|
||||
@@ -63,7 +63,7 @@ that want mouse support simply inherit from ~mouse-mixin~ alongside
|
||||
their primary superclass. Each slot stores a closure invoked when the
|
||||
corresponding event fires; ~nil~ means "no handler."
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defclass mouse-mixin ()
|
||||
((on-mouse-down :initarg :on-mouse-down :initform nil :accessor on-mouse-down)
|
||||
(on-mouse-up :initarg :on-mouse-up :initform nil :accessor on-mouse-up)
|
||||
@@ -79,7 +79,7 @@ function dispatch because the mapping is one-to-one and never needs
|
||||
CLOS multiple-dispatch. Returns ~nil~ when no handler is bound (the
|
||||
caller can decide whether to bubble the event up).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun handle-mouse-event (component event)
|
||||
(let* ((type (mouse-event-type event))
|
||||
(handler (case type
|
||||
@@ -98,7 +98,7 @@ innermost matching component wins (front-most in rendering order).
|
||||
yet (no ~layout-node~ bound). This makes hit-testing safe to call
|
||||
mid-render when the tree is partially constructed.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun hit-test (root x y)
|
||||
"Find the deepest component at (X, Y) by testing layout-node bounds.
|
||||
Recurses into component-children to find the innermost match.
|
||||
@@ -131,7 +131,7 @@ process without threading it through the entire component tree. This
|
||||
keeps the API simple for now; a future refactor could store the
|
||||
selection on a per-frame or per-window basis if needed.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defvar *selection* nil)
|
||||
#+END_SRC
|
||||
|
||||
@@ -143,7 +143,7 @@ avoiding name collisions. Using a struct (vs. a class) gives inline
|
||||
accessors and no CLOS overhead, which matters when the selection is
|
||||
read on every render frame.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defstruct (selection (:conc-name sel-))
|
||||
(start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
|
||||
#+END_SRC
|
||||
@@ -153,7 +153,7 @@ read on every render frame.
|
||||
Simple accessor that returns nil when nothing is selected (rather than
|
||||
an empty string), making it easy for callers to test with ~when~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun get-selection ()
|
||||
(when *selection* (sel-text *selection*)))
|
||||
#+END_SRC
|
||||
@@ -168,7 +168,7 @@ Darwin uses ~pbcopy~. The approach avoids build-time feature detection
|
||||
the common case of a single SBCL binary used across X11 and Wayland
|
||||
sessions.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun copy-to-clipboard (text)
|
||||
#+linux
|
||||
(cond
|
||||
@@ -187,7 +187,7 @@ should draw a highlight overlay. A global flag (rather than threading
|
||||
the drag state through event handlers) mirrors the simplicity of
|
||||
~*selection*~ and makes it trivial to check in rendering code.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defvar *selection-active* nil
|
||||
"T when a drag selection is in progress.")
|
||||
#+END_SRC
|
||||
@@ -198,7 +198,7 @@ Stored as a cons cell ~(X . Y)~ of the mouse-down position. Using a
|
||||
cons (vs. a struct) keeps the imperative mutation simple — ~setf~ with
|
||||
~cons~ is a single expression.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defvar *selection-start* nil
|
||||
"Cons (X . Y) of mouse-down position during drag.")
|
||||
#+END_SRC
|
||||
@@ -209,7 +209,7 @@ Updated on every mouse-move during a drag so the rendering loop can
|
||||
draw the live highlight rectangle between ~*selection-start*~ and
|
||||
~*selection-end*~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defvar *selection-end* nil
|
||||
"Cons (X . Y) of current mouse position during drag.")
|
||||
#+END_SRC
|
||||
@@ -220,7 +220,7 @@ Initializes all three drag state variables in one call. Both start and
|
||||
end are set to the same position so that before the first mouse-move
|
||||
the "selection" is a zero-width region (which renders as nothing).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun start-selection (x y)
|
||||
"Begin a drag selection at (X Y)."
|
||||
(setf *selection-start* (cons x y)
|
||||
@@ -234,7 +234,7 @@ Called on every mouse-move event while dragging. Only updates the end
|
||||
position; the start remains fixed from the original mouse-down. The
|
||||
rendering loop reads both globals to draw the highlight rectangle.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun update-selection (x y)
|
||||
"Update the drag selection end position to (X Y)."
|
||||
(setf *selection-end* (cons x y)))
|
||||
@@ -246,7 +246,7 @@ Encapsulates the global flag behind a function so that callers don't
|
||||
need to know the variable name. Returning ~*selection-active*~
|
||||
directly works because it is always ~nil~ or ~T~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun selection-active-p ()
|
||||
"Return T if a drag selection is in progress."
|
||||
*selection-active*)
|
||||
@@ -260,7 +260,7 @@ framebuffer via ~cl-tty.rendering:extract-text~, stores the result in
|
||||
~*selection*~, and returns the extracted string. The ~fb~ parameter
|
||||
must be the current framebuffer at the time of release.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun finalize-selection (fb)
|
||||
"End the drag selection and extract text from the framebuffer."
|
||||
(setf *selection-active* nil)
|
||||
@@ -283,7 +283,7 @@ Delegates to the rendering layer's ~fb-cell-link-url~ to look up the
|
||||
cell metadata. This indirection keeps mouse code independent of the
|
||||
framebuffer's internal storage format.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun cell-link-at (fb x y)
|
||||
"Return the link URL at (X Y) in framebuffer FB, or nil."
|
||||
(cl-tty.rendering:fb-cell-link-url fb x y))
|
||||
@@ -296,7 +296,7 @@ If ~cell-link-at~ finds a URL, open it with the OS default handler
|
||||
the caller can log or react to the result. The ~:wait nil~ avoids
|
||||
blocking the TTY UI while the browser launches.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
|
||||
(defun open-link-at (fb x y)
|
||||
"If there is a link URL at (X Y) in FB, open it via xdg-open."
|
||||
(let ((url (cell-link-at fb x y)))
|
||||
@@ -314,7 +314,7 @@ Isolates test symbols in their own package to avoid polluting the
|
||||
production namespace. FiveAM's ~def-suite~ groups all mouse tests
|
||||
under a single name for convenient batch execution.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(defpackage :cl-tty-mouse-test (:use :cl :cl-tty.mouse :fiveam))
|
||||
(in-package :cl-tty-mouse-test)
|
||||
|
||||
@@ -328,7 +328,7 @@ Verifies that the mixin class can be instantiated and passes a basic
|
||||
typep check. This guards against missing ~:initform~ values or
|
||||
superclass chain issues.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(def-test mouse-mixin-create ()
|
||||
(let ((m (make-instance 'mouse-mixin)))
|
||||
(is-true (typep m 'mouse-mixin))))
|
||||
@@ -340,7 +340,7 @@ superclass chain issues.
|
||||
for any coordinates. This tests the ~ignore-errors~ guard path in the
|
||||
hit-testing logic.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(def-test mouse-hit-test-point ()
|
||||
"hit-test returns nil when no component has position slots bound"
|
||||
(let ((obj (make-instance 'mouse-mixin)))
|
||||
@@ -354,7 +354,7 @@ Sets ~*selection*~ directly (simulating a completed drag) and checks
|
||||
that ~get-selection~ returns the expected text. This validates the
|
||||
~selection~ struct accessor chain end-to-end.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(def-test selection-set-and-get ()
|
||||
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
|
||||
(is (equal "hello" (get-selection))))
|
||||
@@ -367,7 +367,7 @@ that ~get-selection~ returns the expected text. This validates the
|
||||
resets globals to avoid cross-test contamination (FiveAM does not
|
||||
automatically reset special variables between tests).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(def-test start-selection-initializes-state ()
|
||||
(start-selection 5 10)
|
||||
(is-true (selection-active-p))
|
||||
@@ -384,7 +384,7 @@ After ~start-selection~, calling ~update-selection~ must update
|
||||
~*selection-end*~ while leaving ~*selection-start*~ unchanged. This
|
||||
validates the drag-tracking update path.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(def-test update-selection-moves-end ()
|
||||
(start-selection 0 0)
|
||||
(update-selection 3 7)
|
||||
@@ -401,7 +401,7 @@ simulates a drag selection, and verifies that ~finalize-selection~
|
||||
extracts the correct multi-line string. This exercises the full chain
|
||||
from framebuffer cell storage through coordinate normalization.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
|
||||
(def-test finalize-selection-extracts-text ()
|
||||
(let* ((fb-be (cl-tty.rendering:make-framebuffer-backend))
|
||||
(fb (cl-tty.rendering:fb-framebuffer fb-be)))
|
||||
|
||||
@@ -53,7 +53,7 @@ computation. We export it separately from the rendering symbols
|
||||
because it is also needed by code that walks the component tree
|
||||
without triggering a full render.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
(defpackage :cl-tty.box
|
||||
(:use :cl :cl-tty.backend :cl-tty.layout)
|
||||
(:export
|
||||
@@ -75,7 +75,7 @@ properties without pulling in the internal representation. We keep
|
||||
the accessor list flat (no grouping macro) to make the package
|
||||
surface easy to grep and to keep the API browser-friendly.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
;; Span
|
||||
#:span
|
||||
#:span-text #:span-bold #:span-italic #:span-underline
|
||||
@@ -97,7 +97,7 @@ separate ~cl-tty.text~ package to keep inter-component references
|
||||
trivial — boxes can hold text children, and text can be nested inside
|
||||
other components, all without cross-package imports.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
;; Text
|
||||
#:text #:make-text
|
||||
#:text-layout-node #:text-content #:text-spans
|
||||
@@ -113,7 +113,7 @@ exported specifically so the test suite can unit-test them in
|
||||
isolation. They are not part of the public component API and should
|
||||
not be relied upon by application code outside of tests.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
;; Utilities (for tests)
|
||||
#:word-wrap #:split-string
|
||||
#+END_SRC
|
||||
@@ -131,7 +131,7 @@ dirty-p)~) makes it easy for subclasses to add side effects on dirty
|
||||
transitions — for example, invalidating a cached bitmap or
|
||||
recomputing string metrics.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
;; Dirty tracking
|
||||
#:dirty-mixin #:dirty-p #:mark-clean #:mark-dirty
|
||||
#+END_SRC
|
||||
@@ -151,7 +151,7 @@ Collecting these under a single "Rendering pipeline" group signals to
|
||||
readers that they form a coherent subsystem — if you override one,
|
||||
you likely need to understand all of them.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
;; Rendering pipeline
|
||||
#:render #:render-screen #:render-node
|
||||
#:component-layout-node #:component-children #:component-parent
|
||||
@@ -172,7 +172,7 @@ boxes and text reference theme colors by name at render time, and the
|
||||
theme object is passed in from the application level. This separation
|
||||
means themes can be swapped without touching component instances.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
|
||||
;; Theme engine
|
||||
#:theme #:make-theme #:theme-mode
|
||||
#:theme-color #:load-preset #:define-preset))
|
||||
|
||||
@@ -72,7 +72,7 @@ to a string stream instead of writing to the real terminal. This helper
|
||||
creates a ~modern-backend~ with a ~string-output-stream~ and returns
|
||||
both, so tests can inspect what was rendered.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
|
||||
@@ -90,7 +90,7 @@ generic dispatch works for the box type and that the border rendering
|
||||
pipeline is intact. A regression here would mean ~render-box~ is not
|
||||
being called or produces no output.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(test render-generic-dispatches-box
|
||||
"render dispatches to render-box for box instances"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -108,7 +108,7 @@ dispatch works for the text type and that text content is correctly
|
||||
emitted to the backend. A regression would mean ~render-text~ is not
|
||||
being called.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(test render-generic-dispatches-text
|
||||
"render dispatches to render-text for text instances"
|
||||
(multiple-value-bind (b s) (make-capturing-backend)
|
||||
@@ -127,7 +127,7 @@ return a ~layout-node~ instance from their ~component-layout-node~
|
||||
method. A failure here means a component type is missing its method or
|
||||
the slot accessor is wrong.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(test component-layout-node-works
|
||||
"component-layout-node returns the right slot for each type"
|
||||
(let ((bx (make-box)) (tx (make-text "")))
|
||||
@@ -143,7 +143,7 @@ nor text accidentally inherits or defines a method that returns
|
||||
non-nil, which would break the tree-walk in ~render-node~ by causing
|
||||
infinite recursion or rendering phantom children.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(test component-children-returns-nil
|
||||
"Leaf components have no children"
|
||||
(let ((bx (make-box)) (tx (make-text "")))
|
||||
@@ -160,7 +160,7 @@ test verifies that calling ~propagate-dirty~ on a clean component sets
|
||||
it dirty. Without this, components that mutate would never trigger a
|
||||
re-render and the display would become stale.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(test propagate-dirty-marks-component
|
||||
"propagate-dirty marks the component dirty"
|
||||
(let ((c (make-box)))
|
||||
@@ -180,7 +180,7 @@ computation. This matters because container components use
|
||||
~available-width~ to position children — getting a sensible default
|
||||
prevents division-by-zero or garbled layouts during initialization.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
|
||||
(test available-width-defaults
|
||||
"available-width returns 0 for components without explicit width"
|
||||
(let ((c (make-box)))
|
||||
@@ -203,7 +203,7 @@ rendering must have a layout node — it stores the computed position and
|
||||
size after layout passes. The generic is defined with two specific
|
||||
methods for the built-in component types.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
;; ── Component Protocol ────────────────────────────────────────
|
||||
@@ -215,7 +215,7 @@ methods for the built-in component types.
|
||||
Each component type returns its internal layout node slot. This method
|
||||
specializes on ~box~ and returns the ~box-layout-node~ slot value.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defmethod component-layout-node ((bx box))
|
||||
(box-layout-node bx))
|
||||
#+END_SRC
|
||||
@@ -224,7 +224,7 @@ The ~text~ component stores its layout node in the ~text-layout-node~
|
||||
slot. Both methods return the same type (~layout-node~), so the layout
|
||||
engine can operate uniformly regardless of component type.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defmethod component-layout-node ((tx text))
|
||||
(text-layout-node tx))
|
||||
#+END_SRC
|
||||
@@ -236,7 +236,7 @@ Leaf components (~box~, ~text~) have no children. Container components
|
||||
default method on ~t~ returns ~nil~, so new component types are
|
||||
automatically treated as leaves unless they explicitly override.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defgeneric component-children (component)
|
||||
(:documentation "Return the children of COMPONENT, or nil.")
|
||||
(:method ((c t)) nil))
|
||||
@@ -250,7 +250,7 @@ used by ~propagate-dirty~ to walk up the tree. The default method on
|
||||
recursive dirty walk — when ~component-parent~ returns ~nil~, we've
|
||||
reached the root.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defgeneric component-parent (component)
|
||||
(:documentation "Return the parent of COMPONENT, or nil.")
|
||||
(:method ((c t)) nil))
|
||||
@@ -266,7 +266,7 @@ pipeline. Every component type that can be drawn defines a method on
|
||||
objects (or components still under development) don't cause errors
|
||||
when the tree walk reaches them.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
;; ── Rendering Pipeline ────────────────────────────────────────
|
||||
|
||||
(defgeneric render (component backend)
|
||||
@@ -282,7 +282,7 @@ Boxes are rendered with border characters. The ~render~ method
|
||||
delegates to the ~render-box~ function defined in ~box.lisp~, which
|
||||
handles the actual drawing of border lines and corners.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defmethod render ((bx box) backend)
|
||||
(render-box bx backend))
|
||||
#+END_SRC
|
||||
@@ -293,7 +293,7 @@ Text components render their content string at the computed position.
|
||||
The ~render~ method delegates to ~render-text~ from ~text.lisp~, which
|
||||
writes the string with appropriate escape sequences for positioning.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defmethod render ((tx text) backend)
|
||||
(render-text tx backend))
|
||||
#+END_SRC
|
||||
@@ -313,7 +313,7 @@ The pipeline is: (1) query backend pixel/dimension size, (2) begin
|
||||
sync, (3) compute layout at the root, (4) walk the tree rendering each
|
||||
node, (5) end sync.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defun render-screen (root backend)
|
||||
"Render the component tree ROOT using BACKEND.
|
||||
Computes layout at the root level, then traverses children
|
||||
@@ -334,7 +334,7 @@ are available from its ~layout-node~. The recursion is depth-first:
|
||||
parents are drawn before children, which matters for z-ordering (the
|
||||
parent's background is drawn first, children overlay on top).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defun render-node (node backend)
|
||||
"Render a component NODE and its children.
|
||||
Layout is computed once at the root by render-screen, so children
|
||||
@@ -354,7 +354,7 @@ reflects the actual allocated space — not the requested width. The
|
||||
fallback of 80 matches the default terminal width when no layout node
|
||||
exists (during initialization or testing without a backend).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defun available-width (component)
|
||||
"Return the available width for COMPONENT (or 80 as default)."
|
||||
(let ((ln (component-layout-node component)))
|
||||
@@ -369,7 +369,7 @@ fallback of 24 matches the default terminal height. These accessors
|
||||
provide a clean API for components that need to know their allocated
|
||||
space during rendering, avoiding direct access to layout nodes.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
(defun available-height (component)
|
||||
"Return the available height for COMPONENT (or 24 as default)."
|
||||
(let ((ln (component-layout-node component)))
|
||||
@@ -391,7 +391,7 @@ immediately for clean components (handled in each component's render,
|
||||
not here). The recursion terminates when ~component-parent~ returns
|
||||
~nil~ (the root component has no parent).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
|
||||
;; ── Dirty Propagation ─────────────────────────────────────────
|
||||
|
||||
(defun propagate-dirty (component)
|
||||
|
||||
@@ -45,7 +45,7 @@ Defining this as a class (rather than a struct) lets us integrate with
|
||||
the CLOS-based component protocol — ~render~ dispatches on the class,
|
||||
and dirty-mixin provides the marking machinery used by the refresh loop.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(in-package #:cl-tty.container)
|
||||
|
||||
(defclass scroll-box (dirty-mixin)
|
||||
@@ -69,7 +69,7 @@ value explicitly passed as ~:sticky-scroll-p nil~ needs to be
|
||||
preserved). Using a function instead of making the user call
|
||||
~make-instance~ directly keeps the API ergonomic and hides CLOS plumbing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0)
|
||||
sticky-scroll-p)
|
||||
(make-instance 'scroll-box
|
||||
@@ -87,7 +87,7 @@ delegating to the ~scroll-box-children~ accessor, we keep the protocol
|
||||
implementation thin — just an indirection that makes ~scroll-box~
|
||||
participate polymorphically alongside other container types.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defmethod component-children ((sb scroll-box))
|
||||
(scroll-box-children sb))
|
||||
#+END_SRC
|
||||
@@ -99,7 +99,7 @@ uses to position the ScrollBox itself within its parent. Each ScrollBox
|
||||
creates its own layout node at construction time via ~make-layout-node~,
|
||||
so this method simply returns that stored node.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defmethod component-layout-node ((sb scroll-box))
|
||||
(scroll-box-layout-node sb))
|
||||
#+END_SRC
|
||||
@@ -113,7 +113,7 @@ content dimensions from the content-size helpers, then clamps both
|
||||
scroll offsets with ~max~/~min~ to ensure they never go below 0 or
|
||||
beyond the scrollable range.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun clamp-scroll (sb)
|
||||
"Clamp scroll offsets to valid range."
|
||||
(let* ((ln (scroll-box-layout-node sb))
|
||||
@@ -137,7 +137,7 @@ the component dirty so the render loop picks up the change. This is
|
||||
the primary API entry point for programmatic scrolling (from keyboard
|
||||
input or mouse wheel events).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun scroll-by (sb dy dx)
|
||||
"Scroll by DY rows and DX columns. Clamps to valid range."
|
||||
(incf (scroll-box-scroll-y sb) dy)
|
||||
@@ -154,7 +154,7 @@ layout node, with a minimum of 1 row (even zero-height children get a
|
||||
floor so they don't collapse the layout). This is used by
|
||||
~clamp-scroll~, scrollbar rendering, and sticky-scroll logic.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun scroll-box-content-height (sb)
|
||||
"Total height of all children."
|
||||
(reduce #'+ (scroll-box-children sb)
|
||||
@@ -171,7 +171,7 @@ since horizontal scrolling follows the widest child rather than summing
|
||||
widths. Like the height counterpart, it floors child widths at 1 so
|
||||
empty children don't zero out the measurement.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun scroll-box-content-width (sb)
|
||||
"Maximum width among children."
|
||||
(reduce #'max (scroll-box-children sb)
|
||||
@@ -198,7 +198,7 @@ position.
|
||||
After child rendering, it delegates to ~draw-scrollbars~ for the
|
||||
scrollbar overlay.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defmethod render ((sb scroll-box) backend)
|
||||
"Render visible children with scroll offset applied.
|
||||
Delegates to each child's `render` method, temporarily offsetting
|
||||
@@ -241,7 +241,7 @@ viewport-h 1)~) so minor content changes don't cause jitter. The sticky
|
||||
flag is reset to nil when the user manually scrolls up (handled by
|
||||
callers of ~scroll-by~).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun update-sticky-scroll (sb)
|
||||
"If sticky-scroll-p is active and at bottom, keep at bottom."
|
||||
(when (sticky-scroll-p sb)
|
||||
@@ -262,7 +262,7 @@ it returns 0.0 (no scrolling possible). This normalized value is used
|
||||
by ~draw-scrollbars~ to compute the pixel/character position of the
|
||||
thumb.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
|
||||
"Return the thumb position for a scrollbar (0.0 to 1.0)."
|
||||
(if (> content-size viewport-size)
|
||||
@@ -283,7 +283,7 @@ the bottom edge. Both account for the scrollbox's own position within
|
||||
the layout tree (~ox~, ~oy~) so nested scrollboxes render scrollbars at
|
||||
the correct screen coordinates.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
|
||||
(defun draw-scrollbars (sb backend viewport-w viewport-h)
|
||||
"Draw scrollbars if content exceeds viewport."
|
||||
(let* ((content-h (scroll-box-content-height sb))
|
||||
@@ -342,7 +342,7 @@ along with the base ~:cl~ language and ~:fiveam~ itself.
|
||||
unconditionally; it runs the ~scrollbox-suite~ and prints results via
|
||||
~fiveam:explain!~ before exiting.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(defpackage :cl-tty-scrollbox-test
|
||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
|
||||
(:export #:run-tests))
|
||||
@@ -363,7 +363,7 @@ Confirms a bare ~make-scroll-box~ returns a ~scroll-box~ instance with
|
||||
default scroll offsets of 0 and no children. This establishes that the
|
||||
class definition and constructor are wired up correctly.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test scrollbox-creates
|
||||
"A ScrollBox can be created with defaults."
|
||||
(let ((sb (make-scroll-box)))
|
||||
@@ -379,7 +379,7 @@ Verifies that the ~:children~ initarg is accepted and that
|
||||
~scroll-box-children~ returns the list. A ScrollBox with one child
|
||||
should report length 1.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test scrollbox-with-children
|
||||
"A ScrollBox can have children."
|
||||
(let ((sb (make-scroll-box :children (list (make-text "hello")))))
|
||||
@@ -393,7 +393,7 @@ scroll-y is non-negative after the operation. Combined with
|
||||
~scrollbox-scroll-clamp~ below, this covers both the normal and
|
||||
boundary behavior of the scroll mechanic.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test scrollbox-scroll-by
|
||||
"ScrollBy adjusts offset clamped to valid range."
|
||||
(let ((sb (make-scroll-box :scroll-y 0)))
|
||||
@@ -408,7 +408,7 @@ same child list that ~scroll-box-children~ does. This ensures the
|
||||
protocol indirection works and that the rendering pipeline will see the
|
||||
correct children.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test scrollbox-component-children
|
||||
"Component protocol: children are accessible."
|
||||
(let* ((child (make-text "hello"))
|
||||
@@ -423,7 +423,7 @@ The test passes if no errors are signaled — this guards against nil
|
||||
layout nodes or unbound slots causing problems during the render
|
||||
pipeline's initial traversal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test scrollbox-render-noop
|
||||
"Rendering a ScrollBox with no children does not error."
|
||||
(let* ((stream (make-string-output-stream))
|
||||
@@ -439,7 +439,7 @@ Confirms a bare ~make-tab-bar~ returns a ~tab-bar~ instance with no
|
||||
active tab and no tabs. This validates the TabBar class definition and
|
||||
constructor.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-creates
|
||||
"A TabBar can be created with defaults."
|
||||
(let ((tb (make-tab-bar)))
|
||||
@@ -454,7 +454,7 @@ Tests that ~tab-bar-add~ returns the supplied ID, adds a tab to the
|
||||
internal list, and stores the title correctly. Each tab is stored as a
|
||||
plist, so the test checks both list length and the ~:title~ property.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-add-tab
|
||||
"Adding a tab returns the id and updates tabs."
|
||||
(let ((tb (make-tab-bar)))
|
||||
@@ -469,7 +469,7 @@ plist, so the test checks both list length and the ~:title~ property.
|
||||
Verifies that ~(setf tab-bar-active)~ correctly selects a tab by ID and
|
||||
that ~tab-bar-active~ returns that ID afterward.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-active-tab
|
||||
"Setting active tab works."
|
||||
(let ((tb (make-tab-bar)))
|
||||
@@ -486,7 +486,7 @@ a string-output-stream backend to confirm the render method doesn't
|
||||
error. A TabBar must draw its tab strip without crashing even when
|
||||
disconnected from a real terminal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-render-noop
|
||||
"Rendering a TabBar does not error."
|
||||
(let* ((stream (make-string-output-stream))
|
||||
@@ -507,7 +507,7 @@ wrapping around past the first. This is the core keyboard interaction
|
||||
for tabbed UIs and must handle edge cases (empty bar, single tab, etc.)
|
||||
gracefully.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-next-prev
|
||||
"TabBar next/prev wraps around through tabs."
|
||||
(let ((tb (make-tab-bar)))
|
||||
@@ -531,7 +531,7 @@ gracefully.
|
||||
next/prev navigation). This test verifies that selecting ~:tab2~ from a
|
||||
three-tab bar correctly sets the active tab.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-select
|
||||
"TabBar select activates the specified tab."
|
||||
(let ((tb (make-tab-bar)))
|
||||
@@ -548,7 +548,7 @@ three-tab bar correctly sets the active tab.
|
||||
This tests the bridge between the input event system and the TabBar
|
||||
navigation API.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test tabbar-handle-key
|
||||
"TabBar handle-key dispatches left/right."
|
||||
(let ((tb (make-tab-bar)))
|
||||
@@ -568,7 +568,7 @@ values (negative and extremely large) and confirming they get clamped
|
||||
back to 0. With no children, content size is 0 so the max scroll is
|
||||
also 0 — this exercises the degenerate case.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
|
||||
(test scrollbox-scroll-clamp
|
||||
"ScrollBox clamp prevents scrolling past bounds."
|
||||
(let ((sb (make-scroll-box :scroll-y 5 :scroll-x 3)))
|
||||
|
||||
@@ -47,19 +47,19 @@ by the select widget tests — FiveAM itself, the backend/box/layout/input infra
|
||||
and the ~cl-tty.select~ package under test. ~run-tests~ is the entry point for
|
||||
CI and interactive use.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(defpackage :cl-tty-select-test
|
||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.select)
|
||||
(:export #:run-tests))
|
||||
(in-package #:cl-tty-select-test)
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(def-suite select-suite :description "Select widget tests")
|
||||
(in-suite select-suite)
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(defun run-tests ()
|
||||
(let ((result (run 'select-suite)))
|
||||
(fiveam:explain! result)
|
||||
@@ -72,7 +72,7 @@ Verifies that a select widget can be constructed with default values. The
|
||||
~selected-index~ should start at 0, and both ~options~ and ~filter~ should
|
||||
be nil. This establishes the baseline contract for the default constructor.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-creates
|
||||
"A Select can be created with defaults."
|
||||
(let ((sel (make-select)))
|
||||
@@ -87,7 +87,7 @@ be nil. This establishes the baseline contract for the default constructor.
|
||||
Ensures that passing ~:options~ to ~make-select~ stores them correctly. The
|
||||
length check is the simplest invariant — two options in, two options out.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-with-options
|
||||
"A Select stores options."
|
||||
(let ((sel (make-select :options '((:title "Red" :value :red)
|
||||
@@ -102,7 +102,7 @@ match \"Blue\" but not \"Red\" or \"Green\". The return value is an alist of
|
||||
~(display-index original-index option)~, so we dig into the third element
|
||||
to check the ~:value~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-filtered-exact
|
||||
"Filter returns case-insensitive substring matches."
|
||||
(let ((sel (make-select
|
||||
@@ -121,7 +121,7 @@ When the filter is nil ~select-filtered-options~ must return every option
|
||||
unchanged. This is the unfiltered/identity case and the most common state
|
||||
when the user hasn't typed anything.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-filtered-all
|
||||
"Nil filter returns all options."
|
||||
(let ((sel (make-select
|
||||
@@ -137,7 +137,7 @@ Exercises ~select-next~ and ~select-prev~ through a three-item list,
|
||||
confirming that forward and backward movement works and that both directions
|
||||
wrap around at list boundaries.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-navigation
|
||||
"Select-next and select-prev navigate through options."
|
||||
(let ((sel (make-select
|
||||
@@ -162,7 +162,7 @@ navigation — ~select-next~ and ~select-prev~ skip over them. This test
|
||||
sets up a list with two category headers interleaved and verifies they
|
||||
are transparent to movement.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-navigation-skips-categories
|
||||
"Navigation skips category header options."
|
||||
(let ((sel (make-select
|
||||
@@ -186,7 +186,7 @@ Validates that ~select-handle-key~ dispatches correctly: Down moves forward,
|
||||
Up moves backward, and Enter invokes the ~on-select~ callback with the
|
||||
currently highlighted option's plist.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-handle-key
|
||||
"Select handle-key dispatches navigation and selection."
|
||||
(let* ((result (list nil))
|
||||
@@ -207,7 +207,7 @@ Ctrl+N and Ctrl+P are Emacs-compatible alternatives to Down/Up. They must
|
||||
produce identical navigation behavior. This test confirms the control-key
|
||||
dispatch paths.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-handle-key-ctrl
|
||||
"Ctrl+N and Ctrl+P navigate like down/up."
|
||||
(let ((sel (make-select
|
||||
@@ -224,7 +224,7 @@ dispatch paths.
|
||||
height. This test creates 20 options, sets the layout height to 5, and
|
||||
asserts the visible subset fits within that constraint.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-visible-count
|
||||
"Visible options respects viewport height."
|
||||
(let* ((ln (make-layout-node))
|
||||
@@ -242,7 +242,7 @@ When exact substring matching fails, the filter falls back to character-set
|
||||
Jaccard similarity. ~\"nrd\"~ should match ~\"Nord\"~ because the character
|
||||
overlap (n, o, r, d → 3 of 4) exceeds the 0.3 threshold.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
|
||||
(test select-fuzzy-fallback
|
||||
"Fuzzy filter catches near-misses."
|
||||
(let ((sel (make-select
|
||||
@@ -265,7 +265,7 @@ and input subsystems. The exported symbols cover the public API: the
|
||||
handling, rendering, and the fuzzy matching predicate (exposed for
|
||||
testing and extensibility).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select-package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select-package.lisp
|
||||
(defpackage :cl-tty.select
|
||||
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
||||
(:export
|
||||
@@ -292,7 +292,7 @@ currently highlighted option. ~filter~ is a string (or nil for
|
||||
unfiltered). ~on-select~ is a callback receiving the selected option
|
||||
plist. ~layout-node~ positions the widget in the window.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(in-package #:cl-tty.select)
|
||||
|
||||
(defclass select (dirty-mixin)
|
||||
@@ -314,7 +314,7 @@ A convenience constructor that wraps ~make-instance~ with keyword
|
||||
arguments. Defaults to nil for all optional parameters, matching the
|
||||
~defclass~ initforms.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun make-select (&key options filter on-select)
|
||||
(make-instance 'select
|
||||
:options (or options nil)
|
||||
@@ -330,7 +330,7 @@ The layout engine needs a uniform way to access a component's position.
|
||||
~component-layout-node~ is part of the component protocol; this method
|
||||
for ~select~ simply delegates to the ~select-layout-node~ accessor.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defmethod component-layout-node ((sel select))
|
||||
(select-layout-node sel))
|
||||
#+END_SRC
|
||||
@@ -352,7 +352,7 @@ Internally, the filter first checks for exact substring containment via
|
||||
character-set ~fuzzy-match-p~ predicate. Category headers short-circuit
|
||||
so they always pass through the filter.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun select-filtered-options (sel)
|
||||
"Return list of options matching the current filter, in display order.
|
||||
Each item: (display-index original-index option-plist)."
|
||||
@@ -424,7 +424,7 @@ query and target exceeds 0.3. The character-set approach is simpler
|
||||
and cheaper than trigrams while still catching common typos and
|
||||
near-misses like ~\"nrd\"~ for ~\"Nord\"~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun fuzzy-match-p (query target)
|
||||
"T if character-set Jaccard similarity exceeds threshold (0.3)."
|
||||
(let* ((q-chars (remove-duplicates (coerce (string-downcase query) 'list)))
|
||||
@@ -443,7 +443,7 @@ index may point beyond the filtered list. ~select-clamp-index~ ensures
|
||||
the index stays within valid bounds. If the list is empty the index
|
||||
resets to 0.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun select-clamp-index (sel)
|
||||
"Ensure selected-index is valid. Wraps if empty."
|
||||
(let* ((filtered (select-filtered-options sel))
|
||||
@@ -461,7 +461,7 @@ through the filtered list starting from the current index, wrapping
|
||||
around at the end. Each candidate is checked for ~:category t~ and
|
||||
skipped. Marks the widget dirty so the render pass picks up the change.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun select-next (sel)
|
||||
"Move selection to next non-category option. Wraps at end."
|
||||
(let* ((filtered (select-filtered-options sel))
|
||||
@@ -483,7 +483,7 @@ Moves the selection backward to the previous non-category option.
|
||||
Mirrors ~select-next~ but decrements the index (with modular arithmetic
|
||||
for wrap-around). Category headers are skipped identically.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun select-prev (sel)
|
||||
"Move selection to previous non-category option. Wraps at start."
|
||||
(let* ((filtered (select-filtered-options sel))
|
||||
@@ -512,7 +512,7 @@ Dispatches keyboard events:
|
||||
Returns T if the key was handled (consumed), NIL otherwise so the
|
||||
caller knows not to propagate the event further.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun select-handle-key (sel event)
|
||||
"Handle a key-event. Returns T if handled."
|
||||
(let ((key (key-event-key event))
|
||||
@@ -545,7 +545,7 @@ hundreds of items when the viewport shows only 10. The window is
|
||||
centered around the currently selected index so the user always sees
|
||||
context around their cursor.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defun select-visible-options (sel)
|
||||
"Return filtered options that fit within the viewport."
|
||||
(let* ((ln (select-layout-node sel))
|
||||
@@ -569,7 +569,7 @@ background. Category headers are rendered dimmed (~:text-muted~) and
|
||||
visually distinct from selectable items. Long titles are truncated with
|
||||
an ellipsis character to fit the viewport width.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
|
||||
(defmethod render ((sel select) backend)
|
||||
(let* ((ln (select-layout-node sel))
|
||||
(x (if ln (layout-node-x ln) 0))
|
||||
|
||||
32
org/slot.org
32
org/slot.org
@@ -50,7 +50,7 @@ same slot with conflicting mode specifications.
|
||||
The package provides the public API and exports all slot system symbols.
|
||||
Clients :use this package or refer to symbols qualified.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot-package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot-package.lisp
|
||||
(defpackage :cl-tty.slot
|
||||
(:use :cl)
|
||||
(:export
|
||||
@@ -73,7 +73,7 @@ case-insensitive lookup via ~equal~). Each value is a plist:
|
||||
The ~:test #'equal~ ensures that ~:sidebar~ and ~"sidebar"~ map to the
|
||||
same key.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
|
||||
(in-package :cl-tty.slot)
|
||||
|
||||
(defvar *slots* (make-hash-table :test 'equal)
|
||||
@@ -97,7 +97,7 @@ The mode parameter is validated on first call via ~assert~ and then
|
||||
frozen for subsequent calls. This prevents a later registration from
|
||||
changing the slot's semantics out from under earlier registrations.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
|
||||
(defun defslot (name &key (order 0) render-fn (mode :stack))
|
||||
(let* ((key (string name))
|
||||
(slot (gethash key *slots*)))
|
||||
@@ -143,7 +143,7 @@ changing the slot's semantics out from under earlier registrations.
|
||||
|
||||
Returns ~nil~ if the slot has no registrations or if the handler is nil.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
|
||||
(defun slot-render (slot-name &rest args)
|
||||
(let ((slot (gethash (string slot-name) *slots*)))
|
||||
(when slot
|
||||
@@ -169,7 +169,7 @@ Uses ~nth-value 1~ of ~gethash~ which returns ~t~ if the key is
|
||||
present (even if the value is ~nil~) or ~nil~ if absent. This is the
|
||||
canonical Common Lisp idiom for testing hash-table membership.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
|
||||
(defun slot-p (slot-name)
|
||||
(nth-value 1 (gethash (string slot-name) *slots*)))
|
||||
#+END_SRC
|
||||
@@ -180,7 +180,7 @@ Calls ~remhash~ to delete the slot's entry from the hash table
|
||||
entirely. After this call ~slot-p~ returns false and ~slot-render~
|
||||
returns nil for the given slot name.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
|
||||
(defun clear-slot (slot-name)
|
||||
(remhash (string slot-name) *slots*))
|
||||
#+END_SRC
|
||||
@@ -191,7 +191,7 @@ Iterates over all hash keys in ~*slots*~ and returns them as a list.
|
||||
Only slots that have been registered (i.e. have at least one entry)
|
||||
appear in the result.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
|
||||
(defun list-slots ()
|
||||
(loop for key being the hash-keys of *slots* collect key))
|
||||
#+END_SRC
|
||||
@@ -203,7 +203,7 @@ including mode-specific behavior.
|
||||
|
||||
*** Test Package and Suite
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam))
|
||||
(in-package :cl-tty-slot-test)
|
||||
|
||||
@@ -213,7 +213,7 @@ including mode-specific behavior.
|
||||
|
||||
*** defslot-register: Registering a slot makes it visible
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test defslot-register ()
|
||||
(clear-slot :test-slot)
|
||||
(defslot :test-slot :order 1 :render-fn (lambda () "hello"))
|
||||
@@ -225,7 +225,7 @@ including mode-specific behavior.
|
||||
Verifies that ~:stack~ mode preserves multiple registrations and calls
|
||||
them in ascending order sequence.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test slot-render-calls ()
|
||||
(clear-slot :test-slot)
|
||||
(defslot :test-slot :order 1 :render-fn (lambda () "a"))
|
||||
@@ -235,7 +235,7 @@ them in ascending order sequence.
|
||||
|
||||
*** slot-render-empty: Unregistered slot returns nil
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test slot-render-empty ()
|
||||
(clear-slot :ghost)
|
||||
(is-false (slot-render :ghost)))
|
||||
@@ -243,7 +243,7 @@ them in ascending order sequence.
|
||||
|
||||
*** clear-slot-removes: Clearing a slot makes it absent
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test clear-slot-removes ()
|
||||
(clear-slot :test-slot)
|
||||
(defslot :test-slot :order 1 :render-fn (lambda () "x"))
|
||||
@@ -256,7 +256,7 @@ them in ascending order sequence.
|
||||
Verifies that ~:stack~ mode (default) accumulates entries across
|
||||
multiple ~defslot~ calls.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test stack-mode-multiple-entries ()
|
||||
(clear-slot :stack-test)
|
||||
(defslot :stack-test :order 1 :render-fn (lambda () "first"))
|
||||
@@ -270,7 +270,7 @@ multiple ~defslot~ calls.
|
||||
Verifies that ~:replace~ mode discards previous entries on each new
|
||||
~defslot~ call.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test replace-mode-last-wins ()
|
||||
(clear-slot :replace-test)
|
||||
(defslot :replace-test :mode :replace :order 1 :render-fn (lambda () "old"))
|
||||
@@ -282,7 +282,7 @@ Verifies that ~:replace~ mode discards previous entries on each new
|
||||
|
||||
Verifies that ~:single-winner~ mode ignores subsequent registrations.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test single-winner-mode-first-wins ()
|
||||
(clear-slot :winner-test)
|
||||
(defslot :winner-test :mode :single-winner :order 1
|
||||
@@ -297,7 +297,7 @@ Verifies that ~:single-winner~ mode ignores subsequent registrations.
|
||||
Verifies that clearing a slot removes the mode lock, so a subsequent
|
||||
~defslot~ can set a new mode.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
|
||||
(def-test clear-slot-removes-mode ()
|
||||
(clear-slot :mode-test)
|
||||
(defslot :mode-test :mode :replace :render-fn (lambda () "only"))
|
||||
|
||||
@@ -32,7 +32,7 @@ other container components (scrollbox, box, slot, etc.). This keeps
|
||||
the symbol namespace clean and avoids accidental collisions with
|
||||
user-level code.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(in-package #:cl-tty.container)
|
||||
#+END_SRC
|
||||
|
||||
@@ -48,7 +48,7 @@ The ~tabs~ slot is a simple plist list rather than a hash table or
|
||||
alist because the total number of tabs in a UI is typically small
|
||||
(< 20) and we need ordered iteration for rendering.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defclass tab-bar (dirty-mixin)
|
||||
((tabs :initform nil :initarg :tabs
|
||||
:accessor tab-bar-tabs :type list)
|
||||
@@ -65,7 +65,7 @@ Convenience constructor that forwards keyword arguments to
|
||||
~make-instance~ everywhere gives us a single place to add
|
||||
defaulting, validation, or initialization hooks in the future.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defun make-tab-bar (&key tabs active)
|
||||
(make-instance 'tab-bar :tabs (or tabs nil) :active active))
|
||||
#+END_SRC
|
||||
@@ -79,7 +79,7 @@ tab becomes active automatically — this ensures there is always a
|
||||
sensible default when the first tab is created. Returns the ~id~ so
|
||||
callers can chain or store it.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defun tab-bar-add (tb id title)
|
||||
"Add a tab with ID and TITLE. Sets as active if first tab."
|
||||
(setf (tab-bar-tabs tb)
|
||||
@@ -95,7 +95,7 @@ Returns the layout node so the layout engine can position and size
|
||||
the tab bar within its parent. Every component that participates in
|
||||
automatic layout must implement this method.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defmethod component-layout-node ((tb tab-bar))
|
||||
(tab-bar-layout-node tb))
|
||||
#+END_SRC
|
||||
@@ -110,7 +110,7 @@ The lookup strategy — mapcar ids, position, mod — is O(n) but
|
||||
acceptable since tab lists are small. A hash-based index would be
|
||||
premature optimization at this scale.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defun tab-bar-next (tb)
|
||||
"Move to next tab."
|
||||
(let* ((tabs (tab-bar-tabs tb))
|
||||
@@ -130,7 +130,7 @@ incrementing it. ~mod~ handles negative wrap-around correctly in
|
||||
Common Lisp (returns a non-negative remainder), so ~(mod (1- 0) 3)~
|
||||
produces 2 rather than −1.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defun tab-bar-prev (tb)
|
||||
"Move to previous tab."
|
||||
(let* ((tabs (tab-bar-tabs tb))
|
||||
@@ -150,7 +150,7 @@ cyclic navigation. This is used when a user clicks a tab (via mouse
|
||||
binding), when a programmatic action needs to switch views, or when
|
||||
activating a tab from outside the keyboard flow. Always marks dirty.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defun tab-bar-select (tb id)
|
||||
"Select a tab by ID."
|
||||
(setf (tab-bar-active tb) id)
|
||||
@@ -165,7 +165,7 @@ consumed and ~nil~ otherwise, which lets the keybinding system fall
|
||||
through to other handlers — important for composable UIs where a tab
|
||||
bar lives alongside other focusable elements.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defun tab-bar-handle-key (tb event)
|
||||
"Handle a key-event on a TabBar. Returns T if handled."
|
||||
(case (key-event-key event)
|
||||
@@ -186,7 +186,7 @@ exceeds the available space, tabs are truncated and an ellipsis
|
||||
~...~ is drawn at the overflow point. This prevents the tab bar from
|
||||
breaking the layout on narrow terminals.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
|
||||
(defmethod render ((tb tab-bar) backend)
|
||||
(let* ((ln (tab-bar-layout-node tb))
|
||||
(x (if ln (layout-node-x ln) 0))
|
||||
|
||||
@@ -178,7 +178,7 @@ start avoids package redefinition churn. The current system does not yet call
|
||||
raw mode from within the input module; consumers manage raw mode themselves
|
||||
via ~sb-posix~ directly.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input-package.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input-package.lisp
|
||||
(defpackage :cl-tty.input
|
||||
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
|
||||
(:export
|
||||
@@ -243,7 +243,7 @@ textarea line splitting — a blank document has one empty line.
|
||||
This is the first block tangling to input.lisp, so it includes the
|
||||
~in-package~ form that all subsequent blocks share.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
(defun %split-string (string separator)
|
||||
@@ -262,12 +262,12 @@ application's main loop. Widget ~render~ methods use them to draw themselves.
|
||||
Defining them here rather than in the rendering module keeps the dependency
|
||||
clean — input widgets depend on rendering, not the other way around.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defvar *current-backend* nil
|
||||
"The active backend used for rendering.")
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defvar *current-theme* nil
|
||||
"The active theme used for semantic color resolution.")
|
||||
#+END_SRC
|
||||
@@ -299,7 +299,7 @@ or lowercase, but ~code~ preserves the actual code point. The
|
||||
~handle-text-input~ function uses ~code-char~ on the code slot to get the
|
||||
true character for insertion.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defstruct key-event
|
||||
(key nil :type (or keyword null))
|
||||
(ctrl nil :type boolean)
|
||||
@@ -323,7 +323,7 @@ field is :press, :release, or :drag, determined by whether the button
|
||||
code includes the motion bit (bit 5). Coordinates are 1-indexed from
|
||||
the terminal; no adjustment is performed here.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defstruct mouse-event
|
||||
(type nil :type (or keyword null))
|
||||
(button nil :type (or keyword null))
|
||||
@@ -342,7 +342,7 @@ the modern xterm format, as opposed to the single-letter terminators used
|
||||
by VT100-style sequences (~ESC[H~ = Home, ~ESC[F~ = End). Modern terminal
|
||||
emulators emit the tilde form for most keys; we handle both.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defparameter *csi-tilde-table*
|
||||
'((1 . :home) (2 . :insert) (3 . :delete) (4 . :end)
|
||||
(5 . :page-up) (6 . :page-down)
|
||||
@@ -363,7 +363,7 @@ emitted by most terminal emulators in "normal" (non-application) cursor
|
||||
key mode. The ~:back-tab~ mapping for Z handles Shift+Tab, which some
|
||||
emulators report as ~ESC[Z~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defparameter *csi-key-table*
|
||||
'((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
|
||||
(#\F . :end) (#\H . :home)
|
||||
@@ -391,7 +391,7 @@ Modifier encoding follows the xterm convention: Shift=1, Alt=2, Ctrl=4.
|
||||
The extended parameter vector carries the raw parameter bytes for
|
||||
sequences where modifiers appear in a non-standard position.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun parse-csi-params (params terminator extended)
|
||||
(let* ((key (if (find terminator '(#\~ #\u))
|
||||
(cdr (assoc (first params) *csi-tilde-table*))
|
||||
@@ -440,7 +440,7 @@ and read directly into the backing storage. This avoids alien allocation
|
||||
and manual ~free-alien~ while keeping the GC from moving the buffer
|
||||
during the ~unix-read~ syscall.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun read-raw-byte (&key timeout)
|
||||
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
|
||||
(fd 0)
|
||||
@@ -481,7 +481,7 @@ The SS3 path handles shifted cursor keys that some emulators report as
|
||||
~ESC O A~ through ~ESC O D~ (shifted up/down/right/left). These use a
|
||||
different byte prefix from the CSI form ~ESC [ A~ through ~ESC [ D~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun %read-escape-sequence ()
|
||||
(flet ((read-next (&optional (timeout nil))
|
||||
(let ((b (read-raw-byte :timeout timeout)))
|
||||
@@ -536,7 +536,7 @@ non-digit byte, handling an optional list of initial bytes that were
|
||||
already consumed by the caller. Returns the parsed integer and the
|
||||
terminator byte.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun %read-digits (&optional (initial-bytes nil))
|
||||
"Read bytes until a non-digit is encountered.
|
||||
Returns (values number terminator-byte)."
|
||||
@@ -564,7 +564,7 @@ a ~mouse-event~ struct with proper button and type classification.
|
||||
Coordinates are converted from 1-based (terminal protocol) to 0-based
|
||||
(framebuffer convention) by subtracting 1 from both x and y.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun %parse-sgr-mouse ()
|
||||
"Parse SGR mouse escape sequence: ESC [ < Cb ; Cx ; Cy M/m
|
||||
Returns a mouse-event struct."
|
||||
@@ -609,7 +609,7 @@ the modifier appears after the primary parameter in an extended format
|
||||
(e.g., ~ESC [ 1 ; 5 A~ where 5 encodes Ctrl+Shift). This array is passed
|
||||
to ~parse-csi-params~ for modifier extraction.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun parse-csi-sequence ()
|
||||
(flet ((read-param (next-fn) (let ((acc nil))
|
||||
(loop for b = (funcall next-fn)
|
||||
@@ -655,7 +655,7 @@ Overlong sequences (e.g., encoding ASCII in 2+ bytes) are rejected because
|
||||
the range checks on the leading byte exclude them: a 2-byte sequence with
|
||||
b0=0xC0 would have ~(= #xc2 b0 #xdf)~ fail since 0xC0 < 0xC2.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun utf8-decode (bytes)
|
||||
(case (length bytes)
|
||||
(2 (let ((b0 (first bytes)) (b1 (second bytes)))
|
||||
@@ -703,7 +703,7 @@ streamed in real time from the terminal; if we're too aggressive, we
|
||||
might cut off a multi-byte character during a slow paste or network
|
||||
connection. The 500ms gives the terminal ample time to deliver all bytes.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun %read-event (&key timeout)
|
||||
(multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
|
||||
(unless b (return-from %read-event (if (eq reason :eof) :eof nil)))
|
||||
@@ -754,11 +754,11 @@ call and, if set, query the new terminal dimensions and redraw. The
|
||||
flag is not automatically cleared — the consumer must set it to ~nil~
|
||||
after handling the resize.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defvar *terminal-resized-p* nil)
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
#+sbcl
|
||||
(eval-when (:load-toplevel :execute)
|
||||
(require :sb-posix)
|
||||
@@ -775,7 +775,7 @@ input). SBCL's ~SB-POSIX:WITH-RAW-TERMINAL~ is not available in all builds
|
||||
(e.g. Debian-packaged SBCL 2.5.x). This implementation uses ~stty~ for
|
||||
portability.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun %raw-mode-on ()
|
||||
(uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr")
|
||||
:output nil :error-output nil :ignore-error-status t))
|
||||
@@ -806,7 +806,7 @@ This method is deliberately simple: it's a thin wrapper that adapts the
|
||||
~%read-event~ API to the backend protocol's ~read-event~ generic function.
|
||||
All the complexity lives in ~%read-event~ and its callees.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defmethod read-event ((b cl-tty.backend:backend) &key timeout)
|
||||
;; Check for pending terminal resize before reading input.
|
||||
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
|
||||
@@ -851,7 +851,7 @@ shift out when full) keeps memory bounded.
|
||||
This is the first block tangling to textarea.lisp, so it includes the
|
||||
~in-package~ form.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
(defclass textarea (dirty-mixin)
|
||||
@@ -878,7 +878,7 @@ The constructor is a separate function rather than a ~:constructor~
|
||||
option on ~defclass~ because it needs to normalize the value argument
|
||||
~(or value "")~ — a pattern that would clutter the class definition.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun make-textarea (&key value on-submit)
|
||||
(make-instance 'textarea
|
||||
:value (or value "")
|
||||
@@ -895,13 +895,13 @@ line, which is the correct representation of a blank document.
|
||||
~textarea-line-count~ is a simple wrapper for the number of lines.
|
||||
It's used by cursor movement functions to clamp the cursor row.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-lines (ta)
|
||||
"Split value into lines."
|
||||
(%split-string (textarea-value ta) #\Newline))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-line-count (ta)
|
||||
"Number of lines in value."
|
||||
(length (textarea-lines ta)))
|
||||
@@ -919,7 +919,7 @@ that change line structure (newline, backspace joining lines). It
|
||||
also marks the widget dirty, ensuring the renderer picks up the
|
||||
cursor position change.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-ensure-cursor (ta)
|
||||
"Clamp cursor to valid range."
|
||||
(let ((lines (textarea-lines ta)))
|
||||
@@ -942,7 +942,7 @@ the textarea code work with different representations — ~textarea-lines~
|
||||
returns a list, but the insertion/backspace code operates on vectors
|
||||
for efficient element replacement.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun %join-lines (lines)
|
||||
"Join a sequence of strings with newlines."
|
||||
(with-output-to-string (s)
|
||||
@@ -969,7 +969,7 @@ within the current line. The algorithm:
|
||||
The function updates ~cursor-col~ by 1 after insertion and marks the
|
||||
widget dirty.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-insert-char (ta char)
|
||||
"Insert CHAR at the cursor position."
|
||||
(textarea-push-undo ta)
|
||||
@@ -1010,7 +1010,7 @@ Algorithm:
|
||||
6. If the cursor row is beyond the last line, simply append a newline.
|
||||
7. Mark dirty.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-newline (ta)
|
||||
"Insert a newline at the cursor."
|
||||
(textarea-push-undo ta)
|
||||
@@ -1056,7 +1056,7 @@ line, removing the newline character between them.
|
||||
|
||||
All paths push undo state before modifying the value.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-backspace (ta)
|
||||
"Delete character before cursor."
|
||||
(textarea-push-undo ta)
|
||||
@@ -1106,13 +1106,13 @@ on a long line and moves up to a shorter 5-character line, the column
|
||||
clamps to 5. This matches how most editors handle column preservation
|
||||
— the column "remembers" its position but is constrained by line length.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-move-up (ta)
|
||||
(decf (textarea-cursor-row ta))
|
||||
(textarea-ensure-cursor ta))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-move-down (ta)
|
||||
(incf (textarea-cursor-row ta))
|
||||
(textarea-ensure-cursor ta))
|
||||
@@ -1143,7 +1143,7 @@ discarded because the edit graph has branched. Implementing a full tree
|
||||
undo would be significantly more complex and is unnecessary for a TUI
|
||||
textarea.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-push-undo (ta)
|
||||
"Save current value on undo stack."
|
||||
(let ((stack (textarea-undo-stack ta)))
|
||||
@@ -1155,7 +1155,7 @@ textarea.
|
||||
(setf (fill-pointer (textarea-redo-stack ta)) 0)))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-undo (ta)
|
||||
(let ((stack (textarea-undo-stack ta)))
|
||||
(when (plusp (length stack))
|
||||
@@ -1166,7 +1166,7 @@ textarea.
|
||||
(mark-dirty ta)))))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun textarea-redo (ta)
|
||||
(let ((stack (textarea-redo-stack ta)))
|
||||
(when (plusp (length stack))
|
||||
@@ -1203,7 +1203,7 @@ rather than looking at ~key-event-key~. This is because ~key-event-key~
|
||||
is always an uppercase keyword (~:a~ for both 'a' and 'A'), but the
|
||||
code preserves the actual character.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defun handle-textarea-input (ta event)
|
||||
"Process a key-event on a textarea widget."
|
||||
(cond
|
||||
@@ -1277,7 +1277,7 @@ Cursor rendering is handled by the focus/selection rendering layer,
|
||||
not by this method. This keeps the render method simple — it just
|
||||
paints text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
||||
(defmethod render ((ta textarea) (backend t))
|
||||
"Render textarea lines at layout position."
|
||||
(let* ((ln (textarea-layout-node ta))
|
||||
@@ -1321,7 +1321,7 @@ tracking. Slots:
|
||||
This is the first block tangling to text-input.lisp, so it includes the
|
||||
~in-package~ form.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
(defclass text-input (dirty-mixin)
|
||||
@@ -1350,7 +1350,7 @@ The ~(or value "")~ pattern ensures the value is always a string,
|
||||
even if the caller passes nil. This eliminates a class of nil-pointer
|
||||
errors in string operations downstream.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun make-text-input (&key value cursor placeholder max-length on-submit)
|
||||
(make-instance 'text-input
|
||||
:value (or value "")
|
||||
@@ -1376,7 +1376,7 @@ This is a pure insert — it does not replace the character at the cursor;
|
||||
it shifts subsequent characters right. For overwrite behavior, the caller
|
||||
would need a different function.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-insert (input char)
|
||||
(let* ((val (text-input-value input))
|
||||
(pos (text-input-cursor input))
|
||||
@@ -1396,7 +1396,7 @@ The algorithm concatenates the prefix (up to one before cursor) with
|
||||
the suffix (from cursor onward), effectively removing the character
|
||||
at cursor-1. The cursor is decremented by 1.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-backspace (input)
|
||||
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
|
||||
(when (zerop pos) (return-from text-input-backspace))
|
||||
@@ -1417,7 +1417,7 @@ moving the cursor position.
|
||||
This contrasts with backspace, which removes the character before
|
||||
cursor and decrements the cursor.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-delete (input)
|
||||
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
|
||||
(when (>= pos (length val)) (return-from text-input-delete))
|
||||
@@ -1434,13 +1434,13 @@ one character position, clamped to [0, length]. Left movement stops at
|
||||
Each movement function marks the widget dirty so the renderer redraws
|
||||
the cursor position.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-move-left (input)
|
||||
(when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
|
||||
(mark-dirty input))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-move-right (input)
|
||||
(when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
|
||||
(mark-dirty input))
|
||||
@@ -1454,13 +1454,13 @@ the cursor position.
|
||||
These are the programmatic equivalents of the Home and End keys and
|
||||
are also used by the Ctrl+A and Ctrl+E keybindings.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-move-home (input)
|
||||
(setf (text-input-cursor input) 0)
|
||||
(mark-dirty input))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-move-end (input)
|
||||
(setf (text-input-cursor input) (length (text-input-value input)))
|
||||
(mark-dirty input))
|
||||
@@ -1485,7 +1485,7 @@ A "word" here is defined as a run of non-space characters. This matches
|
||||
the shell/Emacs convention for Ctrl+W rather than an English word boundary
|
||||
(which would involve punctuation handling).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun text-input-delete-word-before (input)
|
||||
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
|
||||
(when (zerop pos) (return-from text-input-delete-word-before))
|
||||
@@ -1523,7 +1523,7 @@ visible characters (letters, digits, punctuation, symbols) are
|
||||
inserted. Control characters and spaces are handled by their specific
|
||||
key bindings.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defun handle-text-input (input event)
|
||||
(cond
|
||||
((key-event-ctrl event)
|
||||
@@ -1569,7 +1569,7 @@ The cursor is a solid block ("█") drawn at the cursor column offset
|
||||
from the text start. If the cursor is beyond the truncated display
|
||||
width, it's clamped to the last visible position.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
||||
(defmethod render ((in text-input) (backend t))
|
||||
(let* ((ln (text-input-layout-node in))
|
||||
(x (if ln (layout-node-x ln) 0)) (y (if ln (layout-node-y ln) 0))
|
||||
@@ -1608,7 +1608,7 @@ polymorphism is handled by the dispatch function.
|
||||
This is the first block tangling to keybindings.lisp, so it includes
|
||||
the ~in-package~ form.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
(in-package #:cl-tty.input)
|
||||
|
||||
(defstruct keymap
|
||||
@@ -1628,11 +1628,11 @@ chord support (e.g., ~(:ctrl+x :ctrl+s)~). Currently only single-key
|
||||
specs work; the timeout and list-of-lists spec syntax are placeholders
|
||||
for the eventual chord implementation.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
(defparameter *keymaps* (make-hash-table :test #'equal))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
(defparameter *chord-timeout* 0.5)
|
||||
#+END_SRC
|
||||
|
||||
@@ -1657,7 +1657,7 @@ The modifier matching uses ~string=?~ on the modifier part because
|
||||
on the keyword would make them different specifiers, which is unexpected
|
||||
for users writing ~:ctrl+p~ in their keymaps.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
(defun key-match-p (spec event)
|
||||
"T if SPEC matches EVENT. Spec is :ctrl+p (modifier+key keyword)
|
||||
or (:ctrl+p) for single-spec in a list, or (:ctrl+x :ctrl+s) for chords."
|
||||
@@ -1716,7 +1716,7 @@ Chords ~((:ctrl+x :ctrl+s))~ are not yet supported; only single
|
||||
key specs work. The ~*chord-timeout*~ variable and list-of-lists syntax
|
||||
are reserved for future implementation.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
(defun dispatch-key-event (event &key component)
|
||||
(labels ((try-keymap (km)
|
||||
(when km
|
||||
@@ -1738,7 +1738,7 @@ are reserved for future implementation.
|
||||
~defkeymap~ is a convenience macro that registers a keymap in the global
|
||||
~*keymaps*~ hash table. Syntax:
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
(defmacro defkeymap (name &body bindings)
|
||||
`(setf (gethash ',name *keymaps*)
|
||||
(make-keymap :name ',name
|
||||
@@ -1759,7 +1759,7 @@ This generic function allows the dispatch system to query any object for
|
||||
its keymap, enabling per-component keybinding customization without
|
||||
requiring components to inherit from a specific base class.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
||||
;;; --- Component protocol integration ---
|
||||
(defgeneric component-keymap (component)
|
||||
(:method ((c t)) nil))
|
||||
@@ -1780,7 +1780,7 @@ The test suite is tangled to ~../tests/input-tests.lisp~ and covers:
|
||||
key-spec matching with all modifiers, list-form specs, return values,
|
||||
empty keymap, local-over-global, multiple bindings, defkeymap macro)
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/input-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/input-tests.lisp
|
||||
(defpackage :cl-tty-input-test
|
||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
||||
(:export #:run-tests))
|
||||
|
||||
@@ -49,7 +49,7 @@ and the backend's ~*theme-colors*~ for SGR resolution.
|
||||
|
||||
Package declaration and test suite registration.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(in-package :cl-tty-box-test)
|
||||
(in-suite box-suite)
|
||||
#+END_SRC
|
||||
@@ -60,7 +60,7 @@ Verifies basic construction of a theme with default ~:dark~ mode. The
|
||||
~make-theme~ constructor should return an instance of the ~theme~
|
||||
class with ~:dark~ as the initial mode.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test theme-create-default
|
||||
"A theme can be created with default mode"
|
||||
(let ((th (make-theme)))
|
||||
@@ -73,7 +73,7 @@ class with ~:dark~ as the initial mode.
|
||||
Verifies explicit ~:light~ mode works. Both modes must produce themes
|
||||
ready to accept color role assignments.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test theme-create-light
|
||||
"A theme can be created in light mode"
|
||||
(let ((th (make-theme :mode :light)))
|
||||
@@ -86,7 +86,7 @@ Confirms ~setf~ on ~theme-color~ stores a value and that reading it
|
||||
back returns the same string. This is the core read/write contract
|
||||
for the theme's role map.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test theme-color-set-and-get
|
||||
"theme-color setf/get works"
|
||||
(let ((th (make-theme)))
|
||||
@@ -100,7 +100,7 @@ Unassigned roles must return ~nil~ rather than signaling an error.
|
||||
This allows components to degrade gracefully when a theme doesn't
|
||||
define every possible role.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test theme-color-unknown-returns-nil
|
||||
"Unknown roles return nil"
|
||||
(let ((th (make-theme)))
|
||||
@@ -113,7 +113,7 @@ Loading the ~:default~ preset in ~:dark~ mode must populate a set of
|
||||
expected roles with their documented hex values. We spot-check
|
||||
~:primary~, ~:background~, and ~:error~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test load-default-dark-preset
|
||||
"Loading the default dark preset populates roles"
|
||||
(let ((th (make-theme :mode :dark)))
|
||||
@@ -129,7 +129,7 @@ The light variant of ~:default~ must produce different values (warm
|
||||
tones on near-white). This validates the mode dispatch inside
|
||||
~load-preset~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test load-default-light-preset
|
||||
"Light variant has different colors"
|
||||
(let ((th (make-theme :mode :light)))
|
||||
@@ -144,7 +144,7 @@ The ~:nord~ preset must produce a distinct cool-blue palette,
|
||||
different from the ~:default~ gold scheme. This validates independent
|
||||
preset data.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test load-nord-preset
|
||||
"Nord preset has different colors than default"
|
||||
(let ((th (make-theme :mode :dark)))
|
||||
@@ -159,7 +159,7 @@ An unknown preset name must signal a ~warning~ (not an ~error~) and
|
||||
leave the theme's roles unpopulated. This ensures graceful degradation
|
||||
when a preset is missing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test load-preset-unknown-warns
|
||||
"Unknown preset warns but doesn't error"
|
||||
(let ((th (make-theme)))
|
||||
@@ -173,7 +173,7 @@ Switching the mode at runtime and re-loading the same preset must
|
||||
produce the other variant's colors. This validates that ~load-preset~
|
||||
reads the current ~theme-mode~ each time, not a cached value.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
||||
(test preset-switch-mode
|
||||
"Switching mode and reloading changes colors"
|
||||
(let ((th (make-theme :mode :dark)))
|
||||
@@ -200,7 +200,7 @@ table storing role→hex mappings, lazily initialized to an empty
|
||||
hash table). Using ~make-hash-table~ as the ~:initform~ ensures each
|
||||
instance gets its own table instead of sharing one.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(in-package :cl-tty.box)
|
||||
|
||||
(defclass theme ()
|
||||
@@ -215,7 +215,7 @@ this in a function lets us change the constructor signature without
|
||||
breaking callers. Mode defaults to ~:dark~, suitable for dark-background
|
||||
terminals; callers pass ~:mode :light~ for light backgrounds.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(defun make-theme (&key (mode :dark))
|
||||
(make-instance 'theme :mode mode))
|
||||
#+END_SRC
|
||||
@@ -229,7 +229,7 @@ Reads a semantic role from the theme's roles hash table. Uses
|
||||
degrade gracefully rather than crashing. The backend treats ~nil~ as
|
||||
"use default."
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(defun theme-color (theme role)
|
||||
"Resolve a semantic ROLE to a hex color string in THEME."
|
||||
(gethash role (theme-roles theme)))
|
||||
@@ -241,7 +241,7 @@ The setter companion to ~theme-color~. Storing via ~setf~ writes
|
||||
directly into the roles hash table. Uses ~setf~ on ~gethash~ which
|
||||
creates the entry if it doesn't exist.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(defun (setf theme-color) (hex theme role)
|
||||
"Set the hex color for a semantic ROLE in THEME."
|
||||
(setf (gethash role (theme-roles theme)) hex))
|
||||
@@ -258,7 +258,7 @@ table keeps preset data inline and readable.
|
||||
Global storage for preset definitions. The ~eq~ test matches keyword
|
||||
identity, which is the fastest hash test for keywords.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(defparameter *presets* (make-hash-table :test #'eq))
|
||||
#+END_SRC
|
||||
|
||||
@@ -269,7 +269,7 @@ Registers a preset by name (~keyword~) at macro-expansion time. The
|
||||
~setf~ of ~gethash~, storing a plist of ~:dark~ and ~:light~ variants.
|
||||
Using a quoted list (not an alist or hash) keeps the data compact.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(defmacro define-preset (name &key dark light)
|
||||
"Define a theme preset with DARK and LIGHT variants.
|
||||
NAME should be a keyword (e.g., :default, :nord)."
|
||||
@@ -292,7 +292,7 @@ pairs, setting both the theme entry and the backend entry. If the
|
||||
preset doesn't exist, ~warn~ is called instead of ~error~ — a missing
|
||||
preset shouldn't crash the application.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(defun load-preset (theme preset-name)
|
||||
"Load PRESET-NAME colors into THEME.
|
||||
Side-effect: populates cl-tty.backend:*theme-colors* so that semantic
|
||||
@@ -320,7 +320,7 @@ Two presets are built in:
|
||||
Gold/accent palette on dark navy background. The light variant
|
||||
inverts to warm tones on near-white.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(define-preset :default
|
||||
:dark (:primary "#FFD700" :secondary "#B8860B" :accent "#FFA500"
|
||||
:error "#FF4444" :warning "#FF8800" :success "#44BB44" :info "#4488FF"
|
||||
@@ -351,7 +351,7 @@ inverts to warm tones on near-white.
|
||||
Cool blue palette inspired by Arctic Studio's Nord theme. Softer
|
||||
contrast than default, designed for reduced eye strain.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
||||
(define-preset :nord
|
||||
:dark (:primary "#88C0D0" :secondary "#81A1C1" :accent "#5E81AC"
|
||||
:error "#BF616A" :warning "#D08770" :success "#A3BE8C" :info "#B48EAD"
|
||||
|
||||
Reference in New Issue
Block a user