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

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

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

8 nov. 2019 kl. 19.28 skrev martin rudalics <rudalics@gmx.at>:

> At least here on Windows pressing the right mouse button does nothing
> with Firefox, Thunderbird or the desktop.

Not much of a Windows user myself. Firefox on Linux allows press-drag-release.

> > However, I think we largely agree that the current buffer and face
> > menus are of limited utility and that their bindings should not be
> > considered sacred territory.
> 
> I fully agree but obviously cannot speak for the others.  It would be
> nice though to settle this very issue in order to free the down
> bindings for good.

Right. To avoid conflating issues, I propose using control-meta for rectangular selection at least as the initial binding. The attached patch also contains documentation updates.

Not sure what to do about the menus. Combining the buffer and appearance menus would free up a binding.

Eli had some concerns regarding the behaviour of an early patch, so I'll wait for him to take another look whenever he can spare a moment. (No hurry.)


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

From 0e5430492a900e9396b5a40a03dca06ae94c8e04 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.
* 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          | 90 +++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 99 insertions(+), 1 deletion(-)

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..5db1690eef 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,90 @@ 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))
+    (setq track-mouse 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)
+       (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
-- 
2.21.0 (Apple Git-122)