bug#31240: 26.1; mouse-save-then-kill does not kill rectangles

[Federico Tedin <federicotedin@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1817 bytes --]

>  > So I think I have two options now: either forbid the user from
>  > dragging a rectangle to a position where the inserted rectangle would
>  > intersect the original rectangle,
>
> IIRC that would be faithful to the original (non-rectangle-dragging)
> design.

> This second option sounds like it can be quite hard to define.  If you
> decide in the end to prevent the user from dragging the region
> somewhere that would intersect with the dragged region (which, as
> Martin said, is in line with the original design of
> mouse-drag-and-drop-region) that would be fine.

After trying out some solutions and reading these two suggestions, I've
decided to implement the feature like this. The problem of correctly handling
the cases where the dragged rectangular text would overlap with the original
one was more complex than I'd thought, and I have some doubts if the usefulness
of the feature justifies this added complexity.

I'm attaching a new patch with all my changes to mouse.el (and rect.el) so far.
I've created two new helper functions in rect.el to avoid cluttering mouse.el
with more functions.

So, the cases to test out are:

1) Dragging and dropping non-rectangular regions should be exactly the
same as before.
2) Dragging and dropping a rectangle _outside_ of itself should insert
it in the new
position, and then delete the original.
3) Dragging and dropping a rectangle _inside_ of itself should leave
everything unchanged.

After evaluating "(setq mouse-drag-and-drop-region 'shift)":

4) Dragging and dropping a rectangle inside or outside of itself, while holding
the Shift key when dropping, should insert it there, without deleting
the original.

When I say 'outside of itself' I mean that there shouldn't be any
overlapping at all
between the original and the newly inserted rectangles.

[-- Attachment #2: mouse.patch --]
[-- Type: text/x-patch, Size: 11591 bytes --]

From 777aaf732f348b3b7cf41d3366071f602b8cbb0c Mon Sep 17 00:00:00 2001
From: Federico Tedin <federicotedin@gmail.com>
Date: Sat, 29 Sep 2018 20:16:00 -0300
Subject: [PATCH 1/1] 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): Add a new function.
  (rectangle-position-as-coordinates): Add a new function.
---
 lisp/mouse.el | 92 ++++++++++++++++++++++++++++++++++++---------------
 lisp/rect.el  | 35 ++++++++++++++++++++
 2 files changed, 101 insertions(+), 26 deletions(-)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index cb63ca51c5..b00f38a0f6 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 @@ mouse-save-then-kill
       (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 @@ mouse-save-then-kill
 	(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,15 @@ mouse-drag-and-drop-region
          (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 +2465,11 @@ mouse-drag-and-drop-region
           ;; 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 +2482,18 @@ mouse-drag-and-drop-region
                         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.
@@ -2500,12 +2520,20 @@ mouse-drag-and-drop-region
             ;; text will be inserted to inside of the original
             ;; region.
             (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
+                           ;; 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.
+                           (let ((size (cons region-width region-height)))
+                             (rectangle-intersect-p
+                              (rectangle-position-as-coordinates start) size
+                              (rectangle-position-as-coordinates point-to-paste) size))
+                         (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 +2552,9 @@ mouse-drag-and-drop-region
                                (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 +2610,9 @@ mouse-drag-and-drop-region
           (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 +2621,17 @@ mouse-drag-and-drop-region
           (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 +2641,9 @@ mouse-drag-and-drop-region
               ;; 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 +2653,17 @@ mouse-drag-and-drop-region
             (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 8ccf051ee1..0456242f64 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -167,6 +167,41 @@ apply-on-rectangle
                  (<= (point) endpt))))
       final-point)))
 
+(defun rectangle-position-as-coordinates (position)
+  "Return an integer buffer position as a (COL . LINE) coordinate."
+  (save-excursion
+    (goto-char position)
+    (let ((col (current-column))
+          (line (progn
+                  (beginning-of-line)
+                  (count-lines 1 position))))
+      (cons col line))))
+
+(defun rectangle-intersect-p (pos1 size1 pos2 size2)
+  "Return t if the rectangle defined by POS1 and SIZE1 intersects with
+the one defined by POS2 and SIZE2, and return nil if they do not.
+
+POS1 and POS2 should describe the positions of the upper-left
+corners of the first and second rectangles, in the form of (COL . LINE).
+SIZE1 and SIZE2 should describe the dimensions of the first and second
+rectangles, in the form of (WIDTH . HEIGHT)."
+  (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)
-- 
2.17.1