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