* gnus-sum.el (gnus-summary-move-article)

(gnus-summary-expire-articles): send data header for article, not
just article ID

* gnus-registry.el (gnus-registry-hashtb, gnus-register-action)
(gnus-register-spool-action): added hashtable of message ID keys
with message motion data

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9147072..0cac25e 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2003-02-21  Teodor Zlatanov  <tzz@bwh.harvard.edu>
+
+       * gnus-sum.el (gnus-summary-move-article)
+       (gnus-summary-expire-articles): send data header for article, not
+       just article ID
+
+       * gnus-registry.el (gnus-registry-hashtb, gnus-register-action) 
+       (gnus-register-spool-action): added hashtable of message ID keys
+       with message motion data
+
 2003-02-21  Florian Weimer  <fw@deneb.enyo.de>
        From Reiner Steib  <Reiner.Steib@gmx.de>.
 

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 79b4ad5..7aab355 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -33,29 +33,46 @@
 (require 'gnus-sum)
 (require 'nnmail)
 
-;; (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")))
-
-(defun regtest-nnmail (id group)
-  (message "Registry: article %s spooled to %s"
+(defvar gnus-registry-hashtb nil
+  "*The article registry by Message ID.")
+(setq gnus-registry-hashtb (make-hash-table 
+                           :size 4096
+                           :test 'equal)) ; we test message ID strings equality
+
+;; sample data-header
+;; (defvar tzz-header '(49 "Re[2]: good news" "\"Jonathan Pryor\" <offerlm@aol.com>" "Mon, 17 Feb 2003 10:41:46 +-0800" "<88288020@dytqq>" "" 896 18 "lockgroove.bwh.harvard.edu spam.asian:49" nil))
+
+;; (maphash (lambda (key value) (message "key: %s value: %s" key value)) gnus-registry-hashtb)
+;; (clrhash gnus-registry-hashtb)
+
+(defun gnus-register-action (action data-header from &optional to method)
+  (let* ((id (mail-header-id data-header))
+       (hash-entry (gethash id gnus-registry-hashtb)))
+    (gnus-message 5 "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"))
+    (unless hash-entry 
+      (setq hash-entry (puthash id (list data-header) gnus-registry-hashtb)))
+    (puthash id (cons (list action from to method) 
+                     (gethash id gnus-registry-hashtb)) gnus-registry-hashtb)))
+
+(defun gnus-register-spool-action (id group)
+  (gnus-message 5 "Registry: article %s spooled to %s"
           id
-          (gnus-group-prefixed-name group gnus-internal-registry-spool-current-method t)))
-
-;;(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)
-(add-hook 'nnmail-spool-hook 'regtest-nnmail)
-
-;; TODO:
+          (gnus-group-prefixed-name 
+           group 
+           gnus-internal-registry-spool-current-method 
+           t)))
+
+(add-hook 'gnus-summary-article-move-hook 'gnus-register-action) ; also does copy, respool, and crosspost
+(add-hook 'gnus-summary-article-delete-hook 'gnus-register-action)
+(add-hook 'gnus-summary-article-expire-hook 'gnus-register-action)
+(add-hook 'nnmail-spool-hook 'gnus-register-spool-action)
+
+;; TODO: a lot of things
+;; TODO: we have to load and save the registry through gnus-save-newsrc-file
 
 (provide 'gnus-registry)
 

diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index e20aeba..bf97fc8 100644 (file)
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -8794,14 +8794,15 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                      (nnheader-get-report (car to-method))))
        ((eq art-group 'junk)
        (when (eq action 'move)
-         (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))))
+         (gnus-summary-mark-article article gnus-canceled-mark)
+         (gnus-message 4 "Deleted article %s" article)
+         ;; run the delete hook
+         (run-hook-with-args 'gnus-summary-article-delete-hook
+                             action
+                             (gnus-data-header
+                              (assoc article (gnus-data-list nil)))
+                             gnus-newsgroup-name nil
+                             select-method)))
        (t
        (let* ((pto-group (gnus-group-prefixed-name
                           (car art-group) to-method))
@@ -8882,15 +8883,17 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
               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)))
+                             action
+                             (gnus-data-header 
+                              (assoc article (gnus-data-list nil)))
+                             gnus-newsgroup-name
+                             to-newsgroup
+                             select-method))
 
        ;;;!!!Why is this necessary?
        (set-buffer gnus-summary-buffer)
-
+       
        (gnus-summary-goto-subject article)
        (when (eq action 'move)
          (gnus-summary-mark-article article gnus-canceled-mark))))
@@ -9108,12 +9111,13 @@ This will be the case if the article has both been mailed and posted."
                (when (and (not (memq article es))
                           (gnus-data-find article))
                  (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)))))))
+                 (run-hook-with-args 'gnus-summary-article-expire-hook
+                                     'delete
+                                     (gnus-data-header
+                                      (assoc article (gnus-data-list nil)))
+                                     gnus-newsgroup-name
+                                     nil
+                                     nil))))))
        (gnus-message 6 "Expiring articles...done")))))
 
 (defun gnus-summary-expire-articles-now ()