(message-included-forward-headers): Add "Mail-Followup-To:" and
authorshuhei-k <shuhei-k>
Sat, 30 May 1998 14:53:05 +0000 (14:53 +0000)
committershuhei-k <shuhei-k>
Sat, 30 May 1998 14:53:05 +0000 (14:53 +0000)
"Mail-Reply-To:" fields.
(message-font-lock-keywords): Ditto.

lisp/message.el

index 4aa804b..7b6f80d 100644 (file)
@@ -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"