Re: mouse-drag-and-drop-region

[Tak Kunihiro]

I re-re-revised mouse-drag-and-drop-region.  I'm sending replay to
https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00663.html,
ChangeLog, and patch.

* ChangeLog

2017-12-01 Tak Kunihiro <address@hidden>

        Improve comments and have four new options

        * lisp/mouse.el (mouse-drag-and-drop-region): Have option to make 
dragging cut among buffers. Make usage of tooltip option.
        (mouse-drag-and-drop-region-cut-when-buffers-differ): New variable. If 
non-nil, text is cut instead of copied when dragged among buffers.
        (mouse-drag-and-drop-region-show-tooltip): New variable. If non-nil, 
text is shown by tooltip in a graphic display.
        (mouse-drag-and-drop-region-show-cursor): New variable. If non-nil, 
point is set to where the mouse cursor.
        (mouse-drag-and-drop-region-face): New variable for face. The face is 
used to highlight the original text.


* Replay

> `mouse-drag-and-drop-region-show-tooltip' to toggle the showing of
> tooltips during dragging and nothing else.

OK.

> `mouse-drag-and-drop-region-highlight-region' to toggle highlighting
> the region with `mouse-drag-and-drop-region-face'
> 
> `mouse-drag-and-drop-region-show-cursor' which should synchronize the
> cursor with the mouse cursor just as `mouse-drag-track' does.

OK.  A new variable `mouse-drag-and-drop-region-show-cursor' is
defined.  When mouse-drag-and-drop-region-show-cursor is non-nil, the
region also is highlighted.  I did not define a variable
`mouse-drag-and-drop-region-highlight-region'.  Also, cursor-type
would be changed to give user feedback.

> When I try to drop the region on the toolbar or another frame (things
> some users might try out soon because they are not too far-fetched) I
> currently get something like
> 
> Wrong type argument: windowp, #<frame address@hidden 05408d00>
>
> We should tell them instead something like "Drop failed" or "Cannot
> drop into initial region".  And, if such an error occurs, we should be
> sure to delete the `mouse-drag-and-drop-overlay' and restore the
> initial region, if necessary.

Now the code checks if cursor is on the text area.  If not, it restore
the initial region.  I'm not sure to tell "Drop failed" is a good
idea.  When an user wants to undo the drag, he may drag to toolbar.
Restore the initial region is what is expected.  The code for now does
not tell the message.

> But typing during dragging should be caught by us in some way.  It
> should not defer us from showing tooltips by default.

I tried read-key instead of read-event as suggested by Alex and that
solved the problem.

> Stepping through every single character in
> 
>    (dolist (index (number-sequence start end))
>    ;; (add-text-properties (region-beginning) (region-end) '(read-only t))
>    (setq text-from-read-only (or text-from-read-only
>                                  (get-text-property index 'read-only)))))
> 
> is not very efficient if the region is large.  Please consider using
> `next-single-char-property-change' instead.

OK.


* Patch

diff --git a/lisp/mouse.el b/lisp/mouse.el
old mode 100644
new mode 100755
index 17d1732..3e59f6f
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2361,6 +2361,31 @@ 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 t
+  "If non-nil, text is shown by a tooltip in a graphic display."
+  :type 'boolean
+  :version "26.1"
+  :group 'mouse)
+
+(defvar mouse-drag-and-drop-region-show-cursor t
+  "If non-nil, point is set to where the mouse cursor is during
+dragging and the original text is highlighted by face
+`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 +2394,197 @@ 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)
+  (let* ((mouse-button (event-basic-type last-input-event))
+         (mouse-drag-and-drop-region-show-tooltip
+          (and mouse-drag-and-drop-region-show-tooltip
+               (display-multi-frame-p)
+               (require 'tooltip)))
+         (start (region-beginning))
+         (end (region-end))
+         (point (point))
+         (buffer (current-buffer))
+         (window (selected-window))
+         (cursor-type cursor-type)
+         (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".
+
     (track-mouse
-      ;; When event was click instead of drag, skip loop
+      ;; When event was "click" instead of "drag", skip loop.
       (while (progn
-               (setq event (read-event))
+               ;; 
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)))
-        (unless value-selection ; initialization
-          (delete-overlay mouse-secondary-overlay)
+        ;; 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))
-          (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)
+
+          ;; 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)))))
+        (ignore-errors
+          (setq window-to-paste (posn-window (event-end event)))
+          (setq point-to-paste (posn-point (event-end event)))
+          (setq buffer-to-paste (and (windowp window-to-paste)
+                                     (window-buffer window-to-paste)))
+          (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 (and mouse-drag-and-drop-region-show-tooltip
+                   (not drag-but-negligible)
+                   (not point-to-paste-read-only)
+                   cursor-in-text-area)
+              (tooltip-show value-selection)
+            (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)
+        (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))
-         ;; "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)))
+
+        ;; * 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)))))
+
+    ;; Clean up.
+    (delete-overlay mouse-drag-and-drop-overlay)))
 

 ;;; Bindings for mouse commands.