(eval-and-compile
(autoload 'sha1 "sha1-el")
(autoload 'gnus-find-method-for-group "gnus")
- (autoload 'nnvirtual-find-group-art "nnvirtual"))
+ (autoload 'nnvirtual-find-group-art "nnvirtual")
+ (autoload 'gnus-group-decoded-name "gnus-group"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
:group 'message-forwarding
:type 'boolean)
-(defcustom message-forward-show-mml nil
- "*Non-nil means show forwarded messages as mml.
-Otherwise, forwarded messages are unchanged."
+(defcustom message-forward-show-mml 'best
+ "*Non-nil means show forwarded messages as MML (decoded from MIME).
+Otherwise, forwarded messages are unchanged.
+Can also be the symbol `best' to indicate that MML should be
+used, except when it is a bad idea to use MML. One example where
+it is a bad idea is when forwarding a signed or encrypted
+message, because converting MIME to MML would invalidate the
+digital signature."
:version "21.1"
:group 'message-forwarding
- :type 'boolean)
+ :type '(choice (const :tag "use MML" t)
+ (const :tag "don't use MML " nil)
+ (const :tag "use MML when appropriate" best)))
(defcustom message-forward-before-signature t
"*Non-nil means put forwarded message before signature, else after."
(defcustom message-hidden-headers nil
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
-starting with `not' and followed by regexps.."
+starting with `not' and followed by regexps."
:group 'message
:type '(repeat regexp))
(defvar message-draft-article nil)
(defvar message-mime-part nil)
(defvar message-posting-charset nil)
+(defvar message-inserted-headers nil)
;; Byte-compiler warning
(eval-when-compile
(set-text-properties 0 (length value) nil value)
value)))
+(defun message-field-value (header &optional not-all)
+ "The same as `message-fetch-field', only narrow to the headers first."
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field header not-all))))
+
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(beginning-of-line)
;;;###autoload
(defun message-change-subject (new-subject)
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
+ ;; <URL:http://www.karlsruhe.org/rfc/son1036.txt>
+ ;; <URL:http://www.karlsruhe.org/rfc/draft-ietf-usefor-article-09.txt>
+ ;; But not mentioned in...
+ ;; <URL:http://www.karlsruhe.org/rfc/draft-ietf-usefor-article-11.txt>
(interactive
(list
(read-from-minibuffer "New subject: ")))
See `message-mark-insert-begin' and `message-mark-insert-end'."
(interactive "r")
(save-excursion
- ; add to the end of the region first, otherwise end would be invalid
+ ;; add to the end of the region first, otherwise end would be invalid
(goto-char end)
(insert message-mark-insert-end)
(goto-char beg)
;; (typical) mailing-lists stuff
["Send to list only" message-to-list-only t]
["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
["Reduce To: to Cc:" message-reduce-to-to-cc t]
"----"
["Sort Headers" message-sort-headers t]
M-RET `message-newline-and-reformat' (break the line and reformat)."
(setq local-abbrev-table text-mode-abbrev-table)
(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)
- (make-local-variable 'message-postpone-actions)
- (make-local-variable 'message-draft-article)
+ (set (make-local-variable 'message-inserted-headers) nil)
+ (set (make-local-variable 'message-send-actions) nil)
+ (set (make-local-variable 'message-exit-actions) nil)
+ (set (make-local-variable 'message-kill-actions) nil)
+ (set (make-local-variable 'message-postpone-actions) nil)
+ (set (make-local-variable 'message-draft-article) nil)
(setq buffer-offer-save t)
(set (make-local-variable 'facemenu-add-face-function)
(lambda (face end)
(message-remove-header "Disposition-Notification-To"))
(message-goto-eoh)
(insert (format "Disposition-Notification-To: %s\n"
- (or (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "From")))
+ (or (message-field-value "Reply-to")
+ (message-field-value "From")
(message-make-from))))))
(defun message-elide-region (b e)
(when (funcall (cadr elem))
(when (and (or (not (memq (car elem)
message-sent-message-via))
- (not (message-fetch-field "supersedes"))
+ (message-fetch-field "supersedes")
(if (or (message-gnksa-enable-p 'multiple-copies)
(not (eq (car elem) 'news)))
(y-or-n-p
(user-domain
(if (and user-mail
(string-match "@\\(.*\\)\\'" user-mail))
- (match-string 1 user-mail))))
+ (match-string 1 user-mail)))
+ (case-fold-search t))
(cond
((and message-user-fqdn
(stringp message-user-fqdn)
(let (rhs ace start startpos endpos ovl)
(goto-char (point-min))
(while (re-search-forward (concat "^" header) nil t)
- (while (re-search-forward "@\\([^ \t\r\n>]+\\)"
+ (while (re-search-forward "@\\([^ \t\r\n>,]+\\)"
(or (save-excursion
(re-search-forward "^[^ \t]" nil t))
(point-max))
(Expires (message-make-expires))
(case-fold-search t)
(optionalp nil)
- header value elem)
+ header value elem header-string)
;; First we remove any old generated headers.
(let ((headers message-deletable-headers))
(unless (buffer-modified-p)
optionalp t)
(setq header (car elem)))
(setq header elem))
+ (setq header-string (if (stringp header)
+ header
+ (symbol-name header)))
(when (or (not (re-search-forward
(concat "^"
- (regexp-quote
- (downcase
- (if (stringp header)
- header
- (symbol-name header))))
+ (regexp-quote (downcase header-string))
":")
nil t))
(progn
(setq value
(cond
((and (consp elem)
- (eq (car elem) 'optional))
+ (eq (car elem) 'optional)
+ (not (member header-string message-inserted-headers)))
;; This is an optional header. If the cdr of this
;; is something that is nil, then we do not insert
;; this header.
(cdr (assq header message-header-format-alist))))
(if formatter
(funcall formatter header value)
- (insert (if (stringp header)
- header (symbol-name header))
- ": " value))
+ (insert header-string ": " value))
;; We check whether the value was ended by a
;; newline. If now, we insert one.
(unless (bolp)
;; If the header is optional, and the header was
;; empty, we con't insert it anyway.
(unless optionalp
+ (push header-string message-inserted-headers)
(insert value)))
;; Add the deletable property to the headers that require it.
(and (memq header message-deletable-headers)
(defvar message-forward-decoded-p nil
"Non-nil means the original message is decoded.")
-(defun message-forward-subject-author-subject (subject)
+(defun message-forward-subject-name-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
-Source is the sender, and if the original message was news, Source is
-the list of newsgroups is was posted to."
- (concat "["
- (let ((prefix
- (or (message-fetch-field "newsgroups")
- (message-fetch-field "from")
- "(nowhere)")))
+Source is the name of the sender, and if the original message was
+news, Source is the list of newsgroups is was posted to."
+ (let* ((group (message-fetch-field "newsgroups"))
+ (from (message-fetch-field "from"))
+ (prefix
+ (if group
+ (gnus-group-decoded-name group)
+ (or (and from (cdr (mail-header-parse-address from)))
+ "(nowhere)"))))
+ (concat "["
(if message-forward-decoded-p
prefix
- (mail-decode-encoded-word-string prefix)))
- "] " subject))
+ (mail-decode-encoded-word-string prefix))
+ "] " subject)))
-(defun message-forward-subject-name-subject (subject)
+(defun message-forward-subject-author-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
-Source is the name of the sender, and if the original message was
-news, Source is the list of newsgroups is was posted to."
- (concat "["
- (let ((prefix
- (or (message-fetch-field "newsgroups")
- (let ((from (message-fetch-field "from")))
- (and from
- (cdr (mail-header-parse-address from))))
- "(nowhere)")))
+Source is the sender, and if the original message was news, Source is
+the list of newsgroups is was posted to."
+ (let* ((group (message-fetch-field "newsgroups"))
+ (prefix
+ (if group
+ (gnus-group-decoded-name group)
+ (or (message-fetch-field "from")
+ "(nowhere)"))))
+ (concat "["
(if message-forward-decoded-p
prefix
- (mail-decode-encoded-word-string prefix)))
- "] " subject))
+ (mail-decode-encoded-word-string prefix))
+ "] " subject)))
(defun message-forward-subject-fwd (subject)
"Generate a SUBJECT for a forwarded message.
The form is: Fwd: Subject, where Subject is the original subject of
the message."
- (concat "Fwd: " subject))
+ (if (string-match "^Fwd: " subject)
+ subject
+ (concat "Fwd: " subject)))
(defun message-make-forward-subject ()
"Return a Subject header suitable for the message in the current buffer."
(message-mail nil subject))
(message-forward-make-body cur digest)))
+(defun message-forward-make-body-plain (forward-buffer)
+ (insert
+ "\n-------------------- Start of forwarded message --------------------\n")
+ (let ((b (point)) e)
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-with-unibyte-current-buffer (buffer-string))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
+ (setq e (point))
+ (insert
+ "\n-------------------- End of forwarded message --------------------\n")
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
+
+(defun message-forward-make-body-mime (forward-buffer)
+ (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
+ (let ((b (point)) e)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mml-insert-buffer forward-buffer)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (goto-char (point-max)))
+ (setq e (point))
+ (insert "<#/part>\n")))
+
+(defun message-forward-make-body-mml (forward-buffer)
+ (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+ (let ((b (point)) e)
+ (if (not message-forward-decoded-p)
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-with-unibyte-current-buffer (buffer-string))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mml-insert-buffer forward-buffer)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (goto-char (point-max))))
+ (setq e (point))
+ (insert "<#/mml>\n")
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
+
+(defun message-forward-make-body-digest-plain (forward-buffer)
+ (insert
+ "\n-------------------- Start of forwarded message --------------------\n")
+ (let ((b (point)) e)
+ (mml-insert-buffer forward-buffer)
+ (setq e (point))
+ (insert
+ "\n-------------------- End of forwarded message --------------------\n")))
+
+(defun message-forward-make-body-digest-mime (forward-buffer)
+ (insert "\n<#multipart type=digest>\n")
+ (let ((b (point)) e)
+ (insert-buffer-substring forward-buffer)
+ (setq e (point))
+ (insert "<#/multipart>\n")
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (delete-region (point-min) (point-max)))))
+
+(defun message-forward-make-body-digest (forward-buffer)
+ (if message-forward-as-mime
+ (message-forward-make-body-digest-mime forward-buffer)
+ (message-forward-make-body-digest-plain forward-buffer)))
+
;;;###autoload
(defun message-forward-make-body (forward-buffer &optional digest)
;; Put point where we want it before inserting the forwarded
(if message-forward-before-signature
(message-goto-body)
(goto-char (point-max)))
- (if message-forward-as-mime
- (if digest
- (insert "\n<#multipart type=digest>\n")
- (if message-forward-show-mml
- (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
- (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
- (insert "\n-------------------- Start of forwarded message --------------------\n"))
- (let ((b (point)) e)
- (if digest
- (if message-forward-as-mime
- (insert-buffer-substring forward-buffer)
- (mml-insert-buffer forward-buffer))
- (if (and message-forward-show-mml
- (not message-forward-decoded-p))
- (insert
- (with-temp-buffer
- (mm-disable-multibyte)
- (insert
- (with-current-buffer forward-buffer
- (mm-with-unibyte-current-buffer (buffer-string))))
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (goto-char (point-max)))))
- (setq e (point))
+ (if digest
+ (message-forward-make-body-digest forward-buffer)
(if message-forward-as-mime
- (if digest
- (insert "<#/multipart>\n")
- (if message-forward-show-mml
- (insert "<#/mml>\n")
- (insert "<#/part>\n")))
- (insert "\n-------------------- End of forwarded message --------------------\n"))
- (if (and digest message-forward-as-mime)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (delete-region (point-min) (point-max)))
- (when (and (not current-prefix-arg)
- message-forward-ignored-headers
- ;; don't remove CTE, X-Gnus etc when doing "raw" forward:
- message-forward-show-mml)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
+ (if (and message-forward-show-mml
+ (not (and (eq message-forward-show-mml 'best)
+ (with-current-buffer forward-buffer
+ (goto-char (point-min))
+ (re-search-forward
+ "Content-Type: *multipart/\\(signed\\|encrypted\\)"
+ nil t)))))
+ (message-forward-make-body-mml forward-buffer)
+ (message-forward-make-body-mime forward-buffer))
+ (message-forward-make-body-plain forward-buffer)))
(message-position-point))
;;;###autoload
message-setup-hook)
(message-setup `((To . ,address))))
;; Insert our usual headers.
- (message-generate-headers '(From Date To))
+ (message-generate-headers '(From Date To Message-ID))
(message-narrow-to-headers)
;; Remove X-Draft-From header etc.
(message-remove-header message-ignored-mail-headers t)
(mm-insert-part handles)
(undo-boundary)
(goto-char (point-min))
- (search-forward "\n\n" nil t)
- (if (or (and (re-search-forward message-unsent-separator nil t)
- (forward-line 1))
- (re-search-forward "^Return-Path:.*\n" nil t))
- ;; We remove everything before the bounced mail.
- (delete-region
- (point-min)
- (if (re-search-forward "^[^ \n\t]+:" nil t)
- (match-beginning 0)
- (point)))
+ (re-search-forward "\n\n+" nil t)
+ (setq boundary (point))
+ ;; We remove everything before the bounced mail.
+ (if (or (re-search-forward message-unsent-separator nil t)
+ (progn
+ (search-forward "\n\n" nil 'move)
+ (re-search-backward "^Return-Path:.*\n" boundary t)))
+ (progn
+ (forward-line 1)
+ (delete-region (point-min)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
+ (match-beginning 0)
+ (point))))
+ (goto-char boundary)
(when (re-search-backward "^.?From .*\n" nil t)
(delete-region (match-beginning 0) (match-end 0)))))
(mm-enable-multibyte)
projects / gnus / blobdiff