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

Make 'mouse-drag-and-drop-region' more robust and customizable

Browse source 
* lisp/mouse.el
(mouse-drag-and-drop-region-cut-when-buffers-differ): New option
to permit 'mouse-drag-and-drop-region' to cut text also when source
and destination buffers differ.
(mouse-drag-and-drop-region-show-tooltip): New option to toggle
display of tooltip during mouse dragging on graphic displays.
(mouse-drag-and-drop-region-show-cursor): New option to toggle
moving point with mouse cursor during mouse dragging of region.
(mouse-drag-and-drop-region): New face to highlight original
text while dragging.
(mouse-drag-and-drop-region): Make use of new options and face.
Ignore errors during tracking.
This commit is contained in:
Tak Kunihiro 2017-12-17 11:19:19 +01:00 • committed by Martin Rudalics
parent 2e9eba2013
commit c62ced5b4d
1 changed files with 278 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

309
lisp/mouse.el
View file

@ -2345,10 +2345,10 @@ choose a font."
;; Drag and drop support. ;; Drag and drop support.
(defcustom mouse-drag-and-drop-region nil (defcustom mouse-drag-and-drop-region nil
"If non-nil, dragging the mouse drags the region, if that exists. "If non-nil, dragging the mouse drags the region, if it exists.
If the value is a modifier, such as `control' or `shift' or `meta', If the value is a modifier, such as `control' or `shift' or
then if that modifier key is pressed when dropping the region, region `meta', then if that modifier key is pressed when dropping the
text is copied instead of being cut." region, text is copied instead of being cut."
:type `(choice :type `(choice
(const :tag "Disable dragging the region" nil) (const :tag "Disable dragging the region" nil)
,@(mapcar ,@(mapcar
@ -2361,6 +2361,45 @@ text is copied instead of being cut."
:version "26.1" :version "26.1"
:group 'mouse) :group 'mouse)
(defcustom mouse-drag-and-drop-region-cut-when-buffers-differ nil
"If non-nil, cut text also when source and destination buffers differ.
If this option is nil, `mouse-drag-and-drop-region' will leave
the text in the source buffer alone when dropping it in a
different buffer. If this is non-nil, it will cut the text just
as it does when dropping text in the source buffer."
:type 'boolean
:version "26.1"
:group 'mouse)
(defcustom mouse-drag-and-drop-region-show-tooltip 256
"If non-nil, text is shown by a tooltip in a graphic display.
If this option is nil, `mouse-drag-and-drop-region' does not show
tooltips. If this is t, it shows the entire text dragged in a
tooltip. If this is an integer (as with the default value of
256), it will show that many characters of the dragged text in
a tooltip."
:type 'integer
:version "26.1"
:group 'mouse)
(defcustom mouse-drag-and-drop-region-show-cursor t
"If non-nil, move point with mouse cursor during dragging.
If this is nil, `mouse-drag-and-drop-region' leaves point alone.
Otherwise, it will move point together with the mouse cursor and,
in addition, temporarily highlight the original region with the
`mouse-drag-and-drop-region' face."
:type 'boolean
:version "26.1"
:group 'mouse)
(defface mouse-drag-and-drop-region '((t :inherit region))
"Face to highlight original text during dragging.
This face is used by `mouse-drag-and-drop-region' to temporarily
highlight the original region when
`mouse-drag-and-drop-region-show-cursor' is non-nil."
:version "26.1"
:group 'mouse)
(defun mouse-drag-and-drop-region (event) (defun mouse-drag-and-drop-region (event)
"Move text in the region to point where mouse is dragged to. "Move text in the region to point where mouse is dragged to.
The transportation of text is also referred as `drag and drop'. The transportation of text is also referred as `drag and drop'.
@ -2369,66 +2408,246 @@ modifier key was pressed when dropping, and the value of the
variable `mouse-drag-and-drop-region' is that modifier, the text variable `mouse-drag-and-drop-region' is that modifier, the text
is copied instead of being cut." is copied instead of being cut."
(interactive "e") (interactive "e")
(require 'tooltip) (let* ((mouse-button (event-basic-type last-input-event))
(let ((start (region-beginning)) (mouse-drag-and-drop-region-show-tooltip
(when (and mouse-drag-and-drop-region-show-tooltip
(display-multi-frame-p)
(require 'tooltip))
mouse-drag-and-drop-region-show-tooltip))
(start (region-beginning))
(end (region-end)) (end (region-end))
(point (point)) (point (point))
(buffer (current-buffer)) (buffer (current-buffer))
(window (selected-window)) (window (selected-window))
value-selection) (text-from-read-only buffer-read-only)
(mouse-drag-and-drop-overlay (make-overlay start end))
point-to-paste
point-to-paste-read-only
window-to-paste
buffer-to-paste
cursor-in-text-area
no-modifier-on-drop
drag-but-negligible
clicked
value-selection ; This remains nil when event was "click".
text-tooltip
states
window-exempt)
;; STATES stores for each window on this frame its start and point
;; positions so we can restore them on all windows but for the one
;; where the drop occurs. For inter-frame drags we'll have to do
;; this for all windows on all visible frames. In addition we save
;; also the cursor type for the window's buffer so we can restore it
;; in case we modified it.
;; https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00090.html
(walk-window-tree
(lambda (window)
(setq states
(cons
(list
window
(copy-marker (window-start window))
(copy-marker (window-point window))
(with-current-buffer (window-buffer window)
cursor-type))
states))))
(ignore-errors
(track-mouse (track-mouse
;; When event was click instead of drag, skip loop ;; When event was "click" instead of "drag", skip loop.
(while (progn (while (progn
(setq event (read-event)) (setq event (read-key)) ; read-event or read-key
(or (mouse-movement-p event) (or (mouse-movement-p event)
;; Handle `mouse-autoselect-window'. ;; Handle `mouse-autoselect-window'.
(eq (car-safe event) 'select-window))) (eq (car-safe event) 'select-window)))
(unless value-selection ; initialization ;; Obtain the dragged text in region. When the loop was
(delete-overlay mouse-secondary-overlay) ;; skipped, value-selection remains nil.
(unless value-selection
(setq value-selection (buffer-substring start end)) (setq value-selection (buffer-substring start end))
(move-overlay mouse-secondary-overlay start end)) ; (deactivate-mark) (when mouse-drag-and-drop-region-show-tooltip
(ignore-errors (deactivate-mark) ; care existing region in other window (let ((text-size mouse-drag-and-drop-region-show-tooltip))
(mouse-set-point event) (setq text-tooltip
(tooltip-show value-selection))) (if (and (integerp text-size)
(> (length value-selection) text-size))
(concat
(substring value-selection 0 (/ text-size 2))
"\n...\n"
(substring value-selection (- (/ text-size 2)) -1))
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 window-to-paste (posn-window (event-end event)))
(setq point-to-paste (posn-point (event-end event)))
;; Set nil when target buffer is minibuffer.
(setq buffer-to-paste (let (buf)
(when (windowp window-to-paste)
(setq buf (window-buffer window-to-paste))
(when (not (minibufferp buf))
buf))))
(setq cursor-in-text-area (and window-to-paste
point-to-paste
buffer-to-paste))
(when cursor-in-text-area
;; Check if point under mouse is read-only.
(save-window-excursion
(select-window window-to-paste)
(setq point-to-paste-read-only
(or buffer-read-only
(get-text-property point-to-paste 'read-only))))
;; Check if "drag but negligible". Operation "drag but
;; negligible" is defined as drag-and-drop the text to
;; the original region. When modifier is pressed, the
;; text will be inserted to inside of the original
;; region.
(setq drag-but-negligible
(and (eq (overlay-buffer mouse-drag-and-drop-overlay)
buffer-to-paste)
(< (overlay-start mouse-drag-and-drop-overlay)
point-to-paste)
(< point-to-paste
(overlay-end mouse-drag-and-drop-overlay)))))
;; Show a tooltip.
(if mouse-drag-and-drop-region-show-tooltip
(tooltip-show text-tooltip)
(tooltip-hide)) (tooltip-hide))
;; Do not modify buffer under mouse when "event was click",
;; "drag negligible", or ;; Show cursor and highlight the original region.
;; "drag to read-only". (when mouse-drag-and-drop-region-show-cursor
(if (or (equal (mouse-posn-property (event-end event) 'face) 'region) ; "event was click" ;; Modify cursor even when point is out of frame.
(member 'secondary-selection ; "drag negligible" (setq cursor-type (cond
(mapcar (lambda (xxx) (overlay-get xxx 'face)) ((not cursor-in-text-area)
(overlays-at (posn-point (event-end event))))) nil)
buffer-read-only) ((or point-to-paste-read-only
;; Do not modify buffer under mouse. drag-but-negligible)
'hollow)
(t
'bar)))
(when cursor-in-text-area
(overlay-put mouse-drag-and-drop-overlay
'face 'mouse-drag-and-drop-region)
(deactivate-mark) ; Maintain region in other window.
(mouse-set-point event)))))
;; Hide a tooltip.
(when mouse-drag-and-drop-region-show-tooltip (tooltip-hide))
;; Check if modifier was pressed on drop.
(setq no-modifier-on-drop
(not (member mouse-drag-and-drop-region (event-modifiers event))))
;; Check if event was "click".
(setq clicked (not value-selection))
;; Restore status on drag to outside of text-area or non-mouse input.
(when (or (not cursor-in-text-area)
(not (equal (event-basic-type event) mouse-button)))
(setq drag-but-negligible t
no-modifier-on-drop t))
;; Do not modify any buffers when event is "click",
;; "drag but negligible", or "drag to read-only".
(let* ((mouse-drag-and-drop-region-cut-when-buffers-differ
(if no-modifier-on-drop
mouse-drag-and-drop-region-cut-when-buffers-differ
(not mouse-drag-and-drop-region-cut-when-buffers-differ)))
(wanna-paste-to-same-buffer (equal buffer-to-paste buffer))
(wanna-cut-on-same-buffer (and wanna-paste-to-same-buffer
no-modifier-on-drop))
(wanna-cut-on-other-buffer
(and (not wanna-paste-to-same-buffer)
mouse-drag-and-drop-region-cut-when-buffers-differ))
(cannot-paste (or point-to-paste-read-only
(when (or wanna-cut-on-same-buffer
wanna-cut-on-other-buffer)
text-from-read-only))))
(cond (cond
;; "drag negligible" or "drag to read-only", restore region. ;; Move point within region.
(value-selection (clicked
(select-window window) ; In case miss drag to other window (deactivate-mark)
(mouse-set-point event))
;; Undo operation. Set back the original text as region.
((or (and drag-but-negligible
no-modifier-on-drop)
cannot-paste)
;; Inform user either source or destination buffer cannot be modified.
(when (and (not drag-but-negligible)
cannot-paste)
(message "Buffer is read-only"))
;; Select source window back and restore region.
;; (set-window-point window point)
(select-window window)
(goto-char point) (goto-char point)
(setq deactivate-mark nil) (setq deactivate-mark nil)
(activate-mark)) (activate-mark))
;; "event was click" ;; Modify buffers.
(t (t
(deactivate-mark) ;; * DESTINATION BUFFER::
(mouse-set-point event))) ;; Insert the text to destination buffer under mouse.
;; Modify buffer under mouse by inserting text. (select-window window-to-paste)
(setq window-exempt window-to-paste)
(goto-char point-to-paste)
(push-mark) (push-mark)
(insert value-selection) (insert value-selection)
(when (not (equal (mark) (point))) ; on success insert ;; On success, set the text as region on destination buffer.
(when (not (equal (mark) (point)))
(setq deactivate-mark nil) (setq deactivate-mark nil)
(activate-mark)) ; have region on destination (activate-mark))
;; Take care of initial region on source.
(if (equal (current-buffer) buffer) ; when same buffer ;; * SOURCE BUFFER::
(let (deactivate-mark) ; remove text ;; Set back the original text as region or delete the original
(unless (member mouse-drag-and-drop-region (event-modifiers event)) ;; text, on source buffer.
(kill-region (overlay-start mouse-secondary-overlay) (if wanna-paste-to-same-buffer
(overlay-end mouse-secondary-overlay)))) ;; When source buffer and destination buffer are the same,
(let ((window1 (selected-window))) ; when beyond buffer ;; remove the original text.
(select-window window) (when no-modifier-on-drop
(goto-char point) ; restore point on source window (let (deactivate-mark)
(activate-mark) ; restore region (delete-region (overlay-start mouse-drag-and-drop-overlay)
(select-window window1)))) (overlay-end mouse-drag-and-drop-overlay))))
(delete-overlay mouse-secondary-overlay))) ;; When source buffer and destination buffer are different,
;; keep (set back the original text as region) or remove the
;; original text.
(select-window window) ; Select window with source buffer.
(goto-char point) ; Move point to the original text on source buffer.
(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))
;; 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)
;; Restore old states but for the window where the drop
;; occurred. Restore cursor types for all windows.
(dolist (state states)
(let ((window (car state)))
(when (and window-exempt
(not (eq window window-exempt)))
(set-window-start window (nth 1 state) 'noforce)
(set-marker (nth 1 state) nil)
;; If window is selected, the following automatically sets
;; point for that window's buffer.
(set-window-point window (nth 2 state))
(set-marker (nth 2 state) nil))
(with-current-buffer (window-buffer window)
(setq cursor-type (nth 3 state)))))))
;;; Bindings for mouse commands. ;;; Bindings for mouse commands.