;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
(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."
+(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)))))
+ (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 (cons 'type (or 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
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-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)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (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
;; icicles redefines read-file-name and returns a
'filename (mm-substring-no-properties file)
'disposition (or 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 (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
- (file-name-nondirectory file))))))
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-dnd-attach-file (uri action)
"Attach a drag and drop file.
(description (mml-minibuffer-read-description))
(disposition (mml-minibuffer-read-disposition type nil)))
(list buffer type description disposition)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (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 'buffer buffer
'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 (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message
"The buffer \"%s\" has been attached at the end of the message"
- buffer)))))
+ 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)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (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)
+ ;; 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 (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
- (file-name-nondirectory file))))))
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-insert-multipart (&optional type)
(interactive (if (message-in-body-p)
(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 (if (message-in-body-p)
(list (mml-minibuffer-read-type ""))
(error "Use this command in the message body")))
- (mml-insert-tag 'part 'type type 'disposition "inline"))
+ ;; 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")
+ (save-excursion
+ (mml-insert-tag '/part)))
(declare-function message-subscribed-p "message" ())
(declare-function message-make-mail-followup-to "message"
projects / gnus / blobdiff