unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Federico Tedin <federicotedin@gmail.com>
To: rudalics@gmx.at
Cc: 31240@debbugs.gnu.org, charles@aurox.ch
Subject: bug#31240: 26.1; mouse-save-then-kill does not kill rectangles
Date: Mon, 1 Oct 2018 18:34:45 -0300	[thread overview]
Message-ID: <CAA8GjP=Ygy-T3gci93t46P8MStjS8GB6HBhHYHgAhqMs-NzGjQ@mail.gmail.com> (raw)
In-Reply-To: <5BB1DBF0.5060706@gmx.at>

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

> Here the first evaluation gets me 1 and the second 0.  I suppose
> it's the latter you want.

Martin, thanks for your feedback. My use of the variable POSITON was a
mistake on my part, the correct thing to do was calling (point), as
the point had already been set to POSITION (by goto-char), and then
moved by forward-line.

While fixing the mistake, I found the function line-number-at-pos,
which uses the same method I was using (after your correction) to
calculate the line number. I'm attaching a new patch which uses this
function instead.

Slightly related question: is it better for me to keep sending patches
with all my changes and fixes included, or is it better to send an
initial one, and then send additional (smaller) patches with fixes to
the first one?

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

From 715f56150c513d31b81fdc164e020d7225821964 Mon Sep 17 00:00:00 2001
From: Federico Tedin <federicotedin@gmail.com>
Date: Mon, 1 Oct 2018 18:27:18 -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  | 31 +++++++++++++++++
 2 files changed, 97 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..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


  reply	other threads:[~2018-10-01 21:34 UTC|newest]

Thread overview: 48+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2018-04-22 18:35 bug#31240: 26.1; mouse-save-then-kill does not kill rectangles Charles A. Roelli
2018-08-20  2:26 ` Federico Tedin
2018-08-30 20:06   ` Charles A. Roelli
2018-09-12  0:39   ` Federico Tedin
2018-09-12 18:14     ` Charles A. Roelli
2018-09-22 20:05       ` Federico Tedin
2018-09-23 10:16         ` Charles A. Roelli
2018-09-23 22:23           ` Federico Tedin
2018-09-24 20:04             ` Charles A. Roelli
2018-09-26  0:33               ` Federico Tedin
2018-09-27 20:34                 ` Charles A. Roelli
2018-09-27 23:45                   ` Federico Tedin
2018-09-28  7:47                     ` martin rudalics
2018-09-29 23:18                       ` Federico Tedin
2018-09-30  7:59                         ` martin rudalics
2018-09-30 15:45                         ` Charles A. Roelli
2018-09-30 16:20                           ` Federico Tedin
2018-09-30 17:18                             ` Eli Zaretskii
2018-09-30 17:50                             ` martin rudalics
2018-09-30 18:25                               ` Federico Tedin
2018-10-01  8:33                                 ` martin rudalics
2018-10-01 21:34                                   ` Federico Tedin [this message]
2018-10-02  7:39                                     ` martin rudalics
2018-10-02 12:37                                       ` Federico Tedin
2018-10-02 13:17                                         ` martin rudalics
2018-10-04  2:56                                           ` Homeros Misasa
2018-10-05  6:57                                             ` martin rudalics
2018-10-05  9:28                                               ` Tak Kunihiro
2018-10-05 12:15                                                 ` Federico Tedin
2018-10-06 17:08                                                   ` martin rudalics
2018-10-06 20:16                                                     ` Federico Tedin
2018-10-07  6:17                                                       ` martin rudalics
2018-10-08 10:25                                                         ` Tak Kunihiro
2018-10-08 23:18                                                           ` Federico Tedin
2018-10-09  7:43                                                             ` martin rudalics
2018-10-10  6:19                                                               ` martin rudalics
2018-10-12  0:42                                                                 ` Federico Tedin
2018-10-12  8:44                                                                   ` martin rudalics
2018-10-12 22:08                                                                     ` Federico Tedin
2018-10-13  8:18                                                                       ` martin rudalics
2018-10-13 14:01                                                                         ` Federico Tedin
2018-10-15  7:56                                                                           ` martin rudalics
2018-10-17  7:28                                                                             ` martin rudalics
2018-10-19  0:02                                                                               ` Federico Tedin
2018-10-19  7:40                                                                                 ` martin rudalics
2018-10-19 12:53                                                                                   ` Federico Tedin
2018-10-11  2:14                                                               ` Tak Kunihiro
2018-09-29 10:07                     ` Charles A. Roelli

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='CAA8GjP=Ygy-T3gci93t46P8MStjS8GB6HBhHYHgAhqMs-NzGjQ@mail.gmail.com' \
    --to=federicotedin@gmail.com \
    --cc=31240@debbugs.gnu.org \
    --cc=charles@aurox.ch \
    --cc=rudalics@gmx.at \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).