diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 22277033f52..5c6d25ba686 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -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) diff --git a/src/keyboard.c b/src/keyboard.c index e5708c06d93..8b8d348c41a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -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; } diff --git a/src/xselect.c b/src/xselect.c index d90916c6b63..a1f590632f8 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -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); diff --git a/src/xterm.c b/src/xterm.c index d7c3bfa7aff..7298feb43a1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -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; } diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index aae9c80273f..18dd55c206c 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -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))