bug#38013: [PATCH] Rectangular region selection with mouse

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 326 bytes --]

Here is an updated patch that makes the selection work better with characters that aren't a multiple of the standard font width. 

The underlying rect.el isn't really geared for this sort of thing, leading to ragged rectangle edges and other effects, but at least it is not a new problem; this is not the time to fix it.


[-- Attachment #2: 0001-Mouse-rectangular-region-selection-bug-38013.patch --]
[-- Type: application/octet-stream, Size: 11528 bytes --]

From 38cc3baa7f01f418653e36cc5d8e4cf5b151d26e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
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 'fine-grained-mouse-movement'.
* doc/lispref/commands.texi (Motion Events):
Document 'fine-grained-mouse-movement'.
* 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             | 109 +++++++++++++++++++++++++++++++++++++-
 lisp/rect.el              |   8 ++-
 src/xdisp.c               |  12 +++++
 7 files changed, 142 insertions(+), 3 deletions(-)

diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 091c011fb9..f6c2d23913 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -91,6 +91,10 @@ Mouse Commands
 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 80e2868908..ce00cb38a7 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -732,6 +732,9 @@ Rectangles
 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 0c848a8025..8a614c721f 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1661,6 +1661,12 @@ Motion Events
 does not generate events for mere motion of the mouse, and these
 events do not appear.  @xref{Mouse Tracking}.
 
+@defvar fine-grained-mouse-movement
+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 485d2b1fdf..db00d40bb6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -582,6 +582,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 c91760a734..29cb9716c3 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1045,10 +1045,12 @@ mouse-scroll-min-lines
 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 @@ mouse-scroll-subr
 		   ;; 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))))
@@ -1960,6 +1964,109 @@ secondary-selection-from-region
     (move-overlay mouse-secondary-overlay (region-beginning) (region-end))))
 
 \f
+(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-fine-grained-mouse-movement fine-grained-mouse-movement)
+         ;; 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))))
+    (setq track-mouse t)
+    (setq fine-grained-mouse-movement t)
+    (set-transient-map
+     (let ((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.
+             (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)))
+
+             (setq dragged t))
+
+           (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)))))))
+       map)
+     t
+     (lambda ()
+       (setq track-mouse old-track-mouse)
+       (setq fine-grained-mouse-movement old-fine-grained-mouse-movement)
+       (when (or (not dragged)
+                 (not (mark))
+                 (equal (rectangle-dimensions (mark) (point)) '(0 . 1)))
+         ;; No nontrivial region selected; deactivate rectangle mode.
+         (deactivate-mark))))))
+
+;; 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)
+
+\f
 (defcustom mouse-buffer-menu-maxlen 20
   "Number of buffers in one pane (submenu) of the buffer menu.
 If we have lots of buffers, divide them into groups of
diff --git a/lisp/rect.el b/lisp/rect.el
index 4d4d6146f2..1109786fc5 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -133,11 +133,15 @@ rectangle--point-col
 (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 c5676b3e17..384827c94e 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 (fine_grained_mouse_movement)
+    {
+      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.  */
 
@@ -34943,6 +34949,12 @@ syms_of_xdisp (void)
 may be more familiar to users.  */);
   display_raw_bytes_as_hex = false;
 
+  DEFVAR_BOOL ("fine-grained-mouse-movement", fine_grained_mouse_movement,
+    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).  */);
+  fine_grained_mouse_movement = false;
+
 }
 
 
-- 
2.21.0 (Apple Git-122)