From a4a865dbdf60158c2e8036d564311515a08f4830 Mon Sep 17 00:00:00 2001 From: Federico Tedin Date: Tue, 25 Sep 2018 21:29:19 -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. --- lisp/mouse.el | 71 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 48 insertions(+), 23 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index d5c132f484..344f39eddc 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1606,8 +1606,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 +1632,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))) @@ -2408,10 +2408,15 @@ mouse-drag-and-drop-region (start (region-beginning)) (end (region-end)) (point (point)) + (region-noncontiguous (region-noncontiguous-p)) (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))) point-to-paste point-to-paste-read-only window-to-paste @@ -2455,7 +2460,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 +2477,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 +2515,12 @@ 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) + (<= (overlay-start (car mouse-drag-and-drop-overlays)) point-to-paste) (<= point-to-paste - (overlay-end mouse-drag-and-drop-overlay))))) + (overlay-end (car (last mouse-drag-and-drop-overlays))))))) ;; Show a tooltip. (if mouse-drag-and-drop-region-show-tooltip @@ -2524,8 +2539,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))))) @@ -2590,11 +2606,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 +2626,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 +2638,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. -- 2.17.1