[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master f62a6acd00: Better handle drag-and-drop from one Emacs frame to a
|
From: |
Po Lu |
|
Subject: |
master f62a6acd00: Better handle drag-and-drop from one Emacs frame to another |
|
Date: |
Wed, 16 Mar 2022 00:33:54 -0400 (EDT) |
branch: master
commit f62a6acd00fa5045fbc537bcaa87756416e246a4
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Better handle drag-and-drop from one Emacs frame to another
* doc/lispref/frames.texi (Drag and Drop): Document new
parameter `return-frame' to `x-begin-drag'.
* lisp/mouse.el (mouse-drag-and-drop-region): Utilize new
feature.
* src/xfns.c (Fx_begin_drag): New parameter `return-frame'.
* src/xterm.c (x_dnd_begin_drag_and_drop): New parameter
return_frame_p.
(handle_one_xevent): Set new flags and return frame whenever
appropriate.
* src/xterm.h: Update prototypes.
---
doc/lispref/frames.texi | 8 +-
lisp/mouse.el | 235 ++++++++++++++++++++++++------------------------
src/xfns.c | 11 ++-
src/xterm.c | 50 ++++++++++-
src/xterm.h | 3 +-
5 files changed, 185 insertions(+), 122 deletions(-)
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 38897d6a0b..ea5dd4c675 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4042,7 +4042,7 @@ you want to alter Emacs behavior, you can customize these
variables.
On some window systems, Emacs also supports dragging contents from
itself to other frames.
-@defun x-begin-drag targets action &optional frame
+@defun x-begin-drag targets action &optional frame return-frame
This function begins a drag from @var{frame}, and returns when the
session ends, either because the drop was successful, or because the
drop was rejected. The drop occurs when all mouse buttons are
@@ -4061,6 +4061,12 @@ the drop target, or @code{XdndActionMove}, which means
the same as
@code{XdndActionCopy}, but also means the caller should delete
whatever was saved into that selection afterwards.
+If @var{return-frame} is non-nil and the mouse moves over an Emacs
+frame after first moving out of @var{frame}, then that frame will be
+returned immediately. This is useful when you want to treat dragging
+content from one frame to another specially, while also being able to
+drag content to other programs.
+
If the drop was rejected or no drop target was found, this function
returns @code{nil}. Otherwise, it returns a symbol describing the
action the target chose to perform, which can differ from @var{action}
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 3e2097e761..b650bea1bd 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -3061,123 +3061,126 @@ is copied instead of being cut."
(or (mouse-movement-p event)
;; Handle `mouse-autoselect-window'.
(memq (car event) '(select-window switch-frame))))
- ;; Obtain the dragged text in region. When the loop was
- ;; skipped, value-selection remains nil.
- (unless value-selection
- (setq value-selection (funcall region-extract-function nil))
- (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.
- (setq text-from-read-only
- (or text-from-read-only
- (catch 'loop
- (dolist (bound (region-bounds))
- (when (text-property-not-all
- (car bound) (cdr bound) 'read-only nil)
- (throw 'loop t)))))))
-
- (when (and mouse-drag-and-drop-region-cross-program
- (fboundp 'x-begin-drag)
- (framep (posn-window (event-end event)))
- (let ((location (posn-x-y (event-end event)))
- (frame (posn-window (event-end event))))
- (or (< (car location) 0)
- (< (cdr location) 0)
- (> (car location)
- (frame-pixel-width frame))
- (> (cdr location)
- (frame-pixel-height frame)))))
- (tooltip-hide)
- (gui-set-selection 'XdndSelection value-selection)
- (x-begin-drag '("UTF8_STRING" "STRING")
- 'XdndActionMove (posn-window (event-end event)))
- (throw 'cross-program-drag nil))
-
- (setq window-to-paste (posn-window (event-end event)))
- (setq point-to-paste (posn-point (event-end event)))
- ;; Set nil when target buffer is minibuffer.
- (setq buffer-to-paste (let (buf)
- (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)
- (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.
- ;;
- ;; If the region is rectangular, check if the newly inserted
- ;; rectangular text would intersect the already selected
- ;; region. If it would, then set "drag-but-negligible" to t.
- ;; As a special case, allow dragging the region freely anywhere
- ;; to the left, as this will never trigger its contents to be
- ;; inserted into the overlays tracking it.
- (setq drag-but-negligible
- (and (eq (overlay-buffer (car
mouse-drag-and-drop-overlays))
- buffer-to-paste)
- (if region-noncontiguous
- (let ((dimensions (rectangle-dimensions start
end))
- (start-coordinates
- (rectangle-position-as-coordinates start))
- (point-to-paste-coordinates
- (rectangle-position-as-coordinates
- point-to-paste)))
- (and (rectangle-intersect-p
- start-coordinates dimensions
- point-to-paste-coordinates dimensions)
- (not (< (car point-to-paste-coordinates)
- (car start-coordinates)))))
- (and (<= (overlay-start
- (car mouse-drag-and-drop-overlays))
- point-to-paste)
- (<= point-to-paste
- (overlay-end
- (car mouse-drag-and-drop-overlays))))))))
-
- ;; Show a tooltip.
- (if mouse-drag-and-drop-region-show-tooltip
- (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)))
+ (catch 'drag-again
+ ;; Obtain the dragged text in region. When the loop was
+ ;; skipped, value-selection remains nil.
+ (unless value-selection
+ (setq value-selection (funcall region-extract-function nil))
+ (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.
+ (setq text-from-read-only
+ (or text-from-read-only
+ (catch 'loop
+ (dolist (bound (region-bounds))
+ (when (text-property-not-all
+ (car bound) (cdr bound) 'read-only nil)
+ (throw 'loop t)))))))
+
+ (when (and mouse-drag-and-drop-region-cross-program
+ (fboundp 'x-begin-drag)
+ (framep (posn-window (event-end event)))
+ (let ((location (posn-x-y (event-end event)))
+ (frame (posn-window (event-end event))))
+ (or (< (car location) 0)
+ (< (cdr location) 0)
+ (> (car location)
+ (frame-pixel-width frame))
+ (> (cdr location)
+ (frame-pixel-height frame)))))
+ (tooltip-hide)
+ (gui-set-selection 'XdndSelection value-selection)
+ (when (framep
+ (x-begin-drag '("UTF8_STRING" "STRING") 'XdndActionCopy
+ (posn-window (event-end event)) t))
+ (throw 'drag-again nil))
+ (throw 'cross-program-drag nil))
+
+ (setq window-to-paste (posn-window (event-end event)))
+ (setq point-to-paste (posn-point (event-end event)))
+ ;; Set nil when target buffer is minibuffer.
+ (setq buffer-to-paste (let (buf)
+ (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
- (dolist (overlay mouse-drag-and-drop-overlays)
- (overlay-put overlay
- 'face 'mouse-drag-and-drop-region))
- (deactivate-mark) ; Maintain region in other window.
- (mouse-set-point event))))))
+ ;; Check if point under mouse is read-only.
+ (save-window-excursion
+ (select-window window-to-paste)
+ (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.
+ ;;
+ ;; If the region is rectangular, check if the newly inserted
+ ;; rectangular text would intersect the already selected
+ ;; region. If it would, then set "drag-but-negligible" to t.
+ ;; As a special case, allow dragging the region freely anywhere
+ ;; to the left, as this will never trigger its contents to be
+ ;; inserted into the overlays tracking it.
+ (setq drag-but-negligible
+ (and (eq (overlay-buffer (car
mouse-drag-and-drop-overlays))
+ buffer-to-paste)
+ (if region-noncontiguous
+ (let ((dimensions (rectangle-dimensions start
end))
+ (start-coordinates
+ (rectangle-position-as-coordinates
start))
+ (point-to-paste-coordinates
+ (rectangle-position-as-coordinates
+ point-to-paste)))
+ (and (rectangle-intersect-p
+ start-coordinates dimensions
+ point-to-paste-coordinates dimensions)
+ (not (< (car point-to-paste-coordinates)
+ (car start-coordinates)))))
+ (and (<= (overlay-start
+ (car mouse-drag-and-drop-overlays))
+ point-to-paste)
+ (<= point-to-paste
+ (overlay-end
+ (car
mouse-drag-and-drop-overlays))))))))
+
+ ;; Show a tooltip.
+ (if mouse-drag-and-drop-region-show-tooltip
+ (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
+ (dolist (overlay mouse-drag-and-drop-overlays)
+ (overlay-put overlay
+ 'face 'mouse-drag-and-drop-region))
+ (deactivate-mark) ; Maintain region in other window.
+ (mouse-set-point event)))))))
;; Hide a tooltip.
(when mouse-drag-and-drop-region-show-tooltip (tooltip-hide))
diff --git a/src/xfns.c b/src/xfns.c
index 0d197c1dd7..b5d0b2c54e 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6582,7 +6582,7 @@ The coordinates X and Y are interpreted in pixels
relative to a position
return Qnil;
}
-DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 3, 0,
+DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 4, 0,
doc: /* Begin dragging contents on FRAME, with targets TARGETS.
TARGETS is a list of strings, which defines the X selection targets
that will be available to the drop target. Block until the mouse
@@ -6607,9 +6607,14 @@ Emacs. For that reason, they are not mentioned here.
Consult
"Drag-and-Drop Protocol for the X Window System" for more details:
https://freedesktop.org/wiki/Specifications/XDND/.
+If RETURN-FRAME is non-nil, this function will return the frame if the
+mouse pointer moves onto an Emacs frame, after first moving out of
+FRAME.
+
If ACTION is not specified or nil, `XdndActionCopy' is used
instead. */)
- (Lisp_Object targets, Lisp_Object action, Lisp_Object frame)
+ (Lisp_Object targets, Lisp_Object action, Lisp_Object frame,
+ Lisp_Object return_frame)
{
struct frame *f = decode_window_system_frame (frame);
int ntargets = 0;
@@ -6655,7 +6660,7 @@ instead. */)
x_set_dnd_targets (target_atoms, ntargets);
lval = x_dnd_begin_drag_and_drop (f, FRAME_DISPLAY_INFO (f)->last_user_time,
- xaction);
+ xaction, !NILP (return_frame));
return lval;
}
diff --git a/src/xterm.c b/src/xterm.c
index 8a4344f2a4..a3d20a9d22 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -771,6 +771,15 @@ static void x_scroll_bar_end_update (struct x_display_info
*, struct scroll_bar
#endif
static bool x_dnd_in_progress;
+
+/* Whether or not to return a frame from `x_dnd_begin_drag_and_drop'.
+
+ 0 means to do nothing. 1 means to wait for the mouse to first exit
+ `x_dnd_frame'. 2 means to wait for the mouse to move onto a frame,
+ and 3 means to `x_dnd_return_frame_object'. */
+static int x_dnd_return_frame;
+static struct frame *x_dnd_return_frame_object;
+
static Window x_dnd_last_seen_window;
static int x_dnd_last_protocol_version;
static Time x_dnd_selection_timestamp;
@@ -1025,7 +1034,8 @@ x_set_dnd_targets (Atom *targets, int ntargets)
}
Lisp_Object
-x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction)
+x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
+ bool return_frame_p)
{
XEvent next_event;
struct input_event hold_quit;
@@ -1054,6 +1064,10 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time,
Atom xaction)
x_dnd_mouse_rect_target = None;
x_dnd_action = None;
x_dnd_wanted_action = xaction;
+ x_dnd_return_frame = 0;
+
+ if (return_frame_p)
+ x_dnd_return_frame = 1;
while (x_dnd_in_progress)
{
@@ -1085,6 +1099,14 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time,
Atom xaction)
}
}
+ if (x_dnd_return_frame == 3)
+ {
+ x_dnd_return_frame_object->mouse_moved = true;
+
+ XSETFRAME (action, x_dnd_return_frame_object);
+ return action;
+ }
+
FRAME_DISPLAY_INFO (f)->grabbed = 0;
if (x_dnd_wanted_action != None)
@@ -11606,6 +11628,19 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame))
x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ if (x_dnd_last_seen_window == FRAME_X_WINDOW (x_dnd_frame)
+ && x_dnd_return_frame == 1)
+ x_dnd_return_frame = 2;
+
+ if (x_dnd_return_frame == 2
+ && x_window_to_frame (dpyinfo, target))
+ {
+ x_dnd_in_progress = false;
+ x_dnd_return_frame_object
+ = x_window_to_frame (dpyinfo, target);
+ x_dnd_return_frame = 3;
+ }
+
x_dnd_wanted_action = None;
x_dnd_last_seen_window = target;
x_dnd_last_protocol_version
@@ -12825,6 +12860,19 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& x_dnd_last_seen_window != FRAME_X_WINDOW
(x_dnd_frame))
x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ if (x_dnd_last_seen_window == FRAME_X_WINDOW (x_dnd_frame)
+ && x_dnd_return_frame == 1)
+ x_dnd_return_frame = 2;
+
+ if (x_dnd_return_frame == 2
+ && x_window_to_frame (dpyinfo, target))
+ {
+ x_dnd_in_progress = false;
+ x_dnd_return_frame_object
+ = x_window_to_frame (dpyinfo, target);
+ x_dnd_return_frame = 3;
+ }
+
x_dnd_last_seen_window = target;
x_dnd_last_protocol_version
= x_dnd_get_window_proto (dpyinfo, target);
diff --git a/src/xterm.h b/src/xterm.h
index 225aaf4cad..9665e92a9f 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1367,7 +1367,8 @@ extern void x_scroll_bar_configure (GdkEvent *);
extern void x_display_set_last_user_time (struct x_display_info *, Time);
-extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom);
+extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom,
+ bool);
extern void x_set_dnd_targets (Atom *, int);
INLINE int
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master f62a6acd00: Better handle drag-and-drop from one Emacs frame to another,
Po Lu <=