From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/39697 Path: main.gmane.org!not-for-mail From: Josh Huber Newsgroups: gmane.emacs.gnus.general Subject: Re: new Mail-Followup-To patch...please take a look... Date: Thu, 25 Oct 2001 14:48:04 -0400 Organization: Mind your own business, you silly arthur king! Sender: owner-ding@hpc.uh.edu Message-ID: <877ktj1rq3.fsf@mclinux.com> References: <87wv1m9y6j.fsf@mclinux.com> <87bsixhk7t.fsf@mclinux.com> NNTP-Posting-Host: coloc-standby.netfonds.no Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1035175367 29347 80.91.224.250 (21 Oct 2002 04:42:47 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2002 04:42:47 +0000 (UTC) Return-Path: Original-Received: (qmail 12334 invoked from network); 25 Oct 2001 18:49:07 -0000 Original-Received: from malifon.math.uh.edu (mail@129.7.128.13) by mastaler.com with SMTP; 25 Oct 2001 18:49:07 -0000 Original-Received: from sina.hpc.uh.edu ([129.7.128.10] ident=lists) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 15wpXi-0003qn-00; Thu, 25 Oct 2001 13:47:50 -0500 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Thu, 25 Oct 2001 13:47:29 -0500 (CDT) Original-Received: from sclp3.sclp.com (qmailr@sclp3.sclp.com [209.196.61.66]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id NAA17461 for ; Thu, 25 Oct 2001 13:47:15 -0500 (CDT) Original-Received: (qmail 12307 invoked by alias); 25 Oct 2001 18:47:31 -0000 Original-Received: (qmail 12302 invoked from network); 25 Oct 2001 18:47:30 -0000 Original-Received: from quimby.gnus.org (HELO quimby2.netfonds.no) (195.204.10.66) by gnus.org with SMTP; 25 Oct 2001 18:47:30 -0000 Original-Received: from news by quimby2.netfonds.no with local (Exim 3.12 #1 (Debian)) id 15wpeC-0000SU-00 for ; Thu, 25 Oct 2001 20:54:32 +0200 Original-To: ding@gnus.org Original-Path: not-for-mail Original-Newsgroups: gnus.ding Original-Lines: 168 Original-NNTP-Posting-Host: lowell.missioncriticallinux.com Original-X-Trace: quimby2.netfonds.no 1004036072 1636 208.51.139.16 (25 Oct 2001 18:54:32 GMT) Original-X-Complaints-To: usenet@quimby2.netfonds.no Original-NNTP-Posting-Date: 25 Oct 2001 18:54:32 GMT X-Go-Away: or I shall taunt you a second time! X-PGP-KeyID: 6B21489A X-PGP-CertKey: 61F0 6138 BE7B FEBF A223 E9D1 BFE1 2065 6B21 489A X-Request-PGP: finger:huber@db.debian.org Mail-Copies-To: nobody User-Agent: Gnus/5.090004 (Oort Gnus v0.04) XEmacs/21.4 (Artificial Intelligence, powerpc-debian-linux) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:39697 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:39697 Here's my current version. I use the following in my .gnus.el: (setq gnus-parameters '(("^mail\\.lists\\." (subscribed . t)))) (setq message-subscribed-address-functions '(gnus-find-subscribed-addresses)) but I do understand that people would like everything to be automatic. I've got so much stuff in my .gnus.el already that this (small) addition isn't a big deal to me, but getting it for free automatically would be nice. Index: gnus.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v retrieving revision 6.61 diff -u -r6.61 gnus.el --- gnus.el 2001/10/24 17:18:46 6.61 +++ gnus.el 2001/10/25 18:53:44 @@ -2313,6 +2313,21 @@ ;;; Gnus Utility Functions ;;; +(defun gnus-find-subscribed-addresses () + "Return a regexp matching the addresses of all subscribed mail groups. +It consists of the `to-address' or `to-list' parameter of all groups +with a nil `not-subscribed' parameter." + (let ((addresses)) + (mapc (lambda (entry) + (let ((group (car entry))) + (when (gnus-group-find-parameter group 'subscribed) + (let ((address (or + (gnus-group-fast-parameter group 'to-address) + (gnus-group-fast-parameter group 'to-list)))) + (when address + (setq addresses (cons address addresses))))))) + (cdr gnus-newsrc-alist)) + (list (mapconcat 'regexp-quote addresses "\\|")))) (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. Index: message.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/message.el,v retrieving revision 6.137 diff -u -r6.137 message.el --- message.el 2001/10/20 17:27:25 6.137 +++ message.el 2001/10/25 18:53:46 @@ -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). @@ -1721,6 +1750,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) @@ -2527,6 +2561,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 @@ -3536,6 +3580,29 @@ "Return the domain name." (or mail-host-address (message-make-fqdn))) + +(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 'funcall + message-subscribed-address-functions)))) + (save-match-data + (when (eval (apply 'append '(or) + (mapcar + (function (lambda (regexp) + (mapcar + (function (lambda (recipient) + `(string-match ,regexp + ,recipient))) + recipients))) + mft-regexps))) + msg-recipients)))) (defun message-generate-headers (headers) "Prepare article HEADERS. -- Josh Huber