From f62a6acd00fa5045fbc537bcaa87756416e246a4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 16 Mar 2022 12:33:15 +0800 Subject: [PATCH] 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 38897d6a0b3..ea5dd4c675b 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 3e2097e761f..b650bea1bde 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 0d197c1dd7d..b5d0b2c54e8 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 8a4344f2a4f..a3d20a9d226 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 225aaf4cad5..9665e92a9fb 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 -- 2.39.5