cl-tty/org/mouse.org

Mouse Support (v0.10.0)

• Overview
  • Contract
  • Code

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

(defpackage :cl-tty.mouse
  (:use :cl :cl-tty.input :cl-tty.box)
  (: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))

(in-package :cl-tty.mouse)

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

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

(defun hit-test (root x y)
  (labels ((recurse (node)
             (when (and (slot-boundp node 'x) (slot-boundp node 'y)
                        (slot-boundp node 'width) (slot-boundp node 'height))
               (let ((nx (slot-value node 'x))
                     (ny (slot-value node 'y))
                     (nw (slot-value node 'width))
                     (nh (slot-value node 'height)))
                 (when (and (>= x nx) (< x (+ nx nw))
                            (>= y ny) (< y (+ ny nh)))
                   node)))))
    (recurse root)))

;; Selection
(defvar *selection* nil)

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

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

(defun copy-to-clipboard (text)
  #+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
                               :input text :wait nil)
  #+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))

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

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

(def-test mouse-hit-test-point ()
  (let ((obj (make-instance 'mouse-mixin)))
    (is-true t)))  ;; placeholder

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