[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 8fffac1 2/2: Subject: (mouse-drag-and-drop-region):
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 8fffac1 2/2: Subject: (mouse-drag-and-drop-region): Simplify and remove assumptions |
|
Date: |
Fri, 26 Oct 2018 13:16:57 -0400 (EDT) |
branch: master
commit 8fffac14b19d375f774b835ea33ef8989300125d
Author: Federico Tedin <address@hidden>
Commit: Stefan Monnier <address@hidden>
Subject: (mouse-drag-and-drop-region): Simplify and remove assumptions
* lisp/mouse.el (mouse-drag-and-drop-region): Use insert-for-yank for
insertion, remove rectangular-region-specific variables.
Use text-property-not-all.
* lisp/rect.el (rectangle-dimensions): New function.
(rectangle-position-as-coordinates): Use the usual 1-origin for lines.
---
lisp/mouse.el | 36 +++++++++++-------------------------
lisp/rect.el | 22 +++++++++++++++-------
2 files changed, 26 insertions(+), 32 deletions(-)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 44cca4c..7efe751 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2413,16 +2413,13 @@ is copied instead of being cut."
(buffer (current-buffer))
(window (selected-window))
(text-from-read-only buffer-read-only)
- ;; Use multiple overlays to cover cases where the region is
- ;; rectangular.
+ ;; Use multiple overlays to cover cases where the region has more
+ ;; than one boundary.
(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
@@ -2467,10 +2464,6 @@ is copied instead of being cut."
;; skipped, value-selection remains nil.
(unless value-selection
(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
@@ -2485,15 +2478,11 @@ is copied instead of being cut."
;; Check if selected text is read-only.
(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)))))))
+ (dolist (bound (region-bounds))
+ (when (text-property-not-all
+ (car bound) (cdr bound) 'read-only nil)
+ (throw 'loop t)))))))
(setq window-to-paste (posn-window (event-end event)))
(setq point-to-paste (posn-point (event-end event)))
@@ -2531,16 +2520,16 @@ is copied instead of being cut."
(and (eq (overlay-buffer (car mouse-drag-and-drop-overlays))
buffer-to-paste)
(if region-noncontiguous
- (let ((size (cons region-width region-height))
+ (let ((dimensions (rectangle-dimensions start end))
(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)
+ start-coordinates dimensions
+ point-to-paste-coordinates dimensions)
+ (not (< (car point-to-paste-coordinates)
(car start-coordinates)))))
(and (<= (overlay-start
(car mouse-drag-and-drop-overlays))
@@ -2635,10 +2624,7 @@ is copied instead of being cut."
(setq window-exempt window-to-paste)
(goto-char point-to-paste)
(push-mark)
-
- (if region-noncontiguous
- (insert-rectangle (split-string value-selection "\n"))
- (insert value-selection))
+ (insert-for-yank value-selection)
;; On success, set the text as region on destination buffer.
(when (not (equal (mark) (point)))
diff --git a/lisp/rect.el b/lisp/rect.el
index 48db4ff..6b6906a 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -170,21 +170,19 @@ The final point after the last operation will be
returned."
(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."
+returned has the form (COLUMN . LINE)."
(save-excursion
(goto-char position)
(let ((col (current-column))
- (line (1- (line-number-at-pos))))
+ (line (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."
+the first and second rectangles as conses of the form (COLUMN . LINE).
+SIZE1 and SIZE2 specify the dimensions of the first and second
+rectangles, as conses of the form (WIDTH . HEIGHT)."
(let ((x1 (car pos1))
(y1 (cdr pos1))
(x2 (car pos2))
@@ -198,6 +196,16 @@ columns and lines."
(<= (+ y1 h1) y2)
(<= (+ y2 h2) y1)))))
+(defun rectangle-dimensions (start end)
+ "Return the dimensions of the rectangle with corners at START
+and END. The returned value has the form of (WIDTH . HEIGHT)."
+ (save-excursion
+ (let* ((height (1+ (abs (- (line-number-at-pos end)
+ (line-number-at-pos start)))))
+ (cols (rectangle--pos-cols start end))
+ (width (abs (- (cdr cols) (car cols)))))
+ (cons width height))))
+
(defun delete-rectangle-line (startcol endcol fill)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
(delete-region (point)