[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master a1a435b3f6: Respect test function when performing local drag-and-
From: |
Po Lu |
Subject: |
master a1a435b3f6: Respect test function when performing local drag-and-drop |
Date: |
Mon, 13 Jun 2022 03:02:51 -0400 (EDT) |
branch: master
commit a1a435b3f6c7afa910da2256334471ba49010974
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
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 7ee20e0fc3..bcf74762cc 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 bb5a1447df..490a008dfc 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 81b3b5cbef..d9dd29ca12 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 25d145c6c0..25c2453ee7 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 *,
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master a1a435b3f6: Respect test function when performing local drag-and-drop,
Po Lu <=