diff options
Diffstat (limited to 'lisp/gnus/mml.el')
| -rw-r--r-- | lisp/gnus/mml.el | 74 |
1 files changed, 42 insertions, 32 deletions
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 84f895e7e8f..edb3c286242 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1369,9 +1369,9 @@ If not set, `default-directory' will be used." ;;; Attachment functions. (defcustom mml-dnd-protocol-alist - '(("^file:///" . mml-dnd-attach-file) - ("^file://" . dnd-open-file) - ("^file:" . mml-dnd-attach-file)) + '(("^file:///" . mml-dnd-attach-file) ; GNOME, KDE, and suchlike. + ("^file:/[^/]" . mml-dnd-attach-file) ; Motif, other systems. + ("^file:[^/]" . mml-dnd-attach-file)) ; MS-Windows. "The functions to call when a drop in `mml-mode' is made. See `dnd-protocol-alist' for more information. When nil, behave as in other buffers." @@ -1460,34 +1460,43 @@ will be computed and used." (file-name-nondirectory file))) (goto-char at-end)))) -(defun mml-dnd-attach-file (uri _action) - "Attach a drag and drop file. - -Ask for type, description or disposition according to -`mml-dnd-attach-options'." - (let ((file (dnd-get-local-file-name uri t))) - (when (and file (file-regular-p file)) - (let ((mml-dnd-attach-options mml-dnd-attach-options) - type description disposition) - (setq mml-dnd-attach-options - (when (and (eq mml-dnd-attach-options t) - (not - (y-or-n-p - "Use default type, disposition and description? "))) - '(type description disposition))) - (when (or (memq 'type mml-dnd-attach-options) - (memq 'disposition mml-dnd-attach-options)) - (setq type (mml-minibuffer-read-type file))) - (when (memq 'description mml-dnd-attach-options) - (setq description (mml-minibuffer-read-description))) - (when (memq 'disposition mml-dnd-attach-options) - (setq disposition (mml-minibuffer-read-disposition type nil file))) - (mml-attach-file file type description disposition))))) - -(defun mml-attach-buffer (buffer &optional type description disposition) +(defun mml-dnd-attach-file (uris _action) + "Attach a drag and drop URIS, a list of local file URIs. + +Query whether to use the types, dispositions and descriptions +default for each URL, subject to `mml-dnd-attach-options'. + +Return the action `private', communicating to the drop source +that the file has been attached." + (let (file (mml-dnd-attach-options mml-dnd-attach-options)) + (setq mml-dnd-attach-options + (when (and (eq mml-dnd-attach-options t) + (not + (y-or-n-p + "Use default type, disposition and description? "))) + '(type description disposition))) + (dolist (uri uris) + (setq file (dnd-get-local-file-name uri t)) + (when (and file (file-regular-p file)) + (let (type description disposition) + (when (or (memq 'type mml-dnd-attach-options) + (memq 'disposition mml-dnd-attach-options)) + (setq type (mml-minibuffer-read-type file))) + (when (memq 'description mml-dnd-attach-options) + (setq description (mml-minibuffer-read-description))) + (when (memq 'disposition mml-dnd-attach-options) + (setq disposition (mml-minibuffer-read-disposition type nil file))) + (mml-attach-file file type description disposition))))) + 'private) + +(put 'mml-dnd-attach-file 'dnd-multiple-handler t) + +(defun mml-attach-buffer (buffer &optional type description disposition filename) "Attach a buffer to the outgoing MIME message. BUFFER is the name of the buffer to attach. See -`mml-attach-file' for details of operation." +`mml-attach-file' regarding TYPE, DESCRIPTION and DISPOSITION. +FILENAME is a suggested file name for the attachment should a +recipient wish to save a copy separate from the message." (interactive (let* ((buffer (read-buffer "Attach buffer: ")) (type (mml-minibuffer-read-type buffer "text/plain")) @@ -1497,9 +1506,10 @@ BUFFER is the name of the buffer to attach. See ;; If in the message header, attach at the end and leave point unchanged. (let ((head (unless (message-in-body-p) (point)))) (if head (goto-char (point-max))) - (mml-insert-empty-tag 'part 'type type 'buffer buffer - 'disposition disposition - 'description description) + (apply #'mml-insert-empty-tag + 'part 'type type 'buffer buffer + 'disposition disposition 'description description + (and filename `(filename ,filename))) ;; When using Mail mode, make sure it does the mime encoding ;; when you send the message. (or (eq mail-user-agent 'message-user-agent) |