Commit a1a435b3 authored by Po Lu's avatar Po Lu
Browse files

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.
parent 7cd1f432
Pipeline #18477 failed with stages
in 368 minutes and 26 seconds
......@@ -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
......@@ -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;
......
......@@ -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;
}
......@@ -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 *,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment