;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-;; For Emacs < 22.2.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mm-util)
(require 'mm-bodies)
(require 'mm-encode)
(require 'mm-decode)
(require 'mml-sec)
(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (autoload 'message-make-message-id "message")
- (autoload 'gnus-setup-posting-charset "gnus-msg")
- (autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'message-fetch-field "message")
- (autoload 'message-mark-active-p "message")
- (autoload 'message-info "message")
- (autoload 'fill-flowed-encode "flow-fill")
- (autoload 'message-posting-charset "message")
- (autoload 'dnd-get-local-file-name "dnd"))
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
+
+(autoload 'message-make-message-id "message")
+(declare-function gnus-setup-posting-charset "gnus-msg" (group))
+(autoload 'gnus-make-local-hook "gnus-util")
+(autoload 'gnus-completing-read "gnus-util")
+(autoload 'message-fetch-field "message")
+(autoload 'message-mark-active-p "message")
+(autoload 'message-info "message")
+(autoload 'fill-flowed-encode "flow-fill")
+(autoload 'message-posting-charset "message")
+(autoload 'dnd-get-local-file-name "dnd")
(autoload 'message-options-set "message")
(autoload 'message-narrow-to-head "message")
,dispositions))))
:group 'message)
-(defcustom mml-insert-mime-headers-always nil
+(defcustom mml-insert-mime-headers-always t
"If non-nil, always put Content-Type: text/plain at top of empty parts.
It is necessary to work against a bug in certain clients."
- :version "22.1"
+ :version "24.1"
+ :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)
(let* (secure-mode
(taginfo (mml-read-tag))
(keyfile (cdr (assq 'keyfile taginfo)))
- (certfile (cdr (assq 'certfile taginfo)))
+ (certfiles (delq nil (mapcar (lambda (tag)
+ (if (eq (car-safe tag) 'certfile)
+ (cdr tag)))
+ taginfo)))
(recipients (cdr (assq 'recipients taginfo)))
(sender (cdr (assq 'sender taginfo)))
(location (cdr (assq 'tag-location taginfo)))
,@tags
,(if keyfile "keyfile")
,keyfile
- ,(if certfile "certfile")
- ,certfile
+ ,@(apply #'append
+ (mapcar (lambda (certfile)
+ (list "certfile" certfile))
+ certfiles))
,(if recipients "recipients")
,recipients
,(if sender "sender")
(skip-chars-forward "= \t\n")
(setq val (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
- (when (string-match "^\"\\(.*\\)\"$" val)
- (setq val (match-string 1 val)))
+ (when (string-match "\\`\"" val)
+ (setq val (read val))) ;; inverse of prin1 in mml-insert-tag
(push (cons (intern elem) val) contents)
(skip-chars-forward " \t\n"))
(goto-char (match-end 0))
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
(defvar mml-multipart-number 0)
+(defvar mml-inhibit-compute-boundary nil)
+
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url))
-(defun mml-generate-mime ()
- "Generate a MIME message based on the current MML document."
+(defun mml-generate-mime (&optional multipart-type)
+ "Generate a MIME message based on the current MML document.
+MULTIPART-TYPE defaults to \"mixed\", but can also
+be \"related\" or \"alternate\"."
(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)))))
+ (when (and (consp (car cont))
+ (= (length cont) 1)
+ (fboundp 'libxml-parse-html-region)
+ (equal (cdr (assq 'type (car cont))) "text/html"))
+ (setq cont (mml-expand-html-into-multipart-related (car cont))))
+ (prog1
+ (mm-with-multibyte-buffer
+ (setq message-options options)
+ (cond
+ ((and (consp (car cont))
+ (= (length cont) 1))
+ (mml-generate-mime-1 (car cont)))
+ ((eq (car cont) 'multipart)
+ (mml-generate-mime-1 cont))
+ (t
+ (mml-generate-mime-1
+ (nconc (list 'multipart (cons 'type (or multipart-type "mixed")))
+ cont))))
+ (setq options message-options)
+ (buffer-string))
+ (setq message-options options)))))
+
+(defun mml-expand-html-into-multipart-related (cont)
+ (let ((new-parts nil)
+ (cid 1))
+ (mm-with-multibyte-buffer
+ (insert (cdr (assq 'contents cont)))
+ (goto-char (point-min))
+ (with-syntax-table mml-syntax-table
+ (while (re-search-forward "<img\\b" nil t)
+ (goto-char (match-beginning 0))
+ (let* ((start (point))
+ (img (nth 2
+ (nth 2
+ (libxml-parse-html-region
+ (point) (progn (forward-sexp) (point))))))
+ (end (point))
+ (parsed (url-generic-parse-url (cdr (assq 'src (cadr img))))))
+ (when (and (null (url-type parsed))
+ (url-filename parsed)
+ (file-exists-p (url-filename parsed)))
+ (goto-char start)
+ (when (search-forward (url-filename parsed) end t)
+ (let ((cid (format "fsf.%d" cid)))
+ (replace-match (concat "cid:" cid) t t)
+ (push (list cid (url-filename parsed)) new-parts))
+ (setq cid (1+ cid)))))))
+ ;; We have local images that we want to include.
+ (if (not new-parts)
+ (list cont)
+ (setcdr (assq 'contents cont) (buffer-string))
+ (setq cont
+ (nconc (list 'multipart (cons 'type "related"))
+ (list cont)))
+ (dolist (new-part (nreverse new-parts))
+ (setq cont
+ (nconc cont
+ (list `(part (type . "image/png")
+ (filename . ,(nth 1 new-part))
+ (id . ,(concat "<" (nth 0 new-part)
+ ">")))))))
+ cont))))
(defun mml-generate-mime-1 (cont)
(let ((mm-use-ultra-safe-encoding
(setq charset nil
coding nil))
(charset
- (setq charset (intern (downcase charset)))))
+ ;; The value of `charset' might be a bogus alias that
+ ;; `mm-charset-synonym-alist' provides, like `utf8',
+ ;; so we prefer the MIME charset that Emacs knows for
+ ;; the coding system `coding'.
+ (setq charset (or (mm-coding-system-to-mime-charset coding)
+ (intern (downcase charset))))))
(if (and (not raw)
(member (car (split-string type "/")) '("text" "message")))
(progn
;; 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))))))
;; `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))
+ (mml-to-mime)
+ ;; Update handle so mml-compute-boundary can
+ ;; detect collisions with the nested parts.
+ (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))
(unless raw
(setq charset (mm-encode-body charset))))
(insert contents)))))
- (setq encoding (mm-encode-buffer type)
+ (if (setq encoding (cdr (assq 'encoding cont)))
+ (setq encoding (intern (downcase encoding))))
+ (setq encoding (mm-encode-buffer type encoding)
coded (mm-string-as-multibyte (buffer-string))))
(mml-insert-mime-headers cont type charset encoding nil)
(insert "\n" coded))))
"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
- ((eq (car cont) 'part)
- (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
;; Determine type and stuff.
(unless (stringp (car handle))
(unless (setq textp (equal (mm-handle-media-supertype handle) "text"))
- (save-excursion
- (set-buffer (setq buffer (mml-generate-new-buffer " *mml*")))
- (mm-insert-part handle 'no-cache)
- (if (setq mmlp (equal (mm-handle-media-type handle)
- "message/rfc822"))
- (mime-to-mml)))))
+ (with-current-buffer (setq buffer (mml-generate-new-buffer " *mml*"))
+ (if (eq (mail-content-type-get (mm-handle-type handle) 'charset)
+ 'gnus-decoded)
+ ;; A part that mm-uu dissected from a non-MIME message
+ ;; because of `gnus-article-emulate-mime'.
+ (progn
+ (mm-enable-multibyte)
+ (insert-buffer-substring (mm-handle-buffer handle)))
+ (mm-insert-part handle 'no-cache)
+ (if (setq mmlp (equal (mm-handle-media-type handle)
+ "message/rfc822"))
+ (mime-to-mml))))))
(if mmlp
(mml-insert-mml-markup handle nil t t)
(unless (and no-markup
'(:help "Attach a file at point"))]
["Attach Buffer..." mml-attach-buffer
,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a buffer to the outgoing MIME message"))]
+ '(:help "Attach a buffer to the outgoing message"))]
["Attach External..." mml-attach-external
,@(if (featurep 'xemacs) '(t)
- '(:help "Attach reference to file"))]
+ '(:help "Attach reference to an external file"))]
+ ;; FIXME: Is it possible to do this without using
+ ;; `gnus-gcc-externalize-attachments'?
+ ["Externalize Attachments"
+ (lambda ()
+ (interactive)
+ (if (not (and (boundp 'gnus-gcc-externalize-attachments)
+ (memq gnus-gcc-externalize-attachments
+ '(all t nil))))
+ ;; Stupid workaround for XEmacs not honoring :visible.
+ (message "Can't handle this value of `gnus-gcc-externalize-attachments'")
+ (setq gnus-gcc-externalize-attachments
+ (not gnus-gcc-externalize-attachments))
+ (message "gnus-gcc-externalize-attachments is `%s'."
+ gnus-gcc-externalize-attachments)))
+ ;; XEmacs barfs on :visible.
+ ,@(if (featurep 'xemacs) nil
+ '(:visible (and (boundp 'gnus-gcc-externalize-attachments)
+ (memq gnus-gcc-externalize-attachments
+ '(all t nil)))))
+ :style toggle
+ :selected gnus-gcc-externalize-attachments
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Save attachments as external parts in Gcc copies"))]
+ "----"
;;
("Change Security Method"
["PGP/MIME"
["Encrypt/Sign off" mml-unsecure-message
,@(if (featurep 'xemacs) '(t)
'(:help "Don't Encrypt/Sign Message"))]
+ ;; Do we have separate encrypt and encrypt/sign commands for parts?
+ ["Sign Part" mml-secure-sign t]
+ ["Encrypt Part" mml-secure-encrypt t]
+ "----"
;; Maybe we could remove these, because people who write MML most probably
;; don't use the menu:
["Insert Part..." mml-insert-part
["Insert Multipart..." mml-insert-multipart
:active (message-in-body-p)]
;;
- ;; Do we have separate encrypt and encrypt/sign commands for parts?
- ["Sign Part" mml-secure-sign t]
- ["Encrypt Part" mml-secure-encrypt t]
;;["Narrow" mml-narrow-to-part t]
["Quote MML in region" mml-quote-region
:active (message-mark-active-p)
["Emacs MIME manual" (lambda () (interactive) (message-info 4))
,@(if (featurep 'xemacs) '(t)
'(:help "Display the Emacs MIME manual"))]
- ["PGG manual" (lambda () (interactive) (message-info 16))
+ ["PGG manual" (lambda () (interactive) (message-info mml2015-use))
+ ;; XEmacs barfs on :visible.
+ ,@(if (featurep 'xemacs) nil
+ '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg))))
,@(if (featurep 'xemacs) '(t)
- '(:help "Display the PGG manual"))]))
-
-(defvar mml-mode nil
- "Minor mode for editing MML.")
+ '(:help "Display the PGG manual"))]
+ ["EasyPG manual" (lambda () (interactive) (require 'mml2015) (message-info mml2015-use))
+ ;; XEmacs barfs on :visible.
+ ,@(if (featurep 'xemacs) nil
+ '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg))))
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the EasyPG manual"))]))
-(defun mml-mode (&optional arg)
+(define-minor-mode mml-mode
"Minor mode for editing MML.
MML is the MIME Meta Language, a minor mode for composing MIME articles.
See Info node `(emacs-mime)Composing'.
\\{mml-mode-map}"
- (interactive "P")
- (when (set (make-local-variable 'mml-mode)
- (if (null arg) (not mml-mode)
- (> (prefix-numeric-value arg) 0)))
- (add-minor-mode 'mml-mode " MML" mml-mode-map)
+ :lighter " MML" :keymap mml-mode-map
+ (when mml-mode
(easy-menu-add mml-menu mml-mode-map)
(when (boundp 'dnd-protocol-alist)
(set (make-local-variable 'dnd-protocol-alist)
- (append mml-dnd-protocol-alist dnd-protocol-alist)))
- (run-hooks 'mml-mode-hook)))
+ (append mml-dnd-protocol-alist dnd-protocol-alist)))))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
(error "Permission denied: %s" file))
file))
+(declare-function mailcap-parse-mimetypes "mailcap" (&optional path force))
+(declare-function mailcap-mime-types "mailcap" ())
+
(defun mml-minibuffer-read-type (name &optional default)
+ (require 'mailcap)
(mailcap-parse-mimetypes)
(let* ((default (or default
(mm-default-file-encoding name)
;; looks like, and offer text/plain if it looks
;; like text/plain.
"application/octet-stream"))
- (string (completing-read
- (format "Content type (default %s): " default)
- (mapcar 'list (mailcap-mime-types)))))
+ (string (gnus-completing-read
+ "Content type"
+ (mailcap-mime-types)
+ nil nil nil default)))
(if (not (equal string ""))
string
default)))
-(defun mml-minibuffer-read-description ()
- (let ((description (read-string "One line description: ")))
+(defun mml-minibuffer-read-description (&optional default)
+ (let ((description (read-string "One line description: " default)))
(when (string-match "\\`[ \t]*\\'" description)
(setq description nil))
description))
(defun mml-minibuffer-read-disposition (type &optional default filename)
(unless default
(setq default (mml-content-disposition type filename)))
- (let ((disposition (completing-read
- (format "Disposition (default %s): " default)
- '(("attachment") ("inline") (""))
- nil t nil nil default)))
+ (let ((disposition (gnus-completing-read
+ "Disposition"
+ '("attachment" "inline")
+ t nil nil default)))
(if (not (equal disposition ""))
disposition
default)))
(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 "!")))))
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 "None" nil)
(const :tag "Query" t)
(list :value (type description disposition)
(set :inline t
: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
-`\\[message-send-and-exit]' or `\\[message-send]'.
+`\\[message-send-and-exit]' or `\\[message-send]' in Message mode,
+or `\\[mail-send-and-exit]' or `\\[mail-send]' in Mail mode.
FILE is the name of the file to attach. TYPE is its
content-type, a string of the form \"type/subtype\". DESCRIPTION
(description (mml-minibuffer-read-description))
(disposition (mml-minibuffer-read-disposition type nil file)))
(list file type description disposition)))
- (save-excursion
- (unless (message-in-body-p) (goto-char (point-max)))
+ ;; 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
- 'filename file
+ ;; icicles redefines read-file-name and returns a
+ ;; string w/ text properties :-/
+ 'filename (mm-substring-no-properties file)
'disposition (or disposition "attachment")
- 'description description)))
+ 'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
+ (when head
+ (unless (pos-visible-in-window-p)
+ (message "The file \"%s\" has been attached at the end of the message"
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-dnd-attach-file (uri action)
"Attach a drag and drop file.
(setq disposition (mml-minibuffer-read-disposition type nil file)))
(mml-attach-file file type description disposition)))))
-(defun mml-attach-buffer (buffer &optional type description)
+(defun mml-attach-buffer (buffer &optional type description disposition)
"Attach a buffer to the outgoing MIME message.
-See `mml-attach-file' for details of operation."
+BUFFER is the name of the buffer to attach. See
+`mml-attach-file' for details of operation."
(interactive
(let* ((buffer (read-buffer "Attach buffer: "))
(type (mml-minibuffer-read-type buffer "text/plain"))
- (description (mml-minibuffer-read-description)))
- (list buffer type description)))
- (save-excursion
- (unless (message-in-body-p) (goto-char (point-max)))
+ (description (mml-minibuffer-read-description))
+ (disposition (mml-minibuffer-read-disposition type nil)))
+ (list buffer type description disposition)))
+ ;; 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 "attachment"
- 'description description)))
+ 'disposition disposition
+ 'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
+ (when head
+ (unless (pos-visible-in-window-p)
+ (message
+ "The buffer \"%s\" has been attached at the end of the message"
+ buffer))
+ (goto-char head))))
(defun mml-attach-external (file &optional type description)
"Attach an external file into the buffer.
(type (mml-minibuffer-read-type file))
(description (mml-minibuffer-read-description)))
(list file type description)))
- (save-excursion
- (unless (message-in-body-p) (goto-char (point-max)))
+ ;; 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 'external 'type type 'name file
- 'disposition "attachment" 'description description)))
+ 'disposition "attachment" 'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
+ (when head
+ (unless (pos-visible-in-window-p)
+ (message "The file \"%s\" has been attached at the end of the message"
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-insert-multipart (&optional type)
- (interactive (list (completing-read "Multipart type (default mixed): "
- '(("mixed") ("alternative") ("digest") ("parallel")
- ("signed") ("encrypted"))
- nil nil "mixed")))
+ (interactive (if (message-in-body-p)
+ (list (gnus-completing-read "Multipart type"
+ '("mixed" "alternative"
+ "digest" "parallel"
+ "signed" "encrypted")
+ nil "mixed"))
+ (error "Use this command in the message body")))
(or type
(setq type "mixed"))
(mml-insert-empty-tag "multipart" 'type type)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(forward-line -1))
(defun mml-insert-part (&optional type)
- (interactive
- (list (mml-minibuffer-read-type "")))
+ (interactive (if (message-in-body-p)
+ (list (mml-minibuffer-read-type ""))
+ (error "Use this command in the message body")))
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(mml-insert-tag 'part 'type type 'disposition "inline")
- (forward-line -1))
+ (save-excursion
+ (mml-insert-tag '/part)))
(declare-function message-subscribed-p "message" ())
(declare-function message-make-mail-followup-to "message"
"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."
(setq mml-preview-buffer (generate-new-buffer
(concat (if raw "*Raw MIME preview of "
"*MIME preview of ") (buffer-name))))
+ (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
(provide 'mml)
-;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
;;; mml.el ends here
projects / gnus / blobdiff