mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-21 06:55:39 +00:00
Code Issues Releases Activity

Fix reported problem with drag-and-drop inside VirtualBox

Browse Source 
* lisp/x-dnd.el (x-dnd-handle-old-kde, x-dnd-handle-offix)
(x-dnd-handle-motif): Select window before handling drop, like
on Xdnd.
(x-dnd-convert-to-offix, x-dnd-do-offix-drop)
(x-dnd-handle-unsupported-drop): Accept local selection data and
use that instead.

* src/keyboard.c (kbd_buffer_get_event): Call unsupported drop
function with local selection data as 8th arg.
* src/xselect.c (x_get_local_selection): Accept new arg
`local_value'.  All callers changed.
(Fx_get_local_selection): New function.
(syms_of_xselect): Update defsubrs.

* src/xterm.c (x_dnd_lose_ownership): New function.
(x_dnd_begin_drag_and_drop): Unless new variable is true, disown
XdndSelection after returning.  This supposedly makes
drag-and-drop from guest to host work in VirtualBox without
causing pointer motion to become choppy afterwards.
(syms_of_xterm): New variable `x_dnd_preserve_selection_data'
and update doc string of `x-dnd-unsupported-drop-function'.

* test/lisp/dnd-tests.el (dnd-tests-begin-text-drag)
(dnd-tests-begin-file-drag, dnd-tests-begin-drag-files): Set new
variable to nil during tests.
This commit is contained in:
Po Lu 2022-06-29 10:24:14 +08:00
parent 9705609c0e
commit 0e6516a1f0
5 changed files with 142 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
lisp/x-dnd.el
View File

@ -443,6 +443,8 @@ EVENT, FRAME, WINDOW and DATA mean the same thing they do in
;; Now call the test function to decide what action to perform.
(x-dnd-maybe-call-test-function window 'private)
(unwind-protect
(when (windowp window)
(select-window window))
(x-dnd-drop-data event frame window data
(symbol-name type))
(x-dnd-forget-drop window))))))
@ -500,6 +502,8 @@ message (format 32) that caused EVENT to be generated."
;; Now call the test function to decide what action to perform.
(x-dnd-maybe-call-test-function window 'private)
(unwind-protect
(when (windowp window)
(select-window window))
(x-dnd-drop-data event frame window data
(symbol-name type))
(x-dnd-forget-drop window))))
@ -926,6 +930,8 @@ Return a vector of atoms containing the selection targets."
reply)))
((eq message-type 'XmDROP_START)
(when (windowp window)
(select-window window))
(let* ((x (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 8 2 source-byteorder)
2 my-byteorder))
@ -1014,19 +1020,22 @@ Return a vector of atoms containing the selection targets."
;;; Handling drops.
(defvar x-treat-local-requests-remotely)
(declare-function x-get-local-selection "xfns.c")
(defun x-dnd-convert-to-offix (targets)
"Convert the contents of `XdndSelection' to OffiX data.
(defun x-dnd-convert-to-offix (targets local-selection)
"Convert local selection data to OffiX data.
TARGETS should be the list of targets currently available in
`XdndSelection'. Return a list of an OffiX type, and data
suitable for passing to `x-change-window-property', or nil if the
data could not be converted."
data could not be converted.
LOCAL-SELECTION should be the local selection data describing the
selection data to convert."
(let ((x-treat-local-requests-remotely t)
file-name-data string-data)
(cond
((and (member "FILE_NAME" targets)
(setq file-name-data
(gui-get-selection 'XdndSelection 'FILE_NAME)))
(x-get-local-selection local-selection 'FILE_NAME)))
(if (string-match-p "\0" file-name-data)
;; This means there are multiple file names in
;; XdndSelection. Convert the file name data to a format
@ -1035,19 +1044,23 @@ data could not be converted."
(cons 'DndTypeFile (concat file-name-data "\0"))))
((and (member "STRING" targets)
(setq string-data
(gui-get-selection 'XdndSelection 'STRING)))
(x-get-local-selection local-selection 'STRING)))
(cons 'DndTypeText (encode-coding-string string-data
'latin-1))))))
(defun x-dnd-do-offix-drop (targets x y frame window-id)
"Perform an OffiX drop on WINDOW-ID with the contents of `XdndSelection'.
(defun x-dnd-do-offix-drop (targets x y frame window-id contents)
"Perform an OffiX drop on WINDOW-ID with the given selection contents.
Return non-nil if the drop succeeded, or nil if it did not
happen, which can happen if TARGETS didn't contain anything that
the OffiX protocol can represent.
X and Y are the root window coordinates of the drop. TARGETS is
the list of targets `XdndSelection' can be converted to."
(if-let* ((data (x-dnd-convert-to-offix targets))
the list of targets CONTENTS can be converted to, and CONTENTS is
the local selection data to drop onto the target window.
FRAME is the frame that will act as a source window for the
drop."
(if-let* ((data (x-dnd-convert-to-offix targets contents))
(type-id (car (rassq (car data)
x-dnd-offix-id-to-name)))
(source-id (string-to-number
@ -1074,18 +1087,20 @@ the list of targets `XdndSelection' can be converted to."
frame "_DND_PROTOCOL"
32 message-data))))
(defun x-dnd-handle-unsupported-drop (targets x y action window-id frame _time)
(defun x-dnd-handle-unsupported-drop (targets x y action window-id frame _time local-selection-data)
"Return non-nil if the drop described by TARGETS and ACTION should not proceed.
X and Y are the root window coordinates of the drop.
FRAME is the frame the drop originated on.
WINDOW-ID is the X window the drop should happen to."
WINDOW-ID is the X window the drop should happen to.
LOCAL-SELECTION-DATA is the local selection data of the drop."
(not (and (or (eq action 'XdndActionCopy)
(eq action 'XdndActionMove))
(not (and x-dnd-use-offix-drop
(not (and x-dnd-use-offix-drop local-selection-data
(or (not (eq x-dnd-use-offix-drop 'files))
(member "FILE_NAME" targets))
(x-dnd-do-offix-drop targets x
y frame window-id)))
y frame window-id
local-selection-data)))
(or
(member "STRING" targets)
(member "UTF8_STRING" targets)

5
src/keyboard.c
View File

@ -4056,12 +4056,13 @@ kbd_buffer_get_event (KBOARD **kbp,
if (!NILP (Vx_dnd_unsupported_drop_function))
{
if (!NILP (call7 (Vx_dnd_unsupported_drop_function,
if (!NILP (call8 (Vx_dnd_unsupported_drop_function,
XCAR (XCDR (event->ie.arg)), event->ie.x,
event->ie.y, XCAR (XCDR (XCDR (event->ie.arg))),
make_uint (event->ie.code),
event->ie.frame_or_window,
make_int (event->ie.timestamp))))
make_int (event->ie.timestamp),
Fcopy_sequence (XCAR (event->ie.arg)))))
break;
}

74
src/xselect.c
View File

@ -307,18 +307,30 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
This function is used both for remote requests (LOCAL_REQUEST is zero)
and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
If LOCAL_VALUE is non-nil, use it as the local copy. Also allow
quitting in that case, and let DPYINFO be NULL.
This calls random Lisp code, and may signal or gc. */
static Lisp_Object
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
bool local_request, struct x_display_info *dpyinfo)
bool local_request, struct x_display_info *dpyinfo,
Lisp_Object local_value)
{
Lisp_Object local_value, tem;
Lisp_Object tem;
Lisp_Object handler_fn, value, check;
bool may_quit;
specpdl_ref count;
local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
may_quit = false;
if (NILP (local_value)) return Qnil;
if (NILP (local_value))
local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
else
may_quit = true;
if (NILP (local_value))
return Qnil;
/* TIMESTAMP is a special case. */
if (EQ (target_type, QTIMESTAMP))
@ -331,8 +343,10 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
/* Don't allow a quit within the converter.
When the user types C-g, he would be surprised
if by luck it came during a converter. */
specpdl_ref count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
count = SPECPDL_INDEX ();
if (!may_quit)
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
@ -804,7 +818,9 @@ x_handle_selection_request (struct selection_input_event *event)
target that doesn't support XDND. */
if (SELECTION_EVENT_TIME (event) == pending_dnd_time + 1
|| SELECTION_EVENT_TIME (event) == pending_dnd_time + 2)
selection_symbol = QXdndSelection;
/* Always reply with the contents of PRIMARY, since that's where
the selection data is. */
selection_symbol = QPRIMARY;
local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
@ -915,7 +931,7 @@ x_convert_selection (Lisp_Object selection_symbol,
lisp_selection
= x_get_local_selection (selection_symbol, target_symbol,
false, dpyinfo);
false, dpyinfo, Qnil);
frame = selection_request_stack;
@ -2131,7 +2147,7 @@ On Nextstep, TIME-STAMP and TERMINAL are unused. */)
}
val = x_get_local_selection (selection_symbol, target_type, true,
FRAME_DISPLAY_INFO (f));
FRAME_DISPLAY_INFO (f), Qnil);
if (NILP (val) && FRAME_LIVE_P (f))
{
@ -2273,6 +2289,45 @@ On Nextstep, TERMINAL is unused. */)
return (owner ? Qt : Qnil);
}
DEFUN ("x-get-local-selection", Fx_get_local_selection, Sx_get_local_selection,
0, 2, 0,
doc: /* Run selection converters for VALUE, and return the result.
TARGET is the selection target that is used to find a suitable
converter. VALUE is a list of 4 values NAME, SELECTION-VALUE,
TIMESTAMP and FRAME. NAME is the name of the selection that will be
passed to selection converters, SELECTION-VALUE is the value of the
selection used by the converter, TIMESTAMP is not meaningful (but must
be a number that fits in an X timestamp), and FRAME is the frame
describing the terminal for which the selection converter will be
run. */)
(Lisp_Object value, Lisp_Object target)
{
Time time;
Lisp_Object name, timestamp, frame, result;
CHECK_SYMBOL (target);
name = Fnth (make_fixnum (0), value);
timestamp = Fnth (make_fixnum (2), value);
frame = Fnth (make_fixnum (3), value);
CHECK_SYMBOL (name);
CONS_TO_INTEGER (timestamp, Time, time);
check_window_system (decode_live_frame (frame));
result = x_get_local_selection (name, target, true,
NULL, value);
if (CONSP (result) && SYMBOLP (XCAR (result)))
{
result = XCDR (result);
if (CONSP (result) && NILP (XCDR (result)))
result = XCAR (result);
}
return clean_local_selection_data (result);
}
/* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
property (https://www.freedesktop.org/wiki/ClipboardManager/). */
@ -2809,6 +2864,7 @@ syms_of_xselect (void)
defsubr (&Sx_get_atom_name);
defsubr (&Sx_send_client_message);
defsubr (&Sx_register_dnd_atom);
defsubr (&Sx_get_local_selection);
reading_selection_reply = Fcons (Qnil, Qnil);
staticpro (&reading_selection_reply);

51
src/xterm.c
View File

@ -11234,6 +11234,19 @@ x_dnd_delete_action_list (Lisp_Object frame)
unblock_input ();
}
static void
x_dnd_lose_ownership (Lisp_Object timestamp_and_frame)
{
struct frame *f;
f = XFRAME (XCDR (timestamp_and_frame));
if (FRAME_LIVE_P (f))
Fx_disown_selection_internal (QXdndSelection,
XCAR (timestamp_and_frame),
XCDR (timestamp_and_frame));
}
/* This function is defined far away from the rest of the XDND code so
it can utilize `x_any_window_to_frame'. */
@ -11324,12 +11337,13 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
if (!NILP (Vx_dnd_unsupported_drop_function))
{
if (!NILP (call7 (Vx_dnd_unsupported_drop_function,
if (!NILP (call8 (Vx_dnd_unsupported_drop_function,
XCAR (XCDR (event->ie.arg)), event->ie.x,
event->ie.y, XCAR (XCDR (XCDR (event->ie.arg))),
make_uint (event->ie.code),
event->ie.frame_or_window,
make_int (event->ie.timestamp))))
make_int (event->ie.timestamp),
Fcopy_sequence (XCAR (event->ie.arg)))))
continue;
}
@ -11364,12 +11378,6 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
/* If local_value is nil, then we lost ownership of XdndSelection.
Signal a more informative error than args-out-of-range. */
if (NILP (local_value))
error ("Lost ownership of XdndSelection");
if (CONSP (local_value))
x_own_selection (QXdndSelection,
Fnth (make_fixnum (1), local_value), frame);
else
error ("No local value for XdndSelection");
if (popup_activated ())
@ -11387,6 +11395,14 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
else
x_dnd_selection_timestamp = XFIXNUM (ltimestamp);
/* Release ownership of XdndSelection after this function returns.
VirtualBox uses the owner of XdndSelection to determine whether
or not mouse motion is part of a drag-and-drop operation. */
if (!x_dnd_preserve_selection_data)
record_unwind_protect (x_dnd_lose_ownership,
Fcons (ltimestamp, frame));
x_dnd_motif_operations
= xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), xaction);
@ -27959,17 +27975,21 @@ mouse position list. */);
DEFVAR_LISP ("x-dnd-unsupported-drop-function", Vx_dnd_unsupported_drop_function,
doc: /* Function called when trying to drop on an unsupported window.
This function is called whenever the user tries to drop something on a
window that does not support either the XDND or Motif protocols for
drag-and-drop. It should return a non-nil value if the drop was
handled by the function, and nil if it was not. It should accept
several arguments TARGETS, X, Y, ACTION, WINDOW-ID, FRAME and TIME,
where TARGETS is the list of targets that was passed to
`x-begin-drag', WINDOW-ID is the numeric XID of the window that is
several arguments TARGETS, X, Y, ACTION, WINDOW-ID, FRAME, TIME and
LOCAL-SELECTION, where TARGETS is the list of targets that was passed
to `x-begin-drag', WINDOW-ID is the numeric XID of the window that is
being dropped on, X and Y are the root window-relative coordinates
where the drop happened, ACTION is the action that was passed to
`x-begin-drag', FRAME is the frame which initiated the drag-and-drop
operation, and TIME is the X server time when the drop happened. */);
operation, TIME is the X server time when the drop happened, and
LOCAL-SELECTION is the contents of the `XdndSelection' when
`x-begin-drag' was run, which can be passed to
`x-get-local-selection'. */);
Vx_dnd_unsupported_drop_function = Qnil;
DEFVAR_INT ("x-color-cache-bucket-size", x_color_cache_bucket_size,
@ -27996,4 +28016,11 @@ should return a symbol describing what to return from
If the value is nil, or the function returns a value that is not
a symbol, a drop on an Emacs frame will be canceled. */);
Vx_dnd_native_test_function = Qnil;
DEFVAR_BOOL ("x-dnd-preserve-selection-data", x_dnd_preserve_selection_data,
doc: /* Preserve selection data after `x-begin-drag' returns.
This lets you inspect the contents of `XdndSelection' after a
drag-and-drop operation, which is useful when writing tests for
drag-and-drop code. */);
x_dnd_preserve_selection_data = false;
}

10
test/lisp/dnd-tests.el
View File

@ -38,6 +38,7 @@
"Alist of selection names to their values.")
(defvar x-treat-local-requests-remotely)
(defvar x-dnd-preserve-selection-data)
;; Define some replacements for functions used by the drag-and-drop
;; code on X when running under something else.
@ -152,7 +153,8 @@ This function only tries to handle strings."
;; program with reasonably correct behavior, such as dtpad, gedit,
;; or Mozilla.
;; ASCII Latin-1 UTF-8
(let ((test-text "hello, everyone! sæl öllsömul! всем привет"))
(let ((test-text "hello, everyone! sæl öllsömul! всем привет")
(x-dnd-preserve-selection-data t))
;; Verify that dragging works.
(should (eq (dnd-begin-text-drag test-text) 'copy))
(should (eq (dnd-begin-text-drag test-text nil 'move) 'move))
@ -187,7 +189,8 @@ This function only tries to handle strings."
(normal-multibyte-file (expand-file-name
(make-temp-name "тест-на-перетаскивание")
temporary-file-directory))
(remote-temp-file (dnd-tests-make-temp-name)))
(remote-temp-file (dnd-tests-make-temp-name))
(x-dnd-preserve-selection-data t))
;; Touch those files if they don't exist.
(unless (file-exists-p normal-temp-file)
(write-region "" 0 normal-temp-file))
@ -273,7 +276,8 @@ This function only tries to handle strings."
(expand-file-name (make-temp-name "dnd-test")
temporary-file-directory))
(nonexistent-remote-file (dnd-tests-make-temp-name))
(nonexistent-remote-file-1 (dnd-tests-make-temp-name)))
(nonexistent-remote-file-1 (dnd-tests-make-temp-name))
(x-dnd-preserve-selection-data t))
;; Touch those files if they don't exist.
(unless (file-exists-p normal-temp-file)
(write-region "" 0 normal-temp-file))