From 4eb7db5d4b84708912c63a77569c8adeeff6c640 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 25 Oct 2019 11:16:39 +0200 Subject: [PATCH] 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. --- doc/emacs/frames.texi | 4 ++ doc/emacs/killing.texi | 3 + doc/lispref/commands.texi | 6 ++ etc/NEWS | 3 + lisp/mouse.el | 113 +++++++++++++++++++++++++++++++++++++- lisp/rect.el | 8 ++- src/xdisp.c | 12 ++++ 7 files changed, 146 insertions(+), 3 deletions(-) diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 091c011fb96..f6c2d239132 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -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. +@xref{Rectangles}. @end table @findex mouse-set-point diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 80e2868908a..ce00cb38a74 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -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 diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 0c848a80257..032f005e9c4 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index 98a35206225..8233328fa3c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -613,6 +613,9 @@ region using a given replacement-function in a non-destructive manner arguments mitigating performance issues when operating on huge buffers. ++++ +** 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 diff --git a/lisp/mouse.el b/lisp/mouse.el index c91760a7348..f076e90bd93 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -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." (cond ((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) + 'right-to-left) + (- (frame-text-cols) col -1) + col))) + (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) + (deactivate-mark) + (posn-set-point start-pos) + (rectangle-mark-mode) + ;; 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) + 0)) + (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)) + (rectangle--col-pos + (funcall adjusted-col mouse-col) 'point) + (rectangle--reset-point-crutches))))) + (if (and (eq window start-window) + mouse-row + (<= top mouse-row (1- bottom))) + ;; Drag inside the same window. + (progn + (posn-set-point posn) + (funcall set-col)) + ;; Drag outside the window: scroll. + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr + start-window (- mouse-row top) nil start-point + set-col)) + ((>= mouse-row bottom) + (mouse-scroll-subr + start-window (1+ (- mouse-row bottom)) nil start-point + set-col))))))) + (condition-case err + (progn + (setq track-mouse t) + (setq mouse-fine-grained-tracking t) + (set-transient-map + 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. + (deactivate-mark))))) + ;; 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. diff --git a/lisp/rect.el b/lisp/rect.el index 4d4d6146f21..1109786fc5b 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -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--reset-point-crutches)) + ;;; Rectangle operations. (defun apply-on-rectangle (function start end &rest args) diff --git a/src/xdisp.c b/src/xdisp.c index 2b4dda27157..c4d23be4cde 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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); + return; + } + /* 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; + } -- 2.39.5