Re: Generating Mail-Followup-To: headers

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

prj@po.cwru.edu (Paul Jarc) writes:

> And I just noticed that we don't actually need to get a cleaner
> string at all.  So mail-fetch-field alone should work.

Indeed...

here's the new version:

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/19 20:01:31
@@ -424,6 +424,24 @@
 		 (const use)
 		 (const ask)))
 
+(defcustom message-mft-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.  One such useful function might be
+`gnus-get-subscribed-addresses'.  These functions can be used in
+conjunction with `message-mft-regexps'."
+  :group 'message-interface
+  :type '(repeat sexp))
+
+(defcustom message-mft-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-mft-address-functions'."
+  :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 +1486,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 +1566,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 +1590,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 +1735,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 +2540,15 @@
       (let ((message-deletable-headers
 	     (if news nil message-deletable-headers)))
 	(message-generate-headers message-required-mail-headers))
+      ;; Generate the Mail-Followup-To header...
+      ;; only if the header doesn't exist.
+      (when (and (or message-mft-regexps message-mft-address-functions)
+		 (not (message-fetch-field "mail-followup-to")))
+	(let ((Mail-Followup-To (message-make-mft)))
+	  (message-generate-headers '((optional . Mail-Followup-To)))))
+      ;; otherwise, delete the MFT header if the field is empty
+      (and (string= "" (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 +3558,17 @@
   "Return the domain name."
   (or mail-host-address
       (message-make-fqdn)))
+
+(defun message-make-mft ()
+  "Return the Mail-Followup-To header."
+  (let ((recipients (message-options-get 'message-recipients))
+	(mft-regexps (apply 'append message-mft-regexps
+			    (mapcar '(lambda (func) (funcall func))
+				    message-mft-address-functions))))
+    (and (eval `(or ,@(mapcar '(lambda (regexp)
+				 (and regexp (string-match regexp recipients)))
+			      mft-regexps)))
+	 recipients)))
 
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.


here's a little support code for enabling it look at the group
parameters:

;;*===========================
;;* Mail-Followup-To settings

(setq gnus-parameters
      '(("^mail\\.lists\\." (subscribed . t))))

(defun jmh-find-subscribed-addresses ()
  (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))
			      (mapcar '(lambda (item) (car item))
				      gnus-newsrc-alist)))))

(add-to-list 'message-mft-address-functions
	     (lambda ()
	       (mapcar 'regexp-quote (jmh-find-subscribed-addresses))))



Does anyone have any suggestions?

Running the -find-subscribed-addresses just once as a utility function
and storing those values in the message-mft-regexps variable would be
a good idea, especially since, at least my version, seems to run
pretty slow. (.5 second pause)

ttyl,

-- 
Josh Huber