[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 134ba45: Allow two mouse functions to work with Rec
From: |
Martin Rudalics |
Subject: |
[Emacs-diffs] master 134ba45: Allow two mouse functions to work with Rectangle Mark mode |
Date: |
Wed, 17 Oct 2018 02:38:30 -0400 (EDT) |
branch: master
commit 134ba45bf0c11048c44a46c11d5dc8da12ca4d3e
Author: Federico Tedin <address@hidden>
Commit: Martin Rudalics <address@hidden>
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.
---
lisp/mouse.el | 106 ++++++++++++++++++++++++++++++++++++++++++++--------------
lisp/rect.el | 31 +++++++++++++++++
2 files changed, 111 insertions(+), 26 deletions(-)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index cb63ca5..44cca4c 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 8ccf051..48db4ff 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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 134ba45: Allow two mouse functions to work with Rectangle Mark mode,
Martin Rudalics <=