v1.0.0: merge mouse → input — eliminate cl-tty.mouse package
The mouse-event struct was already in cl-tty.input. All mouse handling logic (mouse-mixin, hit-test, selection, clipboard, link detection) was in a separate cl-tty.mouse package. Moved everything into the input package where the struct lives, eliminating one package boundary. Changes: - absorb mouse-mixin, handle-mouse-event, hit-test, selection struct, selection variables/functions, cell-link-at, open-link-at into text-input.org (tangled to input.lisp) - update cl-tty.input defpackage with mouse exports - mouse tests merged into INPUT-SUITE (appended to input-tests.lisp) - delete mouse.org, mouse-package.lisp, mouse.lisp, mouse-tests.lisp - update ASDF, run-all-tests.lisp, scripts to drop mouse references All test suites pass at 100% (INPUT-SUITE: 102 tests, +6 from mouse)
This commit is contained in:
11
cl-tty.asd
11
cl-tty.asd
@@ -43,10 +43,7 @@
|
||||
;; Dialog + Toast (v0.9.0)
|
||||
(:file "dialog-package" :depends-on ("package" "input-package"))
|
||||
(:file "dialog" :depends-on ("dialog-package" "dirty" "text-input"))
|
||||
;; Mouse support (v0.10.0)
|
||||
(:file "mouse-package" :depends-on ("package" "input-package"))
|
||||
(:file "mouse" :depends-on ("mouse-package" "dirty" "input"))
|
||||
;; Slot system (v0.11.0)
|
||||
;; Slot system (v0.11.0)
|
||||
(:file "slot-package" :depends-on ("package"))
|
||||
(:file "slot" :depends-on ("slot-package")))))
|
||||
:in-order-to ((test-op (test-op :cl-tty/test))))
|
||||
@@ -72,8 +69,7 @@
|
||||
(:file "scrollbox-tabbar-tests" :pathname "../../tests/scrollbox-tabbar-tests")
|
||||
(:file "markdown-tests" :pathname "../../tests/markdown-tests")
|
||||
(:file "dialog-tests" :pathname "../../tests/dialog-tests")
|
||||
(:file "mouse-tests" :pathname "../../tests/mouse-tests")
|
||||
(:file "slot-tests" :pathname "../../tests/slot-tests")))
|
||||
(:file "slot-tests" :pathname "../../tests/slot-tests")))
|
||||
(:module "src/rendering"
|
||||
:components
|
||||
((:file "framebuffer-tests" :pathname "../../tests/framebuffer-tests"))))
|
||||
@@ -88,8 +84,7 @@
|
||||
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
|
||||
(:cl-tty-markdown-test)
|
||||
(:cl-tty-dialog-test "DIALOG-SUITE")
|
||||
(:cl-tty-mouse-test "MOUSE-SUITE")
|
||||
(:cl-tty-slot-test "SLOT-SUITE")
|
||||
(:cl-tty-slot-test "SLOT-SUITE")
|
||||
(:cl-tty-layout-test "LAYOUT-SUITE")
|
||||
(:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")
|
||||
(:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE")))
|
||||
|
||||
415
org/mouse.org
415
org/mouse.org
@@ -1,415 +0,0 @@
|
||||
#+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 ~/.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
|
||||
#: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 ~/.local/share/cl-tty/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 ~/.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)
|
||||
(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 ~/.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
|
||||
(: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 ~/.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.
|
||||
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 ~/.local/share/cl-tty/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 ~/.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
|
||||
|
||||
*** ~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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.local/share/cl-tty/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 ~/.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
|
||||
|
||||
*** ~*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 ~/.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
|
||||
|
||||
*** ~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 ~/.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)
|
||||
*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 ~/.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)))
|
||||
#+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 ~/.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*)
|
||||
#+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 ~/.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)
|
||||
(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 ~/.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))
|
||||
#+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 ~/.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)))
|
||||
(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 ~/.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)
|
||||
|
||||
(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 ~/.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))))
|
||||
#+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 ~/.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)))
|
||||
(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 ~/.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))))
|
||||
#+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 ~/.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))
|
||||
(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 ~/.local/share/cl-tty/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 ~/.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)))
|
||||
(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
|
||||
@@ -220,7 +220,18 @@ via ~sb-posix~ directly.
|
||||
#:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent
|
||||
#:*keymaps* #:*chord-timeout*
|
||||
#:defkeymap #:dispatch-key-event #:key-match-p
|
||||
#:component-keymap))
|
||||
#:component-keymap
|
||||
;; Mouse (merged from cl-tty.mouse)
|
||||
#: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
|
||||
#:*selection* #:*selection-active* #:*selection-start* #:*selection-end*
|
||||
#:cell-link-at #:open-link-at))
|
||||
#+END_SRC
|
||||
|
||||
* Input Reader Core
|
||||
@@ -1769,6 +1780,153 @@ requiring components to inherit from a specific base class.
|
||||
(:method ((c t)) nil))
|
||||
#+END_SRC
|
||||
|
||||
* Mouse support (merged from cl-tty.mouse)
|
||||
|
||||
Mouse event propagation through the component tree. The input system
|
||||
already parses SGR mouse sequences into ~mouse-event~ structs. This
|
||||
section 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. Text selection: drag highlight + clipboard copy
|
||||
|
||||
** mouse-mixin — mixin class for mouse event handler slots
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(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
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(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)
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun hit-test (root x y)
|
||||
"Find the deepest component at (X, Y) by testing layout-node bounds."
|
||||
(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)))
|
||||
(dolist (child (ignore-errors (component-children node)))
|
||||
(let ((child-hit (recurse child)))
|
||||
(when child-hit (setf best child-hit))))
|
||||
(or best
|
||||
(when (and (>= x nx) (< x (+ nx nw))
|
||||
(>= y ny) (< y (+ ny nh)))
|
||||
node)))))))
|
||||
(recurse root)))
|
||||
#+END_SRC
|
||||
|
||||
** Selection state
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defvar *selection* nil)
|
||||
(defvar *selection-active* nil "T when a drag selection is in progress.")
|
||||
(defvar *selection-start* nil "Cons (X . Y) of mouse-down position during drag.")
|
||||
(defvar *selection-end* nil "Cons (X . Y) of current mouse position during drag.")
|
||||
#+END_SRC
|
||||
|
||||
** selection struct
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defstruct (selection (:conc-name sel-))
|
||||
(start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
|
||||
#+END_SRC
|
||||
|
||||
** get-selection / copy-to-clipboard
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun get-selection ()
|
||||
(when *selection* (sel-text *selection*)))
|
||||
|
||||
(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
|
||||
|
||||
** start-selection / update-selection
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(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))
|
||||
|
||||
(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
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(defun selection-active-p ()
|
||||
"Return T if a drag selection is in progress."
|
||||
*selection-active*)
|
||||
#+END_SRC
|
||||
|
||||
** finalize-selection
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(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 / open-link-at
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
||||
(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))
|
||||
|
||||
(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
|
||||
|
||||
The test suite is tangled to ~../tests/input-tests.lisp~ and covers:
|
||||
@@ -2195,3 +2353,44 @@ The test suite is tangled to ~../tests/input-tests.lisp~ and covers:
|
||||
(print be)))))
|
||||
(is (listp expanded))))
|
||||
#+END_SRC
|
||||
|
||||
;; ─── Mouse tests (merged from cl-tty.mouse) ───────────────────
|
||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/input-tests.lisp
|
||||
(def-test mouse-mixin-create ()
|
||||
(let ((m (make-instance 'mouse-mixin)))
|
||||
(is-true (typep m 'mouse-mixin))))
|
||||
|
||||
(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))))
|
||||
|
||||
(def-test selection-set-and-get ()
|
||||
(setf *selection* (make-selection :text "hello"))
|
||||
(is (equal "hello" (get-selection))))
|
||||
|
||||
(def-test start-selection-initializes-state ()
|
||||
(start-selection 5 10)
|
||||
(is-true (selection-active-p))
|
||||
(is (equal '(5 . 10) *selection-start*))
|
||||
(is (equal '(5 . 10) *selection-end*))
|
||||
(setf *selection-active* nil *selection-start* nil *selection-end* nil))
|
||||
|
||||
(def-test update-selection-moves-end ()
|
||||
(start-selection 0 0)
|
||||
(update-selection 3 7)
|
||||
(is (equal '(3 . 7) *selection-end*))
|
||||
(setf *selection-active* nil *selection-start* nil *selection-end* nil))
|
||||
|
||||
(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
|
||||
|
||||
@@ -14,7 +14,6 @@
|
||||
"tests/scrollbox-tabbar-tests.lisp"
|
||||
"tests/markdown-tests.lisp"
|
||||
"tests/dialog-tests.lisp"
|
||||
"tests/mouse-tests.lisp"
|
||||
"tests/slot-tests.lisp"
|
||||
"tests/framebuffer-tests.lisp"
|
||||
"tests/integration-tests.lisp"))
|
||||
@@ -28,8 +27,7 @@
|
||||
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
|
||||
(:cl-tty-markdown-test :cl-tty-markdown-test)
|
||||
(:cl-tty-dialog-test "DIALOG-SUITE")
|
||||
(:cl-tty-mouse-test "MOUSE-SUITE")
|
||||
(:cl-tty-slot-test "SLOT-SUITE")
|
||||
(:cl-tty-slot-test "SLOT-SUITE")
|
||||
(:cl-tty-layout-test "LAYOUT-SUITE")
|
||||
(:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")
|
||||
(:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE")
|
||||
|
||||
@@ -33,11 +33,10 @@
|
||||
"src/components/dialog-package.lisp" "src/components/dialog.lisp"
|
||||
"src/components/dirty.lisp"
|
||||
"src/components/input-package.lisp" "src/components/input.lisp"
|
||||
"src/components/keybindings.lisp"
|
||||
"src/components/markdown-package.lisp" "src/components/markdown.lisp"
|
||||
"src/components/mouse-package.lisp" "src/components/mouse.lisp"
|
||||
"src/components/package.lisp" "src/components/render.lisp"
|
||||
"src/components/scrollbox.lisp" "src/components/slot-package.lisp"
|
||||
"src/components/keybindings.lisp"
|
||||
"src/components/markdown-package.lisp" "src/components/markdown.lisp"
|
||||
"src/components/package.lisp" "src/components/render.lisp"
|
||||
"src/components/scrollbox.lisp" "src/components/slot-package.lisp"
|
||||
"src/components/slot.lisp" "src/components/tabbar.lisp"
|
||||
"src/components/text-input.lisp" "src/components/text.lisp"
|
||||
"src/components/textarea.lisp" "src/components/theme.lisp"
|
||||
@@ -51,7 +50,7 @@
|
||||
"src/components/input-tests.lisp"
|
||||
"tests/scrollbox-tabbar-tests.lisp" "tests/dialog-tests.lisp"
|
||||
"tests/markdown-tests.lisp" "tests/dialog-tests.lisp"
|
||||
"tests/mouse-tests.lisp" "tests/slot-tests.lisp"
|
||||
"tests/dialog-tests.lisp" "tests/slot-tests.lisp"
|
||||
"tests/framebuffer-tests.lisp")))
|
||||
(dolist (f files)
|
||||
(if (probe-file f)
|
||||
|
||||
@@ -32,11 +32,10 @@
|
||||
"src/components/dialog-package.lisp" "src/components/dialog.lisp"
|
||||
"src/components/dirty.lisp"
|
||||
"src/components/input-package.lisp" "src/components/input.lisp"
|
||||
"src/components/keybindings.lisp"
|
||||
"src/components/markdown-package.lisp" "src/components/markdown.lisp"
|
||||
"src/components/mouse-package.lisp" "src/components/mouse.lisp"
|
||||
"src/components/package.lisp" "src/components/render.lisp"
|
||||
"src/components/scrollbox.lisp" "src/components/slot-package.lisp"
|
||||
"src/components/keybindings.lisp"
|
||||
"src/components/markdown-package.lisp" "src/components/markdown.lisp"
|
||||
"src/components/package.lisp" "src/components/render.lisp"
|
||||
"src/components/scrollbox.lisp" "src/components/slot-package.lisp"
|
||||
"src/components/slot.lisp" "src/components/tabbar.lisp"
|
||||
"src/components/text-input.lisp" "src/components/text.lisp"
|
||||
"src/components/textarea.lisp" "src/components/theme.lisp"
|
||||
@@ -58,7 +57,6 @@
|
||||
"tests/scrollbox-tabbar-tests.lisp"
|
||||
"tests/markdown-tests.lisp"
|
||||
"tests/dialog-tests.lisp"
|
||||
"tests/mouse-tests.lisp"
|
||||
"tests/slot-tests.lisp"
|
||||
"tests/framebuffer-tests.lisp"))
|
||||
(load f))
|
||||
|
||||
Reference in New Issue
Block a user