#+TITLE: Mouse Support (v0.10.0) #+DATE: 2026-05-11 #+AUTHOR: Amr Gharbeia / Hermes * Overview Mouse event propagation through the component tree. The input system already parses SGR mouse sequences into ~mouse-event~ structs. This module adds: 1. A ~mouse-mixin~ class with event handler slots 2. Hit-testing: given (x,y), find the deepest component owning that cell 3. Event dispatch: route ~mouse-event~ → component handlers, bubble up 4. ScrollBox integration: wheel → scroll 5. Text selection: drag highlight + clipboard copy ** Contract - ~mouse-mixin~ — mixin class with ~:on-mouse-down/up/move/scroll~ slots - ~handle-mouse-event component event~ — dispatch to the right handler - ~hit-test root x y~ → deepest component at (x,y) - ~selection~ — highlighted text region (start-x, start-y, end-x, end-y) - ~get-selection~ → selected text as string - ~copy-to-clipboard text~ → pipe to xclip/wl-copy ** 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) (:export #:mouse-mixin #:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll #:handle-mouse-event #:hit-test #:selection #:get-selection #:copy-to-clipboard #:make-selection #:selection-p #:start-selection #:update-selection #:finalize-selection #:selection-active-p #: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 (:press (on-mouse-down component)) (:release (on-mouse-up component)) (: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. Components without a layout-node or position return nil." (labels ((recurse (node) (let ((ln (ignore-errors (component-layout-node node))) (best nil)) (when ln (let ((nx (layout-node-x ln)) (ny (layout-node-y ln)) (nw (layout-node-width ln)) (nh (layout-node-height ln))) ;; Check children first for deeper match (dolist (child (ignore-errors (component-children node))) (let ((child-hit (recurse child))) (when child-hit (setf best child-hit)))) ;; If no child matched, check self (or best (when (and (>= x nx) (< x (+ nx nw)) (>= y ny) (< y (+ ny nh))) node))))))) (recurse root))) #+END_SRC *** ~*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 *** ~copy-to-clipboard~ — platform-aware clipboard writing 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 (defun copy-to-clipboard (text) #+linux (cond ((sb-ext:posix-getenv "WAYLAND_DISPLAY") (sb-ext:run-program "wl-copy" nil :input text :wait nil)) (t (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-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) (when (and *selection-start* *selection-end* fb) (let* ((x1 (car *selection-start*)) (y1 (cdr *selection-start*)) (x2 (car *selection-end*)) (y2 (cdr *selection-end*)) (text (cl-tty.rendering:extract-text fb x1 y1 x2 y2))) (setf *selection* (make-selection :start-x x1 :start-y y1 :end-x x2 :end-y y2 :text text)) (setf *selection-start* nil *selection-end* nil) text))) #+END_SRC *** ~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))) (when url #+linux (sb-ext:run-program "xdg-open" (list url) :wait nil) #+darwin (sb-ext:run-program "open" (list url) :wait nil)) 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 **** 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)) (is (equal '(5 . 10) cl-tty.mouse::*selection-start*)) (is (equal '(5 . 10) cl-tty.mouse::*selection-end*)) (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) (is (equal '(3 . 7) cl-tty.mouse::*selection-end*)) (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))) (cl-tty.backend:draw-text fb-be 0 0 "hello" nil nil) (cl-tty.backend:draw-text fb-be 0 1 "world" nil nil) (start-selection 0 0) (update-selection 4 1) (let ((text (finalize-selection fb))) (is (equal "hello world" text))))) #+END_SRC