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.

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