aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorFederico Tedin2018-10-26 13:16:50 -0400
committerStefan Monnier2018-10-26 13:16:50 -0400
commit8fffac14b19d375f774b835ea33ef8989300125d (patch)
treea70868fb5928796e8f2522bf9dc13a0072a8c88c
parentf172ceda8aa5011c1ab79d812f2374a1dbe7a3ef (diff)
downloademacs-8fffac14b19d375f774b835ea33ef8989300125d.tar.gz
emacs-8fffac14b19d375f774b835ea33ef8989300125d.zip
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.
-rw-r--r--lisp/mouse.el36
-rw-r--r--lisp/rect.el22
2 files changed, 26 insertions, 32 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 44cca4c868a..7efe751ab6b 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2413,16 +2413,13 @@ is copied instead of being cut."
2413 (buffer (current-buffer)) 2413 (buffer (current-buffer))
2414 (window (selected-window)) 2414 (window (selected-window))
2415 (text-from-read-only buffer-read-only) 2415 (text-from-read-only buffer-read-only)
2416 ;; Use multiple overlays to cover cases where the region is 2416 ;; Use multiple overlays to cover cases where the region has more
2417 ;; rectangular. 2417 ;; than one boundary.
2418 (mouse-drag-and-drop-overlays (mapcar (lambda (bounds) 2418 (mouse-drag-and-drop-overlays (mapcar (lambda (bounds)
2419 (make-overlay (car bounds) 2419 (make-overlay (car bounds)
2420 (cdr bounds))) 2420 (cdr bounds)))
2421 (region-bounds))) 2421 (region-bounds)))
2422 (region-noncontiguous (region-noncontiguous-p)) 2422 (region-noncontiguous (region-noncontiguous-p))
2423 (region-width (- (overlay-end (car mouse-drag-and-drop-overlays))
2424 (overlay-start (car mouse-drag-and-drop-overlays))))
2425 (region-height (length mouse-drag-and-drop-overlays))
2426 point-to-paste 2423 point-to-paste
2427 point-to-paste-read-only 2424 point-to-paste-read-only
2428 window-to-paste 2425 window-to-paste
@@ -2467,10 +2464,6 @@ is copied instead of being cut."
2467 ;; skipped, value-selection remains nil. 2464 ;; skipped, value-selection remains nil.
2468 (unless value-selection 2465 (unless value-selection
2469 (setq value-selection (funcall region-extract-function nil)) 2466 (setq value-selection (funcall region-extract-function nil))
2470 ;; Remove yank-handler property in order to re-insert text using
2471 ;; the `insert-rectangle' function later on.
2472 (remove-text-properties 0 (length value-selection)
2473 '(yank-handler) value-selection)
2474 (when mouse-drag-and-drop-region-show-tooltip 2467 (when mouse-drag-and-drop-region-show-tooltip
2475 (let ((text-size mouse-drag-and-drop-region-show-tooltip)) 2468 (let ((text-size mouse-drag-and-drop-region-show-tooltip))
2476 (setq text-tooltip 2469 (setq text-tooltip
@@ -2485,15 +2478,11 @@ is copied instead of being cut."
2485 ;; Check if selected text is read-only. 2478 ;; Check if selected text is read-only.
2486 (setq text-from-read-only 2479 (setq text-from-read-only
2487 (or text-from-read-only 2480 (or text-from-read-only
2488 (get-text-property start 'read-only)
2489 (get-text-property end 'read-only)
2490 (catch 'loop 2481 (catch 'loop
2491 (dolist (bound (region-bounds)) 2482 (dolist (bound (region-bounds))
2492 (unless (equal 2483 (when (text-property-not-all
2493 (next-single-char-property-change 2484 (car bound) (cdr bound) 'read-only nil)
2494 (car bound) 'read-only nil (cdr bound)) 2485 (throw 'loop t)))))))
2495 (cdr bound))
2496 (throw 'loop t)))))))
2497 2486
2498 (setq window-to-paste (posn-window (event-end event))) 2487 (setq window-to-paste (posn-window (event-end event)))
2499 (setq point-to-paste (posn-point (event-end event))) 2488 (setq point-to-paste (posn-point (event-end event)))
@@ -2531,16 +2520,16 @@ is copied instead of being cut."
2531 (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) 2520 (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays))
2532 buffer-to-paste) 2521 buffer-to-paste)
2533 (if region-noncontiguous 2522 (if region-noncontiguous
2534 (let ((size (cons region-width region-height)) 2523 (let ((dimensions (rectangle-dimensions start end))
2535 (start-coordinates 2524 (start-coordinates
2536 (rectangle-position-as-coordinates start)) 2525 (rectangle-position-as-coordinates start))
2537 (point-to-paste-coordinates 2526 (point-to-paste-coordinates
2538 (rectangle-position-as-coordinates 2527 (rectangle-position-as-coordinates
2539 point-to-paste))) 2528 point-to-paste)))
2540 (and (rectangle-intersect-p 2529 (and (rectangle-intersect-p
2541 start-coordinates size 2530 start-coordinates dimensions
2542 point-to-paste-coordinates size) 2531 point-to-paste-coordinates dimensions)
2543 (not (<= (car point-to-paste-coordinates) 2532 (not (< (car point-to-paste-coordinates)
2544 (car start-coordinates))))) 2533 (car start-coordinates)))))
2545 (and (<= (overlay-start 2534 (and (<= (overlay-start
2546 (car mouse-drag-and-drop-overlays)) 2535 (car mouse-drag-and-drop-overlays))
@@ -2635,10 +2624,7 @@ is copied instead of being cut."
2635 (setq window-exempt window-to-paste) 2624 (setq window-exempt window-to-paste)
2636 (goto-char point-to-paste) 2625 (goto-char point-to-paste)
2637 (push-mark) 2626 (push-mark)
2638 2627 (insert-for-yank value-selection)
2639 (if region-noncontiguous
2640 (insert-rectangle (split-string value-selection "\n"))
2641 (insert value-selection))
2642 2628
2643 ;; On success, set the text as region on destination buffer. 2629 ;; On success, set the text as region on destination buffer.
2644 (when (not (equal (mark) (point))) 2630 (when (not (equal (mark) (point)))
diff --git a/lisp/rect.el b/lisp/rect.el
index 48db4ffd8f4..6b6906ac893 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -170,21 +170,19 @@ The final point after the last operation will be returned."
170(defun rectangle-position-as-coordinates (position) 170(defun rectangle-position-as-coordinates (position)
171 "Return cons of the column and line values of POSITION. 171 "Return cons of the column and line values of POSITION.
172POSITION specifies a position of the current buffer. The value 172POSITION specifies a position of the current buffer. The value
173returned is a cons of the current column of POSITION and its line 173returned has the form (COLUMN . LINE)."
174number."
175 (save-excursion 174 (save-excursion
176 (goto-char position) 175 (goto-char position)
177 (let ((col (current-column)) 176 (let ((col (current-column))
178 (line (1- (line-number-at-pos)))) 177 (line (line-number-at-pos)))
179 (cons col line)))) 178 (cons col line))))
180 179
181(defun rectangle-intersect-p (pos1 size1 pos2 size2) 180(defun rectangle-intersect-p (pos1 size1 pos2 size2)
182 "Return non-nil if two rectangles intersect. 181 "Return non-nil if two rectangles intersect.
183POS1 and POS2 specify the positions of the upper-left corners of 182POS1 and POS2 specify the positions of the upper-left corners of
184the first and second rectangle as conses of their column and line 183the first and second rectangles as conses of the form (COLUMN . LINE).
185values. SIZE1 and SIZE2 specify the dimensions of the first and 184SIZE1 and SIZE2 specify the dimensions of the first and second
186second rectangle, as conses of their width and height measured in 185rectangles, as conses of the form (WIDTH . HEIGHT)."
187columns and lines."
188 (let ((x1 (car pos1)) 186 (let ((x1 (car pos1))
189 (y1 (cdr pos1)) 187 (y1 (cdr pos1))
190 (x2 (car pos2)) 188 (x2 (car pos2))
@@ -198,6 +196,16 @@ columns and lines."
198 (<= (+ y1 h1) y2) 196 (<= (+ y1 h1) y2)
199 (<= (+ y2 h2) y1))))) 197 (<= (+ y2 h2) y1)))))
200 198
199(defun rectangle-dimensions (start end)
200 "Return the dimensions of the rectangle with corners at START
201and END. The returned value has the form of (WIDTH . HEIGHT)."
202 (save-excursion
203 (let* ((height (1+ (abs (- (line-number-at-pos end)
204 (line-number-at-pos start)))))
205 (cols (rectangle--pos-cols start end))
206 (width (abs (- (cdr cols) (car cols)))))
207 (cons width height))))
208
201(defun delete-rectangle-line (startcol endcol fill) 209(defun delete-rectangle-line (startcol endcol fill)
202 (when (= (move-to-column startcol (if fill t 'coerce)) startcol) 210 (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
203 (delete-region (point) 211 (delete-region (point)