(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)
The types are chosen in the order they appear in the list."
:version "22.1"
:type '(repeat string)
- :group 'x
-)
+ :group 'x)
;; Internal variables
(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."
(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
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. */
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;
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);
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'. */
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);
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;
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 ();
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");
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;
}
projects / emacs.git / commitdiff