@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
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
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
\f
* 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.
(,(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'.
`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
(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.
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)
(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
((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
;; 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)
((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)))
(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))))))
(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)))
(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)
(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.
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)
(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
(require 'tramp)
(require 'select)
(require 'ert-x)
+(require 'browse-url)
(defvar dnd-tests-selection-table nil
"Alist of selection names to their values.")
(ignore-errors
(delete-file normal-temp-file)))))
+\f
+
+(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
projects / emacs.git / commitdiff