From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/39668 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: Tue, 23 Oct 2001 21:59:02 -0400 Organization: Mind your own business, you silly arthur king! Sender: owner-ding@hpc.uh.edu Message-ID: <87bsixhk7t.fsf@mclinux.com> References: <87wv1m9y6j.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 1035175343 29197 80.91.224.250 (21 Oct 2002 04:42:23 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2002 04:42:23 +0000 (UTC) Return-Path: Original-Received: (qmail 15560 invoked from network); 24 Oct 2001 01:59:14 -0000 Original-Received: from malifon.math.uh.edu (mail@129.7.128.13) by mastaler.com with SMTP; 24 Oct 2001 01:59:14 -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 15wDJj-0003ej-00; Tue, 23 Oct 2001 20:58:51 -0500 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Tue, 23 Oct 2001 20:58:28 -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 UAA09842 for ; Tue, 23 Oct 2001 20:58:13 -0500 (CDT) Original-Received: (qmail 15543 invoked by alias); 24 Oct 2001 01:58:30 -0000 Original-Received: (qmail 15537 invoked from network); 24 Oct 2001 01:58:29 -0000 Original-Received: from quimby.gnus.org (HELO quimby2.netfonds.no) (195.204.10.66) by gnus.org with SMTP; 24 Oct 2001 01:58:29 -0000 Original-Received: from news by quimby2.netfonds.no with local (Exim 3.12 #1 (Debian)) id 15wDPP-0008Ql-00 for ; Wed, 24 Oct 2001 04:04:43 +0200 Original-To: ding@gnus.org Original-Path: not-for-mail Original-Newsgroups: gnus.ding Original-Lines: 215 Original-NNTP-Posting-Host: h000094c5efff.ne.mediaone.net Original-X-Trace: quimby2.netfonds.no 1003889083 32282 65.96.250.128 (24 Oct 2001 02:04:43 GMT) Original-X-Complaints-To: usenet@quimby2.netfonds.no Original-NNTP-Posting-Date: 24 Oct 2001 02:04:43 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) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:39668 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:39668 Yet another revision... This one incorporates (I think) all of the changes that people have mentioned. Caching, defaulting to use the to-(address|list) unless a not-subscribed group parameter is present, automatically inserting this caching function into message-subscribed-address-functions on startup, etc. the thing I really need help on is where these vars/defuns belong, and the proper way to do what I did to automatically setup the variable. (is modifying gnus-1 the right way?) Also, general comments (as always :) are welcome. especially telling me the right way to use elisp, etc. Index: lisp/gnus-group.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/gnus-group.el,v retrieving revision 6.44 diff -u -r6.44 gnus-group.el --- lisp/gnus-group.el 2001/10/14 23:12:41 6.44 +++ lisp/gnus-group.el 2001/10/24 02:01:37 @@ -2289,6 +2289,7 @@ (gnus-group-prefixed-name (gnus-group-real-name (car info)) method)) nil))) + (setq gnus-group-dirty-flag t) (when (and new-group (not (equal new-group group))) (when (gnus-group-goto-group group) Index: lisp/gnus-start.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/gnus-start.el,v retrieving revision 6.30 diff -u -r6.30 gnus-start.el --- lisp/gnus-start.el 2001/09/14 14:09:30 6.30 +++ lisp/gnus-start.el 2001/10/24 02:01:40 @@ -433,6 +433,41 @@ ;; Byte-compiler warning. (defvar gnus-group-line-format) +;; mail-followup-to handling... +(defvar gnus-group-parameter-cache nil) +(defvar gnus-subscribed-addresses nil) +(defvar gnus-group-dirty-flag nil) + +(defun gnus-find-subscribed-addresses-real () + "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 (not (gnus-group-find-parameter group 'not-subscribed)) + (let ((address (or + (gnus-group-find-parameter group 'to-address) + (gnus-group-find-parameter group 'to-list)))) + (when address + (setq addresses (cons address addresses))))))) + (cdr gnus-newsrc-alist)) + (mapconcat 'regexp-quote addresses "\\|"))) + +(defun gnus-find-subscribed-addresses () + "Return a regexp matching the addresses of all subscrbied mail groups. +This uses `gnus-group-parameter-cache' to keep track of changes to +`gnus-parameters' and `gnus-group-dirty-flag' to keep track of interactive +changes to group parameters." + (if (and (eq gnus-group-parameter-cache gnus-parameters) + (not gnus-group-dirty-flag)) ; how to do this? + gnus-subscribed-addresses + (progn + (setq gnus-group-dirty-flag nil) + (setq gnus-group-parameter-cache gnus-parameters) + (setq gnus-subscribed-addresses + (gnus-find-subscribed-addresses-real))))) + ;; Suggested by Brian Edmonds . (defvar gnus-init-inhibit nil) (defun gnus-read-init-file (&optional inhibit-next) @@ -746,6 +781,11 @@ (gnus-group-first-unread-group) (gnus-configure-windows 'group) (gnus-group-set-mode-line) + + ;; set up support for generating Mail-Followup-To headers + (when (equal message-subscribed-address-functions '(ignore)) + (setq message-subscribed-address-functions + '(gnus-find-subscribed-addresses))) (gnus-run-hooks 'gnus-started-hook)))))) (defun gnus-start-draft-setup () Index: lisp/message.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/message.el,v retrieving revision 6.137 diff -u -r6.137 message.el --- lisp/message.el 2001/10/20 17:27:25 6.137 +++ lisp/message.el 2001/10/24 02:01:45 @@ -424,6 +424,30 @@ (const use) (const ask))) +(defvar message-subscribed-address-functions '(ignore) + "*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'.") + +(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 +1492,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 +1572,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 +1596,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 +1748,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 +2559,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 +3578,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