From 777aaf732f348b3b7cf41d3366071f602b8cbb0c Mon Sep 17 00:00:00 2001 From: Federico Tedin Date: Sat, 29 Sep 2018 20:16:00 -0300 Subject: [PATCH 1/1] 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): Add a new function. (rectangle-position-as-coordinates): Add a new function. --- lisp/mouse.el | 92 ++++++++++++++++++++++++++++++++++++--------------- lisp/rect.el | 35 ++++++++++++++++++++ 2 files changed, 101 insertions(+), 26 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index cb63ca51c5..b00f38a0f6 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 @@ mouse-save-then-kill (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 @@ mouse-save-then-kill (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,15 @@ mouse-drag-and-drop-region (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 +2465,11 @@ mouse-drag-and-drop-region ;; 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 +2482,18 @@ mouse-drag-and-drop-region 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. @@ -2500,12 +2520,20 @@ mouse-drag-and-drop-region ;; text will be inserted to inside of the original ;; region. (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 + ;; 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. + (let ((size (cons region-width region-height))) + (rectangle-intersect-p + (rectangle-position-as-coordinates start) size + (rectangle-position-as-coordinates point-to-paste) size)) + (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 +2552,9 @@ mouse-drag-and-drop-region (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 +2610,9 @@ mouse-drag-and-drop-region (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 +2621,17 @@ mouse-drag-and-drop-region (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 +2641,9 @@ mouse-drag-and-drop-region ;; 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 +2653,17 @@ mouse-drag-and-drop-region (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 8ccf051ee1..0456242f64 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -167,6 +167,41 @@ apply-on-rectangle (<= (point) endpt)))) final-point))) +(defun rectangle-position-as-coordinates (position) + "Return an integer buffer position as a (COL . LINE) coordinate." + (save-excursion + (goto-char position) + (let ((col (current-column)) + (line (progn + (beginning-of-line) + (count-lines 1 position)))) + (cons col line)))) + +(defun rectangle-intersect-p (pos1 size1 pos2 size2) + "Return t if the rectangle defined by POS1 and SIZE1 intersects with +the one defined by POS2 and SIZE2, and return nil if they do not. + +POS1 and POS2 should describe the positions of the upper-left +corners of the first and second rectangles, in the form of (COL . LINE). +SIZE1 and SIZE2 should describe the dimensions of the first and second +rectangles, in the form of (WIDTH . HEIGHT)." + (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) -- 2.17.1