From e8d781baf8ffd0cd911505a50ffefa0f54d2d185 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

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 COLUMN argument.
(mouse-drag-region-rectangle): New.
(mouse--global-with-modifier)
(mouse--set-secondary-selection-bindings, mouse-secondary-selection-modifier)
(mouse--set-rectangular-region-selection-bindings)
(mouse-region-rectangle-modifier): New defcustoms with helper functions.
---
 lisp/mouse.el | 110 +++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 104 insertions(+), 6 deletions(-)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 4a351f7be2..48ea109daa 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1045,10 +1045,11 @@ 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 column)
   "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.
+If COLUMN is non-nil, try to keep point in that column when scrolling.
 Upon exit, point is at the far edge of the newly visible text."
   (cond
    ((and (> jump 0) (< jump mouse-scroll-min-lines))
@@ -1077,6 +1078,8 @@ mouse-scroll-subr
 		   ;; so that we don't mess up the selected window.
 		   (or (eq window (selected-window))
 		       (goto-char opoint))
+                   (when column
+                     (move-to-column column))
 		   (sit-for mouse-scroll-delay)))))
     (or (eq window (selected-window))
 	(goto-char opoint))))
@@ -1666,11 +1669,43 @@ mouse-save-then-kill
       (setq mouse-save-then-kill-posn click-pt)))))
 
 
-(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-modifier (base modifier command)
+  "Globally bind BASE + MODIFIER to COMMAND."
+  (global-set-key (vector (event-convert-list (list modifier base))) command))
+
+(defun mouse--set-secondary-selection-bindings (mod activate)
+  "Set global mouse bindings using MOD for secondary selection.
+If ACTIVATE is nil, remove those bindings."
+  (when mod
+    (mouse--global-with-modifier 'mouse-1 mod
+                                 (and activate 'mouse-start-secondary))
+    (mouse--global-with-modifier 'drag-mouse-1 mod
+                                 (and activate 'mouse-set-secondary))
+    (mouse--global-with-modifier 'down-mouse-1 mod
+                                 (and activate 'mouse-drag-secondary))
+    (mouse--global-with-modifier 'mouse-3 mod
+                                 (and activate 'mouse-secondary-save-then-kill))
+    (mouse--global-with-modifier 'mouse-2 mod
+                                 (and activate 'mouse-yank-secondary))))
+
+(defcustom mouse-secondary-selection-modifier nil
+  "The modifier key for secondary selection using the mouse.
+If nil, mouse secondary selection is disabled."
+  :group 'mouse
+  :type '(choice (const :tag "None (disabled)" nil)
+                 (const meta)
+                 (const control)
+                 (const shift)
+                 (const super)
+                 (const hyper))
+  :version "27.1"
+  :set (lambda (variable new-value)
+         (when (boundp 'mouse-secondary-selection-modifier)
+           (mouse--set-secondary-selection-bindings
+            mouse-secondary-selection-modifier nil))
+         (set-default variable new-value)
+         (mouse--set-secondary-selection-bindings
+          mouse-secondary-selection-modifier t)))
 
 (defconst mouse-secondary-overlay
   (let ((ol (make-overlay (point-min) (point-min))))
@@ -1960,6 +1995,69 @@ 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")
+  (deactivate-mark)
+  (mouse-set-point start-event)
+  (rectangle-mark-mode)
+  (let* ((scroll-margin 0)
+         (start-posn (event-start start-event))
+         (start-point (posn-point start-posn))
+         (start-window (posn-window start-posn))
+         (bounds (window-edges start-window))
+         (top (nth 1 bounds))
+         (bottom (if (window-minibuffer-p start-window)
+                     (nth 3 bounds)
+                   (1- (nth 3 bounds))))
+         event)
+    (track-mouse
+      (while (progn
+               (setq event (read-event))
+               (mouse-movement-p event))
+        (let ((window (posn-window (event-end event)))
+              (mouse-row (cddr (mouse-position))))
+          (if (and (eq window start-window)
+                   mouse-row
+                   (<= top mouse-row (1- bottom)))
+              (mouse-set-point event)
+            (cond
+             ((null mouse-row))
+             ((< mouse-row top)
+              (mouse-scroll-subr start-window (- mouse-row top)
+                                 nil start-point (current-column)))
+             ((>= mouse-row bottom)
+              (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
+                                 nil start-point (current-column))))))))))
+
+(defun mouse--set-rectangular-region-selection-bindings (mod activate)
+  "Set global mouse bindings using MOD for rectangular selection.
+If ACTIVATE is nil, remove those bindings."
+  (when mod
+    (mouse--global-with-modifier 'down-mouse-1 mod
+                                 (and activate 'mouse-drag-region-rectangle))))
+
+(defcustom mouse-region-rectangle-modifier 'meta
+  "The modifier key for rectangular region selection using the mouse.
+If nil, mouse rectangular region selection is disabled."
+  :group 'mouse
+  :type '(choice (const :tag "None (disabled)" nil)
+                 (const meta)
+                 (const control)
+                 (const shift)
+                 (const super)
+                 (const hyper))
+  :version "27.1"
+  :set (lambda (variable new-value)
+         (when (boundp 'mouse-region-rectangle-modifier)
+           (mouse--set-rectangular-region-selection-bindings
+            mouse-region-rectangle-modifier nil))
+         (set-default variable new-value)
+         (mouse--set-rectangular-region-selection-bindings
+          mouse-region-rectangle-modifier t)))
+
+
 (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)

