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

@@ -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

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

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

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

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.

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)

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;
+
 }