;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(require 'mail-parse)
(require 'mm-bodies)
(require 'mm-encode)
+ (require 'mml)
)
(defgroup message '((user-mail-address custom-variable)
:group 'message-interface
:type 'regexp)
+(defcustom message-supersede-setup-function
+ 'message-supersede-setup-for-mime-edit
+ "Function to setup a supersede message."
+ :group 'message-sending
+ :type 'function)
+
(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
"*Regexp matching \"Re: \" in the subject line."
:group 'message-various
:group 'message-buffers
:type '(choice (const :tag "off" nil)
(const :tag "unique" unique)
- (const :tag "unsuniqueent" unsent)
+ (const :tag "unsent" unsent)
(function fun)))
(defcustom message-kill-buffer-on-exit nil
:group 'message-forwarding
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-Receipt"
+(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:type 'regexp)
:group 'message-various
:type 'hook)
+(defcustom message-cancel-hook nil
+ "Hook run when cancelling articles."
+ :group 'message-various
+ :type 'hook)
+
(defcustom message-signature-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
It is run after the headers have been inserted and before
:type 'hook)
(defcustom message-bounce-setup-hook nil
- "Normal hook, run each time a a re-sending bounced message is initialized.
+ "Normal hook, run each time a re-sending bounced message is initialized.
The function `message-bounce' runs this hook."
:group 'message-various
:type 'hook)
+(defcustom message-supersede-setup-hook nil
+ "Normal hook, run each time a supersede message is initialized.
+The function `message-supersede' runs this hook."
+ :group 'message-various
+ :type 'hook)
+
(defcustom message-mode-hook nil
"Hook run in message mode buffers."
:group 'message-various
;;;###autoload
(defcustom message-yank-prefix "> "
- "*Prefix inserted on the lines of yanked messages.
-nil means use indentation."
+ "*Prefix inserted on the lines of yanked messages."
:type 'string
:group 'message-insertion)
(defvar message-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?% ". " table)
+ (modify-syntax-entry ?> ". " table)
+ (modify-syntax-entry ?< ". " table)
table)
"Syntax table used while in Message mode.")
"Face used for displaying cited text names."
:group 'message-faces)
+(defface message-mml-face
+ '((((class color)
+ (background dark))
+ (:foreground "ForestGreen"))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen"))
+ (t
+ (:bold t)))
+ "Face used for displaying MML."
+ :group 'message-faces)
+
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-"))
(,(concat "^[ \t]*"
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
"[:>|}].*")
- (0 'message-cited-text-face))))
+ (0 'message-cited-text-face))
+ ("<#/?\\(multipart\\|part\\|external\\).*>"
+ (0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
;; XEmacs does it like this. For Emacs, we have to set the
(const :tag "always" t)
(const :tag "ask" ask)))
-(defvar message-send-coding-system 'binary
- "Coding system to encode outgoing mail.")
+(defvar message-draft-coding-system
+ (cond
+ ((not (fboundp 'find-coding-system)) nil)
+ ((find-coding-system 'emacs-mule) 'emacs-mule)
+ ((find-coding-system 'escape-quoted) 'escape-quoted)
+ ((find-coding-system 'no-conversion) 'no-conversion)
+ (t nil))
+ "Coding system to compose mail.")
;;; Internal variables.
-(defvar message-default-charset nil)
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
(defvar message-draft-article nil)
+(defvar message-mime-part nil)
+(defvar message-posting-charset nil)
;; Byte-compiler warning
(defvar gnus-active-hashtb)
;;;
;;; Utility functions.
;;;
+(defun message-eval-parameter (parameter)
+ (condition-case ()
+ (if (symbolp parameter)
+ (if (functionp parameter)
+ (funcall parameter)
+ (eval parameter))
+ parameter)
+ (error nil)))
+
+(defsubst message-get-parameter (key &optional alist)
+ (unless alist
+ (setq alist message-parameter-alist))
+ (cdr (assq key alist)))
+
+(defmacro message-get-parameter-with-eval (key &optional alist)
+ `(message-eval-parameter (message-get-parameter ,key ,alist)))
(defmacro message-y-or-n-p (question show &rest text)
"Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- value)))
+ ;; We remove all text props.delete-region
+ (format "%s" value))))
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
- (let ((buffer (message-get-reply-buffer)))
+ (let ((buffer (message-eval-parameter message-reply-buffer)))
(when (and buffer
(buffer-name buffer))
(save-excursion
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))
- (point-max))))
+ (goto-char (point-max)))))
number))
+(defun message-remove-first-header (header)
+ "Remove the first instance of HEADER if there is more than one."
+ (let ((count 0)
+ (regexp (concat "^" (regexp-quote header) ":")))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (incf count)))
+ (while (> count 1)
+ (message-remove-header header nil t)
+ (decf count))))
+
(defun message-narrow-to-headers ()
"Narrow the buffer to the head of the message."
(widen)
(1+ max)))))
(message-sort-headers-1))))
-(defun message-eval-parameter (parameter)
- (condition-case ()
- (if (symbolp parameter)
- (if (functionp parameter)
- (funcall parameter)
- (eval parameter))
- parameter)
- (error nil)))
-
-(defun message-get-reply-buffer ()
- (message-eval-parameter message-reply-buffer))
-
-(defun message-get-original-reply-buffer ()
- (message-eval-parameter
- (cdr (assq 'original-buffer message-parameter-alist))))
-
\f
;;;
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
+ (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
(define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
(define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
(define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
(define-key message-mode-map "\t" 'message-tab)
(define-key message-mode-map "\C-x\C-s" 'message-save-drafts)
- (define-key message-mode-map "\C-xk" 'message-kill-buffer))
+ (define-key message-mode-map "\C-xk" 'message-mimic-kill-buffer))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
C-c C-r message-caesar-buffer-body (rot13 the message body)."
(interactive)
(kill-all-local-variables)
- (make-local-variable 'message-reply-buffer)
- (setq message-reply-buffer nil)
+ (set (make-local-variable 'message-reply-buffer) nil)
(make-local-variable 'message-send-actions)
(make-local-variable 'message-exit-actions)
(make-local-variable 'message-kill-actions)
(setq message-reply-headers nil)
(make-local-variable 'message-user-agent)
(make-local-variable 'message-post-method)
- (make-local-variable 'message-sent-message-via)
- (setq message-sent-message-via nil)
- (make-local-variable 'message-checksum)
- (setq message-checksum nil)
+ (set (make-local-variable 'message-sent-message-via) nil)
+ (set (make-local-variable 'message-checksum) nil)
(make-local-variable 'message-parameter-alist)
(setq message-parameter-alist
(copy-sequence message-startup-parameter-alist))
(eq force 0))
(save-excursion
(goto-char (point-max))
- (not (re-search-backward
- message-signature-separator nil t))))
+ (not (re-search-backward message-signature-separator nil t))))
((and (null message-signature)
force)
t)
prefix, and don't delete any headers."
(interactive "P")
(let ((modified (buffer-modified-p))
- (buffer (message-get-reply-buffer)))
+ (buffer (message-eval-parameter message-reply-buffer)))
(when (and buffer
message-cite-function)
(delete-windows-on buffer t)
message-indent-citation-function
(list message-indent-citation-function)))))
(goto-char end)
- (when (re-search-backward "^-- $" start t)
+ (when (re-search-backward message-signature-separator start t)
;; Also peel off any blank lines before the signature.
(forward-line -1)
(while (looking-at "^[ \t]*$")
mail-citation-hook)
(run-hooks 'mail-citation-hook)
(let ((start (point))
+ (end (mark t))
(functions
(when message-indent-citation-function
(if (listp message-indent-citation-function)
(defun message-dont-send ()
"Don't send the message you have been editing."
(interactive)
- (set-buffer-modified-p t)
- (save-buffer)
- (let ((actions message-postpone-actions))
+ (message-save-drafts)
+ (let ((actions message-postpone-actions)
+ (frame (selected-frame))
+ (org-frame message-original-frame))
(message-bury (current-buffer))
- (message-do-actions actions)))
+ (message-do-actions actions)
+ (message-delete-frame frame org-frame)))
(defun message-kill-buffer ()
"Kill the current buffer."
(message-delete-frame frame org-frame)))
(message ""))
+(defun message-mimic-kill-buffer ()
+ "Kill the current buffer with query."
+ (interactive)
+ (unless (eq 'message-mode major-mode)
+ (error "%s must be invoked from a message buffer." this-command))
+ (let ((command this-command)
+ (bufname (read-buffer (format "Kill buffer: (default %s) "
+ (buffer-name)))))
+ (if (or (not bufname)
+ (string-equal bufname "")
+ (string-equal bufname (buffer-name)))
+ (message-kill-buffer)
+ (message "%s must be invoked only for the current buffer." command))))
+
(defun message-delete-frame (frame org-frame)
"Delete frame for editing message."
(when (and (or (and (featurep 'xemacs)
(message-do-fcc)
;;(when (fboundp 'mail-hist-put-headers-into-history)
;; (mail-hist-put-headers-into-history))
- (run-hooks 'message-sent-hook)
+ (save-excursion
+ (run-hooks 'message-sent-hook))
(message "Sending...done")
;; Mark the buffer as unmodified and delete autosave.
(set-buffer-modified-p nil)
(throw 'message-sending-mail-failure err))))))
nil)
(condition-case err
- (funcall message-send-mail-function)
+ (progn
+ (funcall message-send-mail-function)
+ nil)
(error err))))
(when failure
(if (eq 'error (car failure))
(save-excursion
(set-buffer errbuf)
(erase-buffer))))
- (let ((default-directory "/")
- (coding-system-for-write message-send-coding-system))
- (apply 'call-process-region
- (append (list (point-min) (point-max)
- (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail")
- nil errbuf nil "-oi")
- ;; Always specify who from,
- ;; since some systems have broken sendmails.
- ;; But some systems are more broken with -f, so
- ;; we'll let users override this.
- (if (null message-sendmail-f-is-evil)
- (list "-f" (user-login-name)))
- ;; These mean "report errors by mail"
- ;; and "deliver in background".
- (if (null message-interactive) '("-oem" "-odb"))
- ;; Get the addresses from the message
- ;; unless this is a resend.
- ;; We must not do that for a resend
- ;; because we would find the original addresses.
- ;; For a resend, include the specific addresses.
- (if resend-to-addresses
- (list resend-to-addresses)
- '("-t")))))
+ (let ((default-directory "/"))
+ (as-binary-process
+ (apply 'call-process-region
+ (append (list (point-min) (point-max)
+ (if (boundp 'sendmail-program)
+ sendmail-program
+ "/usr/lib/sendmail")
+ nil errbuf nil "-oi")
+ ;; Always specify who from,
+ ;; since some systems have broken sendmails.
+ ;; But some systems are more broken with -f, so
+ ;; we'll let users override this.
+ (if (null message-sendmail-f-is-evil)
+ (list "-f" (user-login-name)))
+ ;; These mean "report errors by mail"
+ ;; and "deliver in background".
+ (if (null message-interactive) '("-oem" "-odb"))
+ ;; Get the addresses from the message
+ ;; unless this is a resend.
+ ;; We must not do that for a resend
+ ;; because we would find the original addresses.
+ ;; For a resend, include the specific addresses.
+ (if resend-to-addresses
+ (list resend-to-addresses)
+ '("-t"))))))
(when message-interactive
(save-excursion
(set-buffer errbuf)
(run-hooks 'message-send-mail-hook)
;; send the message
(case
- (let ((coding-system-for-write message-send-coding-system))
- (apply
- 'call-process-region 1 (point-max) message-qmail-inject-program
- nil nil nil
- ;; qmail-inject's default behaviour is to look for addresses on the
- ;; command line; if there're none, it scans the headers.
- ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
- ;;
- ;; in general, ALL of qmail-inject's defaults are perfect for simply
- ;; reading a formatted (i. e., at least a To: or Resent-To header)
- ;; message from stdin.
- ;;
- ;; qmail also has the advantage of not having been raped by
- ;; various vendors, so we don't have to allow for that, either --
- ;; compare this with message-send-mail-with-sendmail and weep
- ;; for sendmail's lost innocence.
- ;;
- ;; all this is way cool coz it lets us keep the arguments entirely
- ;; free for -inject-arguments -- a big win for the user and for us
- ;; since we don't have to play that double-guessing game and the user
- ;; gets full control (no gestapo'ish -f's, for instance). --sj
- message-qmail-inject-args))
+ (as-binary-process
+ (apply
+ 'call-process-region 1 (point-max) message-qmail-inject-program
+ nil nil nil
+ ;; qmail-inject's default behaviour is to look for addresses on the
+ ;; command line; if there're none, it scans the headers.
+ ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+ ;;
+ ;; in general, ALL of qmail-inject's defaults are perfect for simply
+ ;; reading a formatted (i. e., at least a To: or Resent-To header)
+ ;; message from stdin.
+ ;;
+ ;; qmail also has the advantage of not having been raped by
+ ;; various vendors, so we don't have to allow for that, either --
+ ;; compare this with message-send-mail-with-sendmail and weep
+ ;; for sendmail's lost innocence.
+ ;;
+ ;; all this is way cool coz it lets us keep the arguments entirely
+ ;; free for -inject-arguments -- a big win for the user and for us
+ ;; since we don't have to play that double-guessing game and the user
+ ;; gets full control (no gestapo'ish -f's, for instance). --sj
+ message-qmail-inject-args))
;; qmail-inject doesn't say anything on it's stdout/stderr,
;; we have to look at the retval instead
(0 nil)
(error "Sending failed; " result)))
(error "Sending failed; no recipients"))))
-(defsubst message-maybe-split-and-send-news ()
+(defsubst message-maybe-split-and-send-news (method)
"Split a message if necessary, and send it via news.
Returns nil if sending succeeded, returns t if sending failed.
This sub function is for exclusive use of `message-send-news'."
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
- (setq result (message-maybe-split-and-send-news)))
+ (setq result (message-maybe-split-and-send-news method)))
(kill-buffer tembuf))
(set-buffer message-edit-buffer)
(if result
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(cond
- ;; Check whether `message-generate-new-buffers' is a function,
- ;; and if so, call it.
- ((message-functionp message-generate-new-buffers)
- (funcall message-generate-new-buffers type to group))
;; Generate a new buffer name The Message Way.
((eq message-generate-new-buffers 'unique)
(generate-new-buffer-name
"")
(if (and group (not (string= group ""))) (concat " on " group) "")
"*")))
+ ;; Check whether `message-generate-new-buffers' is a function,
+ ;; and if so, call it.
+ ((message-functionp message-generate-new-buffers)
+ (funcall message-generate-new-buffers type to group))
((eq message-generate-new-buffers 'unsent)
(generate-new-buffer-name
(concat "*unsent " type
(when actions
(setq message-send-actions actions))
(setq message-reply-buffer
- (or (cdr (assq 'reply-buffer message-parameter-alist))
+ (or (message-get-parameter 'reply-buffer)
replybuffer))
(goto-char (point-min))
;; Insert all the headers.
(setq buffer-file-name (expand-file-name "*message*"
message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
- (clear-visited-file-modtime)))
+ (clear-visited-file-modtime)
+ (setq buffer-file-coding-system message-draft-coding-system)))
(defun message-disassociate-draft ()
"Disassociate the message buffer from the drafts directory."
(nndraft-request-expire-articles
(list message-draft-article) "drafts" nil t)))
+(defun message-insert-headers ()
+ "Generate the headers for the article."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (when (message-news-p)
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-news-headers)))))
+ (when (message-mail-p)
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-mail-headers))))))))
+
\f
;;;
"")
mail-header-separator "\n"
message-cancel-message)
+ (run-hooks 'message-cancel-hook)
(message "Canceling your article...")
(if (let ((message-syntax-checks
'dont-check-for-anything-just-trust-me)
(message "Canceling your article...done"))
(kill-buffer buf)))))
+(defun message-supersede-setup-for-mime-edit ()
+ (set (make-local-variable 'message-setup-hook) nil)
+ (mime-edit-again))
+
;;;###autoload
(defun message-supersede ()
"Start composing a message to supersede the current message.
(goto-char (point-max))
(insert mail-header-separator)
(widen)
- (forward-line 1)))
+ (when message-supersede-setup-function
+ (funcall message-supersede-setup-function))
+ (run-hooks 'message-supersede-setup-hook)
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n") nil t)))
;;;###autoload
(defun message-recover ()
(let ((funcs message-make-forward-subject-function)
(subject (if message-wash-forwarded-subjects
(message-wash-subject
- (or (eword-decode-unstructured-field-body
- (message-fetch-field "Subject")) ""))
- (or (eword-decode-unstructured-field-body
- (message-fetch-field "Subject")) ""))))
+ (or (nnheader-decode-subject
+ (message-fetch-field "Subject"))
+ ""))
+ (or (nnheader-decode-subject
+ (message-fetch-field "Subject"))
+ ""))))
;; Make sure funcs is a list.
(and funcs
(not (listp funcs))
;; Send it.
(let ((message-encoding-buffer (current-buffer))
(message-edit-buffer (current-buffer)))
- (message-send-mail))
+ (let (message-required-mail-headers)
+ (message-send-mail)))
(kill-buffer (current-buffer)))
(message "Resending message to %s...done" address)))
(defun message-bounce-setup-for-mime-edit ()
- (goto-char (point-min))
- (when (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (replace-match "\n\n"))
(set (make-local-variable 'message-setup-hook) nil)
(mime-edit-again))
(let ((locals (save-excursion
(set-buffer buffer)
(buffer-local-variables)))
- (regexp "^gnus\\|^nn\\|^message"))
+ (regexp
+ "^\\(gnus\\|nn\\|message\\|user-\\(mail-address\\|full-name\\)\\)"))
(mapcar
(lambda (local)
(when (and (consp local)
(defun message-mime-insert-article (&optional full-headers)
(interactive "P")
(let ((message-cite-function 'mime-edit-inserted-message-filter)
- (message-reply-buffer (message-get-original-reply-buffer))
+ (message-reply-buffer
+ (message-get-parameter-with-eval 'original-buffer))
(start (point)))
(message-yank-original nil)
(save-excursion
;;; MIME functions
;;;
+(defun message-mime-query-file (prompt)
+ (let ((file (read-file-name prompt nil nil t)))
+ ;; Prevent some common errors. This is inspired by similar code in
+ ;; VM.
+ (when (file-directory-p file)
+ (error "%s is a directory, cannot attach" file))
+ (unless (file-exists-p file)
+ (error "No such file: %s" file))
+ (unless (file-readable-p file)
+ (error "Permission denied: %s" file))
+ file))
+
+(defun message-mime-query-type (file)
+ (let* ((default (or (mm-default-file-encoding file)
+ ;; Perhaps here we should check what the file
+ ;; looks like, and offer text/plain if it looks
+ ;; like text/plain.
+ "application/octet-stream"))
+ (string (completing-read
+ (format "Content type (default %s): " default)
+ (delete-duplicates
+ (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
+ :test 'equal))))
+ (if (not (equal string ""))
+ string
+ default)))
+
+(defun message-mime-query-description ()
+ (let ((description (read-string "One line description: ")))
+ (when (string-match "\\`[ \t]*\\'" description)
+ (setq description nil))
+ description))
+
+(defun message-mime-attach-file (file &optional type description)
+ "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]'.
+
+FILE is the name of the file to attach. TYPE is its content-type, a
+string of the form \"type/subtype\". DESCRIPTION is a one-line
+description of the attachment."
+ (interactive
+ (let* ((file (message-mime-query-file "Attach file: "))
+ (type (message-mime-query-type file))
+ (description (message-mime-query-description)))
+ (list file type description)))
+ (insert (format
+ "<#part type=%s filename=%s%s disposition=attachment><#/part>\n"
+ type (prin1-to-string file)
+ (if description
+ (format " description=%s" (prin1-to-string description))
+ ""))))
+
+(defun message-mime-attach-external (file &optional type description)
+ "Attach an external file into the buffer.
+FILE is an ange-ftp/efs specification of the part location.
+TYPE is the MIME type to use."
+ (interactive
+ (let* ((file (message-mime-query-file "Attach external file: "))
+ (type (message-mime-query-type file))
+ (description (message-mime-query-description)))
+ (list file type description)))
+ (insert (format
+ "<#external type=%s name=%s disposition=attachment><#/external>\n"
+ type (prin1-to-string file))))
+
(defun message-encode-message-body ()
- "Examine the message body, encode it, and add the requisite headers."
- (when (featurep 'mule)
- (let (old-headers)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers-or-head)
- (unless (setq old-headers (message-fetch-field "mime-version"))
- (message-remove-header
- "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t))
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point) (point-max))
- (let* ((charset (mm-encode-body))
- (encoding (mm-body-encoding)))
- (when (consp charset)
- (error "Can't encode messages with multiple charsets (yet)"))
- (widen)
- (message-narrow-to-headers-or-head)
- (goto-char (point-max))
- (setq charset (or charset
- (mm-mule-charset-to-mime-charset 'ascii)))
- ;; We don't insert MIME headers if they only say the default.
- (when (and (not old-headers)
- (not (and (eq charset 'us-ascii)
- (eq encoding '7bit))))
- (mm-insert-rfc822-headers charset encoding))
- (mm-encode-body)))))))
+ (let (lines multipart-p content-type-p)
+ (message-goto-body)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (let ((new (mml-generate-mime)))
+ (when new
+ (delete-region (point-min) (point-max))
+ (insert new)
+ (goto-char (point-min))
+ (if (eq (aref new 0) ?\n)
+ (delete-char 1)
+ (search-forward "\n\n")
+ (setq lines (buffer-substring (point-min) (1- (point))))
+ (delete-region (point-min) (point))))))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-remove-header "Mime-Version")
+ (goto-char (point-max))
+ (insert "Mime-Version: 1.0\n")
+ (when lines
+ (insert lines))
+ (setq multipart-p
+ (re-search-backward "^Content-Type: multipart/" nil t))
+ (goto-char (point-max))
+ (setq content-type-p
+ (re-search-backward "^Content-Type:" nil t)))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-remove-first-header "Content-Type")
+ (message-remove-first-header "Content-Transfer-Encoding"))
+ (when multipart-p
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-remove-first-header "Content-Type")
+ (message-remove-first-header "Content-Transfer-Encoding"))
+ (message-goto-body)
+ (insert "This is a MIME multipart message. If you are reading\n")
+ (insert "this, you shouldn't.\n"))
+ ;; We always make sure that the message has a Content-Type header.
+ ;; This is because some broken MTAs and MUAs get awfully confused
+ ;; when confronted with a message with a MIME-Version header and
+ ;; without a Content-Type header. For instance, Solaris'
+ ;; /usr/bin/mail.
+ (unless content-type-p
+ (goto-char (point-min))
+ (re-search-forward "^MIME-Version:")
+ (forward-line 1)
+ (insert "Content-Type: text/plain; charset=us-ascii\n"))))
(defvar message-save-buffer " *encoding")
(defun message-save-drafts ()
(set-buffer buffer)
(set-buffer-modified-p nil)))
-(run-hooks 'message-load-hook)
-
(provide 'message)
+(run-hooks 'message-load-hook)
+
;;; message.el ends here
projects / elisp / gnus.git- / blobdiff