diff options
| author | Stefan Monnier | 2015-03-11 11:00:25 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2015-03-11 11:00:25 -0400 |
| commit | b90f502cc18b60644ce3898699589ecd9653b397 (patch) | |
| tree | 1dc961d28deff002f1100598be6725c749125e64 | |
| parent | 41bba4b40f6e07924a3681ffeabb26ca48424095 (diff) | |
| download | emacs-b90f502cc18b60644ce3898699589ecd9653b397.tar.gz emacs-b90f502cc18b60644ce3898699589ecd9653b397.zip | |
* lisp/gnus/registry.el (registry-db): Don't oset-default an instance slot.
* lisp/gnus/gnus-registry.el (gnus-registry-handle-action)
(gnus-registry-post-process-groups): Don't add-to-list on a local var.
(gnus-registry-keywords): Make it do something.
(gnus-registry-import-eld): Remove unused var `new-entry'.
(gnus-registry-action): Remove unused var `to-name'.
(gnus-registry-make-db): Prefer `make-instance' to avoid
compiler warnings.
(gnus-registry-load, gnus-registry-fixup-registry): Avoid `oset'.
| -rw-r--r-- | lisp/gnus/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 39 | ||||
| -rw-r--r-- | lisp/gnus/registry.el | 9 |
3 files changed, 39 insertions, 23 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 1744a132804..64124bc183d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,17 @@ | |||
| 1 | 2015-03-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * gnus-registry.el (gnus-registry-handle-action) | ||
| 4 | (gnus-registry-post-process-groups): Don't add-to-list on a local var. | ||
| 5 | (gnus-registry-keywords): Make it do something. | ||
| 6 | (gnus-registry-import-eld): Remove unused var `new-entry'. | ||
| 7 | (gnus-registry-action): Remove unused var `to-name'. | ||
| 8 | (gnus-registry-make-db): Prefer `make-instance' to avoid | ||
| 9 | compiler warnings. | ||
| 10 | (gnus-registry-load, gnus-registry-fixup-registry): Avoid `oset'. | ||
| 11 | |||
| 12 | * registry.el (registry-db): Don't oset-default an instance-allocated | ||
| 13 | slot. | ||
| 14 | |||
| 1 | 2015-03-10 Glenn Morris <rgm@gnu.org> | 15 | 2015-03-10 Glenn Morris <rgm@gnu.org> |
| 2 | 16 | ||
| 3 | * message.el (message-valid-fqdn-regexp): Bump :version for | 17 | * message.el (message-valid-fqdn-regexp): Bump :version for |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index ac903a250ec..1d5887dad26 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -277,16 +277,16 @@ This can slow pruning down. Set to nil to perform no sorting." | |||
| 277 | (defun gnus-registry-fixup-registry (db) | 277 | (defun gnus-registry-fixup-registry (db) |
| 278 | (when db | 278 | (when db |
| 279 | (let ((old (oref db tracked))) | 279 | (let ((old (oref db tracked))) |
| 280 | (oset db precious | 280 | (setf (oref db precious) |
| 281 | (append gnus-registry-extra-entries-precious | 281 | (append gnus-registry-extra-entries-precious |
| 282 | '())) | 282 | '())) |
| 283 | (oset db max-size | 283 | (setf (oref db max-size) |
| 284 | (or gnus-registry-max-entries | 284 | (or gnus-registry-max-entries |
| 285 | most-positive-fixnum)) | 285 | most-positive-fixnum)) |
| 286 | (oset db prune-factor | 286 | (setf (oref db prune-factor) |
| 287 | (or gnus-registry-prune-factor | 287 | (or gnus-registry-prune-factor |
| 288 | 0.1)) | 288 | 0.1)) |
| 289 | (oset db tracked | 289 | (setf (oref db tracked) |
| 290 | (append gnus-registry-track-extra | 290 | (append gnus-registry-track-extra |
| 291 | '(mark group keyword))) | 291 | '(mark group keyword))) |
| 292 | (when (not (equal old (oref db tracked))) | 292 | (when (not (equal old (oref db tracked))) |
| @@ -297,14 +297,13 @@ This can slow pruning down. Set to nil to perform no sorting." | |||
| 297 | (defun gnus-registry-make-db (&optional file) | 297 | (defun gnus-registry-make-db (&optional file) |
| 298 | (interactive "fGnus registry persistence file: \n") | 298 | (interactive "fGnus registry persistence file: \n") |
| 299 | (gnus-registry-fixup-registry | 299 | (gnus-registry-fixup-registry |
| 300 | (registry-db | 300 | (make-instance 'registry-db |
| 301 | "Gnus Registry" | 301 | :file (or file gnus-registry-cache-file) |
| 302 | :file (or file gnus-registry-cache-file) | 302 | ;; these parameters are set in `gnus-registry-fixup-registry' |
| 303 | ;; these parameters are set in `gnus-registry-fixup-registry' | 303 | :max-size most-positive-fixnum |
| 304 | :max-size most-positive-fixnum | 304 | :version registry-db-version |
| 305 | :version registry-db-version | 305 | :precious nil |
| 306 | :precious nil | 306 | :tracked nil))) |
| 307 | :tracked nil))) | ||
| 308 | 307 | ||
| 309 | (defvar gnus-registry-db (gnus-registry-make-db) | 308 | (defvar gnus-registry-db (gnus-registry-make-db) |
| 310 | "The article registry by Message ID. See `registry-db'.") | 309 | "The article registry by Message ID. See `registry-db'.") |
| @@ -336,7 +335,7 @@ This is not required after changing `gnus-registry-cache-file'." | |||
| 336 | old-file-name file))) | 335 | old-file-name file))) |
| 337 | (progn | 336 | (progn |
| 338 | (gnus-registry-read old-file-name) | 337 | (gnus-registry-read old-file-name) |
| 339 | (oset gnus-registry-db :file file) | 338 | (setf (oref gnus-registry-db :file) file) |
| 340 | (gnus-message 1 "Registry filename changed to %s" file)) | 339 | (gnus-message 1 "Registry filename changed to %s" file)) |
| 341 | (gnus-registry-remake-db t)))) | 340 | (gnus-registry-remake-db t)))) |
| 342 | (error | 341 | (error |
| @@ -398,8 +397,7 @@ This is not required after changing `gnus-registry-cache-file'." | |||
| 398 | (sender (nth 0 (gnus-registry-extract-addresses | 397 | (sender (nth 0 (gnus-registry-extract-addresses |
| 399 | (mail-header-from data-header)))) | 398 | (mail-header-from data-header)))) |
| 400 | (from (gnus-group-guess-full-name-from-command-method from)) | 399 | (from (gnus-group-guess-full-name-from-command-method from)) |
| 401 | (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) | 400 | (to (if to (gnus-group-guess-full-name-from-command-method to) nil))) |
| 402 | (to-name (if to to "the Bit Bucket"))) | ||
| 403 | (gnus-message 7 "Gnus registry: article %s %s from %s to %s" | 401 | (gnus-message 7 "Gnus registry: article %s %s from %s to %s" |
| 404 | id (if method "respooling" "going") from to) | 402 | id (if method "respooling" "going") from to) |
| 405 | 403 | ||
| @@ -455,7 +453,8 @@ This is not required after changing `gnus-registry-cache-file'." | |||
| 455 | (let ((new (or (assq (first kv) entry) | 453 | (let ((new (or (assq (first kv) entry) |
| 456 | (list (first kv))))) | 454 | (list (first kv))))) |
| 457 | (dolist (toadd (cdr kv)) | 455 | (dolist (toadd (cdr kv)) |
| 458 | (add-to-list 'new toadd t)) | 456 | (unless (member toadd new) |
| 457 | (setq new (append new (list toadd))))) | ||
| 459 | (setq entry (cons new | 458 | (setq entry (cons new |
| 460 | (assq-delete-all (first kv) entry)))))) | 459 | (assq-delete-all (first kv) entry)))))) |
| 461 | (gnus-message 10 "Gnus registry: new entry for %s is %S" | 460 | (gnus-message 10 "Gnus registry: new entry for %s is %S" |
| @@ -699,7 +698,7 @@ possible. Uses `gnus-registry-split-strategy'." | |||
| 699 | 10 | 698 | 10 |
| 700 | "%s: stripped group %s to %s" | 699 | "%s: stripped group %s to %s" |
| 701 | log-agent group short-name)) | 700 | log-agent group short-name)) |
| 702 | (add-to-list 'out short-name)) | 701 | (pushnew short-name out :test #'equal)) |
| 703 | ;; else... | 702 | ;; else... |
| 704 | (gnus-message | 703 | (gnus-message |
| 705 | 7 | 704 | 7 |
| @@ -785,8 +784,9 @@ Overrides existing keywords with FORCE set non-nil." | |||
| 785 | (gnus-registry-set-id-key id 'keyword words))))) | 784 | (gnus-registry-set-id-key id 'keyword words))))) |
| 786 | 785 | ||
| 787 | (defun gnus-registry-keywords () | 786 | (defun gnus-registry-keywords () |
| 788 | (let ((table (registry-lookup-secondary gnus-registry-db 'keyword))) | 787 | (let ((table (registry-lookup-secondary gnus-registry-db 'keyword)) |
| 789 | (when table (maphash (lambda (k v) k) table)))) | 788 | (ks ())) |
| 789 | (when table (maphash (lambda (k _v) (push k ks)) table) ks))) | ||
| 790 | 790 | ||
| 791 | (defun gnus-registry-find-keywords (keyword) | 791 | (defun gnus-registry-find-keywords (keyword) |
| 792 | (interactive (list | 792 | (interactive (list |
| @@ -1104,7 +1104,6 @@ only the last one's marks are returned." | |||
| 1104 | (setq entry (car-safe old) | 1104 | (setq entry (car-safe old) |
| 1105 | old (cdr-safe old)) | 1105 | old (cdr-safe old)) |
| 1106 | (let* ((id (car-safe entry)) | 1106 | (let* ((id (car-safe entry)) |
| 1107 | (new-entry (gnus-registry-get-or-make-entry id)) | ||
| 1108 | (rest (cdr-safe entry)) | 1107 | (rest (cdr-safe entry)) |
| 1109 | (groups (loop for p in rest | 1108 | (groups (loop for p in rest |
| 1110 | when (stringp p) | 1109 | when (stringp p) |
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 881eb9f5a65..1c83b939d80 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el | |||
| @@ -98,7 +98,12 @@ | |||
| 98 | :type (or null float) | 98 | :type (or null float) |
| 99 | :documentation "The registry version.") | 99 | :documentation "The registry version.") |
| 100 | (max-size :initarg :max-size | 100 | (max-size :initarg :max-size |
| 101 | ;; :initform most-positive-fixnum ;; see below | 101 | ;; EIEIO's :initform is not 100% compatible with CLOS in |
| 102 | ;; that if the form is an atom, it assumes it's constant | ||
| 103 | ;; value rather than an expression, so in order to get the value | ||
| 104 | ;; of `most-positive-fixnum', we need to use an | ||
| 105 | ;; expression that's not just a symbol. | ||
| 106 | :initform (symbol-value 'most-positive-fixnum) | ||
| 102 | :type integer | 107 | :type integer |
| 103 | :custom integer | 108 | :custom integer |
| 104 | :documentation "The maximum number of registry entries.") | 109 | :documentation "The maximum number of registry entries.") |
| @@ -123,8 +128,6 @@ | |||
| 123 | (data :initarg :data | 128 | (data :initarg :data |
| 124 | :type hash-table | 129 | :type hash-table |
| 125 | :documentation "The data hashtable."))) | 130 | :documentation "The data hashtable."))) |
| 126 | ;; Do this separately, since defclass doesn't allow expressions in :initform. | ||
| 127 | (oset-default 'registry-db max-size most-positive-fixnum) | ||
| 128 | 131 | ||
| 129 | (defmethod initialize-instance :BEFORE ((this registry-db) slots) | 132 | (defmethod initialize-instance :BEFORE ((this registry-db) slots) |
| 130 | "Check whether a registry object needs to be upgraded." | 133 | "Check whether a registry object needs to be upgraded." |