Gnus development mailing list
 help / color / mirror / Atom feed
* new Mail-Followup-To patch...please take a look...
@ 2001-10-23 15:24 Josh Huber
  2001-10-23 15:42 ` Josh Huber
                   ` (2 more replies)
  0 siblings, 3 replies; 54+ messages in thread
From: Josh Huber @ 2001-10-23 15:24 UTC (permalink / raw)


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



^ permalink raw reply	[flat|nested] 54+ messages in thread

end of thread, other threads:[~2001-10-31 18:22 UTC | newest]

Thread overview: 54+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2001-10-23 15:24 new Mail-Followup-To patch...please take a look Josh Huber
2001-10-23 15:42 ` Josh Huber
2001-10-23 16:32 ` Paul Jarc
2001-10-23 16:54   ` Josh Huber
2001-10-23 17:45     ` Paul Jarc
2001-10-23 18:54       ` Matt Armstrong
2001-10-23 19:53         ` Paul Jarc
2001-10-24  0:34           ` Josh Huber
2001-10-24 11:35         ` Per Abrahamsen
2001-10-24 12:48           ` Josh Huber
2001-10-24 16:31           ` Paul Jarc
2001-10-24 17:08             ` Per Abrahamsen
2001-10-24 17:18               ` Paul Jarc
2001-10-26  6:24           ` Kai Großjohann
2001-10-27 23:23           ` Florian Weimer
2001-10-23 16:56   ` Josh Huber
2001-10-23 17:32     ` Per Abrahamsen
2001-10-23 23:53       ` Josh Huber
2001-10-23 22:40   ` Davide G. M. Salvetti
2001-10-24  1:40     ` Paul Jarc
2001-10-24 12:45       ` Davide G. M. Salvetti
2001-10-24 13:44         ` Samuel Padgett
2001-10-24 15:23           ` Paul Jarc
2001-10-24 15:42             ` Per Abrahamsen
2001-10-24 15:51             ` Samuel Padgett
2001-10-26  6:28     ` Kai Großjohann
2001-10-27  1:19       ` Barry Fishman
2001-10-29 14:49         ` Kai Großjohann
2001-10-27 22:27     ` Florian Weimer
2001-10-24  1:59 ` Josh Huber
2001-10-24 15:02   ` Per Abrahamsen
2001-10-24 16:48     ` Paul Jarc
2001-10-24 17:13       ` Per Abrahamsen
2001-10-25  1:52     ` Josh Huber
2001-10-24 16:13   ` Paul Jarc
2001-10-24 17:19     ` Per Abrahamsen
2001-10-24 17:28       ` Paul Jarc
2001-10-24 17:38         ` Per Abrahamsen
2001-10-25  1:45           ` Josh Huber
2001-10-25 18:48           ` Josh Huber
2001-10-29 21:58             ` Matt Armstrong
2001-10-29 22:19               ` Josh Huber
2001-10-29 22:31                 ` Paul Jarc
2001-10-30  2:47                   ` Josh Huber
2001-10-30  3:11                     ` Paul Jarc
2001-10-30  3:49                   ` Matt Armstrong
2001-10-30 12:55             ` Per Abrahamsen
2001-10-30 15:31               ` Josh Huber
2001-10-31 13:44             ` ShengHuo ZHU
2001-10-31 17:28               ` Matt Armstrong
2001-10-31 17:51                 ` Josh Huber
2001-10-31 18:22                 ` ShengHuo ZHU
2001-10-26  6:34         ` Kai Großjohann
2001-10-26  9:07           ` Per Abrahamsen

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).