diff options
| author | Stefan Monnier | 2019-06-07 15:28:12 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-06-07 15:28:12 -0400 |
| commit | da1974fabddda6fac029db6960110001c6472ddc (patch) | |
| tree | be1c9d5cd25355eb298d505537266d56d7c98cf1 | |
| parent | 77f96e2cc1da30730f79d5935eaf5d23e53f37ad (diff) | |
| download | emacs-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.el | 31 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 27 | ||||
| -rw-r--r-- | lisp/gnus/spam.el | 4 |
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. | |||
| 13038 | If ALL is a number, fetch this number of articles." | 13037 | If 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. |
| 1524 | When PREPARED-DATA-HEADER is given, don't look in the Gnus data. | 1524 | When PREPARED-DATA-HEADER is given, don't look in the Gnus data. |
| 1525 | When FIELD is 'number, ARTICLE can be any number (since we want | 1525 | When FIELD is 'number, ARTICLE can be any number (since we want |
| 1526 | to find it out)." | 1526 | to 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. |