GNU bug report logs - #26725
patch for mouse.el

Previous Next

Full log

View this message in rfc822 format

From: Tak Kunihiro <tkk <at> misasa.okayama-u.ac.jp>
To: eliz <at> gnu.org
Cc: tkk <at> misasa.okayama-u.ac.jp, 26725 <at> debbugs.gnu.org
Subject: bug#26725: patch for mouse.el
Date: Mon, 15 May 2017 13:01:31 +0900 (JST)

[Message part 1 (text/plain, inline)]

Thank you for the comments.  I revised English as suggested.

>> +(defun mouse-on-region-p (position &optional start end)
>> +  "Return if POSITION is in between START and END in the current buffer.
>> +When START and END are nil but there is active region, those of
>> +active region is fed."
>> +  (when (region-active-p)
>> +    (setq start (or start (region-beginning)))
>> +    (setq end (or end (region-end))))
>> +  (let ((point (posn-point position)))
>> +    (and
>> +     (numberp start)
>> +     (numberp end)
>> +     (numberp point)
>> +     (<= start point)
>> +     (<= point end))))
>
> This algorithm will fail with bidirectional text, where buffer
> positions don't increase monotonically with screen coordinates.  How
> about testing the face of the character under mouse instead?

I revised the code using following statements.  Accordingly,
`mouse-on-region-p' is not necessary anymore.

(equal (mouse-posn-property (event-start start-event) 'face) 'region)
(equal (mouse-posn-property (event-start start-event) 'face) 'secondary-selecton)

>> +(defun mouse-drag-region-pasting (event)
>
> The function's name is confusing.  Why not name it like the defcustom?

I changed the name from `mouse-drag-region-pasting' to
`mouse-drag-and-drop-region'.

> Please add a NEWS entry and some minimal documentation in the user
> manual.

I add ChangeLog, NEWS, and Info as shown below.  I think that all
concerns were resolved for now.


# ChangeLog

2017-05-16  Tak Kunihiro  <tkk <at> misasa.okayama-u.ac.jp>

	Support drag and drop region by the mouse (Bug#26725)

	* doc/emacs/frames.texi (Drag and Drop): Document support of drag
    and drop region by the mouse.
	* lisp/mouse.el (mouse-drag-region): Call mouse-drag-and-drop-region
    when start-event is against region.
    (mouse-drag-and-drop-region): Move the region by dragging the mouse.

# NEWS

** Support drag and drop text by the mouse.
You can start drag-and-drop text by customizing 'mouse-drag-and-drop-region'.

# Info

diff --git a/site-lisp/frames.252.texi b/site-lisp/frames.texi
index 1611bd1..da140a6 100755
--- a/site-lisp/frames.252.texi
+++ b/site-lisp/frames.texi
@@ -1046,12 +1046,17 @@ Window Dividers, elisp, The Emacs Lisp Reference Manual}.
 @cindex drag and drop

   In most graphical desktop environments, Emacs has basic support for
-@dfn{drag and drop} operations.  For instance, dropping text onto an
-Emacs frame inserts the text where it is dropped.  Dropping a file
-onto an Emacs frame visits that file.  As a special case, dropping the
-file on a Dired buffer moves or copies the file (according to the
-conventions of the application it came from) into the directory
-displayed in that buffer.
+@dfn{drag and drop} operations.  For instance, dragging region can move
+the entire region of text to point where mouse is dragged over to.
+Dropping text onto an Emacs frame inserts the text where it is dropped.
+Dropping a file onto an Emacs frame visits that file.  As a special
+case, dropping the file on a Dired buffer moves or copies the file
+(according to the conventions of the application it came from) into the
+directory displayed in that buffer.
+
+@vindex mouse-drag-and-drop-region
+  If you prefer to move the entire region of text by mouse, customize
+the variable @code{mouse-drag-and-drop-region}.

 @vindex dnd-open-file-other-window
   Dropping a file normally visits it in the window you drop it on.  If

[mouse.el.patch (text/x-patch, inline)]

diff --git a/mouse.252.el b/mouse.el
index 3336e2b..b8cc92c 100755
--- a/mouse.252.el
+++ b/mouse.el
@@ -688,12 +688,19 @@ Upon exit, point is at the far edge of the newly visible text."
 Highlight the drag area as you move the mouse.
 This must be bound to a button-down mouse event.
 In Transient Mark mode, the highlighting remains as long as the mark
-remains active.  Otherwise, it remains until the next input event."
-  (interactive "e")
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook)
-  (mouse-drag-track start-event))
+remains active.  Otherwise, it remains until the next input event.
 
+When the region already exists and `mouse-drag-and-drop-region'
+is non-nil, this moves the entire region of text to point where
+mouse is dragged over to."
+  (interactive "e")
+  (if (and mouse-drag-and-drop-region
+           (not (member 'triple (event-modifiers start-event)))
+           (equal (mouse-posn-property (event-start start-event) 'face) 'region))
+      (mouse-drag-and-drop-region start-event)
+    ;; Give temporary modes such as isearch a chance to turn off.
+    (run-hooks 'mouse-leave-buffer-hook)
+    (mouse-drag-track start-event)))
 
 (defun mouse-posn-property (pos property)
   "Look for a property at click position.
@@ -1911,6 +1918,76 @@ choose a font."
 		  t (called-interactively-p 'interactive)))))))))
 
 
+;; Drag and drop support.
+(defcustom mouse-drag-and-drop-region nil
+  "If non-nil, dragging the mouse drags the region, when that exists."
+  :type 'boolean
+  :version "26.1"
+  :group 'mouse)
+
+(defun mouse-drag-and-drop-region (event)
+  "Move text in a region to point where mouse is dragged over to.
+The transportation of text is also referred as `drag and drop'.
+When text is dragged over to a different buffer, 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
+        face-under-mouse)
+    (track-mouse
+      ;; When event was click instead of drag, skip loop
+      (while (progn
+               (setq event (read-event))
+               (mouse-movement-p event))
+        (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 when "event was click",
+    ;; "drag negligible", or "drag to read-only".
+    (setq face-under-mouse (mouse-posn-property (event-end event) 'face))
+    (if (or (equal face-under-mouse 'region)
+            (equal face-under-mouse 'secondary-selecton)
+            buffer-read-only)
+        ;; Do not modify buffer under mouse
+        (cond
+         ;; drag negligible or drag to read-only, restore region
+         (value-selection
+          (select-window window) ; 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
+        (setq deactivate-mark nil)
+        (activate-mark)) ; activate region on new place
+      ;; Take care initial region
+      (if (equal (current-buffer) buffer) ; same buffer
+          (let (deactivate-mark) ; remove text
+            (kill-region (overlay-start mouse-secondary-overlay)
+                         (overlay-end mouse-secondary-overlay)))
+        (let ((window1 (selected-window))) ; beyond buffer
+          (select-window window)
+          (goto-char point) ; restore point to where it was
+          (select-window window1))))
+    (delete-overlay mouse-secondary-overlay)))
+
+
 ;;; Bindings for mouse commands.
 
 (global-set-key [down-mouse-1]	'mouse-drag-region)

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.