Package: emacs;
Reported by: Juri Linkov <juri <at> linkov.net>
Date: Mon, 15 Sep 2025 15:19:01 UTC
Severity: normal
Tags: patch
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: bug-gnu-emacs <at> gnu.org Subject: Mouse shift adjustment mode Date: Mon, 15 Sep 2025 18:10:48 +0300
[Message part 1 (text/plain, inline)]
X-Debbugs-Cc: Spencer Baugh <sbaugh <at> janestreet.com> 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:
[mouse-shift-adjust-mode.patch (text/x-diff, inline)]
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))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.