;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
:type 'boolean
:group 'message)
+(defcustom mml-enable-flowed t
+ "If non-nil, enable format=flowed usage when encoding a message.
+This is only performed when filling on text/plain with hard
+newlines in the text."
+ :version "24.1"
+ :type 'boolean
+ :group 'message)
+
(defvar mml-tweak-type-alist nil
"A list of (TYPE . FUNCTION) for tweaking MML parts.
TYPE is a string containing a regexp to match the MIME type. FUNCTION
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
(defvar mml-multipart-number 0)
+(defvar mml-inhibit-compute-boundary nil)
(defun mml-generate-mime ()
"Generate a MIME message based on the current MML document."
(let ((cont (mml-parse))
- (mml-multipart-number mml-multipart-number))
+ (mml-multipart-number mml-multipart-number)
+ (options message-options))
(if (not cont)
nil
- (mm-with-multibyte-buffer
- (if (and (consp (car cont))
- (= (length cont) 1))
- (mml-generate-mime-1 (car cont))
- (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
- cont)))
- (buffer-string)))))
+ (prog1
+ (mm-with-multibyte-buffer
+ (setq message-options options)
+ (if (and (consp (car cont))
+ (= (length cont) 1))
+ (mml-generate-mime-1 (car cont))
+ (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
+ cont)))
+ (setq options message-options)
+ (buffer-string))
+ (setq message-options options)))))
(defun mml-generate-mime-1 (cont)
(let ((mm-use-ultra-safe-encoding
;; Remove quotes from quoted tags.
(goto-char (point-min))
(while (re-search-forward
- "<#!+/?\\(part\\|multipart\\|external\\|mml\\)"
+ "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)"
nil t)
(delete-region (+ (match-beginning 0) 2)
(+ (match-beginning 0) 3))))))
(mml-to-mime)
;; Update handle so mml-compute-boundary can
;; detect collisions with the nested parts.
- (setcdr (assoc 'contents cont) (buffer-string)))
+ (unless mml-inhibit-compute-boundary
+ (setcdr (assoc 'contents cont) (buffer-string))))
(let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
;; ignore 0x1b, it is part of iso-2022-jp
(setq encoding (mm-body-7-or-8))))
;; in the mml tag or it says "flowed" and there
;; actually are hard newlines in the text.
(let (use-hard-newlines)
- (when (and (string= type "text/plain")
+ (when (and mml-enable-flowed
+ (string= type "text/plain")
(not (string= (cdr (assq 'sign cont)) "pgp"))
(or (null (assq 'format cont))
(string= (cdr (assq 'format cont))
"Return a unique boundary that does not exist in CONT."
(let ((mml-boundary (funcall mml-boundary-function
(incf mml-multipart-number))))
- ;; This function tries again and again until it has found
- ;; a unique boundary.
- (while (not (catch 'not-unique
- (mml-compute-boundary-1 cont))))
+ (unless mml-inhibit-compute-boundary
+ ;; This function tries again and again until it has found
+ ;; a unique boundary.
+ (while (not (catch 'not-unique
+ (mml-compute-boundary-1 cont)))))
mml-boundary))
(defun mml-compute-boundary-1 (cont)
- (let (filename)
- (cond
- ((member (car cont) '(part mml))
- (with-temp-buffer
- (cond
- ((cdr (assq 'buffer cont))
- (insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and (setq filename (cdr (assq 'filename cont)))
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (mm-insert-file-contents filename nil nil nil nil t))
- (t
- (insert (cdr (assq 'contents cont)))))
- (goto-char (point-min))
- (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
- nil t)
- (setq mml-boundary (funcall mml-boundary-function
- (incf mml-multipart-number)))
- (throw 'not-unique nil))))
- ((eq (car cont) 'multipart)
- (mapc 'mml-compute-boundary-1 (cddr cont))))
- t))
+ (cond
+ ((member (car cont) '(part mml))
+ (mm-with-multibyte-buffer
+ (let ((mml-inhibit-compute-boundary t)
+ (mml-multipart-number 0)
+ mml-sign-alist mml-encrypt-alist)
+ (mml-generate-mime-1 cont))
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
+ nil t)
+ (setq mml-boundary (funcall mml-boundary-function
+ (incf mml-multipart-number)))
+ (throw 'not-unique nil))))
+ ((eq (car cont) 'multipart)
+ (mapc 'mml-compute-boundary-1 (cddr cont))))
+ t)
(defun mml-make-boundary (number)
(concat (make-string (% number 60) ?=)
(autoload 'message-encode-message-body "message")
(declare-function message-narrow-to-headers-or-head "message" ())
+;;;###autoload
(defun mml-to-mime ()
"Translate the current buffer from MML to MIME."
;; `message-encode-message-body' will insert an encoded Content-Description
(goto-char (point-min))
;; Quote parts.
(while (re-search-forward
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
+ "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)" nil t)
;; Insert ! after the #.
(goto-char (+ (match-beginning 0) 2))
(insert "!")))))
:version "22.1" ;; Gnus 5.10.9
:group 'message)
+;;;###autoload
(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
"Display current buffer with Gnus, in a new buffer.
If RAW, display a raw encoded MIME message.
-The window layout for the preview buffer is controled by the variables
+The window layout for the preview buffer is controlled by the variables
`special-display-buffer-names', `special-display-regexps', or
`gnus-buffer-configuration' (the first match made will be used),
or the `pop-to-buffer' function."
(require 'gnus-msg) ; for gnus-setup-posting-charset
(save-excursion
(let* ((buf (current-buffer))
+ (article-editing (eq major-mode 'gnus-article-edit-mode))
(message-options message-options)
(message-this-is-mail (message-mail-p))
(message-this-is-news (message-news-p))
(mml-preview-insert-mail-followup-to)
(let ((message-deletable-headers (if (message-news-p)
nil
- message-deletable-headers)))
+ message-deletable-headers))
+ (mail-header-separator (if article-editing
+ ""
+ mail-header-separator)))
(message-generate-headers
(copy-sequence (if (message-news-p)
message-required-news-headers
- message-required-mail-headers))))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
- (replace-match "\n"))
- (let ((mail-header-separator ""));; mail-header-separator is removed.
+ message-required-mail-headers)))
+ (unless article-editing
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (replace-match "\n"))
+ (setq mail-header-separator ""))
(message-sort-headers)
(mml-to-mime))
(if raw
(mm-disable-multibyte)
(insert s)))
(let ((gnus-newsgroup-charset (car message-posting-charset))
- gnus-article-prepare-hook gnus-original-article-buffer)
+ gnus-article-prepare-hook gnus-original-article-buffer
+ gnus-displaying-mime)
(run-hooks 'gnus-article-decode-hook)
(let ((gnus-newsgroup-name "dummy")
(gnus-newsrc-hashtb (or gnus-newsrc-hashtb
projects / gnus / blobdiff