cl-tty/org/mouse.org

Mouse Support (v0.10.0)

• Overview
  • Contract
  • Code
    • Package definition
    • Package entry form
    • mouse-mixin — mixin class for mouse event handler slots
    • handle-mouse-event — dispatch mouse events to the right slot handler
    • hit-test — find the deepest component at a given (x, y)
    • *selection* — global variable holding the current selection
    • selection struct — data representation of a highlighted region
    • get-selection — read the selected text
    • copy-to-clipboard — platform-aware clipboard writing
    • *selection-active* — flag indicating an in-progress drag selection
    • *selection-start* — drag origin coordinates
    • *selection-end* — current drag extent coordinates
    • start-selection — begin a drag selection
    • update-selection — update the drag extent during mouse-move
    • selection-active-p — predicate for drag state
    • finalize-selection — complete the drag and extract text
    • cell-link-at — read a link URL from the framebuffer at (x, y)
    • open-link-at — navigate to a URL embedded at a screen position
    • Tests
      • Test package and suite definition
      • Test: mouse-mixin-create
      • Test: mouse-hit-test-point
      • Test: selection-set-and-get
      • Test: start-selection-initializes-state
      • Test: update-selection-moves-end
      • Test: finalize-selection-extracts-text

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.

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

Package entry form

Standard boilerplate to enter the package defined above.

(in-package :cl-tty.mouse)

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."

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

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

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

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.

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

*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.

(defvar *selection* nil)

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.

(defstruct (selection (:conc-name sel-))
  (start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))

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.

(defun get-selection ()
  (when *selection* (sel-text *selection*)))

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.

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

*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.

(defvar *selection-active* nil
  "T when a drag selection is in progress.")

*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.

(defvar *selection-start* nil
  "Cons (X . Y) of mouse-down position during drag.")

*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*.

(defvar *selection-end* nil
  "Cons (X . Y) of current mouse position during drag.")

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

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

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.

(defun update-selection (x y)
  "Update the drag selection end position to (X Y)."
  (setf *selection-end* (cons x y)))

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.

(defun selection-active-p ()
  "Return T if a drag selection is in progress."
  *selection-active*)

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.

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

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.

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

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.

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

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.

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

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.

(def-test mouse-mixin-create ()
  (let ((m (make-instance 'mouse-mixin)))
    (is-true (typep m 'mouse-mixin))))

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.

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

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.

(def-test selection-set-and-get ()
  (setf cl-tty.mouse::*selection* (make-selection :text "hello"))
  (is (equal "hello" (get-selection))))

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

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

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.

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

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.

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