procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Better handle drag-and-drop from one Emacs frame to another

Browse source 
* 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.
This commit is contained in:
Po Lu 2022-03-16 12:33:15 +08:00
parent 5ff13718a5
commit f62a6acd00
5 changed files with 181 additions and 118 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
doc/lispref/frames.texi
View file

@ -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}

227
lisp/mouse.el
View file

@ -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))))
(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)))))))
;; 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))
(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))
(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)))
(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))

11
src/xfns.c
View file

@ -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;
}

50
src/xterm.c
View file

@ -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);

3
src/xterm.h
View file

@ -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