From eb5c272a373310cc039cd6e55b29367d4c076f66 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.
* src/xdisp.c (remember_mouse_glyph):
(syms_of_xdisp): Add mouse-movement-in-tab, to allow fine-grained
mouse-movement events inside tabs on the screen (stretch glyphs
actually).
* doc/emacs/frames.texi (Mouse Commands):
* doc/emacs/killing.texi (Rectangles):
* etc/NEWS (value): Document.
---
 doc/emacs/frames.texi  |  4 ++
 doc/emacs/killing.texi |  3 ++
 etc/NEWS               |  3 ++
 lisp/mouse.el          | 93 +++++++++++++++++++++++++++++++++++++++++-
 src/xdisp.c            | 13 ++++--
 5 files changed, 112 insertions(+), 4 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/etc/NEWS b/etc/NEWS
index 61b9f933f1..3d181b32da 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 238852ffdc..4de9684173 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,93 @@ secondary-selection-from-region
     (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-movement-in-tab mouse-movement-in-tab))
+    (setq track-mouse t)
+    (setq mouse-movement-in-tab 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)
+             ;; Tell the rectangle selection about the exact column,
+             ;; since it might not correspond exactly to a valid
+             ;; position in the text.
+             (rectangle--col-pos start-col 'mark)
+             (rectangle--col-pos start-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)))
+             (if (and (eq window start-window)
+                      mouse-row
+                      (<= top mouse-row (1- bottom)))
+                 ;; Drag inside the same window.
+                 (progn
+                   (posn-set-point posn)
+                   (rectangle--col-pos mouse-col 'point))
+               ;; Drag outside the window: scroll.
+               (cond
+                ((null mouse-row))
+                ((< mouse-row top)
+                 (mouse-scroll-subr
+                  start-window (- mouse-row top) nil start-point
+                  (lambda () (rectangle--col-pos mouse-col 'point))))
+                ((>= mouse-row bottom)
+                 (mouse-scroll-subr
+                  start-window (1+ (- mouse-row bottom)) nil start-point
+                  (lambda () (rectangle--col-pos mouse-col 'point)))))))))
+       map)
+     t
+     (lambda ()
+       (setq track-mouse old-track-mouse)
+       (setq mouse-movement-in-tab old-mouse-movement-in-tab)
+       (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)
+
+
 (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/src/xdisp.c b/src/xdisp.c
index 8aefab964a..717a94e385 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2572,10 +2572,11 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect)
 
 	  if (g < end)
 	    {
-	      if (g->type == IMAGE_GLYPH)
+	      if (g->type == IMAGE_GLYPH
+                  || (g->type == STRETCH_GLYPH && mouse_movement_in_tab))
 		{
-		  /* Don't remember when mouse is over image, as
-		     image may have hot-spots.  */
+		  /* Don't remember when mouse is over an image, as
+		     images may have hot-spots.  */
 		  STORE_NATIVE_RECT (*rect, 0, 0, 0, 0);
 		  return;
 		}
@@ -34939,6 +34940,12 @@ syms_of_xdisp (void)
 may be more familiar to users.  */);
   display_raw_bytes_as_hex = false;
 
+  DEFVAR_BOOL ("mouse-movement-in-tab", mouse_movement_in_tab,
+    doc: /* Non-nil means generate mouse-movement events inside tab chars.
+When nil, mouse-movement events will not be generated as long as the
+mouse stays within the extent of a single tab character.  */);
+  mouse_movement_in_tab = false;
+
 }
 
 
-- 
2.21.0 (Apple Git-122)

