[gnus git] branch master updated: n0-15-72-g76291d8 =1= gnus-registry.el, registry.el: Silence the byte compiler.
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 76291d81a179dad7f89478eb52e94c36531db83f (commit)
from 1e4b51ee2924b45cf986153f994fc25f338d2c17 (commit)
- Log -----------------------------------------------------------------
commit 76291d81a179dad7f89478eb52e94c36531db83f
Author: Katsumi Yamaoka <[email protected]>
Date: Mon Apr 18 22:50:30 2011 +0000
gnus-registry.el, registry.el: Silence the byte compiler.
gnus-registry.el: Eliminate cl functions.
(gnus-registry-sort-addresses): New function that replaces mapcan.
(gnus-registry-action, gnus-registry-spool-action)
(gnus-registry-split-fancy-with-parent)
(gnus-registry-fetch-recipients-fast): Use it.
(gnus-registry-import-eld): Replace delete* with dolist + delq.
registry.el (initialize-instance, registry-lookup)
(registry-lookup-breaks-before-lexbind, registry-lookup-secondary)
(registry-lookup-secondary-value, registry-search, registry-delete)
(registry-insert, registry-reindex, registry-size, registry-prune):
Use eval-and-compile.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b6fc312..3cbeac0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2011-04-18 Katsumi Yamaoka <[email protected]>
+
+ * gnus-registry.el: Eliminate cl functions.
+ (gnus-registry-sort-addresses): New function that replaces mapcan.
+ (gnus-registry-action, gnus-registry-spool-action)
+ (gnus-registry-split-fancy-with-parent)
+ (gnus-registry-fetch-recipients-fast): Use it.
+ (gnus-registry-import-eld): Replace delete* with dolist + delq.
+
+ * registry.el (initialize-instance, registry-lookup)
+ (registry-lookup-breaks-before-lexbind, registry-lookup-secondary)
+ (registry-lookup-secondary-value, registry-search, registry-delete)
+ (registry-insert, registry-reindex, registry-size, registry-prune):
+ Use eval-and-compile.
+
2011-04-16 Teodor Zlatanov <[email protected]>
* registry.el (registry-reindex): New method to recreate the secondary
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index eab4403..697dc37 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -303,15 +303,9 @@ This is not required after changing `gnus-registry-cache-file'."
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
(subject (mail-header-subject data-header))
- (recipients (sort (mapcan 'gnus-registry-extract-addresses
- (list
- (or (ignore-errors
- (mail-header "Cc" data-header))
- "")
- (or (ignore-errors
- (mail-header "To" data-header))
- "")))
- 'string-lessp))
+ (recipients (gnus-registry-sort-addresses
+ (or (ignore-errors (mail-header "Cc" data-header)) "")
+ (or (ignore-errors (mail-header "To" data-header)) "")))
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
(from (gnus-group-guess-full-name-from-command-method from))
@@ -329,11 +323,9 @@ This is not required after changing `gnus-registry-cache-file'."
(defun gnus-registry-spool-action (id group &optional subject sender recipients)
(let ((to (gnus-group-guess-full-name-from-command-method group))
(recipients (or recipients
- (sort (mapcan 'gnus-registry-extract-addresses
- (list
+ (gnus-registry-sort-addresses
(or (message-fetch-field "cc") "")
- (or (message-fetch-field "to") "")))
- 'string-lessp)))
+ (or (message-fetch-field "to") ""))))
(subject (or subject (message-fetch-field "subject")))
(sender (or sender (message-fetch-field "from"))))
(when (and (stringp id) (string-match "\r$" id))
@@ -409,11 +401,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; these may not be used, but the code is cleaner having them up here
(sender (gnus-string-remove-all-properties
(message-fetch-field "from")))
- (recipients (sort (mapcan 'gnus-registry-extract-addresses
- (list
+ (recipients (gnus-registry-sort-addresses
(or (message-fetch-field "cc") "")
(or (message-fetch-field "to") "")))
- 'string-lessp))
(subject (gnus-string-remove-all-properties
(gnus-registry-simplify-subject
(message-fetch-field "subject"))))
@@ -719,6 +709,11 @@ Addresses without a name will say \"noname\"."
(format "%s <%s>" name addr))))
(mail-extract-address-components text t)))
+(defun gnus-registry-sort-addresses (&rest addresses)
+ "Return a normalized and sorted list of ADDRESSES."
+ (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
+ 'string-lessp))
+
(defun gnus-registry-simplify-subject (subject)
(if (stringp subject)
(gnus-simplify-subject subject)
@@ -738,15 +733,9 @@ Addresses without a name will say \"noname\"."
(gnus-registry-fetch-header-fast "from" article))
(defun gnus-registry-fetch-recipients-fast (article)
- (sort (mapcan 'gnus-registry-extract-addresses
- (list
- (or (ignore-errors
- (gnus-registry-fetch-header-fast "Cc" article))
- "")
- (or (ignore-errors
- (gnus-registry-fetch-header-fast "To" article))
- "")))
- 'string-lessp))
+ (gnus-registry-sort-addresses
+ (or (ignore-errors (gnus-registry-fetch-header-fast "Cc" article)) "")
+ (or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
(defun gnus-registry-fetch-header-fast (article header)
"Fetch the HEADER quickly, using the internal gnus-data-list function"
@@ -982,7 +971,8 @@ only the last one's marks are returned."
collect p))
extra-cell key val)
;; remove all the strings from the entry
- (delete* nil rest :test (lambda (a b) (stringp b)))
+ (dolist (elem rest)
+ (if (stringp elem) (setq rest (delq elem rest))))
(gnus-registry-set-id-key id 'group groups)
;; just use the first extra element
(setq rest (car-safe rest))
diff --git a/lisp/registry.el b/lisp/registry.el
index 3e63842..1a18dbd 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -131,15 +131,17 @@
:type hash-table
:documentation "The data hashtable.")))
-(defmethod initialize-instance :AFTER ((this registry-db) slots)
+(eval-and-compile
+ (defmethod initialize-instance :AFTER ((this registry-db) slots)
"Set value of data slot of THIS after initialization."
(with-slots (data tracker) this
(unless (member :data slots)
- (setq data (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)))
+ (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)))))
-(defmethod registry-lookup ((db registry-db) keys)
+ (defmethod registry-lookup ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns a alist of the key followed by the entry in a list, not a cons cell."
(let ((data (oref db :data)))
@@ -150,7 +152,7 @@ Returns a alist of the key followed by the entry in a list, not a cons cell."
(list k (gethash k data))))
keys))))
-(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
+ (defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns a alist of the key followed by the entry in a list, not a cons cell."
(let ((data (oref db :data)))
@@ -159,7 +161,7 @@ Returns a alist of the key followed by the entry in a list, not a cons cell."
when (gethash key data)
collect (list key (gethash key data))))))
-(defmethod registry-lookup-secondary ((db registry-db) tracksym
+ (defmethod registry-lookup-secondary ((db registry-db) tracksym
&optional create)
"Search for TRACKSYM in the registry-db THIS.
When CREATE is not nil, create the secondary index hashtable if needed."
@@ -172,7 +174,7 @@ When CREATE is not nil, create the secondary index hashtable if needed."
(oref db :tracker))
(gethash tracksym (oref db :tracker))))))
-(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
+ (defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
&optional set)
"Search for TRACKSYM with value VAL in the registry-db THIS.
When SET is not nil, set it for VAL (use t for an empty list)."
@@ -182,7 +184,7 @@ When SET is not nil, set it for VAL (use t for an empty list)."
(when set
(puthash val (if (eq t set) '() set)
(registry-lookup-secondary db tracksym t)))
- (gethash val (registry-lookup-secondary db tracksym))))
+ (gethash val (registry-lookup-secondary db tracksym)))))
(defun registry--match (mode entry check-list)
;; for all members
@@ -204,7 +206,8 @@ When SET is not nil, set it for VAL (use t for an empty list)."
(or found
(registry--match mode entry (cdr-safe check-list))))))
-(defmethod registry-search ((db registry-db) &rest spec)
+(eval-and-compile
+ (defmethod registry-search ((db registry-db) &rest spec)
"Search for SPEC across the registry-db THIS.
For example calling with :member '(a 1 2) will match entry '((a 3 1)).
Calling with :all t (any non-nil value) will match all.
@@ -214,7 +217,8 @@ The test order is to check :all first, then :member, then :regex."
(let ((all (plist-get spec :all))
(member (plist-get spec :member))
(regex (plist-get spec :regex)))
- (loop for k being the hash-keys of (oref db :data) using (hash-values v)
+ (loop for k being the hash-keys of (oref db :data)
+ using (hash-values v)
when (or
;; :all non-nil returns all
all
@@ -224,7 +228,7 @@ The test order is to check :all first, then :member, then :regex."
(and regex (registry--match :regex v regex)))
collect k))))
-(defmethod registry-delete ((db registry-db) keys assert &rest spec)
+ (defmethod registry-delete ((db registry-db) keys assert &rest spec)
"Delete KEYS from the registry-db THIS.
If KEYS is nil, use SPEC to do a search.
Updates the secondary ('tracked') indices as well.
@@ -245,7 +249,8 @@ With assert non-nil, errors out if the key does not exist already."
(when (registry-lookup-secondary db tr)
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
- (let* ((value-keys (registry-lookup-secondary-value db tr val)))
+ (let* ((value-keys (registry-lookup-secondary-value
+ db tr val)))
(when (member key value-keys)
;; override the previous value
(registry-lookup-secondary-value
@@ -256,7 +261,7 @@ With assert non-nil, errors out if the key does not exist already."
(remhash key data)))
keys))
-(defmethod registry-insert ((db registry-db) key entry)
+ (defmethod registry-insert ((db registry-db) key entry)
"Insert ENTRY under KEY into the registry-db THIS.
Updates the secondary ('tracked') indices as well.
Errors out if the key exists already."
@@ -281,7 +286,7 @@ Errors out if the key exists already."
(registry-lookup-secondary-value db tr val value-keys))))
entry)
-(defmethod registry-reindex ((db registry-db))
+ (defmethod registry-reindex ((db registry-db))
"Rebuild the secondary indices of registry-db THIS."
(let ((count 0)
(expected (* (length (oref db :tracked)) (registry-size db))))
@@ -300,16 +305,17 @@ Errors out if the key exists already."
(registry-lookup-secondary-value db tr val value-keys))))
(oref db :data))))))
-(defmethod registry-size ((db registry-db))
+ (defmethod registry-size ((db registry-db))
"Returns the size of the registry-db object THIS.
This is the key count of the :data slot."
(hash-table-count (oref db :data)))
-(defmethod registry-prune ((db registry-db))
+ (defmethod registry-prune ((db registry-db))
"Prunes the registry-db object THIS.
Removes only entries without the :precious keys."
(let* ((precious (oref db :precious))
- (precious-p (lambda (entry-key) (cdr (memq (car entry-key) precious))))
+ (precious-p (lambda (entry-key)
+ (cdr (memq (car entry-key) precious))))
(data (oref db :data))
(limit (oref db :max-soft))
(size (registry-size db))
@@ -326,7 +332,7 @@ Removes only entries without the :precious keys."
(decf candidates-count)
(setq candidates (cdr candidates)))
- (registry-delete db candidates nil)))
+ (registry-delete db candidates nil))))
(ert-deftest registry-instantiation-test ()
(should (registry-db "Testing")))
-----------------------------------------------------------------------
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 | 15 +++
lisp/gnus-registry.el | 48 +++-----
lisp/registry.el | 320 +++++++++++++++++++++++++------------------------
3 files changed, 197 insertions(+), 186 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, master has been updated
hooks/post-receive
--
Gnus Project