aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2015-03-11 11:00:25 -0400
committerStefan Monnier2015-03-11 11:00:25 -0400
commitb90f502cc18b60644ce3898699589ecd9653b397 (patch)
tree1dc961d28deff002f1100598be6725c749125e64
parent41bba4b40f6e07924a3681ffeabb26ca48424095 (diff)
downloademacs-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/ChangeLog14
-rw-r--r--lisp/gnus/gnus-registry.el39
-rw-r--r--lisp/gnus/registry.el9
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 @@
12015-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
12015-03-10 Glenn Morris <rgm@gnu.org> 152015-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."