From d0382f9290ef2d12e6684d399583cb2c1f7d79ea Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Mon, 18 May 2026 16:18:58 -0400 Subject: [PATCH] =?UTF-8?q?v1.0.0:=20merge=20mouse=20=E2=86=92=20input=20?= =?UTF-8?q?=E2=80=94=20eliminate=20cl-tty.mouse=20package?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- cl-tty.asd | 11 +- org/mouse.org | 415 ------------------------------------ org/text-input.org | 201 ++++++++++++++++- run-all-tests.lisp | 4 +- scripts/audit-compiler.lisp | 11 +- scripts/code-audit.lisp | 10 +- 6 files changed, 213 insertions(+), 439 deletions(-) delete mode 100644 org/mouse.org diff --git a/cl-tty.asd b/cl-tty.asd index 1884638..7d9de15 100644 --- a/cl-tty.asd +++ b/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"))) diff --git a/org/mouse.org b/org/mouse.org deleted file mode 100644 index 923a321..0000000 --- a/org/mouse.org +++ /dev/null @@ -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 diff --git a/org/text-input.org b/org/text-input.org index b34b318..944b0dd 100644 --- a/org/text-input.org +++ b/org/text-input.org @@ -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 diff --git a/run-all-tests.lisp b/run-all-tests.lisp index ed872ac..21f2c16 100644 --- a/run-all-tests.lisp +++ b/run-all-tests.lisp @@ -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") diff --git a/scripts/audit-compiler.lisp b/scripts/audit-compiler.lisp index 4ab600d..c4524a2 100644 --- a/scripts/audit-compiler.lisp +++ b/scripts/audit-compiler.lisp @@ -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) diff --git a/scripts/code-audit.lisp b/scripts/code-audit.lisp index 5b3ff2c..823fe76 100644 --- a/scripts/code-audit.lisp +++ b/scripts/code-audit.lisp @@ -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))