Commit 4eb7db5d authored by Mattias Engdegård's avatar Mattias Engdegård

Mouse rectangular region selection (bug#38013)

Make it possible to select a rectangular region using the mouse.
The standard binding is C-M-mouse-1.

* lisp/mouse.el (mouse-scroll-subr): Add ADJUST argument.
(mouse-drag-region-rectangle): New.
* lisp/rect.el (rectangle--reset-point-crutches): New.
(rectangle--reset-crutches): Use 'rectangle--reset-point-crutches'.
* src/xdisp.c (remember_mouse_glyph, syms_of_xdisp):
Add 'mouse-fine-grained-tracking'.
* doc/lispref/commands.texi (Motion Events):
Document 'mouse-fine-grained-tracking'.
* doc/emacs/frames.texi (Mouse Commands):
* doc/emacs/killing.texi (Rectangles):
* etc/NEWS: Document rectangular selection with the mouse.
parent e7b4c248
Pipeline #4181 failed with stage
in 57 minutes and 10 seconds
......@@ -91,6 +91,10 @@ If the region is active, move the nearer end of the region to the
click position; otherwise, set mark at the current value of point and
point at the click position. Save the resulting region in the kill
ring; on a second click, kill it (@code{mouse-save-then-kill}).
@item C-M-mouse-1
Activate a rectangular region around the text selected by dragging.
@end table
@findex mouse-set-point
......@@ -732,6 +732,9 @@ region is controlled. But remember that a given combination of point
and mark values can be interpreted either as a region or as a
rectangle, depending on the command that uses them.
A rectangular region can also be marked using the mouse: click and drag
@kbd{C-M-mouse-1} from one corner of the rectangle to the opposite.
@table @kbd
@item C-x r k
Kill the text of the region-rectangle, saving its contents as the
......@@ -1661,6 +1661,12 @@ events within its body. Outside of @code{track-mouse} forms, Emacs
does not generate events for mere motion of the mouse, and these
events do not appear. @xref{Mouse Tracking}.
@defvar mouse-fine-grained-tracking
When non-@code{nil}, mouse motion events are generated even for very
small movements. Otherwise, motion events are not generated as long
as the mouse cursor remains pointing to the same glyph in the text.
@end defvar
@node Focus Events
@subsection Focus Events
@cindex focus event
......@@ -613,6 +613,9 @@ region using a given replacement-function in a non-destructive manner
arguments mitigating performance issues when operating on huge
** Dragging 'C-M-mouse-1' now marks rectangular regions.
** The command 'delete-indentation' now operates on the active region.
If the region is active, the command joins all the lines in the
......@@ -1045,10 +1045,12 @@ the mouse has moved. However, it always scrolls at least the number
of lines specified by this variable."
:type 'integer)
(defun mouse-scroll-subr (window jump &optional overlay start)
(defun mouse-scroll-subr (window jump &optional overlay start adjust)
"Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
If OVERLAY is an overlay, let it stretch from START to the far edge of
the newly visible text.
ADJUST, if non-nil, is a function, without arguments, to call after
setting point.
Upon exit, point is at the far edge of the newly visible text."
((and (> jump 0) (< jump mouse-scroll-min-lines))
......@@ -1077,6 +1079,8 @@ Upon exit, point is at the far edge of the newly visible text."
;; so that we don't mess up the selected window.
(or (eq window (selected-window))
(goto-char opoint))
(when adjust
(funcall adjust))
(sit-for mouse-scroll-delay)))))
(or (eq window (selected-window))
(goto-char opoint))))
......@@ -1959,6 +1963,113 @@ When there is no region, this function does nothing."
(delete-overlay mouse-secondary-overlay) ; Delete the secondary selection even on a different buffer.
(move-overlay mouse-secondary-overlay (region-beginning) (region-end))))
(defun mouse-drag-region-rectangle (start-event)
"Set the region to the rectangle that the mouse is dragged over.
This must be bound to a button-down mouse event."
(interactive "e")
(let* ((scroll-margin 0)
(start-pos (event-start start-event))
(start-posn (event-start start-event))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
(start-hscroll (window-hscroll start-window))
(start-col (+ (car (posn-col-row start-pos)) start-hscroll))
(bounds (window-edges start-window))
(top (nth 1 bounds))
(bottom (if (window-minibuffer-p start-window)
(nth 3 bounds)
(1- (nth 3 bounds))))
(dragged nil)
(old-track-mouse track-mouse)
(old-mouse-fine-grained-tracking mouse-fine-grained-tracking)
;; For right-to-left text, columns are counted from the right margin;
;; translate from mouse events, which always count from the left.
(adjusted-col (lambda (col)
(if (eq (current-bidi-paragraph-direction)
(- (frame-text-cols) col -1)
(map (make-sparse-keymap)))
(define-key map [switch-frame] #'ignore)
(define-key map [select-window] #'ignore)
(define-key map [mouse-movement]
(lambda (event)
(interactive "e")
(unless dragged
;; This is actually a drag.
(setq dragged t)
(mouse-minibuffer-check start-event)
(posn-set-point start-pos)
;; Only tell rectangle about the exact column if we are possibly
;; beyond end-of-line or in a tab, since the column we got from
;; the mouse position isn't necessarily accurate for use in
;; specifying a rectangle (which uses the `move-to-column'
;; measure).
(when (or (eolp) (eq (following-char) ?\t))
(let ((col (funcall adjusted-col start-col)))
(rectangle--col-pos col 'mark)
(rectangle--col-pos col 'point))))
(let* ((posn (event-end event))
(window (posn-window posn))
(hscroll (if (window-live-p window)
(window-hscroll window)
(mouse-pos (mouse-position))
(mouse-col (+ (cadr mouse-pos) hscroll))
(mouse-row (cddr mouse-pos))
(set-col (lambda ()
(if (or (eolp) (eq (following-char) ?\t))
(funcall adjusted-col mouse-col) 'point)
(if (and (eq window start-window)
(<= top mouse-row (1- bottom)))
;; Drag inside the same window.
(posn-set-point posn)
(funcall set-col))
;; Drag outside the window: scroll.
((null mouse-row))
((< mouse-row top)
start-window (- mouse-row top) nil start-point
((>= mouse-row bottom)
start-window (1+ (- mouse-row bottom)) nil start-point
(condition-case err
(setq track-mouse t)
(setq mouse-fine-grained-tracking t)
map t
(lambda ()
(setq track-mouse old-track-mouse)
(setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking)
(when (or (not dragged)
(not (mark))
(equal (rectangle-dimensions (mark) (point)) '(0 . 1)))
;; No nontrivial region selected; deactivate rectangle mode.
;; Clean up in case something went wrong.
(error (setq track-mouse old-track-mouse)
(setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking)
(signal (car err) (cdr err))))))
;; The drag event must be bound to something but does not need any effect,
;; as everything takes place in `mouse-drag-region-rectangle'.
;; The click event can be anything; `mouse-set-point' is just a convenience.
(global-set-key [C-M-down-mouse-1] #'mouse-drag-region-rectangle)
(global-set-key [C-M-drag-mouse-1] #'ignore)
(global-set-key [C-M-mouse-1] #'mouse-set-point)
(defcustom mouse-buffer-menu-maxlen 20
"Number of buffers in one pane (submenu) of the buffer menu.
......@@ -133,11 +133,15 @@ Point is at the end of the segment of this line within the rectangle."
(defun rectangle--crutches ()
(cons rectangle--mark-crutches
(window-parameter nil 'rectangle--point-crutches)))
(defun rectangle--reset-crutches ()
(kill-local-variable 'rectangle--mark-crutches)
(defun rectangle--reset-point-crutches ()
(if (window-parameter nil 'rectangle--point-crutches)
(setf (window-parameter nil 'rectangle--point-crutches) nil)))
(defun rectangle--reset-crutches ()
(kill-local-variable 'rectangle--mark-crutches)
;;; Rectangle operations.
(defun apply-on-rectangle (function start end &rest args)
......@@ -2491,6 +2491,12 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect)
enum glyph_row_area area;
int x, y, width, height;
if (mouse_fine_grained_tracking)
STORE_NATIVE_RECT (*rect, gx, gy, 1, 1);
/* Try to determine frame pixel position and size of the glyph under
frame pixel coordinates X/Y on frame F. */
......@@ -34946,6 +34952,12 @@ The default is to use octal format (\200) whereas hexadecimal (\x80)
may be more familiar to users. */);
display_raw_bytes_as_hex = false;
DEFVAR_BOOL ("mouse-fine-grained-tracking", mouse_fine_grained_tracking,
doc: /* Non-nil for pixel-wise mouse-movement.
When nil, mouse-movement events will not be generated as long as the
mouse stays within the extent of a single glyph (except for images). */);
mouse_fine_grained_tracking = false;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment