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

From: Federico Tedin <[email-masked]>
Date: Thu, 11 Oct 2018 21:42:54 -0300

> If point-to-paste is on the first line of the original region in
> between its start and end, we would try to replace the text by itself
> on this and all subsequent lines which is just as silly as replacing a
> contiguous region with itself.  So set drag-but-negligible in such a
> case.
>
> If point-to-paste is not on the first line of the original region but
> the region to insert intersects with the original region, then killing
> the original region after inserting the copy might get me some pretty
> unintelligible result.  So set drag-but-negligible in that case as
> well.
>
> But moving the rectangle strictly to the left or the right on the same
> lines it originally occupied seems to work here.  So I would not set
> drag-but-negligible in that case.
>
> I forgot to mention that the second conjunct is probably superfluous
> here because in that case the rectangles won't intersect in the first
> place.  So (<= start point-to-paste) should be sufficient but I have
> not tested it.

Martin, thanks again for your feedback.

As you mentioned, dragging the rectangle to the right of its right
edge will cause rectangle-intersect-p return nil, so that check will
never be evaluated. If I drag the rectangle to the right, but in a way
that it intersects with itself (e.g. one char), then its contents
would be inserted
into the overlays, and it would then be deleted when the original is
deleted (this is why I originally added the intersection check).

If I drag the rectangle to the left in a way it would intersect with
itself, then obviously rectangle-intersect-p will return t. However,
what's interesting about this case is that the insert and delete
operations could be done anyways, as the new content would be inserted
to the left of the overlays, causing them to shift to the right. Then,
the overlays would be deleted, taking with them the original
rectangle. Note that this works even if the drag has a vertical
component (up/down).

So then: moving the rectangle to the left is easy, but moving it to
the right (into itself) is not. My solution was to implement
rectangle-intersection-p to avoid doing the insert and delete if an
intersection was found. One of the conditions you added on your patch
allows moving the rectangle sideways: in my opinion, allowing the user
to move the rectangle only to the left is what's more consistent with
mouse-drag-and-drop-region's behaviour with non-rectangular
regions. You can check this by selecting a word and dragging it one
char to its left: the word is dragged correctly. But if you drag a
word one char to the right, the operation is marked as negligible. It
would make sense that moving a rectangle to the right or to the left
followed the same behaviour.

> Note that I have never written or used rectangle code.  AFAICT
> 'insert-rectangle' inserts spaces (via 'move-to-column') when the
> target line is too short.  And these insertions can make the result of
> a rectangle move look bad when the deletion is done after the copying.
> Is that interpretation correct?  Does it always look intelligible when
> the deletion is done before the copying?

Your guess is probably much better than mine, but I think you're
right. Inserting a rectangle somewhere in a buffer, and then deleting
some text to its left will make it look intelligible. If the deletion
is made before the copying, however, I think the rectangle will always
be inserted correctly (because move-to-column will ensure its content
is aligned correctly).

> IIUC the code of rect.el nowhere provides an operation that kills a
> rectangle and reinserts it in one and the same step not to mention the
> possibility that these operations take place in an overlapping area of
> one and the same buffer.  So I think that you are in uncharted waters
> here and hardly anyone will tell you what to do.
>
> If worse comes to worst, we can always leave your patch as it is now.

At the moment, my current proposal is: allow the user to drag the
rectangle anywhere to the left (on the same line, or on a different
line), or anywhere else where it would not intersect with itself (I'm
attaching a new patch that allows this).

- Federico
From 5888ce9739c3298a5f1939acfaf87158c1023fd9 Mon Sep 17 00:00:00 2001
From: Federico Tedin <[email-masked]>
Date: Thu, 11 Oct 2018 21:29:45 -0300
Subject: [PATCH] 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 | 99 +++++++++++++++++++++++++++++++++++++--------------
 lisp/rect.el  | 31 ++++++++++++++++
 2 files changed, 104 insertions(+), 26 deletions(-)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index cb63ca51c5..37f4087e5f 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,27 @@ 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.
+                           ;; 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.
+                           (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 +2559,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 +2617,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 +2628,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 +2648,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 +2660,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..48db4ffd8f 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -167,6 +167,37 @@ apply-on-rectangle
                  (<= (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)
-- 
2.17.1