diff options
| author | Federico Tedin | 2018-10-26 13:16:50 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2018-10-26 13:16:50 -0400 |
| commit | 8fffac14b19d375f774b835ea33ef8989300125d (patch) | |
| tree | a70868fb5928796e8f2522bf9dc13a0072a8c88c | |
| parent | f172ceda8aa5011c1ab79d812f2374a1dbe7a3ef (diff) | |
| download | emacs-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.el | 36 | ||||
| -rw-r--r-- | lisp/rect.el | 22 |
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. |
| 172 | POSITION specifies a position of the current buffer. The value | 172 | POSITION specifies a position of the current buffer. The value |
| 173 | returned is a cons of the current column of POSITION and its line | 173 | returned has the form (COLUMN . LINE)." |
| 174 | number." | ||
| 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. |
| 183 | POS1 and POS2 specify the positions of the upper-left corners of | 182 | POS1 and POS2 specify the positions of the upper-left corners of |
| 184 | the first and second rectangle as conses of their column and line | 183 | the first and second rectangles as conses of the form (COLUMN . LINE). |
| 185 | values. SIZE1 and SIZE2 specify the dimensions of the first and | 184 | SIZE1 and SIZE2 specify the dimensions of the first and second |
| 186 | second rectangle, as conses of their width and height measured in | 185 | rectangles, as conses of the form (WIDTH . HEIGHT)." |
| 187 | columns 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 | ||
| 201 | and 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) |