Re: message registry for Gnus

[Ted Zlatanov <tzz@lifelogs.com>]

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

On Sun, 02 Feb 2003, larsi@gnus.org wrote:
> Ted Zlatanov <tzz@lifelogs.com> writes:
> 
>> 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?
> 
> You have `gnus-move-split-methods', which can return groups and
> `junk', which means "delete this".  Mostly useful when respooling.

OK, as long as I'm right in calling it a delete hook...

>> 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.
> 
> Could you do a unified diff?  I have a hard time reading raw
> diffs...

Sorry, I forgot the -u.  Unified diff attached, plus gnus-registry.el
for good measure.

>> 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?
> 
> I think that would probably be the best way, but I forget how that
> stuff works in detail...  :-)

Does anyone know?  I'm just trying to avoid an hour of
source-diving...

Thanks
Ted


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

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

Index: gnus.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v
retrieving revision 6.153
diff -u -r6.153 gnus.el
--- gnus.el	24 Jan 2003 19:35:31 -0000	6.153
+++ gnus.el	2 Feb 2003 15:07:05 -0000
@@ -59,6 +59,10 @@
   :link '(custom-manual "(gnus)Article Caching")
   :group 'gnus)
 
+(defgroup gnus-registry nil
+  "Article Registry."
+  :group 'gnus)
+
 (defgroup gnus-start nil
   "Starting your favorite newsreader."
   :group 'gnus)
@@ -3111,14 +3115,29 @@
 (defsubst gnus-method-to-full-server-name (method)
   (format "%s+%s" (car method) (nth 1 method)))
 
-(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)."
   (and (stringp method) (setq method (gnus-server-to-method method)))
   (if (or (not method)
-	  (gnus-server-equal method "native")
+	  (and (not full) (gnus-server-equal method "native"))
 	  (string-match ":" group))
       group
     (concat (gnus-method-to-server-name method) ":" group)))
+
+(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)))
 
 (defun gnus-group-real-prefix (group)
   "Return the prefix of the current group name."
Index: gnus-sum.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus-sum.el,v
retrieving revision 6.300
diff -u -r6.300 gnus-sum.el
--- gnus-sum.el	27 Jan 2003 02:56:44 -0000	6.300
+++ gnus-sum.el	2 Feb 2003 15:07:12 -0000
@@ -847,6 +847,21 @@
   :group 'gnus-summary
   :type 'hook)
 
+(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)
+
 (defcustom gnus-summary-display-arrow
   (and (fboundp 'display-graphic-p)
        (display-graphic-p))
@@ -8756,8 +8771,14 @@
 		      (nnheader-get-report (car to-method))))
        ((eq art-group 'junk)
 	(when (eq action 'move)
-	  (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))))
        (t
 	(let* ((pto-group (gnus-group-prefixed-name
 			   (car art-group) to-method))
@@ -8835,7 +8856,14 @@
 	      (gnus-request-article-this-buffer article gnus-newsgroup-name)
 	      (nnheader-replace-header "Xref" new-xref)
 	      (gnus-request-replace-article
-	       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)))
 
 	;;;!!!Why is this necessary?
 	(set-buffer gnus-summary-buffer)
@@ -9056,7 +9084,13 @@
 	      (dolist (article expirable)
 		(when (and (not (memq article es))
 			   (gnus-data-find article))
-		  (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)))))))
 	(gnus-message 6 "Expiring articles...done")))))
 
 (defun gnus-summary-expire-articles-now ()
@@ -9105,6 +9139,12 @@
 	;; after all.
 	(unless (memq (car articles) not-deleted)
 	  (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+	(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))
 	(setq articles (cdr articles)))
       (when not-deleted
 	(gnus-message 4 "Couldn't delete articles %s" not-deleted)))