From: Federico Tedin <federicotedin@gmail.com>
To: charles@aurox.ch
Cc: 31240@debbugs.gnu.org
Subject: bug#31240: 26.1; mouse-save-then-kill does not kill rectangles
Date: Sun, 30 Sep 2018 13:20:31 -0300 [thread overview]
Message-ID: <CAA8GjPk_3b_0NUd2hFyJfCAstpg1L58GfmxS6H87OwdoBJpyLA@mail.gmail.com> (raw)
In-Reply-To: <m2y3bj0z25.fsf@aurox.ch>
[-- Attachment #1: Type: text/plain, Size: 454 bytes --]
Martin, Charles: Thanks for the suggestions, I've applied them and I'm attaching
the new patch here.
> although this still won't make your patch short enough to qualify as
> "tiny change". So if you haven't done so already, please start the
> paperwork process so we can apply this patch.
This shouldn't be a problem, my copyright assignment was filed one or two months
ago, and since then I've contributed two patches which have already been merged.
[-- Attachment #2: mouse.patch --]
[-- Type: text/x-patch, Size: 11590 bytes --]
From eb5ad6fa5a2948f5c3249927f94e319d38fa90ba Mon Sep 17 00:00:00 2001
From: Federico Tedin <federicotedin@gmail.com>
Date: Sun, 30 Sep 2018 13:09:10 -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 | 92 ++++++++++++++++++++++++++++++++++++---------------
lisp/rect.el | 33 ++++++++++++++++++
2 files changed, 99 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..cac8be3625 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -167,6 +167,39 @@ 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 (progn
+ (forward-line 0)
+ (count-lines (point-min) position))))
+ (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
next prev parent reply other threads:[~2018-09-30 16:20 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 [this message]
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
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=CAA8GjPk_3b_0NUd2hFyJfCAstpg1L58GfmxS6H87OwdoBJpyLA@mail.gmail.com \
--to=federicotedin@gmail.com \
--cc=31240@debbugs.gnu.org \
--cc=charles@aurox.ch \
/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).