From 3083c041b3c31520bfdc2d5dac1bc31ac3b786df Mon Sep 17 00:00:00 2001 From: shuhei-k Date: Sat, 30 May 1998 14:53:05 +0000 Subject: [PATCH] (message-included-forward-headers): Add "Mail-Followup-To:" and "Mail-Reply-To:" fields. (message-font-lock-keywords): Ditto. --- lisp/message.el | 71 ++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 55 insertions(+), 16 deletions(-) diff --git a/lisp/message.el b/lisp/message.el index 4aa804b..7b6f80d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -297,12 +297,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:\\|^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:" "*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) @@ -376,6 +376,20 @@ always query the user whether to use the value. If it is the symbol (const use) (const ask))) +(defcustom message-use-mail-followup-to 'ask + "*Specifies what to do with Mail-Followup-To header." + :group 'message-interface + :type '(choice (const :tag "ignore" nil) + (const use) + (const ask))) + +(defcustom message-use-mail-reply-to 'ask + "*Specifies what to do with Mail-Reply-To header." + :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 @@ -772,7 +786,7 @@ 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-[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) @@ -1189,6 +1203,8 @@ Return the number of headers removed." (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-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) @@ -1248,6 +1264,8 @@ Return the number of headers removed." ["Subject" message-goto-subject t] ["Cc" message-goto-cc t] ["Reply-To" message-goto-reply-to t] + ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Mail-Reply-To" message-goto-mail-reply-to t] ["Summary" message-goto-summary t] ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] @@ -1270,6 +1288,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) @@ -1395,6 +1414,16 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (message-position-on-field "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-reply-to () + "Move point to the Mail-Reply-To header." + (interactive) + (message-position-on-field "Mail-Reply-To" "Subject")) + (defun message-goto-newsgroups () "Move point to the Newsgroups header." (interactive) @@ -3372,7 +3401,7 @@ Headers already prepared in the buffer are not modified." from subject date reply-to to cc references message-id follow-to (inhibit-point-motion-hooks t) - mct never-mct gnus-warning) + mft mct never-mct gnus-warning) (save-restriction (message-narrow-to-head) ;; Allow customizations to have their say. @@ -3392,7 +3421,9 @@ Headers already prepared in the buffer are not modified." 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")) + mft (message-fetch-field "mail-followup-to") + reply-to (or (message-fetch-field "mail-reply-to") + (unless ignore-reply-to (message-fetch-field "reply-to"))) references (message-fetch-field "references") message-id (message-fetch-field "message-id" t)) ;; Remove any (buggy) Re:'s that are present and make a @@ -3414,12 +3445,16 @@ Headers already prepared in the buffer are not modified." (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))) + (cond + (to-address + (setq follow-to (list (cons 'To to-address))) + (when (and wide mct) + (push (cons 'Cc mct) follow-to))) + ((not wide) + (setq follow-to (list (cons 'To (or reply-to from))))) + ((and mft message-use-mail-followup-to) + (setq follow-to (list (cons 'To mft)))) + (t (let (ccalist) (save-excursion (message-set-work-buffer) @@ -3452,7 +3487,7 @@ Headers already prepared in the buffer are not modified." (lambda (addr) (cdr addr)) ccalist ", ")))) (when (string-match "^ +" (cdr ccs)) (setcdr ccs (substring (cdr ccs) (match-end 0)))) - (push ccs follow-to)))))) + (push ccs follow-to))))))) (widen)) (message-pop-to-buffer (message-buffer-name @@ -3483,7 +3518,7 @@ Headers already prepared in the buffer are not modified." If TO-NEWSGROUPS, use that as the new Newsgroups line." (interactive) (let ((cur (current-buffer)) - from subject date reply-to mct + from subject date reply-to mct mft references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-news t) @@ -3505,9 +3540,11 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." followup-to (message-fetch-field "followup-to") newsgroups (message-fetch-field "newsgroups") posted-to (message-fetch-field "posted-to") - reply-to (message-fetch-field "reply-to") + reply-to (or (message-fetch-field "mail-reply-to") + (message-fetch-field "reply-to")) distribution (message-fetch-field "distribution") - mct (message-fetch-field "mail-copies-to")) + mct (message-fetch-field "mail-copies-to") + mft (message-fetch-field "mail-followup-to")) (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) @@ -3547,6 +3584,8 @@ does not read the newsgroup, so he wouldn't see any replies sent to it.")) (setq message-this-is-news nil) (cons 'To (or reply-to from ""))) (cons 'Newsgroups newsgroups))) + ((and mft message-use-mail-followup-to) + (list (cons 'To mft))) (t (if (or (equal followup-to newsgroups) (not (eq message-use-followup-to 'ask)) @@ -3796,7 +3835,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" -- 1.7.10.4