master 4eb7db5: Mouse rectangular region selection (bug#38013)

[Mattias Engdegård]

branch: master
commit 4eb7db5d4b84708912c63a77569c8adeeff6c640
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Mouse rectangular region selection (bug#38013)
    
    Make it possible to select a rectangular region using the mouse.
    The standard binding is C-M-mouse-1.
    
    * lisp/mouse.el (mouse-scroll-subr): Add ADJUST argument.
    (mouse-drag-region-rectangle): New.
    * lisp/rect.el (rectangle--reset-point-crutches): New.
    (rectangle--reset-crutches): Use 'rectangle--reset-point-crutches'.
    * src/xdisp.c (remember_mouse_glyph, syms_of_xdisp):
    Add 'mouse-fine-grained-tracking'.
    * doc/lispref/commands.texi (Motion Events):
    Document 'mouse-fine-grained-tracking'.
    * doc/emacs/frames.texi (Mouse Commands):
    * doc/emacs/killing.texi (Rectangles):
    * etc/NEWS: Document rectangular selection with the mouse.
---
 doc/emacs/frames.texi     |   4 ++
 doc/emacs/killing.texi    |   3 ++
 doc/lispref/commands.texi |   6 +++
 etc/NEWS                  |   3 ++
 lisp/mouse.el             | 113 +++++++++++++++++++++++++++++++++++++++++++++-
 lisp/rect.el              |   8 +++-
 src/xdisp.c               |  12 +++++
 7 files changed, 146 insertions(+), 3 deletions(-)

diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 091c011..f6c2d23 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -91,6 +91,10 @@ If the region is active, move the nearer end of the region 
to the
 click position; otherwise, set mark at the current value of point and
 point at the click position.  Save the resulting region in the kill
 ring; on a second click, kill it (@code{mouse-save-then-kill}).
+
+@item C-M-mouse-1
+Activate a rectangular region around the text selected by dragging.
+@xref{Rectangles}.
 @end table
 
 @findex mouse-set-point
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 80e2868..ce00cb3 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -732,6 +732,9 @@ region is controlled.  But remember that a given 
combination of point
 and mark values can be interpreted either as a region or as a
 rectangle, depending on the command that uses them.
 
+  A rectangular region can also be marked using the mouse: click and drag
+@kbd{C-M-mouse-1} from one corner of the rectangle to the opposite.
+
 @table @kbd
 @item C-x r k
 Kill the text of the region-rectangle, saving its contents as the
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 0c848a8..032f005 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1661,6 +1661,12 @@ events within its body.  Outside of @code{track-mouse} 
forms, Emacs
 does not generate events for mere motion of the mouse, and these
 events do not appear.  @xref{Mouse Tracking}.
 
+@defvar mouse-fine-grained-tracking
+When non-@code{nil}, mouse motion events are generated even for very
+small movements.  Otherwise, motion events are not generated as long
+as the mouse cursor remains pointing to the same glyph in the text.
+@end defvar
+
 @node Focus Events
 @subsection Focus Events
 @cindex focus event
diff --git a/etc/NEWS b/etc/NEWS
index 98a3520..8233328 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -614,6 +614,9 @@ arguments mitigating performance issues when operating on 
huge
 buffers.
 
 +++
+** Dragging 'C-M-mouse-1' now marks rectangular regions.
+
++++
 ** The command 'delete-indentation' now operates on the active region.
 If the region is active, the command joins all the lines in the
 region.  When there's no active region, the command works on the
diff --git a/lisp/mouse.el b/lisp/mouse.el
index c91760a..f076e90 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1045,10 +1045,12 @@ the mouse has moved.  However, it always scrolls at 
least the number
 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 @@ Upon exit, point is at the far edge of the newly visible 
text."
                   ;; 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))))
@@ -1960,6 +1964,113 @@ When there is no region, this function does nothing."
     (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")
+  (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)
+         (old-mouse-fine-grained-tracking mouse-fine-grained-tracking)
+         ;; For right-to-left text, columns are counted from the right margin;
+         ;; translate from mouse events, which always count from the left.
+         (adjusted-col (lambda (col)
+                         (if (eq (current-bidi-paragraph-direction)
+                                 'right-to-left)
+                             (- (frame-text-cols) col -1)
+                           col)))
+         (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.
+          (setq dragged t)
+          (mouse-minibuffer-check start-event)
+          (deactivate-mark)
+          (posn-set-point start-pos)
+          (rectangle-mark-mode)
+          ;; Only tell rectangle about the exact column if we are possibly
+          ;; beyond end-of-line or in a tab, since the column we got from
+          ;; the mouse position isn't necessarily accurate for use in
+          ;; specifying a rectangle (which uses the `move-to-column'
+          ;; measure).
+          (when (or (eolp) (eq (following-char) ?\t))
+            (let ((col (funcall adjusted-col start-col)))
+              (rectangle--col-pos col 'mark)
+              (rectangle--col-pos col 'point))))
+
+        (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))
+               (set-col (lambda ()
+                          (if (or (eolp) (eq (following-char) ?\t))
+                              (rectangle--col-pos
+                               (funcall adjusted-col mouse-col) 'point)
+                            (rectangle--reset-point-crutches)))))
+          (if (and (eq window start-window)
+                   mouse-row
+                   (<= top mouse-row (1- bottom)))
+              ;; Drag inside the same window.
+              (progn
+                (posn-set-point posn)
+                (funcall set-col))
+            ;; Drag outside the window: scroll.
+            (cond
+             ((null mouse-row))
+             ((< mouse-row top)
+              (mouse-scroll-subr
+               start-window (- mouse-row top) nil start-point
+               set-col))
+             ((>= mouse-row bottom)
+              (mouse-scroll-subr
+               start-window (1+ (- mouse-row bottom)) nil start-point
+               set-col)))))))
+    (condition-case err
+        (progn
+          (setq track-mouse t)
+          (setq mouse-fine-grained-tracking t)
+          (set-transient-map
+           map t
+           (lambda ()
+             (setq track-mouse old-track-mouse)
+             (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking)
+             (when (or (not dragged)
+                       (not (mark))
+                       (equal (rectangle-dimensions (mark) (point)) '(0 . 1)))
+               ;; No nontrivial region selected; deactivate rectangle mode.
+               (deactivate-mark)))))
+      ;; Clean up in case something went wrong.
+      (error (setq track-mouse old-track-mouse)
+             (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking)
+             (signal (car err) (cdr err))))))
+
+;; The drag event must be bound to something but does not need any effect,
+;; as everything takes place in `mouse-drag-region-rectangle'.
+;; The click event can be anything; `mouse-set-point' is just a convenience.
+(global-set-key [C-M-down-mouse-1] #'mouse-drag-region-rectangle)
+(global-set-key [C-M-drag-mouse-1] #'ignore)
+(global-set-key [C-M-mouse-1]      #'mouse-set-point)
+
+
 (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
diff --git a/lisp/rect.el b/lisp/rect.el
index 4d4d614..1109786 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -133,11 +133,15 @@ Point is at the end of the segment of this line within 
the rectangle."
 (defun rectangle--crutches ()
   (cons rectangle--mark-crutches
         (window-parameter nil 'rectangle--point-crutches)))
-(defun rectangle--reset-crutches ()
-  (kill-local-variable 'rectangle--mark-crutches)
+
+(defun rectangle--reset-point-crutches ()
   (if (window-parameter nil 'rectangle--point-crutches)
       (setf (window-parameter nil 'rectangle--point-crutches) nil)))
 
+(defun rectangle--reset-crutches ()
+  (kill-local-variable 'rectangle--mark-crutches)
+  (rectangle--reset-point-crutches))
+
 ;;; Rectangle operations.
 
 (defun apply-on-rectangle (function start end &rest args)
diff --git a/src/xdisp.c b/src/xdisp.c
index 2b4dda2..c4d23be 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2491,6 +2491,12 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, 
NativeRectangle *rect)
   enum glyph_row_area area;
   int x, y, width, height;
 
+  if (mouse_fine_grained_tracking)
+    {
+      STORE_NATIVE_RECT (*rect, gx, gy, 1, 1);
+      return;
+    }
+
   /* Try to determine frame pixel position and size of the glyph under
      frame pixel coordinates X/Y on frame F.  */
 
@@ -34946,6 +34952,12 @@ The default is to use octal format (\200) whereas 
hexadecimal (\x80)
 may be more familiar to users.  */);
   display_raw_bytes_as_hex = false;
 
+  DEFVAR_BOOL ("mouse-fine-grained-tracking", mouse_fine_grained_tracking,
+    doc: /* Non-nil for pixel-wise mouse-movement.
+When nil, mouse-movement events will not be generated as long as the
+mouse stays within the extent of a single glyph (except for images).  */);
+  mouse_fine_grained_tracking = false;
+
 }