X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=8c33c13906e70c56a353e63d77377e851fa068fc;hb=ffc1044ac34848d3054ffccee9d91b5befeda865;hp=ff5cb819d1a89df1d6b68b105a58ed33382615f0;hpb=15cf2c08a64d2e909855d9a4e9d53cc595543c51;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index ff5cb81..8c33c13 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2,7 +2,9 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news +;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -29,7 +31,10 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'smtp) + ) (require 'mailheader) (require 'nnheader) @@ -39,6 +44,7 @@ (if (string-match "XEmacs\\|Lucid" emacs-version) (require 'mail-abbrevs) (require 'mailabbrev)) +(require 'mime-edit) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -122,6 +128,11 @@ mailbox format." (function :tag "Other")) :group 'message-sending) +(defcustom message-encode-function 'message-maybe-encode + "*A function called to encode messages." + :group 'message-sending + :type 'function) + (defcustom message-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" "*This is inserted at the start of a mailed copy of a posted message. @@ -172,11 +183,11 @@ shorten-followup-to existing-newsgroups buffer-file-name unchanged." (defcustom message-required-news-headers '(From Newsgroups Subject Date Message-ID (optional . Organization) Lines - (optional . X-Newsreader)) + (optional . User-Agent)) "*Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines, In-Reply-To, Expires, and -X-Newsreader are optional. If don't you want message to insert some +User-Agent are optional. If don't you want message to insert some header, remove it from this list." :group 'message-news :group 'message-headers @@ -184,10 +195,10 @@ header, remove it from this list." (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer)) + (optional . User-Agent)) "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and X-Mailer are optional." +included. Organization, Lines and User-Agent are optional." :group 'message-mail :group 'message-headers :type '(repeat sexp)) @@ -217,6 +228,52 @@ any confusion." :group 'message-interface :type 'regexp) +(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*" + "*Regexp matching \"Re: \" in the subject line." + :group 'message-various + :type 'regexp) + +;;; Some sender agents encode the whole subject including leading "Re: ". +;;; And if followup agent does not decode it for some reason (e.g. unknown +;;; charset) and just add a new "Re: " in front of the encoded-word, the +;;; result will contain multiple "Re: "'s. +(defcustom message-subject-encoded-re-regexp + (concat + "^[ \t]*" + (regexp-quote "=?") + "[-!#$%&'*+0-9A-Z^_`a-z{|}~]+" ; charset + (regexp-quote "?") + "\\(" + "[Bb]" (regexp-quote "?") ; B encoding + "\\(\\(CQk\\|CSA\\|IAk\\|ICA\\)[Jg]\\)*" ; \([ \t][ \t][ \t]\)* + "\\(" + "[Uc][km]U6" ; [Rr][Ee]: + "\\|" + "\\(C[VX]\\|I[FH]\\)J[Fl]O[g-v]" ; [ \t][Rr][Ee]: + "\\|" + "\\(CQl\\|CSB\\|IAl\\|ICB\\)[Sy][RZ]T[o-r]" ; [ \t][ \t][Rr][Ee]: + "\\)" + "\\|" + "[Qb]" (regexp-quote "?") ; Q encoding + "\\(_\\|=09\\|=20\\)*" + "\\([Rr]\\|=[57]2\\)\\([Ee]\\|=[46]5\\)\\(:\\|=3[Aa]\\)" + "\\)" + ) + "*Regexp matching \"Re: \" in the subject line. +Unlike `message-subject-re-regexp', this regexp matches \"Re: \" within +an encoded-word." + :group 'message-various + :type 'regexp) + +(defcustom message-use-subject-re t + "*If t, remove any (buggy) \"Re: \"'s from the subject of the precursor +and add a new \"Re: \". If it is nil, use the subject \"as-is\". If it +is the symbol `guess', try to detect \"Re: \" within an encoded-word." + :group 'message-various + :type '(choice (const :tag "off" nil) + (const :tag "on" t) + (const guess))) + ;;;###autoload (defcustom message-signature-separator "^-- *$" "Regexp matching the signature separator." @@ -270,13 +327,13 @@ If t, use `message-user-organization-file'." :group 'message-headers) (defcustom message-forward-start-separator - "------- Start of forwarded message -------\n" + (concat (mime-make-tag "message" "rfc822") "\n") "*Delimiter inserted before forwarded messages." :group 'message-forwarding :type 'string) (defcustom message-forward-end-separator - "------- End of forwarded message -------\n" + "" "*Delimiter inserted after forwarded messages." :group 'message-forwarding :type 'string) @@ -287,12 +344,12 @@ If t, use `message-user-organization-file'." :type 'boolean) (defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding :type 'regexp) -(defcustom message-ignored-resent-headers "^Return-receipt" +(defcustom message-ignored-resent-headers "^Return-Receipt" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) @@ -316,16 +373,17 @@ variable `mail-header-separator'. Legal values include `message-send-mail-with-sendmail' (the default), `message-send-mail-with-mh', `message-send-mail-with-qmail' and -`smtpmail-send-it'." +`message-send-mail-with-smtp'." :type '(radio (function-item message-send-mail-with-sendmail) (function-item message-send-mail-with-mh) (function-item message-send-mail-with-qmail) - (function-item smtpmail-send-it) + (function-item message-send-mail-with-smtp) (function :tag "Other")) :group 'message-sending :group 'message-mail) -(defcustom message-send-news-function 'message-send-news +;; 1997-09-29 by MORIOKA Tomohiko +(defcustom message-send-news-function 'message-send-news-with-gnus "Function to call to send the current buffer as news. The headers should be delimited by a line whose contents match the variable `mail-header-separator'." @@ -365,6 +423,38 @@ always query the user whether to use the value. If it is the symbol (const use) (const ask))) +(defcustom message-use-mail-copies-to 'ask + "*Specifies what to do with Mail-Copies-To header. +If nil, always ignore the header. If it is t, use its value, but +query before using the value other than \"always\" or \"never\". +If it is the symbol `ask', always query the user whether to use +the value. If it is the symbol `use', always use the value." + :group 'message-interface + :type '(choice (const :tag "ignore" nil) + (const use) + (const ask))) + +(defcustom message-use-mail-followup-to 'ask + "*Specifies what to do with Mail-Followup-To header. +If nil, always ignore the header. If it is the symbol `ask', always +query the user whether to use the value. If it is t or the symbol +`use', always use the value." + :group 'message-interface + :type '(choice (const :tag "ignore" nil) + (const use) + (const ask))) + +(defcustom message-use-mail-reply-to t + "*Specifies what to do with Mail-Reply-To/Reply-To header. +If nil, always ignore the header. If it is t, use its value unless +\"Reply-To\" is marked as \"broken\". If it is the symbol `ask', +always query the user whether to use the value. If it is the symbol +`use', always use the value." + :group 'message-interface + :type '(choice (const :tag "ignore" nil) + (const use) + (const ask))) + ;; stuff relating to broken sendmail in MMDF (defcustom message-sendmail-f-is-evil nil "*Non-nil means that \"-f username\" should not be added to the sendmail @@ -411,7 +501,8 @@ variable isn't used." :group 'message-headers :type 'boolean) -(defcustom message-setup-hook nil +(defcustom message-setup-hook + '(message-maybe-setup-default-charset turn-on-mime-edit) "Normal hook, run each time a new outgoing message is initialized. The function `message-setup' runs this hook." :group 'message-various @@ -429,7 +520,7 @@ the signature is inserted." :group 'message-various :type 'hook) -(defcustom message-header-hook nil +(defcustom message-header-hook '(eword-encode-header) "Hook run in a message mode buffer narrowed to the headers." :group 'message-various :type 'hook) @@ -524,8 +615,6 @@ If stringp, use this; if non-nil, use no host name (user name only)." (defvar message-reply-buffer nil) (defvar message-reply-headers nil) -(defvar message-newsreader nil) -(defvar message-mailer nil) (defvar message-sent-message-via nil) (defvar message-checksum nil) (defvar message-send-actions nil @@ -590,6 +679,10 @@ actually occur." :group 'message-sending :type 'sexp) +;;; XXX: This symbol is overloaded! See below. +(defvar message-user-agent nil + "String of the form of PRODUCT/VERSION. Used for User-Agent header field.") + ;; Ignore errors in case this is used in Emacs 19. ;; Don't use ignore-errors because this is copied into loaddefs.el. ;;;###autoload @@ -760,7 +853,10 @@ Defaults to `text-mode-abbrev-table'.") `((,(concat "^\\([Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-to-face nil t)) - (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) + (,(concat "^\\([GBF]?[Cc][Cc]:\\|[Rr]eply-[Tt]o:\\|" + "[Mm]ail-[Cc]opies-[Tt]o:\\|" + "[Mm]ail-[Rr]eply-[Tt]o:\\|" + "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-cc-face nil t)) (,(concat "^\\([Ss]ubject:\\)" content) @@ -911,8 +1007,7 @@ The cdr of ech entry is a function for applying the face to a region.") (Expires) (Message-ID) (References . message-fill-header) - (X-Mailer) - (X-Newsreader)) + (User-Agent)) "Alist used for formatting headers.") (eval-and-compile @@ -1035,7 +1130,7 @@ The cdr of ech entry is a function for applying the face to a region.") (defun message-strip-subject-re (subject) "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) + (if (string-match message-subject-re-regexp subject) (substring subject (match-end 0)) subject)) @@ -1176,7 +1271,9 @@ Return the number of headers removed." (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) + ;; (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) + (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-mail-reply-to) + (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) @@ -1236,6 +1333,9 @@ Return the number of headers removed." ["Subject" message-goto-subject t] ["Cc" message-goto-cc t] ["Reply-To" message-goto-reply-to t] + ["Mail-Reply-To" message-goto-mail-reply-to t] + ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Mail-Copies-To" message-goto-mail-copies-to t] ["Summary" message-goto-summary t] ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] @@ -1258,6 +1358,7 @@ C-c C-f move to a header field (and create it if there isn't): C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution + C-c C-f C-m move to Mail-Followup-To C-c C-f C-f move to Followup-To C-c C-t message-insert-to (add a To header to a news followup) C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) @@ -1312,8 +1413,7 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." paragraph-separate)) (make-local-variable 'message-reply-headers) (setq message-reply-headers nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) + (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) @@ -1383,6 +1483,21 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (message-position-on-field "Reply-To" "Subject")) +(defun message-goto-mail-reply-to () + "Move point to the Mail-Reply-To header." + (interactive) + (message-position-on-field "Mail-Reply-To" "Subject")) + +(defun message-goto-mail-followup-to () + "Move point to the Mail-Followup-To header." + (interactive) + (message-position-on-field "Mail-Followup-To" "Subject")) + +(defun message-goto-mail-copies-to () + "Move point to the Mail-Copies-To header." + (interactive) + (message-position-on-field "Mail-Copies-To" "Subject")) + (defun message-goto-newsgroups () "Move point to the Newsgroups header." (interactive) @@ -1875,20 +1990,29 @@ the user from the mailer." (message-fix-before-sending) (run-hooks 'message-send-hook) (message "Sending...") - (let ((alist message-send-method-alist) + (let ((message-encoding-buffer + (message-generate-new-buffer-clone-locals " message encoding")) + (message-edit-buffer (current-buffer)) + (message-mime-mode mime-edit-mode-flag) + (alist message-send-method-alist) (success t) elem sent) - (while (and success - (setq elem (pop alist))) - (when (and (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg))))) - (setq sent t))) + (save-excursion + (set-buffer message-encoding-buffer) + (erase-buffer) + (insert-buffer message-edit-buffer) + (funcall message-encode-function) + (while (and success + (setq elem (pop alist))) + (when (and (or (not (funcall (cadr elem))) + (and (or (not (memq (car elem) + message-sent-message-via)) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem)))) + (setq success (funcall (caddr elem) arg))))) + (setq sent t)))) (when (and success sent) (message-do-fcc) ;;(when (fboundp 'mail-hist-put-headers-into-history) @@ -1906,12 +2030,12 @@ the user from the mailer." t)))) (defun message-send-via-mail (arg) - "Send the current message via mail." + "Send the current message via mail." (message-send-mail arg)) (defun message-send-via-news (arg) "Send the current message via news." - (funcall message-send-news-function arg)) + (message-send-news arg)) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -1945,8 +2069,7 @@ the user from the mailer." (require 'mail-utils) (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) (case-fold-search nil) - (news (message-news-p)) - (mailbuf (current-buffer))) + (news (message-news-p))) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -1959,11 +2082,7 @@ the user from the mailer." (save-excursion (set-buffer tembuf) (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer mailbuf) - (buffer-string)))) + (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -1977,9 +2096,15 @@ the user from the mailer." (or (message-fetch-field "cc") (message-fetch-field "to"))) (message-insert-courtesy-copy)) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-mail-function) + ))) (funcall message-send-mail-function)) (kill-buffer tembuf)) - (set-buffer mailbuf) + (set-buffer message-edit-buffer) (push 'mail message-sent-message-via))) (defun message-send-mail-with-sendmail () @@ -2106,13 +2231,151 @@ to find out how to use this." ;; Pass it on to mh. (mh-send-letter))) +(defun message-send-mail-with-smtp () + "Send the prepared message buffer with SMTP." + (require 'smtp) + (let ((errbuf (if mail-interactive + (generate-new-buffer " smtp errors") + 0)) + (case-fold-search nil) + resend-to-addresses + delimline) + (unwind-protect + (save-excursion + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (run-hooks 'message-send-mail-hook) + ;; (sendmail-synch-aliases) + ;; (if mail-aliases + ;; (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t)) + (goto-char (point-min)) + (goto-char (point-min)) + (while (re-search-forward "^Resent-to:" delimline t) + (setq resend-to-addresses + (save-restriction + (narrow-to-region (point) + (save-excursion + (end-of-line) + (point))) + (append (mail-parse-comma-list) + resend-to-addresses)))) +;;; Apparently this causes a duplicate Sender. +;;; ;; If the From is different than current user, insert Sender. +;;; (goto-char (point-min)) +;;; (and (re-search-forward "^From:" delimline t) +;;; (progn +;;; (require 'mail-utils) +;;; (not (string-equal +;;; (mail-strip-quoted-names +;;; (save-restriction +;;; (narrow-to-region (point-min) delimline) +;;; (mail-fetch-field "From"))) +;;; (user-login-name)))) +;;; (progn +;;; (forward-line 1) +;;; (insert "Sender: " (user-login-name) "\n"))) + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:[ \t]*\n" delimline t) + (replace-match "")) + ;; Put the "From:" field in unless for some odd reason + ;; they put one in themselves. + (goto-char (point-min)) + (if (not (re-search-forward "^From:" delimline t)) + (let* ((login user-mail-address) + (fullname (user-full-name))) + (cond ((eq mail-from-style 'angles) + (insert "From: " fullname) + (let ((fullname-start (+ (point-min) 6)) + (fullname-end (point-marker))) + (goto-char fullname-start) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + (progn + ;; Quote fullname, escaping specials. + (goto-char fullname-start) + (insert "\"") + (while (re-search-forward "[\"\\]" + fullname-end 1) + (replace-match "\\\\\\&" t)) + (insert "\"")))) + (insert " <" login ">\n")) + ((eq mail-from-style 'parens) + (insert "From: " login " (") + (let ((fullname-start (point))) + (insert fullname) + (let ((fullname-end (point-marker))) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" fullname-end 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + fullname-end 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start)))) + (insert ")\n")) + ((null mail-from-style) + (insert "From: " login "\n"))))) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (mail-do-fcc delimline)) + (if mail-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + ;; + ;; + ;; + (let ((recipient-address-list + (or resend-to-addresses + (smtp-deduce-address-list (current-buffer) + (point-min) delimline)))) + (smtp-do-bcc delimline) + + (if recipient-address-list + (if (not (smtp-via-smtp recipient-address-list + (current-buffer))) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + )) + (if (bufferp errbuf) + (kill-buffer errbuf))))) + (defun message-send-news (&optional arg) (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) (case-fold-search nil) (method (if (message-functionp message-post-method) (funcall message-post-method arg) message-post-method)) - (messbuf (current-buffer)) (message-syntax-checks (if arg (cons '(existing-newsgroups . disabled) @@ -2135,11 +2398,7 @@ to find out how to use this." (set-buffer tembuf) (buffer-disable-undo (current-buffer)) (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer messbuf) - (buffer-string)))) + (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -2149,30 +2408,48 @@ to find out how to use this." ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) - (let ((case-fold-search t)) - ;; Remove the delimiter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1)) - (run-hooks 'message-send-news-hook) - ;;(require (car method)) - ;;(funcall (intern (format "%s-open-server" (car method))) - ;;(cadr method) (cddr method)) - ;;(setq result - ;; (funcall (intern (format "%s-request-post" (car method))) - ;; (cadr method))) - (gnus-open-server method) - (setq result (gnus-request-post method))) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (save-restriction + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (when (re-search-forward "^Message-Id:" nil t) + (delete-region (match-end 0)(std11-field-end)) + (insert (concat " " (message-make-message-id))) + )) + (funcall message-send-news-function method) + ))) + (setq result (funcall message-send-news-function method))) (kill-buffer tembuf)) - (set-buffer messbuf) + (set-buffer message-edit-buffer) (if result (push 'news message-sent-message-via) (message "Couldn't send message via news: %s" (nnheader-get-report (car method))) nil)))) +;; 1997-09-29 by MORIOKA Tomohiko +(defun message-send-news-with-gnus (method) + (let ((case-fold-search t)) + ;; Remove the delimiter. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (run-hooks 'message-send-news-hook) + ;;(require (car method)) + ;;(funcall (intern (format "%s-open-server" (car method))) + ;;(cadr method) (cddr method)) + ;;(setq result + ;; (funcall (intern (format "%s-request-post" (car method))) + ;; (cadr method))) + (gnus-open-server method) + (gnus-request-post method) + )) + ;;; ;;; Header generation & syntax checking. ;;; @@ -2206,7 +2483,9 @@ to find out how to use this." (message-narrow-to-headers) (message-check-news-header-syntax))) ;; Check the body. - (message-check-news-body-syntax))))) + (save-excursion + (set-buffer message-edit-buffer) + (message-check-news-body-syntax)))))) (defun message-check-news-header-syntax () (and @@ -2467,18 +2746,19 @@ to find out how to use this." (defun message-do-fcc () "Process Fcc headers in the current buffer." (let ((case-fold-search t) - (buf (current-buffer)) + (coding-system-for-write 'raw-text) list file) (save-excursion (set-buffer (get-buffer-create " *message temp*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-buffer-substring buf) + (insert-buffer-substring message-encoding-buffer) (save-restriction (message-narrow-to-headers) (while (setq file (message-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) + (run-hooks 'message-header-hook 'message-before-do-fcc-hook) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) @@ -2549,6 +2829,16 @@ to find out how to use this." (timezone-make-date-arpa-standard (current-time-string now) (current-time-zone now)))) +(defun message-make-followup-subject (subject) + "Make a followup Subject." + (cond + ((and (eq message-use-subject-re 'guess) + (string-match message-subject-encoded-re-regexp subject)) + subject) + (message-use-subject-re + (concat "Re: " (message-strip-subject-re subject))) + (t subject))) + (defun message-make-message-id () "Make a unique Message-ID." (concat "<" (message-unique-id) @@ -2645,18 +2935,20 @@ to find out how to use this." (defun message-make-in-reply-to () "Return the In-Reply-To header for this message." (when message-reply-headers - (let ((from (mail-header-from message-reply-headers)) + (let ((mid (mail-header-message-id message-reply-headers)) + (from (mail-header-from message-reply-headers)) (date (mail-header-date message-reply-headers))) - (when from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (concat (if (and stop-pos - (not (zerop stop-pos))) - (substring from 0 stop-pos) from) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\"")))))) + (when mid + (concat mid + (when from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (concat "\n (" + (if stop-pos (substring from 0 stop-pos) from) + "'s message of " + (if (or (not date) (string= date "")) + "(unknown date)" date) + ")")))))))) (defun message-make-distribution () "Make a Distribution header." @@ -2812,9 +3104,7 @@ Headers already prepared in the buffer are not modified." (To nil) (Distribution (message-make-distribution)) (Lines (message-make-lines)) - (X-Newsreader message-newsreader) - (X-Mailer (and (not (message-fetch-field "X-Newsreader")) - message-mailer)) + (User-Agent message-user-agent) (Expires (message-make-expires)) (case-fold-search t) header value elem) @@ -2958,14 +3248,12 @@ Headers already prepared in the buffer are not modified." (if (or (= (following-char) ?,) (eobp)) (when (not quoted) - (if (and (> (current-column) 78) - last) - (progn - (save-excursion - (goto-char last) - (insert "\n\t")) - (setq last (1+ (point)))) - (setq last (1+ (point))))) + (if last + (save-excursion + (goto-char last) + (looking-at "[ \t]*") + (replace-match "\n " t t))) + (setq last (1+ (point)))) (setq quoted (not quoted))) (unless (eobp) (forward-char 1)))) @@ -2975,8 +3263,8 @@ Headers already prepared in the buffer are not modified." (defun message-fill-header (header value) (let ((begin (point)) - (fill-column 990) - (fill-prefix "\t")) + (fill-column 78) + (fill-prefix " ")) (insert (capitalize (symbol-name header)) ": " (if (consp value) (car value) value) @@ -3185,10 +3473,10 @@ Headers already prepared in the buffer are not modified." "Start editing a reply to the article in the current buffer." (interactive) (let ((cur (current-buffer)) - from subject date reply-to to cc - references message-id follow-to (inhibit-point-motion-hooks t) - mct never-mct gnus-warning) + from date subject mct mft mrt + never-mct to cc + references message-id follow-to gnus-warning) (save-restriction (message-narrow-to-head) ;; Allow customizations to have their say. @@ -3203,74 +3491,123 @@ Headers already prepared in the buffer are not modified." (funcall message-wide-reply-to-function))))) ;; Find all relevant headers we need. (setq from (message-fetch-field "from") - date (message-fetch-field "date") + date (message-fetch-field "date" t) subject (or (message-fetch-field "subject") "none") + references (message-fetch-field "references") + message-id (message-fetch-field "message-id" t) to (message-fetch-field "to") cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t)) + mct (when (and wide message-use-mail-copies-to) + (message-fetch-field "mail-copies-to")) + mft (when (and wide message-use-mail-followup-to) + (message-fetch-field "mail-followup-to")) + mrt (when message-use-mail-reply-to + (or (message-fetch-field "mail-reply-to") + (and (or (eq message-use-mail-reply-to 'use) + (not ignore-reply-to)) + (message-fetch-field "reply-to")))) + gnus-warning (message-fetch-field "gnus-warning")) + (when (and gnus-warning (string-match "<[^>]+>" gnus-warning)) + (setq message-id (match-string 0 gnus-warning))) ;; Remove any (buggy) Re:'s that are present and make a ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond ((equal (downcase mct) "never") - (setq never-mct t) - (setq mct nil)) - ((equal (downcase mct) "always") - (setq mct (or reply-to from))))) - - (unless follow-to - (if (or (not wide) - to-address) - (progn - (setq follow-to (list (cons 'To (or to-address reply-to from)))) - (when (and wide mct) - (push (cons 'Cc mct) follow-to))) - (let (ccalist) - (save-excursion - (message-set-work-buffer) - (unless never-mct - (insert (or reply-to from ""))) - (insert (if to (concat (if (bolp) "" ", ") to "") "")) - (insert (if mct (concat (if (bolp) "" ", ") mct) "")) - (insert (if cc (concat (if (bolp) "" ", ") cc) "")) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " " t t)) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer))) - (goto-char (point-min)) - ;; Perhaps Mail-Copies-To: never removed the only address? - (when (eobp) - (insert (or reply-to from ""))) - (setq ccalist - (mapcar - (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) - (message-tokenize-header (buffer-string)))) - (let ((s ccalist)) - (while s - (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) - (setq follow-to (list (cons 'To (cdr (pop ccalist))))) - (when ccalist - (let ((ccs (cons 'Cc (mapconcat - (lambda (addr) (cdr addr)) ccalist ", ")))) - (when (string-match "^ +" (cdr ccs)) - (setcdr ccs (substring (cdr ccs) (match-end 0)))) - (push ccs follow-to)))))) + (setq subject (message-make-followup-subject subject)) (widen)) + ;; Handle special values of Mail-Copies-To. + (when mct + (cond + ((and (equal (downcase mct) "never") + (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: never? ") t "\ +You should normally obey the Mail-Copies-To: header. + + `Mail-Copies-To: never' +directs you not to send your response to the author."))) + (setq never-mct t) + (setq mct nil)) + ((and (equal (downcase mct) "always") + (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: always? ") t "\ +You should normally obey the Mail-Copies-To: header. + + `Mail-Copies-To: always' +sends a copy of your response to the author."))) + (setq mct (or mrt from))) + ((and (eq message-use-mail-copies-to 'ask) + (not + (message-y-or-n-p + (concat "Obey Mail-Copies-To: " mct " ? ") t "\ +You should normally obey the Mail-Copies-To: header. + + `Mail-Copies-To: " mct "' +sends a copy of your response to " (if (string-match "," mct) + "the specified addresses" + "that address") "."))) + (setq mct nil)) + )) + + (unless follow-to + (cond + (to-address (setq follow-to (list (cons 'To to-address)))) + ((not wide) (setq follow-to (list (cons 'To (or mrt from))))) + ;; Handle Mail-Followup-To. + ((and mft + (or (not (eq message-use-mail-followup-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Followup-To: " mft "? ") t "\ +You should normally obey the Mail-Followup-To: header. + + `Mail-Followup-To: " mft "' +directs your response to " (if (string-match "," mft) + "the specified addresses" + "that address only") ". + +A typical situation where Mail-Followup-To is used is when the author thinks +that further discussion should take place only in " + (if (string-match "," mft) + "the specified mailing lists" + "that mailing list") "."))) + (setq follow-to (list (cons 'To mft))) + (when mct + (push (cons 'Cc mct) follow-to))) + (t + (let (ccalist) + (save-excursion + (message-set-work-buffer) + (unless never-mct + (insert (or mrt from ""))) + (insert (if to (concat (if (bolp) "" ", ") to "") "")) + (insert (if mct (concat (if (bolp) "" ", ") mct) "")) + (insert (if cc (concat (if (bolp) "" ", ") cc) "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " " t t)) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (insert (prog1 (rmail-dont-reply-to (buffer-string)) + (erase-buffer))) + (goto-char (point-min)) + ;; Perhaps Mail-Copies-To: never removed the only address? + (when (eobp) + (insert (or mrt from ""))) + (setq ccalist + (mapcar + (lambda (addr) + (cons (mail-strip-quoted-names addr) addr)) + (message-tokenize-header (buffer-string)))) + (let ((s ccalist)) + (while s + (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) + (setq follow-to (list (cons 'To (cdr (pop ccalist))))) + (when ccalist + (let ((ccs (cons 'Cc (mapconcat + (lambda (addr) (cdr addr)) ccalist ", ")))) + (when (string-match "^ +" (cdr ccs)) + (setcdr ccs (substring (cdr ccs) (match-end 0)))) + (push ccs follow-to))))))) + (message-pop-to-buffer (message-buffer-name (if wide "wide reply" "reply") from (if wide to-address nil))) @@ -3283,8 +3620,7 @@ Headers already prepared in the buffer are not modified." ,@follow-to ,@(if (or references message-id) `((References . ,(concat (or references "") (and references " ") - (or message-id "")))) - nil)) + (or message-id "")))))) cur))) ;;;###autoload @@ -3295,37 +3631,41 @@ Headers already prepared in the buffer are not modified." ;;;###autoload (defun message-followup (&optional to-newsgroups) - "Follow up to the message in the current buffer. -If TO-NEWSGROUPS, use that as the new Newsgroups line." + "Follow up to the message in the current buffer." (interactive) (let ((cur (current-buffer)) - from subject date reply-to mct - references message-id follow-to (inhibit-point-motion-hooks t) + from date subject mct mft mrt (message-this-is-news t) - followup-to distribution newsgroups gnus-warning posted-to) + followup-to distribution newsgroups posted-to + references message-id follow-to gnus-warning) (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) + (message-narrow-to-head) + ;; Allow customizations to have their say. + ;; This is a followup. (when (message-functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) + ;; Find all relevant headers we need. (setq from (message-fetch-field "from") - date (message-fetch-field "date") + date (message-fetch-field "date" t) subject (or (message-fetch-field "subject") "none") references (message-fetch-field "references") message-id (message-fetch-field "message-id" t) - followup-to (message-fetch-field "followup-to") + followup-to (when message-use-followup-to + (message-fetch-field "followup-to")) + distribution (message-fetch-field "distribution") newsgroups (message-fetch-field "newsgroups") posted-to (message-fetch-field "posted-to") - reply-to (message-fetch-field "reply-to") - distribution (message-fetch-field "distribution") - mct (message-fetch-field "mail-copies-to")) - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) + mct (when message-use-mail-copies-to + (message-fetch-field "mail-copies-to")) + mft (when message-use-mail-followup-to + (message-fetch-field "mail-followup-to")) + mrt (when message-use-mail-reply-to + (or (message-fetch-field "mail-reply-to") + (message-fetch-field "reply-to"))) + gnus-warning (message-fetch-field "gnus-warning")) + (when (and gnus-warning (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) ;; Remove bogus distribution. (when (and (stringp distribution) @@ -3334,40 +3674,68 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (setq distribution nil)) ;; Remove any (buggy) Re:'s that are present and make a ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) + (setq subject (message-make-followup-subject subject)) (widen)) - (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) - - (message-setup - `((Subject . ,subject) - ,@(cond - (to-newsgroups - (list (cons 'Newsgroups to-newsgroups))) - (follow-to follow-to) - ((and followup-to message-use-followup-to) - (list - (cond - ((equal (downcase followup-to) "poster") - (if (or (eq message-use-followup-to 'use) - (message-y-or-n-p "Obey Followup-To: poster? " t "\ + ;; Handle special values of Mail-Copies-To. + (when mct + (cond + ((and (equal (downcase mct) "never") + (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: never? ") t "\ +You should normally obey the Mail-Copies-To: header. + + `Mail-Copies-To: never' +directs you not to send your response to the author."))) + (setq mct nil)) + ((and (equal (downcase mct) "always") + (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: always? ") t "\ +You should normally obey the Mail-Copies-To: header. + + `Mail-Copies-To: always' +sends a copy of your response to the author."))) + (setq mct (or mrt from))) + ((and (eq message-use-mail-copies-to 'ask) + (not + (message-y-or-n-p + (concat "Obey Mail-Copies-To: " mct " ? ") t "\ +You should normally obey the Mail-Copies-To: header. + + `Mail-Copies-To: " mct "' +sends a copy of your response to " (if (string-match "," mct) + "the specified addresses" + "that address") "."))) + (setq mct nil)) + )) + + (unless follow-to + (cond + (to-newsgroups (setq follow-to (list (cons 'Newsgroups to-newsgroups)))) + ;; Handle Followup-To. + (followup-to + (cond + ((equal (downcase followup-to) "poster") + (if (or (eq message-use-followup-to 'use) + (message-y-or-n-p "Obey Followup-To: poster? " t "\ You should normally obey the Followup-To: header. -`Followup-To: poster' sends your response via e-mail instead of news. + `Followup-To: poster' +sends your response via e-mail instead of news. -A typical situation where `Followup-To: poster' is used is when the poster +A typical situation where `Followup-To: poster' is used is when the author does not read the newsgroup, so he wouldn't see any replies sent to it.")) - (progn - (setq message-this-is-news nil) - (cons 'To (or reply-to from ""))) - (cons 'Newsgroups newsgroups))) - (t - (if (or (equal followup-to newsgroups) - (not (eq message-use-followup-to 'ask)) - (message-y-or-n-p - (concat "Obey Followup-To: " followup-to "? ") t "\ + (setq message-this-is-news nil + distribution nil + follow-to (list (cons 'To (or mrt from "")))) + (setq follow-to (list (cons 'Newsgroups newsgroups))))) + (t + (if (or (equal followup-to newsgroups) + (not (eq message-use-followup-to 'ask)) + (message-y-or-n-p + (concat "Obey Followup-To: " followup-to "? ") t "\ You should normally obey the Followup-To: header. `Followup-To: " followup-to "' @@ -3382,27 +3750,46 @@ be fragmented and very difficult to follow. Also, some source/announcement newsgroups are not indented for discussion; responses here are directed to other newsgroups.")) - (cons 'Newsgroups followup-to) - (cons 'Newsgroups newsgroups)))))) - (posted-to - `((Newsgroups . ,posted-to))) - (t - `((Newsgroups . ,newsgroups)))) - ,@(and distribution (list (cons 'Distribution distribution))) - ,@(if (or references message-id) - `((References . ,(concat (or references "") (and references " ") - (or message-id ""))))) - ,@(when (and mct - (not (equal (downcase mct) "never"))) - (list (cons 'Cc (if (equal (downcase mct) "always") - (or reply-to from "") - mct))))) + (setq follow-to (list (cons 'Newsgroups followup-to))) + (setq follow-to (list (cons 'Newsgroups newsgroups))))))) + ;; Handle Mail-Followup-To, followup via e-mail. + ((and mft + (or (not (eq message-use-mail-followup-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Followup-To: " mft "? ") t "\ +You should normally obey the Mail-Followup-To: header. + + `Mail-Followup-To: " mft "' +directs your response to " (if (string-match "," mft) + "the specified addresses" + "that address only") " instead of news. + +A typical situation where Mail-Followup-To is used is when the author thinks +that further discussion should take place only in " + (if (string-match "," mft) + "the specified mailing lists" + "that mailing list") "."))) + (setq message-this-is-news nil + distribution nil + follow-to (list (cons 'To mft)))) + (posted-to (setq follow-to (list (cons 'Newsgroups posted-to)))) + (t + (setq follow-to (list (cons 'Newsgroups newsgroups)))))) - cur) + (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")))) + (vector 0 subject from date message-id references 0 0 "")) + (message-setup + `((Subject . ,subject) + ,@follow-to + ,@(and mct (list (cons 'Cc mct))) + ,@(and distribution (list (cons 'Distribution distribution))) + ,@(if (or references message-id) + `((References . ,(concat (or references "") (and references " ") + (or message-id "")))))) + cur))) ;;;###autoload (defun message-cancel-news () @@ -3422,14 +3809,14 @@ responses here are directed to other newsgroups.")) message-id (message-fetch-field "message-id" t) distribution (message-fetch-field "distribution"))) ;; Make sure that this article was written by the user. - (unless (or (and sender - (string-equal - (downcase sender) - (downcase (message-make-sender)))) - (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (cadr (mail-extract-address-components - (message-make-from)))))) + (unless (or (and sender + (string-equal + (downcase sender) + (downcase (message-make-sender)))) + (string-equal + (downcase (cadr (mail-extract-address-components from))) + (downcase (cadr (mail-extract-address-components + (message-make-from)))))) (error "This article is not yours")) ;; Make control message. (setq buf (set-buffer (get-buffer-create " *message cancel*"))) @@ -3446,8 +3833,10 @@ responses here are directed to other newsgroups.")) message-cancel-message) (message "Canceling your article...") (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) + 'dont-check-for-anything-just-trust-me) + (message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-news)) (message "Canceling your article...done")) (kill-buffer buf))))) @@ -3510,7 +3899,8 @@ header line with the old Message-ID." (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) "(nowhere)") - "] " (or (message-fetch-field "Subject") ""))))) + "] " (or (eword-decode-unstructured-field-body + (message-fetch-field "Subject") "")))))) ;;;###autoload (defun message-forward (&optional news) @@ -3560,7 +3950,10 @@ Optional NEWS will use news to forward instead of mail." (set-buffer (get-buffer-create " *message resend*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (message-setup `((To . ,address))) + ;; avoid to turn-on-mime-edit + (let (message-setup-hook) + (message-setup `((To . ,address))) + ) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (message-narrow-to-headers) @@ -3591,7 +3984,9 @@ Optional NEWS will use news to forward instead of mail." (when (looking-at "From ") (replace-match "X-From-Line: ")) ;; Send it. - (message-send-mail) + (let ((message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) @@ -3608,7 +4003,7 @@ you." (insert-buffer-substring cur) (undo-boundary) (message-narrow-to-head) - (if (and (message-fetch-field "Mime-Version") + (if (and (message-fetch-field "MIME-Version") (setq boundary (message-fetch-field "Content-Type"))) (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) (setq boundary (concat (match-string 1 boundary) " *\n" @@ -3843,6 +4238,47 @@ regexp varstr." (cdr local))))) locals))) + +;;; @ for MIME Edit mode +;;; + +(defun message-maybe-setup-default-charset () + (let ((charset + (and (boundp 'gnus-summary-buffer) + (buffer-live-p gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset)))) + (if charset + (progn + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + )))) + +(defun message-maybe-encode () + (when message-mime-mode + (run-hooks 'mime-edit-translate-hook) + (if (catch 'mime-edit-error + (save-excursion + (mime-edit-translate-body) + )) + (error "Translation error!") + ) + (end-of-invisible) + (run-hooks 'mime-edit-exit-hook) + )) + +(defun message-mime-insert-article (&optional message) + (interactive) + (let ((message-cite-function 'mime-edit-inserted-message-filter) + (message-reply-buffer gnus-original-article-buffer) + ) + (message-yank-original nil) + )) + +(set-alist 'mime-edit-message-inserter-alist + 'message-mode (function message-mime-insert-article)) + ;;; Miscellaneous functions ;; stolen (and renamed) from nnheader.el