From a1a435b3f6c7afa910da2256334471ba49010974 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 13 Jun 2022 15:01:06 +0800 Subject: [PATCH] Respect test function when performing local drag-and-drop * lisp/x-dnd.el (x-dnd-test-function): Fix doc string to describe what is actually accepted. (x-dnd-known-types, x-dnd-targets-list): Fix coding style. (x-dnd-handle-native-drop): New function. * src/xselect.c (x_atom_to_symbol): Export. * src/xterm.c (x_dnd_note_self_drop): Call new variable to determine what action to return. (x_clear_dnd_action): New function. (x_dnd_begin_drag_and_drop): Respect new variable. (syms_of_xterm): New defvar `x-dnd-native-test-function'. * src/xterm.h: Update prototypes. --- lisp/x-dnd.el | 45 +++++++++++++++++++++++++++++------------- src/xselect.c | 4 ++-- src/xterm.c | 54 ++++++++++++++++++++++++++++++++++++++++++++++----- src/xterm.h | 1 + 4 files changed, 83 insertions(+), 21 deletions(-) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 7ee20e0fc3c..bcf74762cc4 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -35,22 +35,24 @@ (defcustom x-dnd-test-function #'x-dnd-default-test-function "The function drag and drop uses to determine if to accept or reject a drop. The function takes three arguments, WINDOW, ACTION and TYPES. -WINDOW is where the mouse is when the function is called. WINDOW may be a -frame if the mouse isn't over a real window (i.e. menu bar, tool bar or -scroll bar). ACTION is the suggested action from the drag and drop source, -one of the symbols move, copy, link or ask. TYPES is a list of available -types for the drop. - -The function shall return nil to reject the drop or a cons with two values, -the wanted action as car and the wanted type as cdr. The wanted action -can be copy, move, link, ask or private. +WINDOW is where the mouse is when the function is called. WINDOW +may be a frame if the mouse isn't over a real window (i.e. menu +bar, tool bar or scroll bar). ACTION is the suggested action +from the drag and drop source, one of the symbols move, copy, +link or ask. TYPES is a vector of available types for the drop. + +Each element of TYPE should either be a string (containing the +name of the type's X atom), or a symbol, whose name will be used. + +The function shall return nil to reject the drop or a cons with +two values, the wanted action as car and the wanted type as cdr. +The wanted action can be copy, move, link, ask or private. + The default value for this variable is `x-dnd-default-test-function'." :version "22.1" :type 'symbol :group 'x) - - (defcustom x-dnd-types-alist `((,(purecopy "text/uri-list") . x-dnd-handle-uri-list) (,(purecopy "text/x-moz-url") . x-dnd-handle-moz-url) @@ -94,8 +96,7 @@ if drop is successful, nil if not." The types are chosen in the order they appear in the list." :version "22.1" :type '(repeat string) - :group 'x -) + :group 'x) ;; Internal variables @@ -163,7 +164,6 @@ types in `x-dnd-known-types'. It always returns the action private." (let ((type (x-dnd-choose-type types))) (when type (cons 'private type)))) - (defun x-dnd-current-type (frame-or-window) "Return the type we want the DND data to be in for the current drop. FRAME-OR-WINDOW is the frame or window that the mouse is over." @@ -896,6 +896,23 @@ Return a vector of atoms containing the selection targets." (member "COMPOUND_TEXT" targets) (member "TEXT" targets))))) +(defvar x-dnd-targets-list) +(defvar x-dnd-native-test-function) + +(defun x-dnd-handle-native-drop (pos action) + "Compute the action for a drop at POS. +Return the appropriate drag-and-drop action for a local drop at POS. +ACTION is the action given to `x-begin-drag'." + (let ((state (funcall x-dnd-test-function + (posn-window pos) + (cdr (assoc (symbol-name action) + x-dnd-xdnd-to-action)) + (apply #'vector x-dnd-targets-list)))) + (when state + (intern (car (rassq (car state) x-dnd-xdnd-to-action)))))) + +(setq x-dnd-native-test-function #'x-dnd-handle-native-drop) + (provide 'x-dnd) ;;; x-dnd.el ends here diff --git a/src/xselect.c b/src/xselect.c index bb5a1447df7..490a008dfcb 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -112,7 +112,7 @@ selection_quantum (Display *display) : MAX_SELECTION_QUANTUM); } -#define LOCAL_SELECTION(selection_symbol,dpyinfo) \ +#define LOCAL_SELECTION(selection_symbol, dpyinfo) \ assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist) @@ -179,7 +179,7 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym) /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips and calls to intern whenever possible. */ -static Lisp_Object +Lisp_Object x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom) { char *str; diff --git a/src/xterm.c b/src/xterm.c index 81b3b5cbeff..d9dd29ca128 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1228,6 +1228,10 @@ static XRectangle x_dnd_mouse_rect; protocol, this is set to the atom XdndActionPrivate. */ static Atom x_dnd_action; +/* The symbol to return from `x-begin-drag' if non-nil. Takes + precedence over `x_dnd_action`. */ +static Lisp_Object x_dnd_action_symbol; + /* The action we want the drop target to perform. The drop target may elect to perform some different action, which is guaranteed to be in `x_dnd_action' upon completion of a drop. */ @@ -1242,7 +1246,7 @@ static uint8_t x_dnd_motif_operations; static uint8_t x_dnd_first_motif_operation; /* Array of selection targets available to the drop target. */ -static Atom *x_dnd_targets = NULL; +static Atom *x_dnd_targets; /* The number of elements in that array. */ static int x_dnd_n_targets; @@ -4298,15 +4302,30 @@ x_dnd_note_self_drop (struct x_display_info *dpyinfo, Window target, if (!f) return; + if (NILP (Vx_dnd_native_test_function)) + return; + if (!XTranslateCoordinates (dpyinfo->display, dpyinfo->root_window, FRAME_X_WINDOW (f), root_x, root_y, &win_x, &win_y, &dummy)) return; - /* Emacs can't respond to DND events inside the nested event - loop, so when dragging items to itself, always return - XdndActionPrivate. */ - x_dnd_action = dpyinfo->Xatom_XdndActionPrivate; + /* Emacs can't respond to DND events inside the nested event loop, + so when dragging items to itself, call the test function + manually. */ + + XSETFRAME (lval, f); + x_dnd_action = None; + x_dnd_action_symbol + = safe_call2 (Vx_dnd_native_test_function, + Fposn_at_x_y (make_fixnum (win_x), + make_fixnum (win_y), + lval, Qnil), + x_atom_to_symbol (dpyinfo, + x_dnd_wanted_action)); + + if (!SYMBOLP (x_dnd_action_symbol)) + return; EVENT_INIT (ie); @@ -10779,6 +10798,12 @@ x_detect_pending_selection_requests (void) return pending_selection_requests; } +static void +x_clear_dnd_action (void) +{ + x_dnd_action_symbol = Qnil; +} + /* This function is defined far away from the rest of the XDND code so it can utilize `x_any_window_to_frame'. */ @@ -10922,6 +10947,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_set_dnd_targets (target_atoms, ntargets); record_unwind_protect_void (x_free_dnd_targets); + record_unwind_protect_void (x_clear_dnd_action); ltimestamp = x_timestamp_for_selection (FRAME_DISPLAY_INFO (f), QXdndSelection); @@ -11042,6 +11068,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; x_dnd_mouse_rect_target = None; x_dnd_action = None; + x_dnd_action_symbol = Qnil; x_dnd_wanted_action = xaction; x_dnd_return_frame = 0; x_dnd_waiting_for_finish = false; @@ -11435,6 +11462,9 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_return_frame_object = NULL; FRAME_DISPLAY_INFO (f)->grabbed = 0; + if (!NILP (x_dnd_action_symbol)) + return unbind_to (base, x_dnd_action_symbol); + if (x_dnd_action != None) { block_input (); @@ -26942,6 +26972,9 @@ syms_of_xterm (void) x_dnd_monitors = Qnil; staticpro (&x_dnd_monitors); + x_dnd_action_symbol = Qnil; + staticpro (&x_dnd_action_symbol); + DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms"); DEFSYM (Qlatin_1, "latin-1"); DEFSYM (Qnow, "now"); @@ -27189,4 +27222,15 @@ This variable contains the list of drag-and-drop selection targets during a drag-and-drop operation, in the same format as the TARGET argument to `x-begin-drag'. */); Vx_dnd_targets_list = Qnil; + + DEFVAR_LISP ("x-dnd-native-test-function", Vx_dnd_native_test_function, + doc: /* Function called to determine return when dropping on Emacs itself. +It should accept two arguments POS and ACTION, and return a symbol +describing what to return from `x-begin-drag'. POS is a mouse +position list detailing the location of the drop, and ACTION is the +action specified by the caller of `x-begin-drag'. + +If nil or a non-symbol value is returned, the drop will be +cancelled. */); + Vx_dnd_native_test_function = Qnil; } diff --git a/src/xterm.h b/src/xterm.h index 25d145c6c0a..25c2453ee78 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1535,6 +1535,7 @@ extern void x_handle_property_notify (const XPropertyEvent *); extern void x_handle_selection_notify (const XSelectionEvent *); extern void x_handle_selection_event (struct selection_input_event *); extern void x_clear_frame_selections (struct frame *); +extern Lisp_Object x_atom_to_symbol (struct x_display_info *, Atom); extern bool x_handle_dnd_message (struct frame *, const XClientMessageEvent *, -- 2.39.2