Allow two mouse functions to work with Rectangle Mark mode

* lisp/mouse.el (mouse-save-then-kill): Make
mouse-save-then-kill work with rectangular regions, including
when mouse-drag-copy-region is set to t. (Bug#31240)
(mouse-drag-and-drop-region): Allow dragging and dropping
rectangular regions. (Bug#31240)
* rect.el (rectangle-intersect-p)
(rectangle-position-as-coordinates): New functions.

2 files changed, 111 insertions, 26 deletions

diff --git a/lisp/mouse.el b/lisp/mouse.el
index cb63ca51c54..44cca4c868a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -29,6 +29,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'rect))
+
 ;;; Utility functions.
 
 ;; Indent track-mouse like progn.
@@ -1606,8 +1608,8 @@ if `mouse-drag-copy-region' is non-nil)"
       (if mouse-drag-copy-region
           ;; Region already saved in the previous click;
           ;; don't make a duplicate entry, just delete.
-          (delete-region (mark t) (point))
-        (kill-region (mark t) (point)))
+          (funcall region-extract-function 'delete-only)
+        (kill-region (mark t) (point) 'region))
       (setq mouse-selection-click-count 0)
       (setq mouse-save-then-kill-posn nil))
 
@@ -1632,7 +1634,7 @@ if `mouse-drag-copy-region' is non-nil)"
         (mouse-set-region-1)
         (when mouse-drag-copy-region
           ;; Region already copied to kill-ring once, so replace.
-          (kill-new (filter-buffer-substring (mark t) (point)) t))
+          (kill-new (funcall region-extract-function nil) t))
         ;; Arrange for a repeated mouse-3 to kill the region.
         (setq mouse-save-then-kill-posn click-pt)))
 
@@ -2411,7 +2413,16 @@ is copied instead of being cut."
          (buffer (current-buffer))
          (window (selected-window))
          (text-from-read-only buffer-read-only)
-         (mouse-drag-and-drop-overlay (make-overlay start end))
+         ;; Use multiple overlays to cover cases where the region is
+         ;; rectangular.
+         (mouse-drag-and-drop-overlays (mapcar (lambda (bounds)
+                                                 (make-overlay (car bounds)
+                                                               (cdr bounds)))
+                                               (region-bounds)))
+         (region-noncontiguous (region-noncontiguous-p))
+         (region-width (- (overlay-end (car mouse-drag-and-drop-overlays))
+                          (overlay-start (car mouse-drag-and-drop-overlays))))
+         (region-height (length mouse-drag-and-drop-overlays))
          point-to-paste
          point-to-paste-read-only
          window-to-paste
@@ -2455,7 +2466,11 @@ is copied instead of being cut."
           ;; Obtain the dragged text in region.  When the loop was
           ;; skipped, value-selection remains nil.
           (unless value-selection
-            (setq value-selection (buffer-substring start end))
+            (setq value-selection (funcall region-extract-function nil))
+            ;; Remove yank-handler property in order to re-insert text using
+            ;; the `insert-rectangle' function later on.
+            (remove-text-properties 0 (length value-selection)
+                                    '(yank-handler) value-selection)
             (when mouse-drag-and-drop-region-show-tooltip
               (let ((text-size mouse-drag-and-drop-region-show-tooltip))
                 (setq text-tooltip
@@ -2468,12 +2483,18 @@ is copied instead of being cut."
                         value-selection))))
 
             ;; Check if selected text is read-only.
-            (setq text-from-read-only (or text-from-read-only
-                                          (get-text-property start 'read-only)
-                                          (not (equal
-                                                (next-single-char-property-change
-                                                 start 'read-only nil end)
-                                                end)))))
+            (setq text-from-read-only
+                  (or text-from-read-only
+                      (get-text-property start 'read-only)
+                      (get-text-property end 'read-only)
+                      (catch 'loop
+                             (dolist (bound (region-bounds))
+                               (unless (equal
+                                        (next-single-char-property-change
+                                         (car bound) 'read-only nil (cdr bound))
+                                        (cdr bound))
+                                 (throw 'loop t)))))))
+
           (setq window-to-paste (posn-window (event-end event)))
           (setq point-to-paste (posn-point (event-end event)))
           ;; Set nil when target buffer is minibuffer.
@@ -2499,13 +2520,34 @@ is copied instead of being cut."
             ;; the original region.  When modifier is pressed, the
             ;; text will be inserted to inside of the original
             ;; region.
+            ;;
+            ;; If the region is rectangular, check if the newly inserted
+            ;; rectangular text would intersect the already selected
+            ;; region. If it would, then set "drag-but-negligible" to t.
+            ;; As a special case, allow dragging the region freely anywhere
+            ;; to the left, as this will never trigger its contents to be
+            ;; inserted into the overlays tracking it.
             (setq drag-but-negligible
-                  (and (eq (overlay-buffer mouse-drag-and-drop-overlay)
+                  (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays))
                            buffer-to-paste)
-                       (<= (overlay-start mouse-drag-and-drop-overlay)
-                          point-to-paste)
-                       (<= point-to-paste
-                          (overlay-end mouse-drag-and-drop-overlay)))))
+                       (if region-noncontiguous
+                           (let ((size (cons region-width region-height))
+                                 (start-coordinates
+                                  (rectangle-position-as-coordinates start))
+                                 (point-to-paste-coordinates
+                                  (rectangle-position-as-coordinates
+                                   point-to-paste)))
+                             (and (rectangle-intersect-p
+                                   start-coordinates size
+                                   point-to-paste-coordinates size)
+                                  (not (<= (car point-to-paste-coordinates)
+                                           (car start-coordinates)))))
+                         (and (<= (overlay-start
+                                   (car mouse-drag-and-drop-overlays))
+                                  point-to-paste)
+                              (<= point-to-paste
+                                  (overlay-end
+                                   (car mouse-drag-and-drop-overlays))))))))
 
           ;; Show a tooltip.
           (if mouse-drag-and-drop-region-show-tooltip
@@ -2524,8 +2566,9 @@ is copied instead of being cut."
                                (t
                                 'bar)))
             (when cursor-in-text-area
-              (overlay-put mouse-drag-and-drop-overlay
-                           'face 'mouse-drag-and-drop-region)
+              (dolist (overlay mouse-drag-and-drop-overlays)
+                (overlay-put overlay
+                           'face 'mouse-drag-and-drop-region))
               (deactivate-mark)     ; Maintain region in other window.
               (mouse-set-point event)))))
 
@@ -2581,7 +2624,9 @@ is copied instead of being cut."
           (select-window window)
           (goto-char point)
           (setq deactivate-mark nil)
-          (activate-mark))
+          (activate-mark)
+          (when region-noncontiguous
+            (rectangle-mark-mode)))
          ;; Modify buffers.
          (t
           ;; * DESTINATION BUFFER::
@@ -2590,11 +2635,17 @@ is copied instead of being cut."
           (setq window-exempt window-to-paste)
           (goto-char point-to-paste)
           (push-mark)
-          (insert value-selection)
+
+          (if region-noncontiguous
+              (insert-rectangle (split-string value-selection "\n"))
+            (insert value-selection))
+
           ;; On success, set the text as region on destination buffer.
           (when (not (equal (mark) (point)))
             (setq deactivate-mark nil)
-            (activate-mark))
+            (activate-mark)
+            (when region-noncontiguous
+              (rectangle-mark-mode)))
 
           ;; * SOURCE BUFFER::
           ;; Set back the original text as region or delete the original
@@ -2604,8 +2655,9 @@ is copied instead of being cut."
               ;; remove the original text.
               (when no-modifier-on-drop
                 (let (deactivate-mark)
-                  (delete-region (overlay-start mouse-drag-and-drop-overlay)
-                                 (overlay-end mouse-drag-and-drop-overlay))))
+                  (dolist (overlay mouse-drag-and-drop-overlays)
+                    (delete-region (overlay-start overlay)
+                                   (overlay-end overlay)))))
             ;; When source buffer and destination buffer are different,
             ;; keep (set back the original text as region) or remove the
             ;; original text.
@@ -2615,15 +2667,17 @@ is copied instead of being cut."
             (if mouse-drag-and-drop-region-cut-when-buffers-differ
                 ;; Remove the dragged text from source buffer like
                 ;; operation `cut'.
-                (delete-region (overlay-start mouse-drag-and-drop-overlay)
-                               (overlay-end mouse-drag-and-drop-overlay))
+                (dolist (overlay mouse-drag-and-drop-overlays)
+                    (delete-region (overlay-start overlay)
+                                   (overlay-end overlay)))
               ;; Set back the dragged text as region on source buffer
               ;; like operation `copy'.
               (activate-mark))
             (select-window window-to-paste))))))
 
     ;; Clean up.
-    (delete-overlay mouse-drag-and-drop-overlay)
+    (dolist (overlay mouse-drag-and-drop-overlays)
+      (delete-overlay overlay))
 
     ;; Restore old states but for the window where the drop
     ;; occurred. Restore cursor types for all windows.
diff --git a/lisp/rect.el b/lisp/rect.el
index 8ccf051ee18..48db4ffd8f4 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -167,6 +167,37 @@ The final point after the last operation will be returned."
                  (<= (point) endpt))))
       final-point)))
 
+(defun rectangle-position-as-coordinates (position)
+   "Return cons of the column and line values of POSITION.
+POSITION specifies a position of the current buffer.  The value
+returned is a cons of the current column of POSITION and its line
+number."
+  (save-excursion
+    (goto-char position)
+    (let ((col (current-column))
+          (line (1- (line-number-at-pos))))
+      (cons col line))))
+
+(defun rectangle-intersect-p (pos1 size1 pos2 size2)
+   "Return non-nil if two rectangles intersect.
+POS1 and POS2 specify the positions of the upper-left corners of
+the first and second rectangle as conses of their column and line
+values.  SIZE1 and SIZE2 specify the dimensions of the first and
+second rectangle, as conses of their width and height measured in
+columns and lines."
+  (let ((x1 (car pos1))
+        (y1 (cdr pos1))
+        (x2 (car pos2))
+        (y2 (cdr pos2))
+        (w1 (car size1))
+        (h1 (cdr size1))
+        (w2 (car size2))
+        (h2 (cdr size2)))
+    (not (or (<= (+ x1 w1) x2)
+             (<= (+ x2 w2) x1)
+             (<= (+ y1 h1) y2)
+             (<= (+ y2 h2) y1)))))
+
 (defun delete-rectangle-line (startcol endcol fill)
   (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
     (delete-region (point)