X11 drag-and-drop corrections

* lisp/x-dnd.el (x-dnd-handle-drag-n-drop-event): Take cdddr of
client-message, skipping the selection information.
(x-dnd-do-direct-save): Do not erase the local copy of a remote
file if it was not in fact copied on behalf of the recipient.
(x-dnd-handle-xds-drop): Return proper action.

* src/xterm.c (x_term_init): Remove unused variable on non-GTK
builds.
This commit is contained in:
Po Lu 2025-02-12 15:49:12 +08:00
parent aade1b707c
commit fa4260594f
2 changed files with 44 additions and 37 deletions

View file

@ -469,13 +469,15 @@ Currently XDND, Motif and old KDE 1.x protocols are recognized."
(progn
(let ((action (cdr (assoc (symbol-name (cadr client-message))
x-dnd-xdnd-to-action)))
(targets (cddr client-message))
(targets (cdddr client-message))
(local-value (nth 2 client-message)))
(when (windowp window)
(select-window window))
(x-dnd-save-state window nil nil
(apply #'vector targets))
(x-dnd-maybe-call-test-function window action)
;; Remove XdndDirectSave0 from this list--Emacs does not
;; support this protocol for internal drops.
(setq targets (delete 'XdndDirectSave0 targets))
(x-dnd-save-state window nil nil (apply #'vector targets))
(x-dnd-maybe-call-test-function window action nil)
(unwind-protect
(x-dnd-drop-data event (if (framep window) window
(window-frame window))
@ -1542,43 +1544,46 @@ was taken, or the direct save failed."
(x-dnd-use-offix-drop nil)
(x-dnd-use-unsupported-drop nil)
(prop-deleted nil)
(action nil)
encoded-name)
(unwind-protect
(progn
(when (file-remote-p file)
(setq file-name (file-local-copy file))
(setq dnd-last-dragged-remote-file file-name)
(add-hook 'kill-emacs-hook
#'dnd-remove-last-dragged-remote-file))
(setq encoded-name
(encode-coding-string name
(or file-name-coding-system
default-file-name-coding-system)))
(setq x-dnd-xds-current-file file-name)
(x-change-window-property "XdndDirectSave0" encoded-name
frame "text/plain" 8 nil)
(gui-set-selection 'XdndSelection (concat "file://" file-name))
;; FIXME: this does not work with GTK file managers, since
;; they always reach for `text/uri-list' first, contrary to
;; the spec.
(let ((action (x-begin-drag '("XdndDirectSave0" "text/uri-list"
"application/octet-stream")
'XdndActionDirectSave
frame nil allow-same-frame)))
(if (not x-dnd-xds-performed)
action
(let ((property (x-window-property "XdndDirectSave0" frame
"AnyPropertyType" nil t)))
(setq prop-deleted t)
;; "System-G" deletes the property upon success.
(and (or (null property)
(and (stringp property)
(not (equal property ""))))
action)))))
(setq action
(progn
(when (file-remote-p file)
(setq file-name (file-local-copy file))
(setq dnd-last-dragged-remote-file file-name)
(add-hook 'kill-emacs-hook
#'dnd-remove-last-dragged-remote-file))
(setq encoded-name
(encode-coding-string name
(or file-name-coding-system
default-file-name-coding-system)))
(setq x-dnd-xds-current-file file-name)
(x-change-window-property "XdndDirectSave0" encoded-name
frame "text/plain" 8 nil)
(gui-set-selection 'XdndSelection (concat "file://" file-name))
;; FIXME: this does not work with GTK file managers,
;; since they always reach for `text/uri-list' first,
;; contrary to the spec.
(let ((action (x-begin-drag '("XdndDirectSave0" "text/uri-list"
"application/octet-stream")
'XdndActionDirectSave
frame nil allow-same-frame)))
(if (not x-dnd-xds-performed)
action
(let ((property (x-window-property "XdndDirectSave0" frame
"AnyPropertyType" nil t)))
(setq prop-deleted t)
;; "System-G" deletes the property upon success.
(and (or (null property)
(and (stringp property)
(not (equal property ""))))
action))))))
(unless prop-deleted
(x-delete-window-property "XdndDirectSave0" frame))
;; Delete any remote copy that was made.
(when (not (equal file-name original-file-name))
(when (and (not (equal file-name original-file-name))
x-dnd-xds-performed)
(delete-file file-name)))))
(defun x-dnd-save-direct (need-name filename)
@ -1717,7 +1722,7 @@ VERSION is the version of the XDND protocol understood by SOURCE."
(if (or (not success)
(< version 5))
0
"XdndDirectSave0")))))))
"XdndActionDirectSave")))))))
;; Internal wheel movement.

View file

@ -30591,7 +30591,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
block_input ();
#ifdef USE_GTK
bool was_initialized = x_initialized;
#endif /* USE_GTK */
if (!x_initialized)
{
x_initialize ();