diff --git a/lisp/mouse.el b/lisp/mouse.el index 17d1732..aacb550 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2361,6 +2361,33 @@ text is copied instead of being cut." :version "26.1" :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 an integer, such as 32 or 64, a number giving +the maximum length of the string shown in tooltip." + :type 'integer + :version "26.1" + :group 'mouse) + +(defvar mouse-drag-and-drop-region-show-cursor t + "If non-nil, move point with mouse cursor during dragging. +In addition, highlight the original region with +`mouse-drag-and-drop-region-face'.") + +(defvar mouse-drag-and-drop-region-face 'region + "Face to highlight the original text during dragging. +See also `mouse-drag-and-drop-region-show-cursor'.") + (defun mouse-drag-and-drop-region (event) "Move text in the region to point where mouse is dragged to. The transportation of text is also referred as `drag and drop'. @@ -2369,66 +2396,251 @@ modifier key was pressed when dropping, and the value of the variable `mouse-drag-and-drop-region' is that modifier, the text is copied instead of being cut." (interactive "e") - (require 'tooltip) - (let ((start (region-beginning)) - (end (region-end)) - (point (point)) - (buffer (current-buffer)) - (window (selected-window)) - value-selection) - (track-mouse - ;; When event was click instead of drag, skip loop - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - ;; Handle `mouse-autoselect-window'. - (eq (car-safe event) 'select-window))) - (unless value-selection ; initialization - (delete-overlay mouse-secondary-overlay) - (setq value-selection (buffer-substring start end)) - (move-overlay mouse-secondary-overlay start end)) ; (deactivate-mark) - (ignore-errors (deactivate-mark) ; care existing region in other window - (mouse-set-point event) - (tooltip-show value-selection))) - (tooltip-hide)) - ;; Do not modify buffer under mouse when "event was click", - ;; "drag negligible", or - ;; "drag to read-only". - (if (or (equal (mouse-posn-property (event-end event) 'face) 'region) ; "event was click" - (member 'secondary-selection ; "drag negligible" - (mapcar (lambda (xxx) (overlay-get xxx 'face)) - (overlays-at (posn-point (event-end event))))) - buffer-read-only) - ;; Do not modify buffer under mouse. - (cond - ;; "drag negligible" or "drag to read-only", restore region. - (value-selection - (select-window window) ; In case miss drag to other window - (goto-char point) - (setq deactivate-mark nil) - (activate-mark)) - ;; "event was click" - (t - (deactivate-mark) - (mouse-set-point event))) - ;; Modify buffer under mouse by inserting text. - (push-mark) - (insert value-selection) - (when (not (equal (mark) (point))) ; on success insert - (setq deactivate-mark nil) - (activate-mark)) ; have region on destination - ;; Take care of initial region on source. - (if (equal (current-buffer) buffer) ; when same buffer - (let (deactivate-mark) ; remove text - (unless (member mouse-drag-and-drop-region (event-modifiers event)) - (kill-region (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)))) - (let ((window1 (selected-window))) ; when beyond buffer - (select-window window) - (goto-char point) ; restore point on source window - (activate-mark) ; restore region - (select-window window1)))) - (delete-overlay mouse-secondary-overlay))) + (let* ((mouse-button (event-basic-type last-input-event)) + (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)) + (point (point)) + (buffer (current-buffer)) + (window (selected-window)) + (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-dropped) + + ;; 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)))) + + (condition-case nil + (progn + (track-mouse + ;; When event was "click" instead of "drag", skip loop. + (while (progn + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00364.html + (setq event (read-key)) ; read-event or read-key + (or (mouse-movement-p event) + ;; Handle `mouse-autoselect-window'. + (eq (car-safe event) 'select-window))) + ;; 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)) + (when mouse-drag-and-drop-region-show-tooltip + (let ((text-size mouse-drag-and-drop-region-show-tooltip)) + (setq text-tooltip (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. + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00663.html + ;; (add-text-properties (region-beginning) (region-end) '(read-only t)) + (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))) + (setq buffer-to-paste (let (buf) ; Set nil when target buffer is minibuffer. + (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) + ;; (add-text-properties (region-beginning) (region-end) '(read-only t)) + (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 + (member mouse-drag-and-drop-region-face + (mapcar (lambda (xxx) (overlay-get xxx 'face)) + (overlays-at point-to-paste))))) + + ;; Show a tooltip. + (if mouse-drag-and-drop-region-show-tooltip + ;; (and mouse-drag-and-drop-region-show-tooltip + ;; (not drag-but-negligible) + ;; (not point-to-paste-read-only) + ;; cursor-in-text-area) + (tooltip-show text-tooltip) + (tooltip-hide)) + + ;; Show cursor and highlight the original region. + (when mouse-drag-and-drop-region-show-cursor + ;; Modify cursor even when point is out of frame. + (setq cursor-type (cond + ((not cursor-in-text-area) + nil) + ((or point-to-paste-read-only + drag-but-negligible) + 'hollow) + (t + 'bar))) + (when cursor-in-text-area + (overlay-put mouse-drag-and-drop-overlay + 'face mouse-drag-and-drop-region-face) + (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. + ;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00486.html + (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 + ;; Move point within region. + (clicked + (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) + (setq deactivate-mark nil) + (activate-mark)) + ;; Modify buffers. + (t + ;; * DESTINATION BUFFER:: + ;; Insert the text to destination buffer under mouse. + (select-window window-to-paste) + (setq window-dropped window-to-paste) + (goto-char point-to-paste) + (push-mark) + (insert value-selection) + ;; On success, set the text as region on destination buffer. + (when (not (equal (mark) (point))) + (setq deactivate-mark nil) + (activate-mark)) + + ;; * SOURCE BUFFER:: + ;; Set back the original text as region or delete the original + ;; text, on source buffer. + (if wanna-paste-to-same-buffer + ;; When source buffer and destination buffer are the same, + ;; 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)))) + ;; 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)))))) + (error nil)) + + ;; 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-dropped + (not (eq window window-dropped))) + ;; unless (eq window window-dropped) + (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.