aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-06-07 15:28:12 -0400
committerStefan Monnier2019-06-07 15:28:12 -0400
commitda1974fabddda6fac029db6960110001c6472ddc (patch)
treebe1c9d5cd25355eb298d505537266d56d7c98cf1
parent77f96e2cc1da30730f79d5935eaf5d23e53f37ad (diff)
downloademacs-da1974fabddda6fac029db6960110001c6472ddc.tar.gz
emacs-da1974fabddda6fac029db6960110001c6472ddc.zip
* lisp/gnus: Further reduce assumptions about gnus-data format
* lisp/gnus/gnus-registry.el (gnus-registry-fetch-message-id-fast) (gnus-registry-fetch-simplified-message-subject-fast) (gnus-registry-fetch-sender-fast, gnus-registry-fetch-recipients-fast) (gnus-registry--set/remove-mark): Don't hardcode assoc for gnus-data-find-in. * lisp/gnus/gnus-sum.el (gnus-data-update-list): Don't hardcode `nth 2` for gnus-data-pos. (gnus-summary-insert-old-articles, gnus-summary-insert-new-articles) (gnus-summary-first-article-p): Don't hardcode `car` for `gnus-data-number`. (gnus-summary-move-article, gnus-summary-expire-articles) (gnus-summary-delete-article): Don't hardcode assoc for gnus-data-find-in. * lisp/gnus/spam.el (spam-fetch-article-header): Don't hardcode `nth 3` for gnus-data-header.
-rw-r--r--lisp/gnus/gnus-registry.el31
-rw-r--r--lisp/gnus/gnus-sum.el27
-rw-r--r--lisp/gnus/spam.el4
3 files changed, 26 insertions, 36 deletions
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 634cf926cea..6e549cf246d 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -799,11 +799,9 @@ Overrides existing keywords with FORCE set non-nil."
799 799
800;; message field fetchers 800;; message field fetchers
801(defun gnus-registry-fetch-message-id-fast (article) 801(defun gnus-registry-fetch-message-id-fast (article)
802 "Fetch the Message-ID quickly, using the internal gnus-data-list function." 802 "Fetch the Message-ID quickly, using the internal `gnus-data-find' function."
803 (if (and (numberp article) 803 (when-let* ((data (and (numberp article) (gnus-data-find article))))
804 (assoc article (gnus-data-list nil))) 804 (mail-header-id (gnus-data-header data))))
805 (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
806 nil))
807 805
808(defun gnus-registry-extract-addresses (text) 806(defun gnus-registry-extract-addresses (text)
809 "Extract all the addresses in a normalized way from TEXT. 807 "Extract all the addresses in a normalized way from TEXT.
@@ -830,23 +828,18 @@ Addresses without a name will say \"noname\"."
830 nil)) 828 nil))
831 829
832(defun gnus-registry-fetch-simplified-message-subject-fast (article) 830(defun gnus-registry-fetch-simplified-message-subject-fast (article)
833 "Fetch the Subject quickly, using the internal gnus-data-list function." 831 "Fetch the Subject quickly, using the internal `gnus-data-find' function."
834 (if (and (numberp article) 832 (when-let* ((data (and (numberp article) (gnus-data-find article))))
835 (assoc article (gnus-data-list nil))) 833 (gnus-string-remove-all-properties
836 (gnus-string-remove-all-properties 834 (gnus-registry-simplify-subject
837 (gnus-registry-simplify-subject 835 (mail-header-subject (gnus-data-header data))))))
838 (mail-header-subject (gnus-data-header
839 (assoc article (gnus-data-list nil))))))
840 nil))
841 836
842(defun gnus-registry-fetch-sender-fast (article) 837(defun gnus-registry-fetch-sender-fast (article)
843 (when-let* ((data (and (numberp article) 838 (when-let* ((data (and (numberp article) (gnus-data-find article))))
844 (assoc article (gnus-data-list nil)))))
845 (mail-header-from (gnus-data-header data)))) 839 (mail-header-from (gnus-data-header data))))
846 840
847(defun gnus-registry-fetch-recipients-fast (article) 841(defun gnus-registry-fetch-recipients-fast (article)
848 (when-let* ((data (and (numberp article) 842 (when-let* ((data (and (numberp article) (gnus-data-find article)))
849 (assoc article (gnus-data-list nil))))
850 (extra (mail-header-extra (gnus-data-header data)))) 843 (extra (mail-header-extra (gnus-data-header data))))
851 (gnus-registry-sort-addresses 844 (gnus-registry-sort-addresses
852 (or (cdr (assq 'Cc extra)) "") 845 (or (cdr (assq 'Cc extra)) "")
@@ -887,9 +880,7 @@ FUNCTION should take two parameters, a mark symbol and the cell value."
887 (gnus-message 9 "Applying mark %s to %d articles" 880 (gnus-message 9 "Applying mark %s to %d articles"
888 mark (length articles)) 881 mark (length articles))
889 (dolist (article articles) 882 (dolist (article articles)
890 (gnus-summary-update-article 883 (gnus-summary-update-article article (gnus-data-find article)))))
891 article
892 (assoc article (gnus-data-list nil))))))
893 884
894;; This is ugly code, but I don't know how to do it better. 885;; This is ugly code, but I don't know how to do it better.
895(defun gnus-registry-install-shortcuts () 886(defun gnus-registry-install-shortcuts ()
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 4c4445275a6..8fdb766584b 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -3246,7 +3246,7 @@ The following commands are available:
3246 "Add OFFSET to the POS of all data entries in DATA." 3246 "Add OFFSET to the POS of all data entries in DATA."
3247 (setq gnus-newsgroup-data-reverse nil) 3247 (setq gnus-newsgroup-data-reverse nil)
3248 (while data 3248 (while data
3249 (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) 3249 (cl-incf (gnus-data-pos (car data)) offset)
3250 (setq data (cdr data)))) 3250 (setq data (cdr data))))
3251 3251
3252(defun gnus-summary-article-pseudo-p (article) 3252(defun gnus-summary-article-pseudo-p (article)
@@ -3574,7 +3574,7 @@ buffer that was in action when the last article was fetched."
3574 "Return whether ARTICLE is the first article in the buffer." 3574 "Return whether ARTICLE is the first article in the buffer."
3575 (if (not (setq article (or article (gnus-summary-article-number)))) 3575 (if (not (setq article (or article (gnus-summary-article-number))))
3576 nil 3576 nil
3577 (eq article (caar gnus-newsgroup-data)))) 3577 (eq article (gnus-data-number (car gnus-newsgroup-data)))))
3578 3578
3579(defun gnus-summary-last-article-p (&optional article) 3579(defun gnus-summary-last-article-p (&optional article)
3580 "Return whether ARTICLE is the last article in the buffer." 3580 "Return whether ARTICLE is the last article in the buffer."
@@ -4725,10 +4725,10 @@ If LINE, insert the rebuilt thread starting on line LINE."
4725 (push thr roots)) 4725 (push thr roots))
4726 (setq thread (cdr thread))) 4726 (setq thread (cdr thread)))
4727 ;; We now have all (unique) roots. 4727 ;; We now have all (unique) roots.
4728 (if (= (length roots) 1) 4728 (setq thread (if (= (length roots) 1)
4729 ;; All the loose roots are now one solid root. 4729 ;; All the loose roots are now one solid root.
4730 (setq thread (car roots)) 4730 (car roots)
4731 (setq thread (cons subject (gnus-sort-threads roots)))))) 4731 (cons subject (gnus-sort-threads roots))))))
4732 (let (threads) 4732 (let (threads)
4733 ;; We then insert this thread into the summary buffer. 4733 ;; We then insert this thread into the summary buffer.
4734 (when line 4734 (when line
@@ -4738,6 +4738,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
4738 (if gnus-show-threads 4738 (if gnus-show-threads
4739 (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) 4739 (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
4740 (gnus-summary-prepare-unthreaded thread)) 4740 (gnus-summary-prepare-unthreaded thread))
4741 ;; FIXME: Why is this `nreverse' safe? Don't we need `reverse' instead?
4741 (setq data (nreverse gnus-newsgroup-data)) 4742 (setq data (nreverse gnus-newsgroup-data))
4742 (setq threads gnus-newsgroup-threads)) 4743 (setq threads gnus-newsgroup-threads))
4743 ;; We splice the new data into the data structure. 4744 ;; We splice the new data into the data structure.
@@ -10170,7 +10171,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
10170 (run-hook-with-args 'gnus-summary-article-delete-hook 10171 (run-hook-with-args 'gnus-summary-article-delete-hook
10171 action 10172 action
10172 (gnus-data-header 10173 (gnus-data-header
10173 (assoc article (gnus-data-list nil))) 10174 (gnus-data-find-in article (gnus-data-list nil)))
10174 gnus-newsgroup-name nil 10175 gnus-newsgroup-name nil
10175 select-method))) 10176 select-method)))
10176 (t 10177 (t
@@ -10280,8 +10281,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
10280 ;; run the move/copy/crosspost/respool hook 10281 ;; run the move/copy/crosspost/respool hook
10281 (run-hook-with-args 'gnus-summary-article-move-hook 10282 (run-hook-with-args 'gnus-summary-article-move-hook
10282 action 10283 action
10283 (gnus-data-header 10284 (gnus-data-header (gnus-data-find article))
10284 (assoc article (gnus-data-list nil)))
10285 gnus-newsgroup-name 10285 gnus-newsgroup-name
10286 to-newsgroup 10286 to-newsgroup
10287 select-method)) 10287 select-method))
@@ -10524,7 +10524,7 @@ This will be the case if the article has both been mailed and posted."
10524 (run-hook-with-args 10524 (run-hook-with-args
10525 'gnus-summary-article-expire-hook 10525 'gnus-summary-article-expire-hook
10526 'delete 10526 'delete
10527 (gnus-data-header (assoc article (gnus-data-list nil))) 10527 (gnus-data-header (gnus-data-find article))
10528 gnus-newsgroup-name 10528 gnus-newsgroup-name
10529 (cond 10529 (cond
10530 ((stringp nnmail-expiry-target) nnmail-expiry-target) 10530 ((stringp nnmail-expiry-target) nnmail-expiry-target)
@@ -10588,8 +10588,7 @@ confirmation before the articles are deleted."
10588 (unless (memq (car articles) not-deleted) 10588 (unless (memq (car articles) not-deleted)
10589 (gnus-summary-mark-article (car articles) gnus-canceled-mark) 10589 (gnus-summary-mark-article (car articles) gnus-canceled-mark)
10590 (let* ((article (car articles)) 10590 (let* ((article (car articles))
10591 (ghead (gnus-data-header 10591 (ghead (gnus-data-header (gnus-data-find article))))
10592 (assoc article (gnus-data-list nil)))))
10593 (run-hook-with-args 'gnus-summary-article-delete-hook 10592 (run-hook-with-args 'gnus-summary-article-delete-hook
10594 'delete ghead gnus-newsgroup-name nil 10593 'delete ghead gnus-newsgroup-name nil
10595 nil))) 10594 nil)))
@@ -13038,7 +13037,7 @@ If ALL is non-nil, already read articles become readable.
13038If ALL is a number, fetch this number of articles." 13037If ALL is a number, fetch this number of articles."
13039 (interactive "P") 13038 (interactive "P")
13040 (prog1 13039 (prog1
13041 (let ((old (sort (mapcar #'car gnus-newsgroup-data) #'<)) 13040 (let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<))
13042 older len) 13041 older len)
13043 (setq older 13042 (setq older
13044 ;; Some nntp servers lie about their active range. When 13043 ;; Some nntp servers lie about their active range. When
@@ -13108,7 +13107,7 @@ If ALL is a number, fetch this number of articles."
13108(defun gnus-summary-insert-new-articles () 13107(defun gnus-summary-insert-new-articles ()
13109 "Insert all new articles in this group." 13108 "Insert all new articles in this group."
13110 (interactive) 13109 (interactive)
13111 (let ((old (sort (mapcar #'car gnus-newsgroup-data) #'<)) 13110 (let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<))
13112 (old-high gnus-newsgroup-highest) 13111 (old-high gnus-newsgroup-highest)
13113 (nnmail-fetched-sources (list t)) 13112 (nnmail-fetched-sources (list t))
13114 (new-active (gnus-activate-group gnus-newsgroup-name 'scan)) 13113 (new-active (gnus-activate-group gnus-newsgroup-name 'scan))
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 4d31d0a1f1c..d752bf0efee 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -1520,7 +1520,7 @@ In the case of mover backends, checks the setting of
1520;; nil))) 1520;; nil)))
1521 1521
1522(defun spam-fetch-field-fast (article field &optional prepared-data-header) 1522(defun spam-fetch-field-fast (article field &optional prepared-data-header)
1523 "Fetch a FIELD for ARTICLE with the internal `gnus-data-list' function. 1523 "Fetch a FIELD for ARTICLE with the internal `gnus-data-find' function.
1524When PREPARED-DATA-HEADER is given, don't look in the Gnus data. 1524When PREPARED-DATA-HEADER is given, don't look in the Gnus data.
1525When FIELD is 'number, ARTICLE can be any number (since we want 1525When FIELD is 'number, ARTICLE can be any number (since we want
1526to find it out)." 1526to find it out)."
@@ -1586,7 +1586,7 @@ to find it out)."
1586(defun spam-fetch-article-header (article) 1586(defun spam-fetch-article-header (article)
1587 (with-current-buffer gnus-summary-buffer 1587 (with-current-buffer gnus-summary-buffer
1588 (gnus-read-header article) 1588 (gnus-read-header article)
1589 (nth 3 (assq article gnus-newsgroup-data)))) 1589 (gnus-data-header (gnus-data-find article))))
1590;;}}} 1590;;}}}
1591 1591
1592;;{{{ Spam determination. 1592;;{{{ Spam determination.