diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index a61905cfac0..10fd9e5dac3 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -1442,6 +1442,11 @@ ACTION is the action given to `x-begin-drag'." (defvar x-dnd-disable-motif-protocol) (defvar x-dnd-use-unsupported-drop) +(defvar x-dnd-xds-testing nil + "Whether or not XDS is being tested from ERT. +When non-nil, throw errors from the `XdndDirectSave0' converters +instead of returning \"E\".") + (defun x-dnd-handle-direct-save (_selection _type _value) "Handle a selection request for `XdndDirectSave'." (setq x-dnd-xds-performed t) @@ -1456,15 +1461,24 @@ ACTION is the action given to `x-begin-drag'." (dnd-get-local-file-name local-file-uri)))) (if (not local-name) '(STRING . "F") - (condition-case nil - (progn + ;; We want errors to be signalled immediately during ERT + ;; testing, instead of being silently handled. (bug#56712) + (if x-dnd-xds-testing + (prog1 '(STRING . "S") (copy-file x-dnd-xds-current-file local-name t) (when (equal x-dnd-xds-current-file dnd-last-dragged-remote-file) (dnd-remove-last-dragged-remote-file))) - (:success '(STRING . "S")) - (error '(STRING . "E")))))) + (condition-case nil + (progn + (copy-file x-dnd-xds-current-file + local-name t) + (when (equal x-dnd-xds-current-file + dnd-last-dragged-remote-file) + (dnd-remove-last-dragged-remote-file))) + (:success '(STRING . "S")) + (error '(STRING . "E"))))))) (defun x-dnd-handle-octet-stream (_selection _type _value) "Handle a selecton request for `application/octet-stream'. diff --git a/test/lisp/x-dnd-tests.el b/test/lisp/x-dnd-tests.el index 8856be79ebc..ef9c8aada28 100644 --- a/test/lisp/x-dnd-tests.el +++ b/test/lisp/x-dnd-tests.el @@ -90,6 +90,8 @@ AgAABQMAAAYDAAATGwAAGhsAAA==") ;;; XDS tests. +(defvar x-dnd-xds-testing) + (defvar x-dnd-tests-xds-target-dir nil "The name of the target directory where the file will be saved.") @@ -162,7 +164,8 @@ hostname in the target URI." (original-file (expand-file-name (make-temp-name "x-dnd-test") temporary-file-directory)) - (x-dnd-tests-xds-name (make-temp-name "x-dnd-test-target"))) + (x-dnd-tests-xds-name (make-temp-name "x-dnd-test-target")) + (x-dnd-xds-testing t)) ;; The call to `gui-set-selection' is only used for providing the ;; conventional `text/uri-list' target and can be ignored. (cl-flet ((gui-set-selection #'ignore))