;;; 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"))
(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)
;; included in the message
(let* (secure-mode
(taginfo (mml-read-tag))
+ (keyfile (cdr (assq 'keyfile taginfo)))
+ (certfile (cdr (assq 'certfile taginfo)))
(recipients (cdr (assq 'recipients taginfo)))
(sender (cdr (assq 'sender taginfo)))
(location (cdr (assq 'tag-location taginfo)))
(setq tags (list "sign" method "encrypt" method))))
(eval `(mml-insert-tag ,secure-mode
,@tags
+ ,(if keyfile "keyfile")
+ ,keyfile
+ ,(if certfile "certfile")
+ ,certfile
,(if recipients "recipients")
,recipients
,(if sender "sender")
(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)
+ '(("^file:///" . mml-dnd-attach-file)
+ ("^file://" . dnd-open-file)
+ ("^file:" . mml-dnd-attach-file))))
(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)))
'disposition (or disposition "attachment")
'description description))
-(defun mml-x-dnd-attach-file (uri action)
+(defun mml-dnd-attach-file (uri action)
"Attach a drag and drop file."
- (let ((file (x-dnd-get-local-file-name uri t)))
+ (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))
(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 / gnus / blobdiff