new Mail-Followup-To patch...please take a look...

[Josh Huber <huber@alum.wpi.edu>]

Here's my current mail-followup-to generation patch against message.el
(at the end of the message).

I'm currently using it, and it seems to work fine (for me), but I'd
like other people to test it.

I'm configuring it this way:

;;---------------------
;; Mail-Followup-To settings
(setq gnus-parameters
      '(("^mail\\.lists\\." (subscribed . t))))

(defun jmh-find-subscribed-addresses ()
  (let ((groups (mapcar 'car (cdr gnus-newsrc-alist))))
    (delete-if nil (mapcar
		    '(lambda (group)
		       (or (gnus-group-find-parameter group 'to-address)
			   (gnus-group-find-parameter group 'to-list)))
		    (delete-if-not '(lambda (group)
				      (gnus-group-find-parameter
				       group 'subscribed))
				   groups)))))

(setq message-subscribed-addresses (jmh-find-subscribed-addresses))

(defun show-mft ()
  (let ((recipients))
    (save-excursion
      (save-restriction
	(message-narrow-to-head)
	(message-options-set-recipient)
	(or (message-make-mft) "none")))))
;;--------------------

I'd like the jmh-find-subscribed-addresses to be included in gnus as a
utility function.  Maybe I should write up some documentation for this
as well for the manual?

The show-mft is just a little utility function that tells me what the
MFT header will be when the message is sent.  (for testing)

I've also cleaned up the function for scanning through all the group
parameters and pulling out the subscription addresses a little.  I
like it much better now.

Index: message.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/message.el,v
retrieving revision 6.131
diff -u -r6.131 message.el
--- message.el	2001/10/17 17:53:42	6.131
+++ message.el	2001/10/23 15:28:49
@@ -424,6 +424,32 @@
 		 (const use)
 		 (const ask)))
 
+(defcustom message-subscribed-address-functions nil
+  "*Specifies functions for determining list subscription.
+If nil, do not attempt to determine list subscribtion with functions.
+If non-nil, this variable contains a list of functions which return
+regular expressions to match lists.  These functions can be used in
+conjunction with `message-subscribed-regexps' and
+`message-subscribed-addresses'."
+  :group 'message-interface
+  :type '(repeat sexp))
+
+(defcustom message-subscribed-addresses nil
+  "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions.  This list of
+addresses can be used in conjuction with
+`message-subscribed-address-functions' and `message-subscribed-regexps'."
+  :group 'message-interface
+  :type '(repeat string))
+
+(defcustom message-subscribed-regexps nil
+  "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions.  This list of
+regular expressions can be used in conjuction with
+`message-subscribed-address-functions' and `message-subscribed-addresses'."
+  :group 'message-interface
+  :type '(repeat regexp))
+
 (defcustom message-sendmail-f-is-evil nil
   "*Non-nil means don't add \"-f username\" to the sendmail command line.
 Doing so would be even more evil than leaving it out."
@@ -1468,6 +1494,7 @@
   (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)
+  (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-k" 'message-goto-keywords)
   (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
   (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
@@ -1547,6 +1574,7 @@
     ["Keywords" message-goto-keywords t]
     ["Newsgroups" message-goto-newsgroups t]
     ["Followup-To" message-goto-followup-to t]
+    ["Mail-Followup-To" message-goto-mail-followup-to t]
     ["Distribution" message-goto-distribution t]
     ["Body" message-goto-body t]
     ["Signature" message-goto-signature t]))
@@ -1570,6 +1598,7 @@
 	 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-f  move to Followup-To
+         C-c C-f C-m  move to Mail-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)
 C-c C-b  `message-goto-body' (move to beginning of message text).
@@ -1714,6 +1743,11 @@
   (interactive)
   (message-position-on-field "Followup-To" "Newsgroups"))
 
+(defun message-goto-mail-followup-to ()
+  "Move point to the Mail-Followup-To header."
+  (interactive)
+  (message-position-on-field "Mail-Followup-To" "From"))
+
 (defun message-goto-keywords ()
   "Move point to the Keywords header."
   (interactive)
@@ -2514,6 +2548,16 @@
       (let ((message-deletable-headers
 	     (if news nil message-deletable-headers)))
 	(message-generate-headers message-required-mail-headers))
+      ;; Generate the Mail-Followup-To header if the header is not there...
+      (if (and (or message-subscribed-regexps
+		   message-subscribed-addresses
+		   message-subscribed-address-functions)
+	       (not (mail-fetch-field "mail-followup-to")))
+	  (message-generate-headers
+	   `(("Mail-Followup-To" . ,(message-make-mft))))
+	;; otherwise, delete the MFT header if the field is empty
+	(when (equal "" (mail-fetch-field "mail-followup-to"))
+	  (message-remove-header "Mail-Followup-To")))
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
     (unwind-protect
@@ -3523,6 +3567,28 @@
   "Return the domain name."
   (or mail-host-address
       (message-make-fqdn)))
+
+(defun message-mft-helper (recipients regexps)
+  `(or ,@(apply 'append
+		(mapcar '(lambda (recipient)
+			   (mapcar '(lambda (regexp)
+				      (list 'string-match regexp recipient))
+				   regexps))
+			recipients))))
+
+(defun message-make-mft ()
+  "Return the Mail-Followup-To header."
+  (let* ((msg-recipients (message-options-get 'message-recipients))
+	 (recipients
+	  (mapcar 'mail-strip-quoted-names
+		  (message-tokenize-header msg-recipients)))
+	 (mft-regexps (apply 'append message-subscribed-regexps
+			     (mapcar 'regexp-quote
+				     message-subscribed-addresses)
+			     (mapcar '(lambda (func) (funcall func))
+				     message-subscribed-address-functions))))
+    (when (eval (message-mft-helper recipients mft-regexps))
+      msg-recipients)))
 
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.

-- 
Josh Huber