Re: message registry for Gnus

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 1072 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: registry.patch --]
[-- Type: text/x-patch, Size: 3554 bytes --]

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))

[-- Attachment #3: gnus-registry.el --]
[-- Type: application/emacs-lisp, Size: 1818 bytes --]