diff options
| author | Teodor Zlatanov | 2011-05-09 22:27:17 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-05-09 22:27:17 +0000 |
| commit | 81d7704c970a3d5b7275f450245ab86b23f4e37d (patch) | |
| tree | 4ba3f9f78beeb38b72f65fbab253e46b8a5f9e5a | |
| parent | 9bedd73a50921360823210bcc791d1ba1861be70 (diff) | |
| download | emacs-81d7704c970a3d5b7275f450245ab86b23f4e37d.tar.gz emacs-81d7704c970a3d5b7275f450245ab86b23f4e37d.zip | |
registry.el (registry-full): Add convenience method. Fix logic.
(registry-insert): Use it. Fix logic here too.
gnus-registry.el (gnus-registry-insert): Add wrapper that calls `registry-prune' if `registry-full' returns t.
(gnus-registry-handle-action, gnus-registry-get-or-make-entry, gnus-registry-set-id-key, gnus-registry-usage-test): Use it.
| -rw-r--r-- | lisp/gnus/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 18 | ||||
| -rw-r--r-- | lisp/gnus/registry.el | 8 |
3 files changed, 30 insertions, 7 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 99c636f16a7..aa07038635d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -2,6 +2,17 @@ | |||
| 2 | 2 | ||
| 3 | * nntp.el (nntp-open-connection): Set TCP keepalive option. | 3 | * nntp.el (nntp-open-connection): Set TCP keepalive option. |
| 4 | 4 | ||
| 5 | 2011-05-09 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 6 | |||
| 7 | * registry.el (registry-full): Add convenience method. Fix logic. | ||
| 8 | (registry-insert): Use it. Fix logic here too. | ||
| 9 | |||
| 10 | * gnus-registry.el (gnus-registry-insert): Add wrapper that calls | ||
| 11 | `registry-prune' if `registry-full' returns t. | ||
| 12 | (gnus-registry-handle-action) | ||
| 13 | (gnus-registry-get-or-make-entry, gnus-registry-set-id-key) | ||
| 14 | (gnus-registry-usage-test): Use it. | ||
| 15 | |||
| 5 | 2011-05-07 Julien Danjou <julien@danjou.info> | 16 | 2011-05-07 Julien Danjou <julien@danjou.info> |
| 6 | 17 | ||
| 7 | * shr.el (shr-link): Make shr-link inherit from link by default. | 18 | * shr.el (shr-link): Make shr-link inherit from link by default. |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index e6c96ab2b19..02e4ce7e2e6 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -383,7 +383,7 @@ This is not required after changing `gnus-registry-cache-file'." | |||
| 383 | (gnus-message 10 "Gnus registry: new entry for %s is %S" | 383 | (gnus-message 10 "Gnus registry: new entry for %s is %S" |
| 384 | id | 384 | id |
| 385 | entry) | 385 | entry) |
| 386 | (registry-insert db id entry))) | 386 | (gnus-registry-insert db id entry))) |
| 387 | 387 | ||
| 388 | ;; Function for nn{mail|imap}-split-fancy: look up all references in | 388 | ;; Function for nn{mail|imap}-split-fancy: look up all references in |
| 389 | ;; the cache and if a match is found, return that group. | 389 | ;; the cache and if a match is found, return that group. |
| @@ -962,8 +962,8 @@ only the last one's marks are returned." | |||
| 962 | (entries (registry-lookup db (list id)))) | 962 | (entries (registry-lookup db (list id)))) |
| 963 | 963 | ||
| 964 | (when (null entries) | 964 | (when (null entries) |
| 965 | (registry-insert db id (list (list 'creation-time (current-time)) | 965 | (gnus-registry-insert db id (list (list 'creation-time (current-time)) |
| 966 | '(group) '(sender) '(subject))) | 966 | '(group) '(sender) '(subject))) |
| 967 | (setq entries (registry-lookup db (list id)))) | 967 | (setq entries (registry-lookup db (list id)))) |
| 968 | 968 | ||
| 969 | (nth 1 (assoc id entries)))) | 969 | (nth 1 (assoc id entries)))) |
| @@ -979,9 +979,17 @@ only the last one's marks are returned." | |||
| 979 | (entry (gnus-registry-get-or-make-entry id))) | 979 | (entry (gnus-registry-get-or-make-entry id))) |
| 980 | (registry-delete db (list id) nil) | 980 | (registry-delete db (list id) nil) |
| 981 | (setq entry (cons (cons key vals) (assq-delete-all key entry))) | 981 | (setq entry (cons (cons key vals) (assq-delete-all key entry))) |
| 982 | (registry-insert db id entry) | 982 | (gnus-registry-insert db id entry) |
| 983 | entry)) | 983 | entry)) |
| 984 | 984 | ||
| 985 | (defun gnus-registry-insert (db id entry) | ||
| 986 | "Just like `registry-insert' but tries to prune on error." | ||
| 987 | (when (registry-full db) | ||
| 988 | (message "Trying to prune the registry because it's full") | ||
| 989 | (registry-prune db)) | ||
| 990 | (registry-insert db id entry) | ||
| 991 | entry) | ||
| 992 | |||
| 985 | (defun gnus-registry-import-eld (file) | 993 | (defun gnus-registry-import-eld (file) |
| 986 | (interactive "fOld registry file to import? ") | 994 | (interactive "fOld registry file to import? ") |
| 987 | ;; example content: | 995 | ;; example content: |
| @@ -1075,7 +1083,7 @@ only the last one's marks are returned." | |||
| 1075 | (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup"))) | 1083 | (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup"))) |
| 1076 | (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4"))) | 1084 | (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4"))) |
| 1077 | (message "Trying to insert a duplicate key") | 1085 | (message "Trying to insert a duplicate key") |
| 1078 | (should-error (registry-insert db "55" '())) | 1086 | (should-error (gnus-registry-insert db "55" '())) |
| 1079 | (message "Looking up individual keys (gnus-registry-get-or-make-entry)") | 1087 | (message "Looking up individual keys (gnus-registry-get-or-make-entry)") |
| 1080 | (should (gnus-registry-get-or-make-entry "22")) | 1088 | (should (gnus-registry-get-or-make-entry "22")) |
| 1081 | (message "Saving the Gnus registry to %s" tempfile) | 1089 | (message "Saving the Gnus registry to %s" tempfile) |
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 51bfc9cde57..4beafd4b845 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el | |||
| @@ -261,6 +261,11 @@ With assert non-nil, errors out if the key does not exist already." | |||
| 261 | (remhash key data))) | 261 | (remhash key data))) |
| 262 | keys)) | 262 | keys)) |
| 263 | 263 | ||
| 264 | (defmethod registry-full ((db registry-db)) | ||
| 265 | "Checks if registry-db THIS is full." | ||
| 266 | (>= (registry-size db) | ||
| 267 | (oref db :max-hard))) | ||
| 268 | |||
| 264 | (defmethod registry-insert ((db registry-db) key entry) | 269 | (defmethod registry-insert ((db registry-db) key entry) |
| 265 | "Insert ENTRY under KEY into the registry-db THIS. | 270 | "Insert ENTRY under KEY into the registry-db THIS. |
| 266 | Updates the secondary ('tracked') indices as well. | 271 | Updates the secondary ('tracked') indices as well. |
| @@ -269,8 +274,7 @@ Errors out if the key exists already." | |||
| 269 | (assert (not (gethash key (oref db :data))) nil | 274 | (assert (not (gethash key (oref db :data))) nil |
| 270 | "Key already exists in database") | 275 | "Key already exists in database") |
| 271 | 276 | ||
| 272 | (assert (< (registry-size db) | 277 | (assert (not (registry-full db)) |
| 273 | (oref db :max-hard)) | ||
| 274 | nil | 278 | nil |
| 275 | "registry max-hard size limit reached") | 279 | "registry max-hard size limit reached") |
| 276 | 280 | ||