From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/49745 Path: main.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.gnus.general Subject: Re: message registry for Gnus Date: Sat, 01 Feb 2003 15:20:25 -0500 Organization: =?koi8-r?q?=F4=C5=CF=C4=CF=D2=20=FA=CC=C1=D4=C1=CE=CF=D7?= @ Cienfuegos Sender: owner-ding@hpc.uh.edu Message-ID: References: <4n3cn9i6kq.fsf@lockgroove.bwh.harvard.edu> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1044130255 9789 80.91.224.249 (1 Feb 2003 20:10:55 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sat, 1 Feb 2003 20:10:55 +0000 (UTC) Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18f3yX-0002Xb-00 for ; Sat, 01 Feb 2003 21:10:53 +0100 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 18f3zH-0007l5-00; Sat, 01 Feb 2003 14:11:39 -0600 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Sat, 01 Feb 2003 14:12:35 -0600 (CST) Original-Received: from sclp3.sclp.com (sclp3.sclp.com [66.230.238.2]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id OAA08765 for ; Sat, 1 Feb 2003 14:12:20 -0600 (CST) Original-Received: (qmail 57929 invoked by alias); 1 Feb 2003 20:11:19 -0000 Original-Received: (qmail 57924 invoked from network); 1 Feb 2003 20:11:19 -0000 Original-Received: from ns2.beld.net (208.229.215.82) by 66.230.238.6 with SMTP; 1 Feb 2003 20:11:19 -0000 Original-Received: from heechee.beld.net (dhcp-0-30-bd-1-93-b1.cpe.beld.net [24.233.67.61]) by ns2.beld.net (Postfix) with ESMTP id 819823BE5B for ; Sat, 1 Feb 2003 15:11:16 -0500 (EST) Original-To: ding@gnus.org X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6;d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" Mail-Followup-To: ding@gnus.org User-Agent: Gnus/5.090015 (Oort Gnus v0.15) Emacs/21.2 (i686-pc-linux-gnu) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:49745 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:49745 --=-=-= On Sat, 01 Feb 2003, larsi@gnus.org wrote: >> In Gnus terms, what are the basic message transfer functions? >> >> - message copy >> >> - message move >> >> - new message spooling >> >> - old message respooling > > And expiry with expiry-target. > > Copy, move and respooling are all done in > `gnus-summary-move-article'. OK, I added the hooks for copy/move/respool/delete/expire. Attached is a patch and an empty gnus-registry.el with an example of how things are called. I haven't committed anything to CVS. The message deletion hook (gnus-summary-article-delete-hook) invocation in gnus-summary-move-article doesn't seem to do anything, when is that 'junk condition in gnus-sum.el used? I think I got expiry and deletion right otherwise, can you check? Especially expiry is tricky, I'm not sure I understand the whole function. Incoming messages seem to be spooled in several places, so I'm not sure how to deal with that. I only want to intercept nnmail and nnimap for now, should I just prepend the hook call to their respective split-methods? Thanks Ted --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=registry.patch Index: gnus.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v retrieving revision 6.153 diff -r6.153 gnus.el 61a62,65 > (defgroup gnus-registry nil > "Article Registry." > :group 'gnus) > 3114,3115c3118,3120 < (defun gnus-group-prefixed-name (group method) < "Return the whole name from GROUP and METHOD." --- > (defun gnus-group-prefixed-name (group method &optional full) > "Return the whole name from GROUP and METHOD. Call with full set to > get the fully qualified group name (even if the server is native)." 3118c3123 < (gnus-server-equal method "native") --- > (and (not full) (gnus-server-equal method "native")) 3121a3127,3140 > > (defun gnus-group-guess-prefixed-name (group) > "Guess the whole name from GROUP and METHOD." > (gnus-group-prefixed-name group (gnus-find-method-for-group > group))) > > (defun gnus-group-full-name (group method) > "Return the full name from GROUP and METHOD, even if the method is > native." > (gnus-group-prefixed-name group method t)) > > (defun gnus-group-guess-full-name (group) > "Guess the full name from GROUP, even if the method is native." > (gnus-group-full-name group (gnus-find-method-for-group group))) Index: gnus-sum.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/gnus-sum.el,v retrieving revision 6.300 diff -r6.300 gnus-sum.el 849a850,864 > (defcustom gnus-summary-article-move-hook nil > "*A hook called after an article is moved, copied, respooled, or crossposted." > :group 'gnus-summary > :type 'hook) > > (defcustom gnus-summary-article-delete-hook nil > "*A hook called after an article is deleted." > :group 'gnus-summary > :type 'hook) > > (defcustom gnus-summary-article-expire-hook nil > "*A hook called after an article is expired." > :group 'gnus-summary > :type 'hook) > 8759,8760c8774,8781 < (gnus-summary-mark-article article gnus-canceled-mark) < (gnus-message 4 "Deleted article %s" article))) --- > (let ((id (mail-header-id (gnus-data-header > (assoc article (gnus-data-list nil)))))) > (gnus-summary-mark-article article gnus-canceled-mark) > (gnus-message 4 "Deleted article %s" article) > ;; run the move/copy/crosspost/respool hook > (run-hook-with-args 'gnus-summary-article-delete-hook > action id gnus-newsgroup-name nil > select-method)))) 8838c8859,8866 < article gnus-newsgroup-name (current-buffer))))) --- > article gnus-newsgroup-name (current-buffer)))) > > ;; run the move/copy/crosspost/respool hook > (let ((id (mail-header-id (gnus-data-header > (assoc article (gnus-data-list nil)))))) > (run-hook-with-args 'gnus-summary-article-move-hook > action id gnus-newsgroup-name to-newsgroup > select-method))) 9059c9087,9093 < (gnus-summary-mark-article article gnus-canceled-mark)))))) --- > (gnus-summary-mark-article article gnus-canceled-mark) > (let ((id (mail-header-id (gnus-data-header > (assoc article > (gnus-data-list nil)))))) > (run-hook-with-args 'gnus-summary-article-expire-hook > 'delete id gnus-newsgroup-name nil > nil))))))) 9107a9142,9147 > (let* ((article (car articles)) > (id (mail-header-id (gnus-data-header > (assoc article (gnus-data-list nil)))))) > (run-hook-with-args 'gnus-summary-article-delete-hook > 'delete id gnus-newsgroup-name nil > nil)) --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=gnus-registry.el Content-Transfer-Encoding: 8bit ;;; gnus-registry.el --- article registry for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) (require 'gnus) (require 'gnus-sum) ;; (defcustom gnus-summary-article-spool-hook nil ;; "*A hook called after an article is spooled." ;; :group 'gnus-summary ;; :type 'hook) (defun regtest (action id from &optional to method) (message "Registry: article %s %s from %s to %s" id (if method "respooling" "going") (gnus-group-guess-full-name from) (if to (gnus-group-guess-full-name to) "the Bit Bucket in the sky"))) (add-hook 'gnus-summary-article-move-hook 'regtest) ; also does copy, respool, and crosspost (add-hook 'gnus-summary-article-delete-hook 'regtest) (add-hook 'gnus-summary-article-expire-hook 'regtest) ;; TODO: ;; (add-hook 'gnus-summary-article-spool-hook gnus-registry-article-spool) (provide 'gnus-registry) ;;; gnus-registry.el ends here --=-=-=--