* gnus-registry.el (gnus-register-action)

(gnus-register-spool-action, hashtable-to-alist)
(gnus-registry-translate-from-alist, alist-to-hashtable)
(gnus-registry-translate-to-alist, gnus-registry-headers-hashtb):
new variables and function fixes

* gnus.el (gnus-registry-headers-alist): new variable to hold
article header data
(gnus-variable-list): save gnus-registry-headers-alist

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 42d3115..4ec1f20 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -5,6 +5,16 @@
 
 2003-04-16  Teodor Zlatanov  <tzz@lifelogs.com>
 
+       * gnus-registry.el (gnus-register-action) 
+       (gnus-register-spool-action, hashtable-to-alist) 
+       (gnus-registry-translate-from-alist, alist-to-hashtable) 
+       (gnus-registry-translate-to-alist, gnus-registry-headers-hashtb):
+       new variables and function fixes
+
+       * gnus.el (gnus-registry-headers-alist): new variable to hold
+       article header data
+       (gnus-variable-list): save gnus-registry-headers-alist
+
        * spam-report.el (Module): new module for spam reporting
 
        * gnus.el (spam-process): added

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 630b555..37a4994 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -35,15 +35,19 @@
 
 (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
+
+(defvar gnus-registry-headers-hashtb nil
+  "*The article header 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)
+;; (setq gnus-registry-alist nil)
 
 ;; Function(s) missing in Emacs 20
 (when (memq nil (mapcar 'fboundp '(puthash)))
@@ -53,10 +57,12 @@
     (defalias 'puthash 'cl-puthash)))
 
 (defun gnus-registry-translate-to-alist ()
-  (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb)))
+  (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb))
+  (setq gnus-registry-headers-alist (hashtable-to-alist gnus-registry-headers-hashtb)))
 
 (defun gnus-registry-translate-from-alist ()
-  (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)))
+  (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
+  (setq gnus-registry-headers-hashtb (alist-to-hashtable gnus-registry-headers-alist)))
 
 (defun alist-to-hashtable (alist)
   "Build a hashtable from the values in ALIST."
@@ -75,22 +81,24 @@
     (maphash
      (lambda (key value)
        (setq list (cons (cons key value) list)))
-     hash)))
+     hash)
+    list))
 
 (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)))
+  (let* ((id (mail-header-id data-header)))
     (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) 
+    (unless (gethash id gnus-registry-headers-hashtb)
+      (puthash id (list data-header) gnus-registry-headers-hashtb))
+    (puthash id (cons (list action from to method)
                      (gethash id gnus-registry-hashtb)) gnus-registry-hashtb)))
 
 (defun gnus-register-spool-action (id group)
+  (when (string-match "\r$" id)
+    (setq id (substring id 0 -1)))
   (gnus-message 5 "Registry: article %s spooled to %s"
           id
           (gnus-group-prefixed-name 

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 500425f..223865e 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2289,6 +2289,7 @@ such as a mark that says whether an article is stored in the cache
                        gnus-newsrc-last-checked-date
                        gnus-newsrc-alist gnus-server-alist
                        gnus-registry-alist
+                       gnus-registry-headers-alist
                        gnus-killed-list gnus-zombie-list
                        gnus-topic-topology gnus-topic-alist
                        gnus-agent-covered-methods gnus-format-specs)
@@ -2302,6 +2303,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
   "Assoc list of registry data.
 gnus-registry.el will populate this if it's loaded.")
 
+(defvar gnus-registry-headers-alist nil
+  "Assoc list of registry header data.
+gnus-registry.el will populate this if it's loaded.")
+
 (defvar gnus-newsrc-hashtb nil
   "Hashtable of gnus-newsrc-alist.")