unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#26725: patch for mouse.el
@ 2017-05-01  5:43 Tak Kunihiro
       [not found] ` <handler.26725.B.1493617426654.ack@debbugs.gnu.org>
  2017-05-13 17:38 ` Eli Zaretskii
  0 siblings, 2 replies; 9+ messages in thread
From: Tak Kunihiro @ 2017-05-01  5:43 UTC (permalink / raw)
  To: 26725; +Cc: tkk

[-- Attachment #1: Type: Text/Plain, Size: 271 bytes --]

Drag and drop a file is already supported by Emacs.  This patch
extends drag and drop to region (text).

In other word, this patch lets you `cut and paste' in a buffer only
using mouse.  When destination is other windows, drag and drop a
region will be `copy and paste'.

[-- Attachment #2: mouse.el.patch --]
[-- Type: Text/X-Patch, Size: 4807 bytes --]

--- mouse.252.el	2017-05-01 13:45:39.735936700 +0900
+++ mouse.el	2017-05-01 13:59:11.102725500 +0900
@@ -688,12 +688,19 @@
 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 text on a region to point where mouse is
+dragged over to."
+  (interactive "e")
+  (if (and mouse-drag-and-drop-region
+           (not (member 'triple (event-modifiers start-event)))
+           (mouse-on-region-p (event-start start-event)))
+      (mouse-drag-region-pasting 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,94 @@
 		  t (called-interactively-p 'interactive)))))))))
 
 \f
+;; Drag and drop support.
+(defcustom mouse-drag-and-drop-region nil
+  "If non-nil, dragging mouse of the region moves text."
+  :type 'boolean
+  :version "26.1"
+  :group 'mouse)
+
+(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))))
+
+(defun mouse-drag-region-pasting (event)
+  "Move text on 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 different buffer, the text is copied
+instead of cut.  This works similar to
+`mouse-drag-secondary-moving' but expects region on launch and
+specifies point later, by mouse.
+
+To try this function, evaluate the following line.
+	(global-set-key [down-mouse-3] \\='mouse-drag-region-pasting)
+Then have a region and grab-and-drag it by mouse to point to move
+to."
+  (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))
+               (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".
+    (if (or (mouse-on-region-p (event-end event) start end)
+            buffer-read-only)
+        (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)))
+      ;; insert text
+      (push-mark)
+      (insert value-selection) ; revise buffer
+      (when (not (equal (mark) (point))) ; on success
+        (setq deactivate-mark nil)
+        (activate-mark)) ; activate region on new place
+      ;; take out initial region
+      (if (equal (current-buffer) buffer) ; same buffer
+          (let (deactivate-mark)
+            (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)))
+\f
+
 ;;; Bindings for mouse commands.
 
 (global-set-key [down-mouse-1]	'mouse-drag-region)

^ permalink raw reply	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2017-05-27 12:00 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-05-01  5:43 bug#26725: patch for mouse.el Tak Kunihiro
     [not found] ` <handler.26725.B.1493617426654.ack@debbugs.gnu.org>
2017-05-06 22:06   ` Tak Kunihiro
2017-05-07 17:08     ` Eli Zaretskii
2017-05-07 22:46       ` Tak Kunihiro
2017-05-13 17:38 ` Eli Zaretskii
2017-05-15  4:01   ` Tak Kunihiro
2017-05-19  2:07     ` Tak Kunihiro
2017-05-27 12:00       ` Eli Zaretskii
2017-05-15  9:53   ` Tak Kunihiro

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).