Synch to Gnus 200309042222.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6f9467e..f911008 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,55 @@
+2003-09-04  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * gnus-registry.el: added brief explanation of basics
+       (gnus-registry-track-extra): new variable for tracking of message
+       subjects
+       (gnus-registry-entry-caching): caching parameter, used for extra
+       data
+       (gnus-registry-minimum-subject-length): minimum subject length
+       before it's considered when tracing subjects
+       (gnus-registry-save): accomodate extra data entry caching
+       (gnus-registry-action): change function name, add the subject and
+       pass it to gnus-registry-add-group
+       (gnus-registry-spool-action): change function name, add the
+       subject and pass it to gnus-registry-add-group
+       (gnus-registry-split-fancy-with-parent): add subject tracking
+       (gnus-registry-register-message-ids): pass subject to
+       gnus-registry-add-group
+       (gnus-registry-simplify-subject)
+       (gnus-registry-fetch-simplified-message-subject-fast): new
+       functions
+       (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): add
+       extra data entry caching
+       (gnus-registry-add-group): handle the extra subject parameter
+       (gnus-registry-install-hooks, gnus-registry-unload-hook): fix the
+       gnus-register-* function names
+
+       * nnmail.el (nnmail-cache-insert): add subject parameter, pass it
+       on to the nnmail-spool-hook
+
+       * nnbabyl.el (nnbabyl-request-accept-article): added subject to
+       nnmail-cache-insert call
+
+       * nndiary.el (nndiary-request-accept-article): added subject to
+       nnmail-cache-insert call
+
+       * nnfolder.el (nnfolder-request-accept-article): added subject to
+       nnmail-cache-insert call
+
+       * nnimap.el (nnimap-split-articles): added subject to
+       nnmail-cache-insert call
+       (nnimap-request-accept-article): added subject to
+       nnmail-cache-insert call
+
+       * nnmbox.el (nnmbox-request-accept-article): added subject to
+       nnmail-cache-insert call
+
+       * nnmh.el (nnmh-request-accept-article): added subject to
+       nnmail-cache-insert call
+
+       * nnml.el (nnml-request-accept-article): added subject to
+       nnmail-cache-insert call
+
 2003-09-04  Jesper Harder  <harder@ifa.au.dk>
 
        * gnus-art.el (gnus-button-handle-info-url)

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 8b7ecaf..fc667de 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -24,6 +24,35 @@
 
 ;;; Commentary:
 
+;; This is the gnus-registry.el package, works with other backends
+;; besides nnmail.  The major issue is that it doesn't go across
+;; backends, so for instance if an article is in nnml:sys and you see
+;; a reference to it in nnimap splitting, the article will end up in
+;; nnimap:sys
+
+;; gnus-registry.el intercepts article respooling, moving, deleting,
+;; and copying for all backends.  If it doesn't work correctly for
+;; you, submit a bug report and I'll be glad to fix it.  It needs
+;; documentation in the manual (also on my to-do list).
+
+;; Put this in your startup file (~/.gnus.el for instance)
+
+;; (setq gnus-registry-install t
+;;  gnus-registry-max-entries 2500
+;;  gnus-registry-use-long-group-names t)
+
+;; (require 'gnus-registry)
+
+;; Then use this in your fancy-split:
+
+;; (: gnus-registry-split-fancy-with-parent)
+
+;; TODO:
+
+;; - get the correct group on spool actions
+
+;; - articles that are spooled to a different backend should be handled
+
 ;;; Code:
 
 (eval-when-compile (require 'cl))
@@ -65,6 +94,23 @@ Registry entries are considered empty when they have no groups."
   :group 'gnus-registry
   :type 'boolean)
 
+(defcustom gnus-registry-track-extra nil
+  "Whether the registry should track other things about a message.
+The Subject header is currently the only thing that can be
+tracked this way."
+  :group 'gnus-registry
+  :type 'boolean)
+
+(defcustom gnus-registry-entry-caching t
+  "Whether the registry should cache extra information."
+  :group 'gnus-registry
+  :type 'boolean)
+
+(defcustom gnus-registry-minimum-subject-length 5
+  "The minimum length of a subject before it's considered trackable."
+  :group 'gnus-registry
+  :type 'integer)
+
 (defcustom gnus-registry-trim-articles-without-groups t
   "Whether the registry should clean out message IDs without groups."
   :group 'gnus-registry
@@ -173,15 +219,25 @@ Registry entries are considered empty when they have no groups."
 
 (defun gnus-registry-save (&optional force)
   (when (or gnus-registry-dirty force)
-    ;; remove empty entries
-    (when gnus-registry-clean-empty 
-      (gnus-registry-clean-empty-function))
-    ;; now trim the registry appropriately
-    (setq gnus-registry-alist (gnus-registry-trim 
-                              (hashtable-to-alist gnus-registry-hashtb)))
-    ;; really save
-    (gnus-registry-cache-save)
-    (setq gnus-registry-dirty nil)))
+    (let ((caching gnus-registry-entry-caching))
+      ;; turn off entry caching, so mtime doesn't get recorded
+      (setq gnus-registry-entry-caching nil)
+      ;; remove entry caches
+      (maphash
+       (lambda (key value)
+        (if (hash-table-p value)
+            (remhash key gnus-registry-hashtb)))
+       gnus-registry-hashtb)
+      ;; remove empty entries
+      (when gnus-registry-clean-empty 
+       (gnus-registry-clean-empty-function))
+      ;; now trim the registry appropriately
+      (setq gnus-registry-alist (gnus-registry-trim 
+                                (hashtable-to-alist gnus-registry-hashtb)))
+      ;; really save
+      (gnus-registry-cache-save)
+      (setq gnus-registry-entry-caching entry-caching)
+      (setq gnus-registry-dirty nil))))
 
 (defun gnus-registry-clean-empty-function ()
   "Remove all empty entries from the registry.  Returns count thereof."
@@ -242,8 +298,10 @@ Registry entries are considered empty when they have no groups."
      hash)
     list))
 
-(defun gnus-register-action (action data-header from &optional to method)
+(defun gnus-registry-action (action data-header from &optional to method)
   (let* ((id (mail-header-id data-header))
+        (subject (gnus-registry-simplify-subject 
+                  (mail-header-subject data-header)))
        (from (gnus-group-guess-full-name from))
        (to (if to (gnus-group-guess-full-name to) nil))
        (to-name (if to to "the Bit Bucket"))
@@ -258,11 +316,11 @@ Registry entries are considered empty when they have no groups."
     (gnus-registry-delete-group id from)
 
     (when (equal 'copy action) 
-      (gnus-registry-add-group id from)) ; undo the delete
+      (gnus-registry-add-group id from subject)) ; undo the delete
 
-    (gnus-registry-add-group id to)))
+    (gnus-registry-add-group id to subject)))
 
-(defun gnus-register-spool-action (id group)
+(defun gnus-registry-spool-action (id group &optional subject)
   ;; do not process the draft IDs
 ;  (unless (string-match "totally-fudged-out-message-id" id)
 ;    (let ((group (gnus-group-guess-full-name group)))
@@ -271,7 +329,7 @@ Registry entries are considered empty when they have no groups."
   (gnus-message 5 "Registry: article %s spooled to %s"
                id
                group)
-  (gnus-registry-add-group id group))
+  (gnus-registry-add-group id group subject))
 ;)
 
 ;; Function for nn{mail|imap}-split-fancy: look up all references in
@@ -294,19 +352,42 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
             nnmail-split-fancy-with-parent-ignore-groups
           (list nnmail-split-fancy-with-parent-ignore-groups)))
        references res)
-    (when refstr
-      (setq references (nreverse (gnus-split-references refstr)))
-      (mapcar (lambda (x)
-               (setq res (or (gnus-registry-fetch-group x) res))
-               (when (or (gnus-registry-grep-in-list 
-                          res
-                          gnus-registry-unfollowed-groups)
-                         (gnus-registry-grep-in-list 
-                          res 
-                          nnmail-split-fancy-with-parent-ignore-groups))
-                 (setq res nil)))
-             references)
-      (gnus-message 
+    (if refstr
+       (progn
+         (setq references (nreverse (gnus-split-references refstr)))
+         (mapcar (lambda (x)
+                   (setq res (or (gnus-registry-fetch-group x) res))
+                   (when (or (gnus-registry-grep-in-list 
+                              res
+                              gnus-registry-unfollowed-groups)
+                             (gnus-registry-grep-in-list 
+                              res 
+                              nnmail-split-fancy-with-parent-ignore-groups))
+                     (setq res nil)))
+                 references))
+      ;; there were no references, now try the extra tracking
+      (when gnus-registry-track-extra
+       (let ((subject (gnus-registry-simplify-subject 
+                       (message-fetch-field "subject"))))
+         (when (and subject
+                    (< gnus-registry-minimum-subject-length (length subject)))
+           (maphash
+            (lambda (key value)
+              (let ((this-subject (cdr 
+                                   (gnus-registry-fetch-extra key 'subject))))
+                (when (and this-subject
+                           (equal subject this-subject))
+                  (setq res (gnus-registry-fetch-group key))
+                  (gnus-message
+                   ;; raise level of messaging if gnus-registry-track-extra
+                   (if gnus-registry-track-extra 5 9) 
+                   "%s (extra tracking) traced subject %s to group %s"
+                   "gnus-registry-split-fancy-with-parent"
+                   subject
+                   (if res res "nil")))))
+            gnus-registry-hashtb))))
+
+      (gnus-message
        5 
        "gnus-registry-split-fancy-with-parent traced %s to group %s"
        refstr (if res res "nil"))
@@ -320,8 +401,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
        (unless (gnus-registry-fetch-group id)
          (gnus-message 9 "Registry: Registering article %d with group %s" 
                        article gnus-newsgroup-name)
-         (gnus-registry-add-group (gnus-registry-fetch-message-id-fast article)
-                                  gnus-newsgroup-name))))))
+         (gnus-registry-add-group 
+          (gnus-registry-fetch-message-id-fast article)
+          gnus-newsgroup-name
+          (gnus-registry-fetch-simplified-message-subject-fast article)))))))
 
 (defun gnus-registry-fetch-message-id-fast (article)
   "Fetch the Message-ID quickly, using the internal gnus-data-list function"
@@ -330,6 +413,20 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
     nil))
 
+(defun gnus-registry-simplify-subject (subject)
+  (if (null subject)
+      nil
+    (gnus-simplify-subject subject)))
+
+(defun gnus-registry-fetch-simplified-message-subject-fast (article)
+  "Fetch the Subject quickly, using the internal gnus-data-list function"
+  (if (and (numberp article)
+          (assoc article (gnus-data-list nil)))
+      (gnus-registry-simplify-subject
+       (mail-header-subject (gnus-data-header
+                            (assoc article (gnus-data-list nil)))))
+    nil))
+
 (defun gnus-registry-grep-in-list (word list)
   (when word
     (memq nil
@@ -342,15 +439,38 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 (defun gnus-registry-fetch-extra (id &optional entry)
   "Get the extra data of a message, based on the message ID.
 Returns the first place where the trail finds a nonstring."
-  (let ((trail (gethash id gnus-registry-hashtb)))
-    (dolist (crumb trail)
-      (unless (stringp crumb)
-       (return (gnus-registry-fetch-extra-entry crumb entry))))))
-
-(defun gnus-registry-fetch-extra-entry (alist &optional entry)
-  "Get the extra data of a message, or a specific entry in it."
-  (if entry
-      (assq entry alist)
+  (let ((entry-cache (gethash entry gnus-registry-hashtb)))
+    (if (and entry
+            (hash-table-p entry-cache)
+            (gethash id entry-cache))
+       (gethash id entry-cache)
+      ;; else, if there is no caching possible...
+      (let ((trail (gethash id gnus-registry-hashtb)))
+       (dolist (crumb trail)
+         (unless (stringp crumb)
+           (return (gnus-registry-fetch-extra-entry crumb entry id))))))))
+
+(defun gnus-registry-fetch-extra-entry (alist &optional entry id)
+  "Get the extra data of a message, or a specific entry in it.
+Update the entry cache if needed."
+  (if (and entry id)
+      (let ((entry-cache (gethash entry gnus-registry-hashtb))
+           entree)
+       (when gnus-registry-entry-caching
+         ;; create the hash table
+         (unless (hash-table-p entry-cache)
+           (setq entry-cache (make-hash-table
+                              :size 4096
+                              :test 'equal))
+           (puthash entry entry-cache gnus-registry-hashtb))
+
+         ;; get the entree from the hash table or from the alist
+         (setq entree (gethash id entry-cache)))
+       
+       (unless entree
+         (setq entree (assq entry alist))
+         (puthash id entree entry-cache))
+       entree)
     alist))
 
 (defun gnus-registry-store-extra (id extra)
@@ -404,7 +524,7 @@ Returns the first place where the trail finds a group name."
          (remhash id gnus-registry-hashtb)))
       (gnus-registry-store-extra-entry id 'mtime (current-time)))))
 
-(defun gnus-registry-add-group (id group &rest extra)
+(defun gnus-registry-add-group (id group &optional subject)
   "Add a group for a message, based on the message ID."
   ;; make sure there are no duplicate entries
   (when group
@@ -422,7 +542,13 @@ Returns the first place where the trail finds a group name."
                          (cons group trail)
                        (list group))
                   gnus-registry-hashtb)
-         (when extra (gnus-registry-store-extra id extra))
+
+         (when gnus-registry-track-extra 
+           (gnus-registry-store-extra-entry 
+            id 
+            'subject 
+            (gnus-registry-simplify-subject subject)))
+         
          (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
 
 (defun gnus-registry-clear ()
@@ -435,10 +561,10 @@ Returns the first place where the trail finds a group name."
 (defun gnus-registry-install-hooks ()
   "Install the registry hooks."
   (interactive)
-  (add-hook 'gnus-summary-article-move-hook 'gnus-register-action) 
-  (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)
+  (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) 
+  (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
+  (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
+  (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
   
   (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
   (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
@@ -448,10 +574,10 @@ Returns the first place where the trail finds a group name."
 (defun gnus-registry-unload-hook ()
   "Uninstall the registry hooks."
   (interactive)
-  (remove-hook 'gnus-summary-article-move-hook 'gnus-register-action) 
-  (remove-hook 'gnus-summary-article-delete-hook 'gnus-register-action)
-  (remove-hook 'gnus-summary-article-expire-hook 'gnus-register-action)
-  (remove-hook 'nnmail-spool-hook 'gnus-register-spool-action)
+  (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) 
+  (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
+  (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
+  (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
   
   (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
   (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)

diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el
index 8cecb1e..62fc067 100644 (file)
--- a/lisp/nnbabyl.el
+++ b/lisp/nnbabyl.el
@@ -350,7 +350,9 @@
         (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
           (delete-region (point) (progn (forward-line 1) (point)))))
        (when nnmail-cache-accepted-message-ids
-        (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+        (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                             group
+                             (nnmail-fetch-field "subject")))
        (setq result
             (if (stringp group)
                 (list (cons group (nnbabyl-active-number group)))
@@ -366,7 +368,9 @@
        (insert-buffer-substring buf)
        (when last
         (when nnmail-cache-accepted-message-ids
-          (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+          (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                               group
+                               (nnmail-fetch-field "subject")))
         (save-buffer)
         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
        result))))

diff --git a/lisp/nndiary.el b/lisp/nndiary.el
index 42cb838..51cbd9a 100644 (file)
--- a/lisp/nndiary.el
+++ b/lisp/nndiary.el
@@ -759,7 +759,9 @@ all.  This may very well take some time.")
   (when (nndiary-schedule)
     (let (result)
       (when nnmail-cache-accepted-message-ids
-       (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+       (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                            group
+                            (nnmail-fetch-field "subject")))
       (if (stringp group)
          (and
           (nnmail-activate 'nndiary)

diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el
index 2b8792e..8f16553 100644 (file)
--- a/lisp/nnfolder.el
+++ b/lisp/nnfolder.el
@@ -526,7 +526,9 @@ the group.  Then the marks file will be regenerated properly by Gnus.")
        (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
          (delete-region (point) (progn (forward-line 1) (point))))
        (when nnmail-cache-accepted-message-ids
-         (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+         (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                              group
+                              (nnmail-fetch-field "subject")))
        (setq result (if (stringp group)
                         (list (cons group (nnfolder-active-number group)))
                       (setq art-group

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 89e5551..7001a0d 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -1295,7 +1295,9 @@ function is generally only called when Gnus is shutting down."
                             (let (msgid)
                               (and (setq msgid
                                          (nnmail-fetch-field "message-id"))
-                                   (nnmail-cache-insert msgid to-group)))))
+                                   (nnmail-cache-insert msgid 
+                                                        to-group
+                                                        (nnmail-fetch-field "subject"))))))
                         ;; Add the group-art list to the history list.
                         (push (list (cons to-group 0)) nnmail-split-history))
                        (t
@@ -1472,7 +1474,8 @@ function is generally only called when Gnus is shutting down."
                      (replace-match "\r\n"))
                    (when nnmail-cache-accepted-message-ids
                      (nnmail-cache-insert (nnmail-fetch-field "message-id")
-                                          group)))
+                                          group
+                                          (nnmail-fetch-field "subject"))))
                  (when (and last nnmail-cache-accepted-message-ids)
                    (nnmail-cache-close))
                  ;; this 'or' is for Cyrus server bug

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index d0ba5ba..dde7ff9 100644 (file)
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -1493,9 +1493,9 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 (defvar group)
 (defvar group-art-list)
 (defvar group-art)
-(defun nnmail-cache-insert (id grp)
+(defun nnmail-cache-insert (id grp &optional subject)
   (run-hook-with-args 'nnmail-spool-hook 
-                     id grp)
+                     id grp subject)
   (when nnmail-treat-duplicates
     ;; Store some information about the group this message is written
     ;; to.  This is passed in as the grp argument -- all locations this

diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el
index 7477a31..20d49d4 100644 (file)
--- a/lisp/nnmbox.el
+++ b/lisp/nnmbox.el
@@ -333,7 +333,9 @@
        (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
         (delete-region (point) (progn (forward-line 1) (point))))
        (when nnmail-cache-accepted-message-ids
-        (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+        (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                             group
+                             (nnmail-fetch-field "subject")))
        (setq result (if (stringp group)
                        (list (cons group (nnmbox-active-number group)))
                      (nnmail-article-group 'nnmbox-active-number)))

diff --git a/lisp/nnmh.el b/lisp/nnmh.el
index d4e1483..0d3623d 100644 (file)
--- a/lisp/nnmh.el
+++ b/lisp/nnmh.el
@@ -325,7 +325,9 @@ as unread by Gnus.")
           (not (equal group "draft")))
       (nnmail-check-syntax))
   (when nnmail-cache-accepted-message-ids
-    (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+    (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                        group
+                        (nnmail-fetch-field "subject")))
   (nnheader-init-server-buffer)
   (prog1
       (if (stringp group)

diff --git a/lisp/nnml.el b/lisp/nnml.el
index 16d29b6..f59c7c7 100644 (file)
--- a/lisp/nnml.el
+++ b/lisp/nnml.el
@@ -375,7 +375,9 @@ marks file will be regenerated properly by Gnus.")
   (nnmail-check-syntax)
   (let (result)
     (when nnmail-cache-accepted-message-ids
-      (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+      (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                          group
+                          (nnmail-fetch-field "subject")))
     (if (stringp group)
        (and
         (nnmail-activate 'nnml)