[gnus git] branch tzz-gnus-registry-rewrite updated: n0-15-37-g98c0e74 =2= Fixes suggested by David Engster <[email protected]>. ; gnus-registry bug fixes.
Lars Magne Ingebrigtsen <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 98c0e74e50e3e428605c31fe7c238b8db2a5fcae (commit)
via 982f553eaeeb15b50ad3e4a3e3670c86026a5137 (commit)
from 6ebc531dd4735212f87564fb049831b82f3ec22b (commit)
- Log -----------------------------------------------------------------
commit 98c0e74e50e3e428605c31fe7c238b8db2a5fcae
Author: Ted Zlatanov <[email protected]>
Date: Tue Apr 5 10:54:02 2011 -0500
Fixes suggested by David Engster <[email protected]>.
* gnus-registry.el (gnus-registry-fixup-registry): New function to
fixup the parameters that can be customized by the user between
save/read cycles.
(gnus-registry-read): Use it.
(gnus-registry-make-db): Use it.
(gnus-registry-spool-action, gnus-registry-handle-action): Fix
messaging.
(gnus-registry--split-fancy-with-parent-internal): Fix loop.
(gnus-registry-post-process-groups): Use `cond' for better messaging.
(gnus-registry-usage-test): Add subject lookup test.
* registry.el (registry-db, initialize-instance): Set up constructor
instead of :initform arguments for the sake of older Emacsen.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 45f7371..f790f53 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
2011-04-05 Teodor Zlatanov <[email protected]>
+ * registry.el (registry-db, initialize-instance): Set up constructor
+ instead of :initform arguments for the sake of older Emacsen.
+
* gnus-registry.el (gnus-registry-fixup-registry): New function to
fixup the parameters that can be customized by the user between
save/read cycles.
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 5ae7ed6..504e39a 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -216,6 +216,22 @@ the Bit Bucket."
:type '(radio (const :format "Unlimited " nil)
(integer :format "Maximum number: %v")))
+(defun gnus-registry-fixup-registry (db)
+ (when db
+ (oset db :precious
+ (append gnus-registry-extra-entries-precious
+ '()))
+ (oset db :max-hard
+ (or gnus-registry-max-entries
+ most-positive-fixnum))
+ (oset db :max-soft
+ (or gnus-registry-max-pruned-entries
+ most-positive-fixnum))
+ (oset db :tracked
+ (append gnus-registry-track-extra
+ '(mark group keyword))))
+ db)
+
(defun gnus-registry-make-db (&optional file)
(interactive "fGnus registry persistence file: \n")
(gnus-registry-fixup-registry
@@ -257,22 +273,6 @@ This is not required after changing `gnus-registry-cache-file'."
file)
(gnus-registry-remake-db t)))))
-(defun gnus-registry-fixup-registry (db)
- (when db
- (oset db :precious
- (append gnus-registry-extra-entries-precious
- '()))
- (oset db :max-hard
- (or gnus-registry-max-entries
- most-positive-fixnum))
- (oset db :max-soft
- (or gnus-registry-max-pruned-entries
- most-positive-fixnum))
- (oset db :tracked
- (append gnus-registry-track-extra
- '(mark group keyword))))
- db)
-
(defun gnus-registry-save (&optional file db)
"Save the registry cache file."
(interactive)
diff --git a/lisp/registry.el b/lisp/registry.el
index 3da83d1..ef78fec 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -99,42 +99,42 @@
:custom float
:documentation "The registry version.")
(max-hard :initarg :max-hard
- :initform 5000000
:type integer
:custom integer
:documentation "Never accept more than this many elements.")
(max-soft :initarg :max-soft
- :initform 50000
:type integer
:custom integer
:documentation "Prune as much as possible to get to this size.")
(tracked :initarg :tracked
- :initform nil
:type t
:documentation "The tracked (indexed) fields, a list of symbols.")
(precious :initarg :precious
- :initform nil
:type t
:documentation "The precious fields, a list of symbols.")
(tracker :initarg :tracker
- :initform (make-hash-table :size 100 :rehash-size 2.0)
- :type t
+ :type hash-table
:documentation "The field tracking hashtable.")
(data :initarg :data
- :initform (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)
- :type t
+ :type hash-table
:documentation "The data hashtable.")))
-;; (defmethod initialize-instance :after ((this registry-db) slots)
-;; "Set value of data slot of THIS after initialization."
-;; (with-slots (data tracker max-hard max-soft tracked precious version) this
-;; (setq data (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)
-;; tracker (make-hash-table :size 100 :rehash-size 2.0)
-;; max-hard 5000000
-;; max-soft 50000
-;; tracked nil
-;; precious nil
-;; version 0.1)))
+(defmethod initialize-instance :after ((this registry-db) slots)
+ "Set value of data slot of THIS after initialization."
+ ;; 'data' will already be set if read from file, so don't overwrite it.
+ (with-slots (data tracker tracked precious max-soft max-hard) this
+ (unless (member :data slots)
+ (setq data (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)))
+ (unless (member :tracker slots)
+ (setq tracker (make-hash-table :size 100 :rehash-size 2.0)))
+ (unless (member :max-soft slots)
+ (setq max-soft 50000))
+ (unless (member :max-hard slots)
+ (setq max-hard 5000000))
+ (unless (member :tracked slots)
+ (setq tracked nil))
+ (unless (member :precious slots)
+ (setq precious nil))))
(defmethod registry-lookup ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
commit 982f553eaeeb15b50ad3e4a3e3670c86026a5137
Author: Ted Zlatanov <[email protected]>
Date: Tue Apr 5 10:41:51 2011 -0500
gnus-registry bug fixes.
* gnus-registry.el (gnus-registry-fixup-registry): New function to
fixup the parameters that can be customized by the user between
save/read cycles.
(gnus-registry-read): Use it.
(gnus-registry-make-db): Use it.
(gnus-registry-spool-action, gnus-registry-handle-action): Fix
messaging.
(gnus-registry--split-fancy-with-parent-internal): Fix loop.
(gnus-registry-post-process-groups): Use `cond' for better messaging.
(gnus-registry-usage-test): Add subject lookup test.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index df1e601..45f7371 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2011-04-05 Teodor Zlatanov <[email protected]>
+
+ * gnus-registry.el (gnus-registry-fixup-registry): New function to
+ fixup the parameters that can be customized by the user between
+ save/read cycles.
+ (gnus-registry-read): Use it.
+ (gnus-registry-make-db): Use it.
+ (gnus-registry-spool-action, gnus-registry-handle-action): Fix
+ messaging.
+ (gnus-registry--split-fancy-with-parent-internal): Fix loop.
+ (gnus-registry-post-process-groups): Use `cond' for better messaging.
+ (gnus-registry-usage-test): Add subject lookup test.
+
2011-04-03 Teodor Zlatanov <[email protected]>
* registry.el: New library to manage gnus-registry-style data.
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 9baa18b..5ae7ed6 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -218,17 +218,15 @@ the Bit Bucket."
(defun gnus-registry-make-db (&optional file)
(interactive "fGnus registry persistence file: \n")
+ (gnus-registry-fixup-registry
(registry-db
"Gnus Registry"
:file (or file gnus-registry-cache-file)
- :max-hard (or gnus-registry-max-entries
- most-positive-fixnum)
- :max-soft (or gnus-registry-max-pruned-entries
- most-positive-fixnum)
- :precious (append gnus-registry-extra-entries-precious
- '())
- :tracked (append gnus-registry-track-extra
- '(mark group keyword))))
+ ;; these parameters are set in `gnus-registry-fixup-registry'
+ :max-hard most-positive-fixnum
+ :max-soft most-positive-fixnum
+ :precious nil
+ :tracked nil)))
(defvar gnus-registry-db (gnus-registry-make-db)
"*The article registry by Message ID. See `registry-db'")
@@ -249,7 +247,8 @@ This is not required after changing `gnus-registry-cache-file'."
(condition-case nil
(progn
(gnus-message 5 "Reading Gnus registry from %s..." file)
- (setq gnus-registry-db (eieio-persistent-read file))
+ (setq gnus-registry-db (gnus-registry-fixup-registry
+ (eieio-persistent-read file)))
(gnus-message 5 "Reading Gnus registry from %s...done" file))
(error
(gnus-message
@@ -258,6 +257,22 @@ This is not required after changing `gnus-registry-cache-file'."
file)
(gnus-registry-remake-db t)))))
+(defun gnus-registry-fixup-registry (db)
+ (when db
+ (oset db :precious
+ (append gnus-registry-extra-entries-precious
+ '()))
+ (oset db :max-hard
+ (or gnus-registry-max-entries
+ most-positive-fixnum))
+ (oset db :max-soft
+ (or gnus-registry-max-pruned-entries
+ most-positive-fixnum))
+ (oset db :tracked
+ (append gnus-registry-track-extra
+ '(mark group keyword))))
+ db)
+
(defun gnus-registry-save (&optional file db)
"Save the registry cache file."
(interactive)
@@ -295,7 +310,7 @@ This is not required after changing `gnus-registry-cache-file'."
(let ((to (gnus-group-guess-full-name-from-command-method group)))
(when (and (stringp id) (string-match "\r$" id))
(setq id (substring id 0 -1)))
- (gnus-message 7 "Registry: article %s spooled to %s"
+ (gnus-message 7 "Gnus registry: article %s spooled to %s"
id
to)
(gnus-registry-handle-action id nil to subject sender)))
@@ -321,6 +336,9 @@ This is not required after changing `gnus-registry-cache-file'."
(add-to-list 'new (second kv) t)
(setq entry (cons new
(assq-delete-all (first kv) entry))))))
+ (gnus-message 10 "Gnus registry: new entry for %s is %S"
+ id
+ entry)
(registry-insert db id entry)))
;; Function for nn{mail|imap}-split-fancy: look up all references in
@@ -387,13 +405,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
9
"%s is looking for matches for reference %s from [%s]"
log-agent reference refstr)
+ (setq found
(loop for group in (gnus-registry-get-id-key reference 'group)
when (gnus-registry-follow-group-p group)
do (gnus-message
7
"%s traced the reference %s from [%s] to group %s"
log-agent reference refstr group)
- collect group into found))
+ collect group)))
;; filter the found groups and return them
;; the found groups are the full groups
(setq found (gnus-registry-post-process-groups
@@ -501,13 +520,19 @@ possible. Uses `gnus-registry-split-strategy'."
log-agent group))))
;; is there just one group?
- (if (= (length out) 1)
- out
+ (cond
+ ((= (length out) 1) out)
+ ((null out)
(gnus-message
5
+ "%s: no matches for %s %s."
+ log-agent out mode key)
+ nil)
+ (t (gnus-message
+ 5
"%s: too many extra matches (%s) for %s %s. Returning none."
log-agent out mode key)
- nil)))
+ nil))))
(defun gnus-registry-follow-group-p (group)
"Determines if a group name should be followed.
@@ -819,6 +844,7 @@ only the last one's marks are returned."
(message "Looking up individual keys (gnus-registry-id-key)")
(should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
+ (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
(message "Trying to insert a duplicate key")
(should-error (registry-insert db "55" '()))
(message "Looking up individual keys (gnus-registry-get-or-make-entry)")
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 16 +++++++++
lisp/gnus-registry.el | 84 ++++++++++++++++++++++++++++++++-----------------
lisp/registry.el | 36 ++++++++++----------
3 files changed, 89 insertions(+), 47 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, tzz-gnus-registry-rewrite has been updated
hooks/post-receive
--
Gnus Project