procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow two mouse functions to work with Rectangle Mark mode

Browse source 
* 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)
(rectangle-position-as-coordinates): New functions.
This commit is contained in:
Federico Tedin 2018-10-17 08:34:51 +02:00 • committed by Martin Rudalics
parent e64065bbbd
commit 134ba45bf0
2 changed files with 111 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

106
lisp/mouse.el
View file

@ -29,6 +29,8 @@
;;; Code:
(eval-when-compile (require 'rect))
;;; Utility functions.
;; Indent track-mouse like progn.
@ -1606,8 +1608,8 @@ if `mouse-drag-copy-region' is non-nil)"
(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 @@ if `mouse-drag-copy-region' is non-nil)"
(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,16 @@ is copied instead of being cut."
(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 +2466,11 @@ is copied instead of being cut."
;; 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 +2483,18 @@ is copied instead of being cut."
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.
@ -2499,13 +2520,34 @@ is copied instead of being cut."
;; the original region. When modifier is pressed, the
;; text will be inserted to inside of the original
;; region.
;;
;; 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.
;; As a special case, allow dragging the region freely anywhere
;; to the left, as this will never trigger its contents to be
;; inserted into the overlays tracking it.
(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
(let ((size (cons region-width region-height))
(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)
(car start-coordinates)))))
(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 +2566,9 @@ is copied instead of being cut."
(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 +2624,9 @@ is copied instead of being cut."
(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 +2635,17 @@ is copied instead of being cut."
(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 +2655,9 @@ is copied instead of being cut."
;; 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 +2667,17 @@ is copied instead of being cut."
(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.

31
lisp/rect.el
View file

@ -167,6 +167,37 @@ The final point after the last operation will be returned."
(<= (point) endpt))))
final-point)))
(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."
(save-excursion
(goto-char position)
(let ((col (current-column))
(line (1- (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."
(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)