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

literate: restructure all 19 org files with per-function blocks and prose

Browse Source 
Every function, defclass, defstruct, defgeneric, defmethod, defmacro,
defvar, and defparameter in every org file now has its own #+BEGIN_SRC
block with literate prose above it explaining the design reasoning.

Block counts before → after:
  package.org:           1 → 7
  container-package.org: 1 → 1 (prose expanded)
  dirty.org:             4 → 6
  render.org:           10 → 25
  theme.org:             6 → 19
  box-renderable.org:    9 → 29
  scrollbox.org:         8 → 26
  tabbar.org:            5 → 10
  backend-protocol.org:  8 → 66
  modern-backend.org:   17 → 53
  detection.org:         4 → 6
  layout-engine.org:     9 → 36
  framebuffer.org:       8 → 37
  markdown-renderer.org:13 → 38
  dialog.org:           17 → 23 (merged dual structure)
  mouse.org:             4 → 25
  select.org:           12 → 30
  slot.org:              4 → 12
  text-input.org:       11 → 53

Total: ~153 blocks → ~502 blocks

Bugs fixed during restructuring:
- render.org: stray π character typo (backenπd → backend)
- modern-backend.org: sgr-attr missing closing paren + #+END_SRC
- detection.org: invalid #\Esc character reference
- select.org: extra closing paren in select-visible-options

All 13 test suites pass at 100%.
This commit is contained in:
Hermes Agent
2026-05-12 18:55:07 +00:00
parent 927f786716
commit 29f99a576d
42 changed files with 4730 additions and 1745 deletions
Download Patch File Download Diff File Expand all files Collapse all files

218
org/mouse.org
View File

@@ -25,6 +25,13 @@ module adds:
** Code
*** Package definition
The package lives in its own file so it can be loaded before the
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
(defpackage :cl-tty.mouse
(:use :cl :cl-tty.layout :cl-tty.input :cl-tty.box :cl-tty.rendering)
@@ -40,15 +47,39 @@ module adds:
#:cell-link-at #:open-link-at))
#+END_SRC
*** Package entry form
Standard boilerplate to enter the package defined above.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
(in-package :cl-tty.mouse)
#+END_SRC
*** ~mouse-mixin~ — mixin class for mouse event handler slots
Using a mixin (rather than adding slots to every component class)
keeps the mouse concern orthogonal to layout or rendering. Components
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
(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)
(on-mouse-move :initarg :on-mouse-move :initform nil :accessor on-mouse-move)
(on-mouse-scroll :initarg :on-mouse-scroll :initform nil :accessor on-mouse-scroll)))
#+END_SRC
*** ~handle-mouse-event~ — dispatch mouse events to the right slot handler
Maps from the low-level ~mouse-event-type~ keyword to the
corresponding mixin slot. Using ~case~ here is simpler than a generic
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
(defun handle-mouse-event (component event)
(let* ((type (mouse-event-type event))
(handler (case type
@@ -57,7 +88,17 @@ module adds:
(:drag (on-mouse-move component))
(t nil))))
(when handler (funcall handler event))))
#+END_SRC
*** ~hit-test~ — find the deepest component at a given (x, y)
Recursive coordinate lookup. Children are checked first so that the
innermost matching component wins (front-most in rendering order).
~ignore-errors~ guards against components that haven't been laid out
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
(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.
@@ -81,24 +122,50 @@ Components without a layout-node or position return nil."
(>= y ny) (< y (+ ny nh)))
node)))))))
(recurse root)))
#+END_SRC
;; Selection
*** ~*selection*~ — global variable holding the current selection
A single global makes the selection accessible from anywhere in the
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
(defvar *selection* nil)
#+END_SRC
*** ~selection~ struct — data representation of a highlighted region
Stores the bounding box (start and end coordinates) plus the extracted
text. The ~:conc-name sel-~ prefix keeps accessors short while
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
(defstruct (selection (:conc-name sel-))
(start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
#+END_SRC
*** ~get-selection~ — read the selected text
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
(defun get-selection ()
(when *selection* (sel-text *selection*)))
#+END_SRC
*** Bug Fixes (v1.0.0): Wayland clipboard support
*** ~copy-to-clipboard~ — platform-aware clipboard writing
~copy-to-clipboard~ only called ~xclip~, which fails silently on Wayland
sessions (where ~xclip~ is often unavailable or requires XWayland).
Fix: Check the ~WAYLAND_DISPLAY~ environment variable. If set, use
~wl-copy~ instead of ~xclip~. Fall back to ~xclip~ for traditional X11
The original implementation only called ~xclip~, which fails silently
on Wayland sessions. This version checks ~WAYLAND_DISPLAY~ at runtime
— if set, it uses ~wl-copy~; otherwise it falls back to ~xclip~.
Darwin uses ~pbcopy~. The approach avoids build-time feature detection
(~#+wayland~) in favor of runtime environment checks, which handles
the common case of a single SBCL binary used across X11 and Wayland
sessions.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
@@ -111,32 +178,89 @@ sessions.
(sb-ext:run-program "xclip" (list "-selection" "clipboard")
:input text :wait nil)))
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
#+END_SRC
;;; --- Selection tracking (mouse drag) ---------------------------------------
*** ~*selection-active*~ — flag indicating an in-progress drag selection
Setting this to ~T~ during a mouse drag lets the renderer know it
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
(defvar *selection-active* nil
"T when a drag selection is in progress.")
#+END_SRC
*** ~*selection-start*~ — drag origin coordinates
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
(defvar *selection-start* nil
"Cons (X . Y) of mouse-down position during drag.")
#+END_SRC
*** ~*selection-end*~ — current drag extent coordinates
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
(defvar *selection-end* nil
"Cons (X . Y) of current mouse position during drag.")
#+END_SRC
*** ~start-selection~ — begin a drag selection
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
(defun start-selection (x y)
"Begin a drag selection at (X Y)."
(setf *selection-start* (cons x y)
*selection-end* (cons x y)
*selection-active* t))
#+END_SRC
*** ~update-selection~ — update the drag extent during mouse-move
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
(defun update-selection (x y)
"Update the drag selection end position to (X Y)."
(setf *selection-end* (cons x y)))
#+END_SRC
*** ~selection-active-p~ — predicate for drag state
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
(defun selection-active-p ()
"Return T if a drag selection is in progress."
*selection-active*)
#+END_SRC
*** ~finalize-selection~ — complete the drag and extract text
Clears the active flag, normalizes coordinates (the user may have
dragged right-to-left or bottom-to-top), extracts the text from the
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
(defun finalize-selection (fb)
"End the drag selection and extract text from the framebuffer."
(setf *selection-active* nil)
@@ -151,13 +275,28 @@ sessions.
:text text))
(setf *selection-start* nil *selection-end* nil)
text)))
#+END_SRC
;;; --- Link clicking ---------------------------------------------------------
*** ~cell-link-at~ — read a link URL from the framebuffer at (x, y)
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
(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))
#+END_SRC
*** ~open-link-at~ — navigate to a URL embedded at a screen position
If ~cell-link-at~ finds a URL, open it with the OS default handler
(~xdg-open~ on Linux, ~open~ on Darwin). Returns the URL (or nil) so
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
(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)))
@@ -167,29 +306,68 @@ sessions.
url))
#+END_SRC
*** Tests
**** Test package and suite definition
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
(defpackage :cl-tty-mouse-test (:use :cl :cl-tty.mouse :fiveam))
(in-package :cl-tty-mouse-test)
(def-suite mouse-suite :description "Mouse tests")
(in-suite mouse-suite)
#+END_SRC
**** Test: ~mouse-mixin-create~
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
(def-test mouse-mixin-create ()
(let ((m (make-instance 'mouse-mixin)))
(is-true (typep m 'mouse-mixin))))
#+END_SRC
**** Test: ~mouse-hit-test-point~
~hit-test~ on a bare ~mouse-mixin~ (no layout-node) should return nil
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
(def-test mouse-hit-test-point ()
"hit-test returns nil when no component has position slots bound"
(let ((obj (make-instance 'mouse-mixin)))
(is-false (hit-test obj 0 0))
(is-false (hit-test obj 100 100))))
#+END_SRC
**** Test: ~selection-set-and-get~
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
(def-test selection-set-and-get ()
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
(is (equal "hello" (get-selection))))
#+END_SRC
;; ── Selection tracking ──────────────────────────────────────
**** Test: ~start-selection-initializes-state~
~start-selection~ must set ~*selection-start*~, ~*selection-end*~, and
~*selection-active*~ to their expected initial values. The teardown
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
(def-test start-selection-initializes-state ()
(start-selection 5 10)
(is-true (selection-active-p))
@@ -198,7 +376,15 @@ sessions.
(setf cl-tty.mouse::*selection-active* nil
cl-tty.mouse::*selection-start* nil
cl-tty.mouse::*selection-end* nil))
#+END_SRC
**** Test: ~update-selection-moves-end~
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
(def-test update-selection-moves-end ()
(start-selection 0 0)
(update-selection 3 7)
@@ -206,7 +392,16 @@ sessions.
(setf cl-tty.mouse::*selection-active* nil
cl-tty.mouse::*selection-start* nil
cl-tty.mouse::*selection-end* nil))
#+END_SRC
**** Test: ~finalize-selection-extracts-text~
End-to-end integration test: draws text into a real framebuffer,
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
(def-test finalize-selection-extracts-text ()
(let* ((fb-be (cl-tty.rendering:make-framebuffer-backend))
(fb (cl-tty.rendering:fb-framebuffer fb-be)))
@@ -217,5 +412,4 @@ sessions.
(let ((text (finalize-selection fb)))
(is (equal "hello
world" text)))))
#+END_SRC
#+END_SRC