Enable DND handlers to receive more than one URI at a time
* doc/lispref/frames.texi (Drag and Drop): Illustrate the effect of the dnd-multiple-handler property and how convergent handlers are reconciled. * etc/NEWS (Lisp Changes in Emacs 30.1): Announce this change. * lisp/dnd.el (dnd-protocol-alist): Bring doc string up to date. (dnd-handle-one-url): Obsolete this function. (dnd-handle-multiple-urls): New function. * lisp/pgtk-dnd.el (pgtk-dnd-handle-uri-list) (pgtk-dnd-handle-file-name): * lisp/term/android-win.el (android-handle-dnd-event): * lisp/term/haiku-win.el (haiku-drag-and-drop): * lisp/term/ns-win.el (ns-drag-n-drop): * lisp/term/w32-win.el (w32-handle-dropped-file): * lisp/x-dnd.el (x-dnd-handle-uri-list, x-dnd-handle-file-name): Reimplement in terms of `dnd-handle-multiple-uris'. * lisp/term/pgtk-win.el (pgtk-drag-n-drop) (pgtk-drag-n-drop-other-frame, pgtk-drag-n-drop-as-text): Efface detritus that remained after the removal of the old PGTK drag and drop implementation. * test/lisp/dnd-tests.el (ert-x, dnd-tests-list-1) (dnd-tests-list-2, dnd-tests-list-3, dnd-tests-list-4) (dnd-tests-local-file-function, dnd-tests-remote-file-function) (dnd-tests-http-scheme-function, dnd-tests-browse-url-handler) (dnd-tests-receive-multiple-urls): New tests.
This commit is contained in:
Po Lu
parent
b62ad00981
commit
11f44ec6dd
11 changed files with 283 additions and 101 deletions
|
|
@ -4724,9 +4724,9 @@ seldom consistent medley of data types.
|
|||
@cindex drag and drop
|
||||
|
||||
Data transferred by drag and drop is generally either plain text or
|
||||
a URL designating a file or another resource. When text is dropped,
|
||||
it is inserted at the location of the drop, with recourse to saving it
|
||||
into the kill ring if that is not possible.
|
||||
a list of URLs designating files or other resources. When text is
|
||||
dropped, it is inserted at the location of the drop, with recourse to
|
||||
saving it into the kill ring if that is not possible.
|
||||
|
||||
URLs dropped are supplied to pertinent @dfn{DND handler functions}
|
||||
in the variable @code{dnd-protocol-alist}, or alternatively ``URL
|
||||
|
|
@ -4740,9 +4740,14 @@ This variable is an alist between regexps against which URLs are
|
|||
matched and DND handler functions called on the dropping of matching
|
||||
URLs.
|
||||
|
||||
Each handler function is called with the URL that matched it and one
|
||||
of the symbols @code{copy}, @code{move}, @code{link}, @code{private}
|
||||
or @code{ask} identifying the action to be taken.
|
||||
@cindex dnd-multiple-handler, a symbol property
|
||||
If a handler function is a symbol whose @code{dnd-multiple-handler}
|
||||
property (@pxref{Symbol Properties}) is set, then upon a drop it is
|
||||
given a list of every URL that matches its regexp; absent this
|
||||
property, it is called once for each of those URLs. Following this
|
||||
first argument is one of the symbols @code{copy}, @code{move},
|
||||
@code{link}, @code{private} or @code{ask} identifying the action to be
|
||||
taken.
|
||||
|
||||
If @var{action} is @code{private}, the program that initiated the drop
|
||||
does not insist on any particular behavior on the part of its
|
||||
|
|
@ -4750,19 +4755,29 @@ recipient; a reasonable action to take in that case is to open the URL
|
|||
or copy its contents into the current buffer. The other values of
|
||||
@var{action} imply much the same as in the @var{action} argument to
|
||||
@code{dnd-begin-file-drag}.
|
||||
|
||||
Once its work completes, a handler function must return a symbol
|
||||
designating the action it took: either the action it was provided, or
|
||||
the symbol @code{private}, which communicates to the source of the
|
||||
drop that the action it prescribed has not been executed.
|
||||
|
||||
When multiple handlers match an overlapping subset of items within a
|
||||
drop, the handler matched against by the greatest number of items is
|
||||
called to open that subset. The items it is supplied are subsequently
|
||||
withheld from other handlers, even those they also match.
|
||||
@end defvar
|
||||
|
||||
@cindex drag and drop, X
|
||||
@cindex drag and drop, other formats
|
||||
Emacs does not take measures to accept data besides text and URLs by
|
||||
default, for the window system interfaces which enable this are too
|
||||
far removed from each other to abstract over consistently. Nor are
|
||||
DND handlers accorded the capacity to influence the action they are
|
||||
meant to take, as particular drag-and-drop protocols deny recipients
|
||||
such control. The X11 drag-and-drop implementation rests on several
|
||||
underlying protocols that make use of selection transfer and share
|
||||
much in common, to which low level access is provided through the
|
||||
following functions and variables:
|
||||
Emacs does not take measures to accept data besides text and URLs,
|
||||
for the window system interfaces which enable this are too far removed
|
||||
from each other to abstract over consistently. Nor are DND handlers
|
||||
accorded influence over the actions they are meant to take, as
|
||||
particular drag-and-drop protocols deny recipients such control. The
|
||||
X11 drag-and-drop implementation rests on several underlying protocols
|
||||
that make use of selection transfer and share much in common, to which
|
||||
low level access is provided through the following functions and
|
||||
variables:
|
||||
|
||||
@defvar x-dnd-test-function
|
||||
This function is called to ascertain whether Emacs should accept a
|
||||
|
|
|
|||
10
etc/NEWS
10
etc/NEWS
|
|
@ -1122,6 +1122,16 @@ values.
|
|||
|
||||
* Lisp Changes in Emacs 30.1
|
||||
|
||||
+++
|
||||
** Drag-and-drop functions can now be called once for compound drops.
|
||||
It is now possible for drag-and-drop handler functions to respond to
|
||||
drops incorporating more than one URL. Functions capable of this must
|
||||
set their 'dnd-multiple-handler' symbol properties to a non-nil value.
|
||||
See the Info node "(elisp)Drag and Drop".
|
||||
|
||||
Incident to this change, the function 'dnd-handle-one-url' has been
|
||||
made obsolete, for it cannot take these new handlers into account.
|
||||
|
||||
** New function 're-disassemble' to see the innards of a regexp.
|
||||
If you compiled with '--enable-checking', you can use this to help debug
|
||||
either your regexp performance problems or the regexp engine.
|
||||
|
|
|
|||
94
lisp/dnd.el
94
lisp/dnd.el
|
|
@ -46,13 +46,14 @@
|
|||
(,(purecopy "^file://") . dnd-open-file) ; URL with host
|
||||
(,(purecopy "^file:") . dnd-open-local-file) ; Old KDE, Motif, Sun
|
||||
(,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file))
|
||||
|
||||
"The functions to call for different protocols when a drop is made.
|
||||
This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'.
|
||||
This variable is used by `dnd-handle-multiple-urls'.
|
||||
The list contains of (REGEXP . FUNCTION) pairs.
|
||||
The functions shall take two arguments, URL, which is the URL dropped and
|
||||
ACTION which is the action to be performed for the drop (move, copy, link,
|
||||
private or ask).
|
||||
If a function's `dnd-multiple-handler' property is set, it is provided
|
||||
a list of each URI dropped instead.
|
||||
If no match is found here, and the value of `browse-url-browser-function'
|
||||
is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
|
||||
If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
|
||||
|
|
@ -159,7 +160,10 @@ If no match is found here, `browse-url-handlers' and
|
|||
`browse-url-default-handlers' are searched for a match.
|
||||
If no match is found, just call `dnd-insert-text'. WINDOW is
|
||||
where the drop happened, ACTION is the action for the drop, URL
|
||||
is what has been dropped. Returns ACTION."
|
||||
is what has been dropped. Returns ACTION.
|
||||
|
||||
This function has been obsolete since Emacs 30.1; it has been
|
||||
supplanted by `dnd-handle-multiple-urls'."
|
||||
(let (ret)
|
||||
(or
|
||||
(catch 'done
|
||||
|
|
@ -180,6 +184,90 @@ is what has been dropped. Returns ACTION."
|
|||
(setq ret 'private)))
|
||||
ret))
|
||||
|
||||
(make-obsolete 'dnd-handle-one-url 'dnd-handle-multiple-urls "30.1")
|
||||
|
||||
(defun dnd-handle-multiple-urls (window urls action)
|
||||
"Select a handler for, then open, each element of URLS.
|
||||
The argument ACTION is the action which must be taken, much as
|
||||
that to `dnd-begin-file-drag'.
|
||||
|
||||
Assign and give each URL to one of the \"DND handler\" functions
|
||||
listed in the variable `dnd-protocol-alist'. When multiple
|
||||
handlers matching the same subset of URLs exist, give precedence
|
||||
to the handler assigned the greatest number of URLs.
|
||||
|
||||
If a handler is a symbol with the property
|
||||
`dnd-multiple-handler', call it with ACTION and a list of every
|
||||
URL it is assigned. Otherwise, call it once for each URL
|
||||
assigned with ACTION and the URL in question.
|
||||
|
||||
Subsequently open URLs that don't match any handlers opened with
|
||||
any handler selected by `browse-url-select-handler', and failing
|
||||
even that, insert them with `dnd-insert-text'.
|
||||
|
||||
Return a symbol designating the actions taken by each DND handler
|
||||
called. If all DND handlers called return the same symbol,
|
||||
return that symbol; otherwise, or if no DND handlers are called,
|
||||
return `private'.
|
||||
|
||||
Do not rely on the contents of URLS after calling this function,
|
||||
for it will be modified."
|
||||
(let ((list nil) (return-value nil))
|
||||
(with-selected-window window
|
||||
(dolist (handler dnd-protocol-alist)
|
||||
(let ((pattern (car handler))
|
||||
(handler (cdr handler)))
|
||||
(dolist (uri urls)
|
||||
(when (string-match pattern uri)
|
||||
(let ((cell (or (cdr (assq handler list))
|
||||
(let ((cell (cons handler nil)))
|
||||
(push cell list)
|
||||
cell))))
|
||||
(setcdr cell (cons uri (cdr cell))))))))
|
||||
(setq list (nreverse list))
|
||||
;; While unassessed handlers still exist...
|
||||
(while list
|
||||
;; Sort list by the number of URLs assigned to each handler.
|
||||
(setq list (sort list (lambda (first second)
|
||||
(> (length (cdr first))
|
||||
(length (cdr second))))))
|
||||
;; Call the handler in its car before removing each URL from
|
||||
;; URLs.
|
||||
(let ((handler (caar list))
|
||||
(entry-urls (cdar list)))
|
||||
(setq list (cdr list))
|
||||
(when entry-urls
|
||||
(if (and (symbolp handler)
|
||||
(get handler 'dnd-multiple-handler))
|
||||
(progn
|
||||
(let ((value (funcall handler entry-urls action)))
|
||||
(if (or (not return-value)
|
||||
(eq return-value value))
|
||||
(setq return-value value)
|
||||
(setq return-value 'private)))
|
||||
(dolist (url entry-urls)
|
||||
(setq urls (delq url urls))
|
||||
;; And each handler-URL list after this.
|
||||
(dolist (item list)
|
||||
(setcdr item (delq url (cdr item))))))
|
||||
(dolist (url entry-urls)
|
||||
(let ((value (funcall handler url action)))
|
||||
(if (or (not return-value) (eq return-value value))
|
||||
(setq return-value value)
|
||||
(setq return-value 'private)))
|
||||
(setq urls (delq url urls))
|
||||
;; And each handler-URL list after this.
|
||||
(dolist (item list)
|
||||
(setcdr item (delq url (cdr item)))))))))
|
||||
;; URLS should now incorporate only those which haven't been
|
||||
;; assigned their own handlers.
|
||||
(dolist (leftover urls)
|
||||
(setq return-value 'private)
|
||||
(if-let ((handler (browse-url-select-handler leftover
|
||||
'internal)))
|
||||
(funcall handler leftover action)
|
||||
(dnd-insert-text window action leftover)))
|
||||
(or return-value 'private))))
|
||||
|
||||
(defun dnd-get-local-file-uri (uri)
|
||||
"Return an uri converted to file:/// syntax if uri is a local file.
|
||||
|
|
|
|||
|
|
@ -238,10 +238,9 @@ WINDOW is the window where the drop happened.
|
|||
STRING is the uri-list as a string. The URIs are separated by \\r\\n."
|
||||
(let ((uri-list (split-string string "[\0\r\n]" t))
|
||||
retval)
|
||||
(dolist (bf uri-list)
|
||||
;; If one URL is handled, treat as if the whole drop succeeded.
|
||||
(let ((did-action (dnd-handle-one-url window action bf)))
|
||||
(when did-action (setq retval did-action))))
|
||||
(let ((did-action (dnd-handle-multiple-urls window uri-list
|
||||
action)))
|
||||
(when did-action (setq retval did-action)))
|
||||
retval))
|
||||
|
||||
(defun pgtk-dnd-handle-file-name (window action string)
|
||||
|
|
@ -252,17 +251,21 @@ STRING is the file names as a string, separated by nulls."
|
|||
(coding (or file-name-coding-system
|
||||
default-file-name-coding-system))
|
||||
retval)
|
||||
(dolist (bf uri-list)
|
||||
;; If one URL is handled, treat as if the whole drop succeeded.
|
||||
(if coding (setq bf (encode-coding-string bf coding)))
|
||||
(let* ((file-uri (concat "file://"
|
||||
(mapconcat 'url-hexify-string
|
||||
(split-string bf "/") "/")))
|
||||
(did-action (dnd-handle-one-url window action file-uri)))
|
||||
(when did-action (setq retval did-action))))
|
||||
(let ((did-action
|
||||
(dnd-handle-multiple-urls
|
||||
window action (mapcar
|
||||
(lambda (item)
|
||||
(when coding
|
||||
(setq item (encode-coding-string item
|
||||
coding)))
|
||||
(concat "file://"
|
||||
(mapconcat 'url-hexify-string
|
||||
(split-string item "/")
|
||||
"/")))
|
||||
uri-list))))
|
||||
(when did-action (setq retval did-action)))
|
||||
retval))
|
||||
|
||||
|
||||
(defun pgtk-dnd-choose-type (types &optional known-types)
|
||||
"Choose which type we want to receive for the drop.
|
||||
TYPES are the types the source of the drop offers, a vector of type names
|
||||
|
|
|
|||
|
|
@ -272,6 +272,7 @@ content:// URIs into the special file names which represent them."
|
|||
((eq (car message) 'uri)
|
||||
(let ((uri-list (split-string (cdr message)
|
||||
"[\0\r\n]" t))
|
||||
(new-uri-list nil)
|
||||
(dnd-unescape-file-uris t))
|
||||
(dolist (uri uri-list)
|
||||
(ignore-errors
|
||||
|
|
@ -286,7 +287,9 @@ content:// URIs into the special file names which represent them."
|
|||
;; subject to URI decoding, for it must be
|
||||
;; transformed back into a content URI.
|
||||
dnd-unescape-file-uris nil))))
|
||||
(dnd-handle-one-url (posn-window posn) 'copy uri)))))))
|
||||
(push uri new-uri-list))
|
||||
(dnd-handle-multiple-urls (posn-window posn) 'copy
|
||||
new-uri-list))))))
|
||||
|
||||
(define-key special-event-map [drag-n-drop] 'android-handle-dnd-event)
|
||||
|
||||
|
|
|
|||
|
|
@ -369,14 +369,15 @@ or a pair of markers) and turns it into a file system reference."
|
|||
((posn-area (event-start event)))
|
||||
((assoc "refs" string)
|
||||
(with-selected-window window
|
||||
(dolist (filename (cddr (assoc "refs" string)))
|
||||
(dnd-handle-one-url window action
|
||||
(concat "file:" filename)))))
|
||||
(dnd-handle-multiple-urls
|
||||
window (mapcar
|
||||
(lambda (name) (concat "file:" name))
|
||||
(cddr (assoc "refs" string)))
|
||||
action)))
|
||||
((assoc "text/uri-list" string)
|
||||
(dolist (text (cddr (assoc "text/uri-list" string)))
|
||||
(let ((uri-list (split-string text "[\0\r\n]" t)))
|
||||
(dolist (bf uri-list)
|
||||
(dnd-handle-one-url window action bf)))))
|
||||
(dnd-handle-multiple-urls window uri-list action))))
|
||||
((assoc "text/plain" string)
|
||||
(with-selected-window window
|
||||
(dolist (text (cddr (assoc "text/plain" string)))
|
||||
|
|
|
|||
|
|
@ -520,11 +520,12 @@ string dropped into the current buffer."
|
|||
(goto-char (posn-point (event-start event)))
|
||||
(cond ((or (memq 'ns-drag-operation-generic operations)
|
||||
(memq 'ns-drag-operation-copy operations))
|
||||
;; Perform the default/copy action.
|
||||
(dolist (data objects)
|
||||
(dnd-handle-one-url window 'private (if (eq type 'file)
|
||||
(concat "file:" data)
|
||||
data))))
|
||||
(let ((urls (if (eq type 'file) (mapcar
|
||||
(lambda (file)
|
||||
(concat "file:" file))
|
||||
objects)
|
||||
objects)))
|
||||
(dnd-handle-multiple-urls window urls 'private)))
|
||||
(t
|
||||
;; Insert the text as is.
|
||||
(dnd-insert-text window 'private string))))))
|
||||
|
|
|
|||
|
|
@ -48,45 +48,6 @@
|
|||
|
||||
(declare-function pgtk-use-im-context "pgtkim.c")
|
||||
|
||||
(defun pgtk-drag-n-drop (event &optional new-frame force-text)
|
||||
"Edit the files listed in the drag-n-drop EVENT.
|
||||
Switch to a buffer editing the last file dropped."
|
||||
(interactive "e")
|
||||
(let* ((window (posn-window (event-start event)))
|
||||
(arg (car (cdr (cdr event))))
|
||||
(type (car arg))
|
||||
(data (car (cdr arg)))
|
||||
(url-or-string (cond ((eq type 'file)
|
||||
(concat "file:" data))
|
||||
(t data))))
|
||||
(set-frame-selected-window nil window)
|
||||
(when new-frame
|
||||
(select-frame (make-frame)))
|
||||
(raise-frame)
|
||||
(setq window (selected-window))
|
||||
(if force-text
|
||||
(dnd-insert-text window 'private data)
|
||||
(dnd-handle-one-url window 'private url-or-string))))
|
||||
|
||||
(defun pgtk-drag-n-drop-other-frame (event)
|
||||
"Edit the files listed in the drag-n-drop EVENT, in other frames.
|
||||
May create new frames, or reuse existing ones. The frame editing
|
||||
the last file dropped is selected."
|
||||
(interactive "e")
|
||||
(pgtk-drag-n-drop event t))
|
||||
|
||||
(defun pgtk-drag-n-drop-as-text (event)
|
||||
"Drop the data in EVENT as text."
|
||||
(interactive "e")
|
||||
(pgtk-drag-n-drop event nil t))
|
||||
|
||||
(defun pgtk-drag-n-drop-as-text-other-frame (event)
|
||||
"Drop the data in EVENT as text in a new frame."
|
||||
(interactive "e")
|
||||
(pgtk-drag-n-drop event t t))
|
||||
|
||||
(global-set-key [drag-n-drop] 'pgtk-drag-n-drop)
|
||||
|
||||
(defun pgtk-suspend-error ()
|
||||
"Don't allow suspending if any of the frames are PGTK frames."
|
||||
(if (memq 'pgtk (mapcar 'window-system (frame-list)))
|
||||
|
|
@ -392,7 +353,6 @@ Users should not call this function; see `device-class' instead."
|
|||
|
||||
(defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips)
|
||||
|
||||
|
||||
(define-key special-event-map [drag-n-drop] #'pgtk-dnd-handle-drag-n-drop-event)
|
||||
(add-hook 'after-make-frame-functions #'pgtk-dnd-init-frame)
|
||||
|
||||
|
|
|
|||
|
|
@ -117,12 +117,14 @@
|
|||
(split-string (encode-coding-string f coding)
|
||||
"/")
|
||||
"/")))
|
||||
(dnd-handle-one-url window 'private
|
||||
(concat
|
||||
(if (eq system-type 'cygwin)
|
||||
"file://"
|
||||
"file:")
|
||||
file-name)))
|
||||
;; FIXME: is the W32 build capable only of receiving a single file
|
||||
;; from each drop?
|
||||
(dnd-handle-multiple-urls window (list (concat
|
||||
(if (eq system-type 'cygwin)
|
||||
"file://"
|
||||
"file:")
|
||||
file-name))
|
||||
'private))
|
||||
|
||||
(defun w32-drag-n-drop (event &optional new-frame)
|
||||
"Edit the files listed in the drag-n-drop EVENT.
|
||||
|
|
|
|||
|
|
@ -369,10 +369,9 @@ WINDOW is the window where the drop happened.
|
|||
STRING is the uri-list as a string. The URIs are separated by \\r\\n."
|
||||
(let ((uri-list (split-string string "[\0\r\n]" t))
|
||||
retval)
|
||||
(dolist (bf uri-list)
|
||||
;; If one URL is handled, treat as if the whole drop succeeded.
|
||||
(let ((did-action (dnd-handle-one-url window action bf)))
|
||||
(when did-action (setq retval did-action))))
|
||||
(let ((did-action (dnd-handle-multiple-urls window uri-list
|
||||
action)))
|
||||
(when did-action (setq retval did-action)))
|
||||
retval))
|
||||
|
||||
(defun x-dnd-handle-file-name (window action string)
|
||||
|
|
@ -383,17 +382,21 @@ STRING is the file names as a string, separated by nulls."
|
|||
(coding (or file-name-coding-system
|
||||
default-file-name-coding-system))
|
||||
retval)
|
||||
(dolist (bf uri-list)
|
||||
;; If one URL is handled, treat as if the whole drop succeeded.
|
||||
(if coding (setq bf (encode-coding-string bf coding)))
|
||||
(let* ((file-uri (concat "file://"
|
||||
(mapconcat 'url-hexify-string
|
||||
(split-string bf "/") "/")))
|
||||
(did-action (dnd-handle-one-url window action file-uri)))
|
||||
(when did-action (setq retval did-action))))
|
||||
(let ((did-action
|
||||
(dnd-handle-multiple-urls
|
||||
window action (mapcar
|
||||
(lambda (item)
|
||||
(when coding
|
||||
(setq item (encode-coding-string item
|
||||
coding)))
|
||||
(concat "file://"
|
||||
(mapconcat 'url-hexify-string
|
||||
(split-string item "/")
|
||||
"/")))
|
||||
uri-list))))
|
||||
(when did-action (setq retval did-action)))
|
||||
retval))
|
||||
|
||||
|
||||
(defun x-dnd-choose-type (types &optional known-types)
|
||||
"Choose which type we want to receive for the drop.
|
||||
TYPES are the types the source of the drop offers, a vector of type names
|
||||
|
|
|
|||
|
|
@ -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.")
|
||||
|
|
@ -437,5 +438,100 @@ 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))))))
|
||||
|
||||
(provide 'dnd-tests)
|
||||
;;; dnd-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue