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

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

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

5 nov. 2019 kl. 10.35 skrev martin rudalics <rudalics@gmx.at>:

> Any code based on mouse dragging should be written in such way that
> the corresponding click event can be easily handed over to a separate
> command.  That's what the drag- prefix is for.

All right, I re-wrote the patch to allow for independent use for X-mouse-N, but...

> > but doesn't it force the pop-up menu to be used with
> > click-release-select-click-release instead of the quicker
> > click-select-release?
> 
> Yes and I think that the former is the correct and expected behavior.
> I don't use the buffer menu but if I did I were much more annoyed by
> the fact that when I abandon the selection by clicking somewhere else
> I get an active region which I then have to click away in a further
> step.

I don't think so; being able to select from a menu with a single dragging movement is not only more ergonomic, it's the expected behaviour of pop-up menus. mouse.el even contains a comment to that effect:

 ;; By binding these to down-going events, we let the user use the up-going
 ;; event to make the selection, saving a click.

You can try for yourself: with the patch applied, bind M-mouse-1 to a menu:

 (global-set-key [M-mouse-1] 'mouse-buffer-menu)

Now a single meta-click will open the menu, and meta-drag will mark a rectangle. This sort of multiplexing doesn't feel right, and affects both uses negatively.

For example, suppose you have marked a rectangle and change your mind. Intuitively, you will click somewhere to make the mark go away, using the same modifiers. But that doesn't work, because now you get a pop-up menu.

> IMHO the rule should be that non-dragging commands are always bound to
> clicks (including double and triple ones) and never to a down- event.

My patch now follows that rule, but it doesn't seem to solve any problem.

> And personally, I'd reserve C-drag-mouse for marking arbitrary
> non-contiguous text (like, for example, Firefox does) and use
> C-S-drag-mouse for marking rectangular regions.

Emacs's mouse bindings seem rather haphazard and organised mainly on the principle of first-come, enshrining a fair bit of historical baggage. For example, there are two different buffer menus (one for font and one for everything else). There is also the secondary selection, of which there seems to be much fewer actual users than people who just want to know how to disable it.

We could do worse than following some conventions that have become more or less universal, such as right-clicking (control-click on macOS) for a context menu.

That said, do you have any particular reason (precedence, ergonomics) for suggesting control-shift? I'd rather use meta and move secondary selection to shift-meta (say).

(As before, the attached patch uses meta but that is just a placeholder and should not be interpreted as the final word.)


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

From 0d71173e6409de45629806b10cc11f6f06c7c992 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 modifier is customisable and defaults to meta.
The modifier for mouse secondary selection is now also customisable and
defaults to nil (disabled).

* lisp/mouse.el (mouse-scroll-subr): Add ADJUST argument.
(mouse-drag-region-rectangle): New.
(mouse--global-with-modifiers, mouse--set-secondary-selection-bindings)
(mouse-secondary-selection-modifiers)
(mouse--set-rectangular-region-selection-bindings)
(mouse-region-rectangle-modifiers): New defcustoms with helper functions.
---
 lisp/mouse.el | 150 ++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 144 insertions(+), 6 deletions(-)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 4a351f7be2..2ac9ff3e66 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))))
@@ -1666,11 +1670,40 @@ mouse-save-then-kill
       (setq mouse-save-then-kill-posn click-pt)))))
 
 \f
-(global-set-key [M-mouse-1] 'mouse-start-secondary)
-(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
-(global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
-(global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
-(global-set-key [M-mouse-2] 'mouse-yank-secondary)
+(defun mouse--global-with-modifiers (base modifiers command)
+  "Globally bind BASE + MODIFIERS to COMMAND."
+  (global-set-key (vector (event-convert-list (append modifiers (list base))))
+                  command))
+
+(defun mouse--set-secondary-selection-bindings (mods activate)
+  "Set global mouse bindings using MODS for secondary selection.
+If ACTIVATE is nil, remove those bindings."
+  (when mods
+    (mouse--global-with-modifiers
+     'mouse-1 mods (and activate 'mouse-start-secondary))
+    (mouse--global-with-modifiers
+     'drag-mouse-1 mods (and activate 'mouse-set-secondary))
+    (mouse--global-with-modifiers
+     'down-mouse-1 mods (and activate 'mouse-drag-secondary))
+    (mouse--global-with-modifiers
+     'mouse-3 mods (and activate 'mouse-secondary-save-then-kill))
+    (mouse--global-with-modifiers
+     'mouse-2 mods (and activate 'mouse-yank-secondary))))
+
+(defcustom mouse-secondary-selection-modifiers '(shift meta)
+  "The modifier keys for secondary selection using the mouse.
+If none, mouse secondary selection is disabled."
+  :group 'mouse
+  :type '(set (const meta) (const control) (const shift)
+              (const super) (const hyper))
+  :version "27.1"
+  :set (lambda (variable new-value)
+         (when (boundp 'mouse-secondary-selection-modifiers)
+           (mouse--set-secondary-selection-bindings
+            mouse-secondary-selection-modifiers nil))
+         (set-default variable new-value)
+         (mouse--set-secondary-selection-bindings
+          mouse-secondary-selection-modifiers t)))
 
 (defconst mouse-secondary-overlay
   (let ((ol (make-overlay (point-min) (point-min))))
@@ -1960,6 +1993,111 @@ 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))))))
+
+(defun mouse--set-rectangular-region-selection-bindings (mods activate)
+  "Set global mouse bindings using MODS for rectangular selection.
+If ACTIVATE is nil, remove those bindings."
+  (when mods
+    ;; For rectangular selection to work, down-mouse-N must be bound to
+    ;; `mouse-drag-region-rectangle', and drag-mouse-N to ignore.
+    ;; mouse-N can be bound to anything but `mouse-set-selection' is
+    ;; probably the most ergonomic binding.
+    (mouse--global-with-modifiers 'down-mouse-1 mods
+                                  (and activate 'mouse-drag-region-rectangle))
+    (mouse--global-with-modifiers 'drag-mouse-1 mods
+                                  (and activate 'ignore))))
+
+(defcustom mouse-region-rectangle-modifiers '(meta)
+  "The modifier keys for rectangular region selection using the mouse.
+If none, mouse rectangular region selection is disabled."
+  :group 'mouse
+  :type '(set (const meta) (const control) (const shift)
+              (const super) (const hyper))
+  :version "27.1"
+  :set (lambda (variable new-value)
+         (when (boundp 'mouse-region-rectangle-modifiers)
+           (mouse--set-rectangular-region-selection-bindings
+            mouse-region-rectangle-modifiers nil))
+         (set-default variable new-value)
+         (mouse--set-rectangular-region-selection-bindings
+          mouse-region-rectangle-modifiers t)))
+
+\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)


[-- Attachment #3: Type: text/plain, Size: 2 bytes --]