Subject: Mouse shift adjustment mode

From: Juri Linkov <[email-masked]>
Date: Mon, 15 Sep 2025 18:10:48 +0300

X-Debbugs-Cc: Spencer Baugh <[email-masked]>
Tags: patch

Following the request and discussion about using S-<down-mouse-1> in
https://lists.gnu.org/archive/html/emacs-devel/2025-03/msg00161.html
here is the finished patch that implements all expected features.
The patch below is shorter than the initial experimental patch,
but still correctly supports all cases:

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 907a4883230..bc8077e92d3 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -737,6 +737,25 @@ mouse-yank-from-menu
   (push-mark)
   (insert string))
 
+
+;; Mouse shift adjustment mode.
+
+(defvar mouse-shift-adjust-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [S-down-mouse-1] #'mouse-drag-region-shift-adjust)
+    (define-key map [S-mouse-1]      #'mouse-set-region)
+    (define-key map [S-drag-mouse-1] #'mouse-set-region)
+    map)
+  "Mouse shift adjustment mode map.")
+
+(define-minor-mode mouse-shift-adjust-mode
+  "Toggle mouse shift adjustment mode.
+
+When this mode is enabled, clicking the left mouse button
+with the <Shift> modifier (`S-down-mouse-1') adjusts the
+already selected region using `mouse-drag-region-shift-adjust'."
+  :global t)
+
 
 ;; Commands that operate on windows.
 
@@ -1521,6 +1540,7 @@ mouse-region-match
        (eq mouse-last-region-tick (buffer-modified-tick))))
 
 (defvar mouse--drag-start-event nil)
+(defvar mouse-shift-adjust-point nil)
 
 (defun mouse-set-region (click)
   "Set the region to the text dragged over, and copy to kill ring.
@@ -1530,7 +1550,7 @@ mouse-set-region
   (interactive "e")
   (mouse-minibuffer-check click)
   (select-window (posn-window (event-start click)))
-  (let ((beg (posn-point (event-start click)))
+  (let ((beg (or mouse-shift-adjust-point (posn-point (event-start click))))
         (end
          (if (eq (posn-window (event-end click)) (selected-window))
              (posn-point (event-end click))
@@ -1539,7 +1559,7 @@ mouse-set-region
            (window-point)))
         (click-count (event-click-count click)))
     (let ((drag-start (terminal-parameter nil 'mouse-drag-start)))
-      (when drag-start
+      (when (and drag-start (not mouse-shift-adjust-point))
         ;; Drag events don't come with a click count, sadly, so we hack
         ;; our way around this problem by remembering the start-event in
         ;; `mouse-drag-start' and fetching the click-count from there.
@@ -1554,6 +1574,9 @@ mouse-set-region
                    (not (eq (car drag-start) 'mouse-movement)))
           (setq end beg))
         (setf (terminal-parameter nil 'mouse-drag-start) nil)))
+    (when mouse-shift-adjust-point
+      (setq click-count (1+ mouse-selection-click-count)))
+    (setq mouse-shift-adjust-point nil)
     (when (and (integerp beg) (integerp end))
       (let ((range (mouse-start-end beg end (1- click-count))))
         (if (< end beg)
@@ -1674,11 +1697,22 @@ mouse-drag-region
     (ignore-preserving-kill-region)
     (mouse-drag-track start-event)))
 
+(defun mouse-drag-region-shift-adjust (start-event)
+  "Adjust the already active region while dragging the mouse."
+  (interactive "e")
+  ;; Give temporary modes such as isearch a chance to turn off.
+  (run-hooks 'mouse-leave-buffer-hook)
+  (ignore-preserving-kill-region)
+  (setq mouse-shift-adjust-point
+        (or (and (region-active-p) (mark t)) (point)))
+  (mouse-drag-track start-event))
+
 ;; Inhibit the region-confinement when undoing mouse-drag-region
 ;; immediately after the command.  Otherwise, the selection left
 ;; active around the dragged text would prevent an undo of the whole
 ;; operation.
 (put 'mouse-drag-region 'undo-inhibit-region t)
+(put 'mouse-drag-region-shift-adjust 'undo-inhibit-region t)
 
 (defvar mouse-event-areas-with-no-buffer-positions
   '( mode-line header-line vertical-line
@@ -1840,6 +1874,9 @@ mouse-drag-track
                     (setq scroll-margin scroll-margin-saved))))
     (condition-case err
         (progn
+          ;; Use previous click-count while adjusting previous selection.
+          (when mouse-shift-adjust-point
+            (setq click-count mouse-selection-click-count))
           (setq mouse-selection-click-count click-count)
 
           ;; Suppress automatic scrolling near the edges while tracking
@@ -1861,9 +1898,17 @@ mouse-drag-track
                       (if (eq transient-mark-mode 'lambda)
                           '(only)
                         (cons 'only transient-mark-mode)))
-          (let ((range (mouse-start-end start-point start-point click-count)))
-            (push-mark (nth 0 range) t t)
-            (goto-char (nth 1 range)))
+          (let ((range (mouse-start-end
+                        (or mouse-shift-adjust-point start-point)
+                        start-point click-count)))
+            (cond
+             ((and mouse-shift-adjust-point
+                   (> mouse-shift-adjust-point start-point))
+              (push-mark (nth 1 range) t t)
+              (goto-char (nth 0 range)))
+             (t
+              (push-mark (nth 0 range) t t)
+              (goto-char (nth 1 range)))))
 
           (setf (terminal-parameter nil 'mouse-drag-start) start-event)
           ;; Set 'track-mouse' to something neither nil nor t, so that mouse
@@ -1886,8 +1931,9 @@ mouse-drag-track
                      (setcar start-event 'mouse-movement))
                    (if (and (eq (posn-window end) start-window)
                             (integer-or-marker-p end-point))
-                       (mouse--drag-set-mark-and-point start-point
-                                                       end-point click-count)
+                       (mouse--drag-set-mark-and-point
+                        (or mouse-shift-adjust-point start-point)
+                        end-point click-count)
                      (let ((mouse-row (cdr (cdr (mouse-position)))))
                        (cond
                         ((null mouse-row))