diff options
-rw-r--r-- | lisp/x-dnd.el | 48 | ||||
-rw-r--r-- | src/xfns.c | 88 |
2 files changed, 122 insertions, 14 deletions
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 92899e7a0c6..b25d2ea3d9d 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 748ea10c952..1a65698f490 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; |