From a5e351511f3c199c7fe49bf1ffff251536d30328 Mon Sep 17 00:00:00 2001 From: Federico Tedin Date: Thu, 25 Oct 2018 19:57:40 -0300 Subject: [PATCH 1/1] Better handling of rectangular regions in mouse-drag-and-drop-region * lisp/mouse.el (mouse-drag-and-drop-region): Use insert-for-yank for insertion, remove rectangular-region-specific variables. * lisp/rect.el (rectangle-dimensions): New function. --- 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 44cca4c868..e23e4f1ccd 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2413,16 +2413,13 @@ mouse-drag-and-drop-region (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 @@ mouse-drag-and-drop-region ;; 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 @@ mouse-drag-and-drop-region ;; 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-any + (car bound) (cdr bound) 'read-only t) + (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 @@ mouse-drag-and-drop-region (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 @@ mouse-drag-and-drop-region (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 48db4ffd8f..6b6906ac89 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -170,21 +170,19 @@ apply-on-rectangle (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 @@ rectangle-intersect-p (<= (+ 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) -- 2.17.1