mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00
Code Issues Releases Activity

Throw errors in XDS handler directly

Browse Source 
* lisp/x-dnd.el (x-dnd-xds-testing): New defvar.
(x-dnd-handle-direct-save): Signal errors directly if it is
true.
* test/lisp/x-dnd-tests.el (x-dnd-xds-testing): New defvar.
(x-dnd-tests-do-direct-save-internal): Bind it to t around
x-begin-drag.  (bug#56712)
This commit is contained in:
Po Lu 2022-07-24 21:32:42 +08:00
parent 2024136d31
commit 295efb6025
2 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lisp/x-dnd.el
View File

@ -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'.

5
test/lisp/x-dnd-tests.el
View File

@ -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))