master 200938b95d: Fix generated drag-and-drop mouse rectangles

[Po Lu]

branch: master
commit 200938b95d1b73d03ce758e69a69d4fb198be4e8
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Fix generated drag-and-drop mouse rectangles
    
    * lisp/x-dnd.el (x-dnd-get-drop-width-height): Handle window
    width and height correctly.  Remove unused parameter.
    (x-dnd-after-move-frame): New function.
    (move-frame-functions): Add new hook.
    (x-dnd-compute-root-window-position): New function.
    (x-dnd-get-drop-x-y): Use that instead of `left' and `top'
    parameters, which include the title bar.
    (x-dnd-handle-xdnd): Update accordingly.
    * src/xfns.c (Fx_translate_coordinates): New function.
    (syms_of_xfns): New defsym.
---
 lisp/x-dnd.el | 48 ++++++++++++++++++++++----------
 src/xfns.c    | 88 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 122 insertions(+), 14 deletions(-)

diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 92899e7a0c..b25d2ea3d9 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -588,6 +588,7 @@ message (format 32) that caused EVENT to be generated."
 
 (declare-function x-change-window-property "xfns.c"
                  (prop value &optional frame type format outer-P window-id))
+(declare-function x-translate-coordinates "xfns.c")
 
 (defun x-dnd-init-xdnd-for-frame (frame)
   "Set the XdndAware property for FRAME to indicate that we do XDND."
@@ -595,33 +596,53 @@ message (format 32) that caused EVENT to be generated."
                            '(5)        ;; The version of XDND we support.
                            frame "ATOM" 32 t))
 
-(defun x-dnd-get-drop-width-height (frame w accept)
+(defun x-dnd-get-drop-width-height (w accept)
   "Return the width/height to be sent in a XdndStatus message.
-FRAME is the frame and W is the window where the drop happened.
+W is the window where the drop happened.
 If ACCEPT is nil return 0 (empty rectangle),
 otherwise if W is a window, return its width/height,
 otherwise return the frame width/height."
   (if accept
       (if (windowp w)   ;; w is not a window if dropping on the menu bar,
                        ;; scroll bar or tool bar.
-         (let ((edges (window-inside-pixel-edges w)))
-           (cons
-            (- (nth 2 edges) (nth 0 edges))    ;; right - left
-            (- (nth 3 edges) (nth 1 edges))))  ;; bottom - top
-       (cons (frame-pixel-width frame)
-             (frame-pixel-height frame)))
+         (cons (window-pixel-width)
+                (window-pixel-height))
+        ;; Don't confine to mouse rect if w is not a window.
+        ;; Otherwise, we won't get position events once the mouse does
+        ;; move into a window.
+        0)
     0))
 
+(defun x-dnd-after-move-frame (frame)
+  "Handle FRAME moving to a different position.
+Clear any cached root window position."
+  (set-frame-parameter frame 'dnd-root-window-position
+                       nil))
+
+(add-hook 'move-frame-functions #'x-dnd-after-move-frame)
+
+(defun x-dnd-compute-root-window-position (frame)
+  "Return the position of FRAME's edit widget relative to the root window.
+The value is a cons of (X . Y), describing the position of
+FRAME's edit widget (inner window) relative to the root window of
+its screen."
+  (or (frame-parameter frame 'dnd-root-window-position)
+      (let* ((result (x-translate-coordinates frame))
+             (param (cons (car result) (cadr result))))
+        (unless result
+          (error "Frame isn't on the same screen as its root window"))
+        (prog1 param
+          (set-frame-parameter frame 'dnd-root-window-position param)))))
+
 (defun x-dnd-get-drop-x-y (frame w)
   "Return the x/y coordinates to be sent in a XdndStatus message.
 Coordinates are required to be absolute.
 FRAME is the frame and W is the window where the drop happened.
 If W is a window, return its absolute coordinates,
 otherwise return the frame coordinates."
-  (let* ((frame-left (or (car-safe (cdr-safe (frame-parameter frame 'left)))
-                        (frame-parameter frame 'left)))
-        (frame-top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
-                       (frame-parameter frame 'top))))
+  (let* ((position (x-dnd-compute-root-window-position frame))
+         (frame-left (car position))
+        (frame-top (cdr position)))
     (if (windowp w)
        (let ((edges (window-inside-pixel-edges w)))
          (cons
@@ -700,8 +721,7 @@ FORMAT is 32 (not used).  MESSAGE is the data part of an 
XClientMessageEvent."
                        ;; widget bounds".
                       (+ (if dnd-indicate-insertion-point 2 0) accept)
                       (x-dnd-get-drop-x-y frame window)
-                      (x-dnd-get-drop-width-height
-                       frame window (eq accept 1))
+                      (x-dnd-get-drop-width-height window (eq accept 1))
                        ;; The no-toolkit Emacs build can actually
                        ;; receive drops from programs that speak
                        ;; versions of XDND earlier than 3 (such as
diff --git a/src/xfns.c b/src/xfns.c
index 748ea10c95..1a65698f49 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -7833,6 +7833,92 @@ Otherwise, the return value is a vector with the 
following fields:
   return prop_attr;
 }
 
+
+/***********************************************************************
+                          Coordinate management
+ ***********************************************************************/
+
+DEFUN ("x-translate-coordinates", Fx_translate_coordinates,
+       Sx_translate_coordinates,
+       1, 5, 0, doc: /* Translate coordinates from FRAME.
+Translate the given coordinates SOURCE-X and SOURCE-Y from
+SOURCE-WINDOW's coordinate space to that of DEST-WINDOW, on FRAME.
+
+If SOURCE-X and SOURCE-Y are nil, use 0 instead.
+
+FRAME can either be a terminal or a frame.  If nil, it defaults to the
+selected frame.  SOURCE-WINDOW must be an X window ID, 0 (which means
+to use the root window), or nil, which means to use FRAME's inner
+window.  DEST-WINDOW must be another X window ID, or nil (which means
+to use the root window).
+
+Return a list of (X Y CHILD) if the given coordinates are on the same
+screen, or nil otherwise, where X and Y are the coordinates in
+DEST-WINDOW's coordinate space, and CHILD is the window ID of any
+mapped child in DEST-WINDOW at those coordinates, or nil if there is
+no such window.  */)
+  (Lisp_Object frame, Lisp_Object source_window,
+   Lisp_Object dest_window, Lisp_Object source_x,
+   Lisp_Object source_y)
+{
+  struct x_display_info *dpyinfo;
+  struct frame *source_frame;
+  int dest_x, dest_y;
+  Window child_return, src, dest;
+  Bool rc;
+
+  dpyinfo = check_x_display_info (frame);
+  dest_x = 0;
+  dest_y = 0;
+
+  if (!NILP (source_x))
+    {
+      CHECK_FIXNUM (source_x);
+      dest_x = XFIXNUM (source_x);
+    }
+
+  if (!NILP (source_y))
+    {
+      CHECK_FIXNUM (source_y);
+      dest_y = XFIXNUM (source_y);
+    }
+
+  if (!NILP (source_window))
+    CONS_TO_INTEGER (source_window, Window, src);
+  else
+    {
+      source_frame = decode_window_system_frame (frame);
+      src = FRAME_X_WINDOW (source_frame);
+    }
+
+  if (!src)
+    src = dpyinfo->root_window;
+
+  if (!NILP (dest_window))
+    CONS_TO_INTEGER (dest_window, Window, dest);
+  else
+    dest = dpyinfo->root_window;
+
+  block_input ();
+  x_catch_errors (dpyinfo->display);
+  rc = XTranslateCoordinates (dpyinfo->display, src, dest,
+                             dest_x, dest_y, &dest_x, &dest_y,
+                             &child_return);
+  x_check_errors (dpyinfo->display,
+                 "Couldn't translate coordinates: %s");
+  x_uncatch_errors_after_check ();
+  unblock_input ();
+
+  if (!rc)
+    return Qnil;
+
+  return list3 (make_int (dest_x),
+               make_int (dest_y),
+               (child_return != None
+                ? make_uint (child_return)
+                : Qnil));
+}
+
 /***********************************************************************
                                Tool tips
  ***********************************************************************/
@@ -10003,6 +10089,8 @@ eliminated in future versions of Emacs.  */);
   defsubr (&Sx_double_buffered_p);
   defsubr (&Sx_begin_drag);
   defsubr (&Sx_display_set_last_user_time);
+  defsubr (&Sx_translate_coordinates);
+
   tip_timer = Qnil;
   staticpro (&tip_timer);
   tip_frame = Qnil;