;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(autoload 'message-fetch-field "message")
(autoload 'message-mark-active-p "message")
(autoload 'fill-flowed-encode "flow-fill")
- (autoload 'message-posting-charset "message")
- (autoload 'x-dnd-get-local-file-name "x-dnd"))
+ (autoload 'message-posting-charset "message"))
+
+(eval-when-compile
+ (autoload 'dnd-get-local-file-name "dnd"))
+
+(defvar gnus-article-mime-handles)
+(defvar gnus-mouse-2)
+(defvar gnus-newsrc-hashtb)
+(defvar message-default-charset)
+(defvar message-deletable-headers)
+(defvar message-options)
+(defvar message-posting-charset)
+(defvar message-required-mail-headers)
+(defvar message-required-news-headers)
(defcustom mml-content-type-parameters
'(name access-type expiration size permission format)
with unknown encoding; `multipart': always send messages with more than
one charsets.")
-(defvar mml-generate-default-type "text/plain")
+(defvar mml-generate-default-type "text/plain"
+ "Content type by which the Content-Type header can be omitted.
+The Content-Type header will not be put in the MIME part if the type
+equals the value and there's no parameter (e.g. charset, format, etc.)
+and `mml-insert-mime-headers-always' is nil. The value will be bound
+to \"message/rfc822\" when encoding an article to be forwarded as a MIME
+part. This is for the internal use, you should never modify the value.")
(defvar mml-buffer-list nil)
(mml-tweak-part cont)
(cond
((or (eq (car cont) 'part) (eq (car cont) 'mml))
- (let ((raw (cdr (assq 'raw cont)))
- type charset coding filename encoding flowed coded)
- (setq type (or (cdr (assq 'type cont)) "text/plain")
- charset (cdr (assq 'charset cont))
- coding (mm-charset-to-coding-system charset))
+ (let* ((raw (cdr (assq 'raw cont)))
+ (filename (cdr (assq 'filename cont)))
+ (type (or (cdr (assq 'type cont))
+ (if filename
+ (or (mm-default-file-encoding filename)
+ "application/octet-stream")
+ "text/plain")))
+ (charset (cdr (assq 'charset cont)))
+ (coding (mm-charset-to-coding-system charset))
+ encoding flowed coded)
(cond ((eq coding 'ascii)
(setq charset nil
coding nil))
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and (setq filename (cdr (assq 'filename cont)))
+ ((and filename
(not (equal (cdr (assq 'nofile cont)) "yes")))
(let ((coding-system-for-read coding))
(mm-insert-file-contents filename)))
(cond
((eq (car cont) 'mml)
(let ((mml-boundary (mml-compute-boundary cont))
+ ;; It is necessary for the case where this
+ ;; function is called recursively since
+ ;; `m-g-d-t' will be bound to "message/rfc822"
+ ;; when encoding an article to be forwarded.
(mml-generate-default-type "text/plain"))
(mml-to-mime))
(let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
(insert (with-current-buffer (cdr (assq 'buffer cont))
(mm-with-unibyte-current-buffer
(buffer-string)))))
- ((and (setq filename (cdr (assq 'filename cont)))
+ ((and filename
(not (equal (cdr (assq 'nofile cont)) "yes")))
(let ((coding-system-for-read mm-binary-coding-system))
(mm-insert-file-contents filename nil nil nil nil t))
"access-type=url"))
(when parameters
(mml-insert-parameter-string
- cont '(expiration size permission))))
- (insert "\n\n")
- (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
- (insert "Content-ID: " (message-make-message-id) "\n")
- (insert "Content-Transfer-Encoding: "
- (or (cdr (assq 'encoding cont)) "binary"))
- (insert "\n\n")
- (insert (or (cdr (assq 'contents cont))))
- (insert "\n"))
+ cont '(expiration size permission)))
+ (insert "\n\n")
+ (insert "Content-Type: "
+ (or (cdr (assq 'type cont))
+ (if name
+ (or (mm-default-file-encoding name)
+ "application/octet-stream")
+ "text/plain"))
+ "\n")
+ (insert "Content-ID: " (message-make-message-id) "\n")
+ (insert "Content-Transfer-Encoding: "
+ (or (cdr (assq 'encoding cont)) "binary"))
+ (insert "\n\n")
+ (insert (or (cdr (assq 'contents cont))))
+ (insert "\n")))
((eq (car cont) 'multipart)
(let* ((type (or (cdr (assq 'type cont)) "mixed"))
(mml-generate-default-type (if (equal type "digest")
(> (prefix-numeric-value arg) 0)))
(add-minor-mode 'mml-mode " MML" mml-mode-map)
(easy-menu-add mml-menu mml-mode-map)
- (when (boundp 'x-dnd-protocol-alist)
- (set (make-local-variable 'x-dnd-protocol-alist)
- '(("^file:///" . mml-x-dnd-attach-file)
- ("^file://" . x-dnd-open-file)
- ("^file:" . mml-x-dnd-attach-file))))
+ (when (boundp 'dnd-protocol-alist)
+ (set (make-local-variable 'dnd-protocol-alist)
+ (append mml-dnd-protocol-alist
+ (symbol-value 'dnd-protocol-alist))))
(run-hooks 'mml-mode-hook)))
;;;
description))
(defun mml-minibuffer-read-disposition (type &optional default)
- (let* ((default (or default
- (if (string-match "^text/.*" type)
- "inline"
- "attachment")))
- (disposition (completing-read "Disposition: "
- '(("attachment") ("inline") (""))
- nil t)))
+ (unless default (setq default
+ (if (and (string-match "\\`text/" type)
+ (not (string-match "\\`text/rtf\\'" type)))
+ "inline"
+ "attachment")))
+ (let ((disposition (completing-read
+ (format "Disposition (default %s): " default)
+ '(("attachment") ("inline") (""))
+ nil t nil nil default)))
(if (not (equal disposition ""))
disposition
default)))
;;; Attachment functions.
+(defcustom mml-dnd-protocol-alist
+ '(("^file:///" . mml-dnd-attach-file)
+ ("^file://" . dnd-open-file)
+ ("^file:" . mml-dnd-attach-file))
+ "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."
+ :type '(choice (repeat (cons (regexp) (function)))
+ (const :tag "Behave as in other buffers" nil))
+ :version "23.0" ;; No Gnus
+ :group 'message)
+
+(defcustom mml-dnd-attach-options nil
+ "Which options should be queried when attaching a file via drag and drop.
+
+If it is a list, valid members are `type', `description' and
+`disposition'. `disposition' implies `type'. If it is nil,
+don't ask for options. If it is t, ask the user whether or not
+to specify options."
+ :type '(choice
+ (const :tag "Non" nil)
+ (const :tag "Query" t)
+ (list :value (type description disposition)
+ (set :inline t
+ (const type)
+ (const description)
+ (const disposition))))
+ :version "23.0" ;; No Gnus
+ :group 'message)
+
(defun mml-attach-file (file &optional type description disposition)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
'disposition (or disposition "attachment")
'description description))
-(defun mml-x-dnd-attach-file (uri action)
- "Attach a drag and drop file."
- (let ((file (x-dnd-get-local-file-name uri t)))
+(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* ((type (mml-minibuffer-read-type file))
- (description (mml-minibuffer-read-description))
- (disposition (mml-minibuffer-read-disposition type)))
+ (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)))
(mml-attach-file file type description disposition)))))
(defun mml-attach-buffer (buffer &optional type description)
(goto-char (point-min))))
(if (and (boundp 'gnus-buffer-configuration)
(assq 'mml-preview gnus-buffer-configuration))
- (gnus-configure-windows 'mml-preview)
+ (let ((gnus-message-buffer (current-buffer)))
+ (gnus-configure-windows 'mml-preview))
(pop-to-buffer mml-preview-buffer)))
(defun mml-validate ()
projects / elisp / gnus.git- / blobdiff