From: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
To: eliz@gnu.org
Cc: tkk@misasa.okayama-u.ac.jp, 26725@debbugs.gnu.org
Subject: bug#26725: patch for mouse.el
Date: Mon, 15 May 2017 13:01:31 +0900 (JST) [thread overview]
Message-ID: <20170515.130131.472087335.tkk@misasa.okayama-u.ac.jp> (raw)
In-Reply-To: <83d1bc8xnm.fsf@gnu.org>
[-- Attachment #1: Type: Text/Plain, Size: 3425 bytes --]
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@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
[-- Attachment #2: mouse.el.patch --]
[-- Type: Text/X-Patch, Size: 4355 bytes --]
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)))))))))
\f
+;; 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)))
+\f
+
;;; Bindings for mouse commands.
(global-set-key [down-mouse-1] 'mouse-drag-region)
next prev parent reply other threads:[~2017-05-15 4:01 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
2017-05-19 2:07 ` Tak Kunihiro
2017-05-27 12:00 ` Eli Zaretskii
2017-05-15 9:53 ` Tak Kunihiro
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170515.130131.472087335.tkk@misasa.okayama-u.ac.jp \
--to=tkk@misasa.okayama-u.ac.jp \
--cc=26725@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).