From debbugs-submit-bounces@debbugs.gnu.org Mon Sep 15 11:18:28 2025 Received: (at submit) by debbugs.gnu.org; 15 Sep 2025 15:18:29 +0000 Received: from localhost ([127.0.0.1]:41615 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uyAyK-0001OE-8W for submit@debbugs.gnu.org; Mon, 15 Sep 2025 11:18:28 -0400 Received: from lists.gnu.org ([2001:470:142::17]:59944) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uyAyA-0001Ng-Bd for submit@debbugs.gnu.org; Mon, 15 Sep 2025 11:18:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uyAy2-0004mv-3f for bug-gnu-emacs@gnu.org; Mon, 15 Sep 2025 11:18:11 -0400 Received: from mout-p-102.mailbox.org ([80.241.56.152]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_CHACHA20_POLY1305:256) (Exim 4.90_1) (envelope-from ) id 1uyAxs-0001IT-AZ for bug-gnu-emacs@gnu.org; Mon, 15 Sep 2025 11:18:09 -0400 Received: from smtp202.mailbox.org (smtp202.mailbox.org [10.196.197.202]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by mout-p-102.mailbox.org (Postfix) with ESMTPS id 4cQTDb1Ymhz9tJf for ; Mon, 15 Sep 2025 17:17:51 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=linkov.net; s=MBO0001; t=1757949471; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type; bh=QjYkRFgZn45FhXkN80/GwLTeb0XsSiW8tAikkFV5PTs=; b=Gz+Q9gsQ7H6Ka3qFyoBaFPF+QBPZ+V5cnlaw+rkRkZYLD/v4FTKTqtDqtbKV+oqyuBDQb8 Pd9aCOr1y96Ks1b+CWBZ14HcsuqFfwVoSmvD/ts7+p+oCCrRbwuIBDcWmHwaLKawTzGJCN wYUaU10q5ixNEG+itFrQqmSJl0zfpWqGffCSNEvb+PhTNhWqyZZZaNrYRXZZaccPNLBDSl 1u/KitnrmmuwxqGZVkB+sKiSrtWb7B07CiRyT/pBKwvs7m44+vpVQ0e181bMfVN59QIgnS pRFQQAVYiJS7XMux3WrNc9f+HABVqIfV1N4XUNkOEx339RXVXQ4ZPazTmf+NqQ== From: Juri Linkov To: bug-gnu-emacs@gnu.org Subject: Mouse shift adjustment mode Organization: LINKOV.NET Date: Mon, 15 Sep 2025 18:10:48 +0300 Message-ID: <87y0qfoj4v.fsf@mail.linkov.net> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=80.241.56.152; envelope-from=juri@linkov.net; helo=mout-p-102.mailbox.org X-Spam_score_int: -23 X-Spam_score: -2.4 X-Spam_bar: -- X-Spam_report: (-2.4 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_VALIDITY_CERTIFIED_BLOCKED=0.001, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: 1.0 (+) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) --=-=-= Content-Type: text/plain X-Debbugs-Cc: Spencer Baugh Tags: patch Following the request and discussion about using S- 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=mouse-shift-adjust-mode.patch 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 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)) --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Sep 15 11:24:34 2025 Received: (at 79453) by debbugs.gnu.org; 15 Sep 2025 15:24:34 +0000 Received: from localhost ([127.0.0.1]:41630 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uyB4A-0001kV-F8 for submit@debbugs.gnu.org; Mon, 15 Sep 2025 11:24:34 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:54496) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uyB42-0001io-JV for 79453@debbugs.gnu.org; Mon, 15 Sep 2025 11:24:23 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uyB3p-0002Q2-Qs; Mon, 15 Sep 2025 11:24:10 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date: mime-version; bh=cym89+ex7Ztx2AMagxCNif4Glc013AsGVJa5KHmfO+4=; b=M/DeQ2Y/paCs Xhpu/2it1BHX5NoSws58BqW91m/laCdx+u7ofdOea75A1/zKTe4WrZyshyjxXNxRJXuZP4z6sTgP3 L/7Zor3AwBC52fS++8VeySY+dDDjn9099erVvvMsHOZgKaIujfndNikqWf8XRupFMOLMrsfIorLMz HgNQO8dWXiZanWvhl7LJD7mZqn65/10RXLTs2UHrpSy2gqlsSfq9dmAcWW/nANV7AgvLf1oaQcTIH hitQN2GE3acVE9+Qys/huE9p5kjtLP3GahgSWd9GyyKy+QWV5plzl3CW5GioFRXBGcBkBFKHi92+2 KKgmUCIJo3/3lld09lTlcQ==; Date: Mon, 15 Sep 2025 18:24:04 +0300 Message-Id: <864it3oi23.fsf@gnu.org> From: Eli Zaretskii To: Juri Linkov In-Reply-To: <87y0qfoj4v.fsf@mail.linkov.net> (message from Juri Linkov on Mon, 15 Sep 2025 18:10:48 +0300) Subject: Re: bug#79453: Mouse shift adjustment mode References: <87y0qfoj4v.fsf@mail.linkov.net> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 79453 Cc: sbaugh@janestreet.com, 79453@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: spencer baugh > From: Juri Linkov > Date: Mon, 15 Sep 2025 18:10:48 +0300 > > Following the request and discussion about using S- 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: Thanks, but please remember to call this out in NEWS. From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 16 13:52:59 2025 Received: (at 79453) by debbugs.gnu.org; 16 Sep 2025 17:52:59 +0000 Received: from localhost ([127.0.0.1]:50071 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uyZrP-0002kb-CK for submit@debbugs.gnu.org; Tue, 16 Sep 2025 13:52:59 -0400 Received: from mout-p-101.mailbox.org ([2001:67c:2050:0:465::101]:56558) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uyZrK-0002k3-8T for 79453@debbugs.gnu.org; Tue, 16 Sep 2025 13:52:54 -0400 Received: from smtp1.mailbox.org (smtp1.mailbox.org [10.196.197.1]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by mout-p-101.mailbox.org (Postfix) with ESMTPS id 4cR8cp33tHz9t9F; Tue, 16 Sep 2025 19:52:42 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=linkov.net; s=MBO0001; t=1758045162; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=VxC5+6LwT9OxhpRgHlB+AAw9qkKQQux+gNXENnQ+RRA=; b=j9AgiIgen5ZdPHr3BxmnV0AOvVicv9TWF60UGaQ0nZs7Bdsy7KJQHLyBTf6Cfwnq8g19Z8 g25nCXYpewnlR8ENXNtV2pzzRKfcLuWG7MQIGnHsOjyYFQVj2dW+4y47ix+3M240Ukdo8j SCqT5s1YRTICOX49XsqGBENSiObvkYL3VlIvNTfT/3u3aB8t/VHddPLPzMgZ4dJ99wv74K 6pd+/yPYNRQIxhvBrI+PE7rtuLGwFZ/awaNsJdAV8tjMyHoRGO+jbNcS8xdPkruVJtMcV1 LjgpYjshsEeC+tdLGE3EJWheF2F5tWactY/Z2FKoIzuBm8Kp4ZArXcxC9gPkCQ== From: Juri Linkov To: Eli Zaretskii Subject: Re: bug#79453: Mouse shift adjustment mode In-Reply-To: <864it3oi23.fsf@gnu.org> Organization: LINKOV.NET References: <87y0qfoj4v.fsf@mail.linkov.net> <864it3oi23.fsf@gnu.org> Date: Tue, 16 Sep 2025 20:51:17 +0300 Message-ID: <87jz1ye162.fsf@mail.linkov.net> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 79453 Cc: sbaugh@janestreet.com, 79453@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) >> Following the request and discussion about using S- 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: > > Thanks, but please remember to call this out in NEWS. Now pushed with NEWS, and leaving open for suggestions for more adjustments.