(autoload 'gnus-setup-posting-charset "gnus-msg")
(autoload 'gnus-add-minor-mode "gnus-ems")
(autoload 'message-fetch-field "message")
+ (autoload 'fill-flowed-encode "flow-fill")
(autoload 'message-posting-charset "message"))
(defcustom mml-content-type-parameters
handle. FUNCTION is a Lisp function which is called with the MML
handle to tweak the part.")
-(defvar mml-tweak-sexp-alist
+(defvar mml-tweak-sexp-alist
'((mml-externalize-attachments . mml-tweak-externalize-attachments))
"A list of (SEXP . FUNCTION) for tweaking MML parts.
SEXP is a s-expression. If the evaluation of SEXP is non-nil, FUNCTION
(while (and (not (eobp))
(not (looking-at "<#/multipart")))
(cond
+ ((looking-at "<#secure")
+ ;; The secure part is essentially a meta-meta tag, which
+ ;; expands to either a part tag if there are no other parts in
+ ;; the document or a multipart tag if there are other parts
+ ;; included in the message
+ (let* (secure-mode
+ (taginfo (mml-read-tag))
+ (recipients (cdr (assq 'recipients taginfo)))
+ (location (cdr (assq 'tag-location taginfo))))
+ (save-excursion
+ (if
+ (re-search-forward
+ "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
+ (setq secure-mode "multipart")
+ (setq secure-mode "part")))
+ (save-excursion
+ (goto-char location)
+ (re-search-forward "<#secure[^\n]*>\n"))
+ (delete-region (match-beginning 0) (match-end 0))
+ (mml-insert-tag secure-mode
+ (cdr (assq 'mode taginfo))
+ (cdr (assq 'method taginfo))
+ (and recipients 'recipients)
+ recipients)
+ ;; restart the parse
+ (goto-char location)))
((looking-at "<#multipart")
(push (nconc (mml-read-tag) (mml-parse-1)) struct))
((looking-at "<#external")
(list
(intern (downcase (cdr (assq 'charset tag))))))
(t
- (mm-find-mime-charset-region point (point)
+ (mm-find-mime-charset-region point (point)
mm-hack-charsets))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
(setq contents (append (list (cons 'tag-location orig-point)) contents))
(cons (intern name) (nreverse contents))))
+(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+ (let ((str (buffer-substring-no-properties start end))
+ (bufstart start) tmp)
+ (while (setq tmp (text-property-any start end 'hard 't))
+ (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
+ '(hard t) str)
+ (setq start (1+ tmp)))
+ str))
+
(defun mml-read-part (&optional mml)
"Return the buffer up till the next part, multipart or closing part or multipart.
If MML is non-nil, return the buffer up till the correspondent mml tag."
(if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
- (buffer-substring-no-properties beg (if (> count 0)
- (point)
- (match-beginning 0))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (if (> count 0)
+ (point)
+ (match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
- (buffer-substring-no-properties beg (match-beginning 0))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
- (buffer-substring-no-properties beg (goto-char (point-max)))))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
(cond
((or (eq (car cont) 'part) (eq (car cont) 'mml))
(let ((raw (cdr (assq 'raw cont)))
- coded encoding charset filename type)
+ coded encoding charset filename type flowed)
(setq type (or (cdr (assq 'type cont)) "text/plain"))
(if (and (not raw)
(member (car (split-string type "/")) '("text" "message")))
(setq charset (mm-encode-body charset))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
+ ;; Only perform format=flowed filling on text/plain
+ ;; parts where there either isn't a format parameter
+ ;; 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")
+ (or (null (assq 'format cont))
+ (string= (assq 'format cont) "flowed"))
+ (setq use-hard-newlines
+ (text-property-any
+ (point-min) (point-max) 'hard 't)))
+ (fill-flowed-encode)
+ ;; Indicate that `mml-insert-mime-headers' should
+ ;; insert a "; format=flowed" string unless the
+ ;; user has already specified it.
+ (setq flowed (null (assq 'format cont)))))
(setq coded (buffer-string)))
- (mml-insert-mime-headers cont type charset encoding)
+ (mml-insert-mime-headers cont type charset encoding flowed)
(insert "\n")
(insert coded))
(mm-with-unibyte-buffer
(insert (cdr (assq 'contents cont)))))
(setq encoding (mm-encode-buffer type)
coded (mm-string-as-multibyte (buffer-string))))
- (mml-insert-mime-headers cont type charset encoding)
+ (mml-insert-mime-headers cont type charset encoding nil)
(insert "\n")
(mm-with-unibyte-current-buffer
(insert coded)))))
(if (setq sender (cdr (assq 'sender cont)))
(message-options-set 'message-sender sender))
(if (setq recipients (cdr (assq 'recipients cont)))
- (message-options-set 'message-sender recipients))
+ (message-options-set 'message-recipients recipients))
(funcall (nth 1 item) cont)))
(let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist))
sender recipients)
(if (setq sender (cdr (assq 'sender cont)))
(message-options-set 'message-sender sender))
(if (setq recipients (cdr (assq 'recipients cont)))
- (message-options-set 'message-sender recipients))
+ (message-options-set 'message-recipients recipients))
(funcall (nth 1 item) cont))))))
(defun mml-compute-boundary (cont)
"")
mml-base-boundary))
-(defun mml-insert-mime-headers (cont type charset encoding)
+(defun mml-insert-mime-headers (cont type charset encoding flowed)
(let (parameters disposition description)
(setq parameters
(mml-parameter-string
cont mml-content-type-parameters))
(when (or charset
parameters
+ flowed
(not (equal type mml-generate-default-type)))
(when (consp charset)
(error
(when charset
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
+ (when flowed
+ (insert "; format=flowed"))
(when parameters
(mml-insert-parameter-string
cont mml-content-type-parameters))
(encrypt (make-sparse-keymap))
(map (make-sparse-keymap))
(main (make-sparse-keymap)))
- (define-key sign "p" 'mml-secure-sign-pgpmime)
- (define-key sign "o" 'mml-secure-sign-pgp)
- (define-key sign "s" 'mml-secure-sign-smime)
- (define-key encrypt "p" 'mml-secure-encrypt-pgpmime)
- (define-key encrypt "o" 'mml-secure-encrypt-pgp)
- (define-key encrypt "s" 'mml-secure-encrypt-smime)
+ (define-key sign "p" 'mml-secure-message-sign-pgpmime)
+ (define-key sign "o" 'mml-secure-message-sign-pgp)
+ (define-key sign "s" 'mml-secure-message-sign-smime)
+ (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
+ (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
+ (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
(define-key map "f" 'mml-attach-file)
(define-key map "b" 'mml-attach-buffer)
(define-key map "e" 'mml-attach-external)
["Attach External" mml-attach-external t]
["Insert Part" mml-insert-part t]
["Insert Multipart" mml-insert-multipart t]
- ["PGP/MIME Sign" mml-secure-sign-pgpmime t]
- ["PGP/MIME Encrypt" mml-secure-encrypt-pgpmime t]
- ["PGP Sign" mml-secure-sign-pgp t]
- ["PGP Encrypt" mml-secure-encrypt-pgp t]
- ["S/MIME Sign" mml-secure-sign-smime t]
- ["S/MIME Encrypt" mml-secure-encrypt-smime t]
+ ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t]
+ ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t]
+ ["PGP Sign" mml-secure-message-sign-pgp t]
+ ["PGP Encrypt" mml-secure-message-encrypt-pgp t]
+ ["S/MIME Sign" mml-secure-message-sign-smime t]
+ ["S/MIME Encrypt" mml-secure-message-encrypt-smime t]
;;["Narrow" mml-narrow-to-part t]
["Quote MML" mml-quote-region t]
["Validate MML" mml-validate t]
"Display current buffer with Gnus, in a new buffer.
If RAW, don't highlight the article."
(interactive "P")
- (let* ((buf (current-buffer))
- (message-options message-options)
- (message-this-is-news (message-news-p))
- (message-posting-charset (or (gnus-setup-posting-charset
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups")))
- message-posting-charset)))
- (message-options-set-recipient)
- (switch-to-buffer (generate-new-buffer
- (concat (if raw "*Raw MIME preview of "
- "*MIME preview of ") (buffer-name))))
- (erase-buffer)
- (insert-buffer buf)
- (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.
- (mml-to-mime))
- (if raw
- (when (fboundp 'set-buffer-multibyte)
- (let ((s (buffer-string)))
- ;; Insert the content into unibyte buffer.
- (erase-buffer)
- (mm-disable-multibyte)
- (insert s)))
- (let ((gnus-newsgroup-charset (car message-posting-charset)))
- (run-hooks 'gnus-article-decode-hook)
- (let ((gnus-newsgroup-name "dummy"))
- (gnus-article-prepare-display))))
- ;; Disable article-mode-map.
- (use-local-map nil)
- (setq buffer-read-only t)
- (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
- (goto-char (point-min))))
+ (save-excursion
+ (let* ((buf (current-buffer))
+ (message-options message-options)
+ (message-this-is-news (message-news-p))
+ (message-posting-charset (or (gnus-setup-posting-charset
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Newsgroups")))
+ message-posting-charset)))
+ (message-options-set-recipient)
+ (switch-to-buffer (generate-new-buffer
+ (concat (if raw "*Raw MIME preview of "
+ "*MIME preview of ") (buffer-name))))
+ (erase-buffer)
+ (insert-buffer buf)
+ (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.
+ (mml-to-mime))
+ (if raw
+ (when (fboundp 'set-buffer-multibyte)
+ (let ((s (buffer-string)))
+ ;; Insert the content into unibyte buffer.
+ (erase-buffer)
+ (mm-disable-multibyte)
+ (insert s)))
+ (let ((gnus-newsgroup-charset (car message-posting-charset))
+ gnus-article-prepare-hook gnus-original-article-buffer)
+ (run-hooks 'gnus-article-decode-hook)
+ (let ((gnus-newsgroup-name "dummy"))
+ (gnus-article-prepare-display))))
+ ;; Disable article-mode-map.
+ (use-local-map nil)
+ (setq buffer-read-only t)
+ (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
+ (goto-char (point-min)))))
(defun mml-validate ()
"Validate the current MML document."
(defun mml-tweak-externalize-attachments (cont)
"Tweak attached files as external parts."
(let (filename-cons)
- (when (and (eq (car cont) 'part)
+ (when (and (eq (car cont) 'part)
(not (cdr (assq 'buffer cont)))
(and (setq filename-cons (assq 'filename cont))
(not (equal (cdr (assq 'nofile cont)) "yes"))))