diff options
Diffstat (limited to 'lisp/gnus/gnus-registry.el')
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 62 |
1 files changed, 27 insertions, 35 deletions
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 80d73b5c21a..634cf926cea 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -76,7 +76,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) (require 'gnus) (require 'gnus-int) @@ -165,12 +166,7 @@ nnmairix groups are specifically excluded because they are ephemeral." (defvar gnus-registry-misc-menus nil) ; ugly way to keep the menus -(make-obsolete-variable 'gnus-registry-clean-empty nil "23.4") -(make-obsolete-variable 'gnus-registry-use-long-group-names nil "23.4") -(make-obsolete-variable 'gnus-registry-max-track-groups nil "23.4") -(make-obsolete-variable 'gnus-registry-entry-caching nil "23.4") -(make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4") -;; FIXME it was simply deleted. +;; It was simply deleted. (make-obsolete-variable 'gnus-registry-max-pruned-entries nil "25.1") (defcustom gnus-registry-track-extra '(subject sender recipient) @@ -372,7 +368,7 @@ This is not required after changing `gnus-registry-cache-file'." (grouphashtb (registry-lookup-secondary db 'group)) (old-size (registry-size db))) (registry-reindex db) - (loop for k being the hash-keys of grouphashtb + (cl-loop for k being the hash-keys of grouphashtb using (hash-values v) when (gnus-registry-ignore-group-p k) do (registry-delete db v nil)) @@ -443,14 +439,14 @@ This is not required after changing `gnus-registry-cache-file'." (sender ,sender) (recipient ,@recipients) (subject ,subject))) - (when (second kv) - (let ((new (or (assq (first kv) entry) - (list (first kv))))) + (when (cadr kv) + (let ((new (or (assq (car kv) entry) + (list (car kv))))) (dolist (toadd (cdr kv)) (unless (member toadd new) (setq new (append new (list toadd))))) (setq entry (cons new - (assq-delete-all (first kv) entry)))))) + (assq-delete-all (car kv) entry)))))) (gnus-message 10 "Gnus registry: new entry for %s is %S" id entry) @@ -504,7 +500,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." :subject subject :log-agent "Gnus registry fancy splitting with parent"))) -(defun* gnus-registry--split-fancy-with-parent-internal +(cl-defun gnus-registry--split-fancy-with-parent-internal (&rest spec &key references refstr sender subject recipients log-agent &allow-other-keys) @@ -524,7 +520,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." log-agent refstr) (dolist (reference (nreverse references)) (gnus-message 9 "%s is looking up %s" log-agent reference) - (loop for group in (gnus-registry-get-id-key reference 'group) + (cl-loop for group in (gnus-registry-get-id-key reference 'group) when (gnus-registry-follow-group-p group) do (progn @@ -547,7 +543,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (gnus-registry-get-id-key reference 'group)) (registry-lookup-secondary-value db 'subject subject))))) (setq found - (loop for group in groups + (cl-loop for group in groups when (gnus-registry-follow-group-p group) do (gnus-message ;; warn more if gnus-registry-track-extra @@ -574,7 +570,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (gnus-registry-get-id-key reference 'group)) (registry-lookup-secondary-value db 'sender sender))))) (setq found - (loop for group in groups + (cl-loop for group in groups when (gnus-registry-follow-group-p group) do (gnus-message ;; warn more if gnus-registry-track-extra @@ -604,7 +600,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (registry-lookup-secondary-value db 'recipient recp))))) (setq found - (loop for group in groups + (cl-loop for group in groups when (gnus-registry-follow-group-p group) do (gnus-message ;; warn more if gnus-registry-track-extra @@ -640,7 +636,7 @@ possible. Uses `gnus-registry-split-strategy'." out chosen) ;; the strategy can be nil, in which case chosen is nil (setq chosen - (case gnus-registry-split-strategy + (cl-case gnus-registry-split-strategy ;; default, take only one-element lists into chosen ((nil) (and (= (length groups) 1) @@ -692,7 +688,7 @@ possible. Uses `gnus-registry-split-strategy'." 10 "%s: stripped group %s to %s" log-agent group short-name)) - (pushnew short-name out :test #'equal)) + (cl-pushnew short-name out :test #'equal)) ;; else... (gnus-message 7 @@ -844,21 +840,17 @@ Addresses without a name will say \"noname\"." nil)) (defun gnus-registry-fetch-sender-fast (article) - (gnus-registry-fetch-header-fast "from" article)) + (when-let* ((data (and (numberp article) + (assoc article (gnus-data-list nil))))) + (mail-header-from (gnus-data-header data)))) (defun gnus-registry-fetch-recipients-fast (article) - (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." - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (gnus-string-remove-all-properties - (cdr (assq header (gnus-data-header - (assoc article (gnus-data-list nil)))))) - nil)) + (when-let* ((data (and (numberp article) + (assoc article (gnus-data-list nil)))) + (extra (mail-header-extra (gnus-data-header data)))) + (gnus-registry-sort-addresses + (or (cdr (assq 'Cc extra)) "") + (or (cdr (assq 'To extra)) "")))) ;; registry marks glue (defun gnus-registry-do-marks (type function) @@ -1089,7 +1081,7 @@ only the last one's marks are returned." (expected (length old)) entry) (while (car-safe old) - (incf count) + (cl-incf count) ;; don't use progress reporters for backwards compatibility (when (and (< 0 expected) (= 0 (mod count 100))) @@ -1099,7 +1091,7 @@ only the last one's marks are returned." old (cdr-safe old)) (let* ((id (car-safe entry)) (rest (cdr-safe entry)) - (groups (loop for p in rest + (groups (cl-loop for p in rest when (stringp p) collect p)) extra-cell key val) @@ -1235,7 +1227,7 @@ from your existing entries." (when extra (let ((db gnus-registry-db)) (registry-reindex db) - (loop for k being the hash-keys of (oref db data) + (cl-loop for k being the hash-keys of (oref db data) using (hash-value v) do (let ((newv (delq nil (mapcar #'(lambda (entry) (unless (member (car entry) extra) |