diff options
Diffstat (limited to 'test/lisp/dnd-tests.el')
| -rw-r--r-- | test/lisp/dnd-tests.el | 160 |
1 files changed, 159 insertions, 1 deletions
diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index a603f29eb6d..7a7f54ba0bb 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -33,6 +33,7 @@ (require 'tramp) (require 'select) (require 'ert-x) +(require 'browse-url) (defvar dnd-tests-selection-table nil "Alist of selection names to their values.") @@ -172,7 +173,7 @@ This function only tries to handle strings." (extracted-1 (dnd-tests-extract-selection-data string-data-1 t)) (extracted (dnd-tests-extract-selection-data string-data t))) (should (and (stringp extracted) (stringp extracted-1))) - (should (equal extracted extracted))) + (should (equal extracted extracted-1))) ;; Now check text/plain. (let ((string-data (dnd-tests-verify-selection-data 'text/plain))) @@ -437,5 +438,162 @@ This function only tries to handle strings." (ignore-errors (delete-file normal-temp-file))))) + + +(defvar dnd-tests-list-1 '("file:///usr/openwin/include/pixrect/pr_impl.h" + "file:///usr/openwin/include/pixrect/pr_io.h") + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defvar dnd-tests-list-2 '("file:///usr/openwin/include/pixrect/pr_impl.h" + "file://remote/usr/openwin/include/pixrect/pr_io.h") + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defvar dnd-tests-list-3 (append dnd-tests-list-2 '("http://example.com")) + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defvar dnd-tests-list-4 (append dnd-tests-list-3 '("scheme1://foo.bar" + "scheme2://foo.bar")) + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defun dnd-tests-local-file-function (urls _action) + "Signal an error if URLS doesn't match `dnd-tests-list-1'. +ACTION is ignored. Return the symbol `copy' otherwise." + (should (equal urls dnd-tests-list-1)) + 'copy) + +(put 'dnd-tests-local-file-function 'dnd-multiple-handler t) + +(defun dnd-tests-remote-file-function (urls _action) + "Signal an error if URLS doesn't match `dnd-tests-list-2'. +ACTION is ignored. Return the symbol `copy' otherwise." + (should (equal urls dnd-tests-list-2)) + 'copy) + +(put 'dnd-tests-remote-file-function 'dnd-multiple-handler t) + +(defun dnd-tests-http-scheme-function (url _action) + "Signal an error if URLS doesn't match `dnd-tests-list-3''s third element. +ACTION is ignored. Return the symbol `private' otherwise." + (should (equal url (car (last dnd-tests-list-3)))) + 'private) + +(defun dnd-tests-browse-url-handler (url &rest _ignored) + "Verify URL is `dnd-tests-list-4''s fourth element." + (should (equal url (nth 3 dnd-tests-list-4)))) + +(put 'dnd-tests-browse-url-handler 'browse-url-browser-kind 'internal) + +(ert-deftest dnd-tests-receive-multiple-urls () + (let ((dnd-protocol-alist '(("^file:///" . dnd-tests-local-file-function) + ("^file:" . error) + ("^unrelated-scheme:" . error))) + (browse-url-handlers nil)) + ;; Check that the order of the alist is respected when the + ;; precedences of two handlers are equal. + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-1) + 'copy) + 'copy)) + ;; Check that sorting handlers by precedence functions correctly. + (setq dnd-protocol-alist '(("^file:///" . error) + ("^file:" . dnd-tests-remote-file-function) + ("^unrelated-scheme:" . error))) + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-2) + 'copy) + 'copy)) + ;; Check that multiple handlers can be called at once, and actions + ;; are properly "downgraded" to private when multiple handlers + ;; return inconsistent values. + (setq dnd-protocol-alist '(("^file:" . dnd-tests-remote-file-function) + ("^file:///" . error) + ("^http://" . dnd-tests-http-scheme-function))) + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-3) + 'copy) + 'private)) + ;; Now verify that the function's documented fallback behavior + ;; functions correctly. Set browse-url-handlers to an association + ;; list incorporating a test function, then guarantee that is + ;; called. + (setq browse-url-handlers '(("^scheme1://" . dnd-tests-browse-url-handler))) + ;; Furthermore, guarantee the fifth argument of the test data is + ;; inserted, for no apposite handler exists. + (save-window-excursion + (set-window-buffer nil (get-buffer-create " *dnd-tests*")) + (set-buffer (get-buffer-create " *dnd-tests*")) + (erase-buffer) + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-4) + 'copy) + 'private)) + (should (equal (buffer-string) (nth 4 dnd-tests-list-4)))) + ;; Check that a handler enumerated twice in the handler list + ;; receives URIs assigned to it only once. + (let* ((received-p nil) + (lambda (lambda (uri _action) + (should (equal uri "scheme1://test")) + (should (null received-p)) + (setq received-p 'copy)))) + (setq dnd-protocol-alist (list (cons "scheme1://" lambda) + (cons "scheme1://" lambda))) + (should (equal (dnd-handle-multiple-urls (selected-window) + (list "scheme1://test") + 'copy) + 'copy))))) + +(ert-deftest dnd-tests-default-file-name-handlers () + (let* ((local-files-opened nil) + (remote-files-opened nil) + (function-1 (lambda (file _uri) + (push file local-files-opened) + 'copy)) + (function-2 (lambda (file _uri) + (push file remote-files-opened) + 'copy))) + (unwind-protect + (progn + (advice-add #'dnd-open-local-file :override + function-1) + (advice-add #'dnd-open-file :override + function-2) + ;; Guarantee that file names are properly categorized as either + ;; local or remote by the default dnd-protocol-alist. + (dnd-handle-multiple-urls + (selected-window) + (list + ;; These are run-of-the-mill local file URIs. + "file:///usr/include/sys/acct.h" + "file:///usr/include/sys/acctctl.h" + ;; These URIs incorporate a host; they should match + ;; function-2 but never function-1. + "file://remotehost/usr/src/emacs/configure.ac" + "file://remotehost/usr/src/emacs/configure" + ;; These URIs are generated by drag-and-drop event + ;; handlers from local file names alone; they are not + ;; echt URIs in and of themselves, but a product of our + ;; drag and drop code. + "file:/etc/vfstab" + "file:/etc/dfs/sharetab" + ;; These URIs are generated under MS-Windows. + "file:c:/path/to/file/name" + "file:d:/path/to/file/name") + 'copy) + (should (equal (sort local-files-opened #'string<) + '("file:///usr/include/sys/acct.h" + "file:///usr/include/sys/acctctl.h" + "file:/etc/dfs/sharetab" + "file:/etc/vfstab" + "file:c:/path/to/file/name" + "file:d:/path/to/file/name"))) + (should (equal (sort remote-files-opened #'string<) + '("file://remotehost/usr/src/emacs/configure" + "file://remotehost/usr/src/emacs/configure.ac")))) + (advice-remove #'dnd-open-local-file function-2)))) + (provide 'dnd-tests) ;;; dnd-tests.el ends here |