diff options
| author | Stefan Monnier | 2019-05-16 21:50:16 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-05-16 21:50:16 -0400 |
| commit | 5f6c08ef2c52c7fe526cbe4f9a684438f6a72007 (patch) | |
| tree | 4d8904ab5cdd8f520e96a95bf00620b5dda41f71 | |
| parent | ca3c59146bd5c0effdc7602718b91f1ee41f866a (diff) | |
| download | emacs-5f6c08ef2c52c7fe526cbe4f9a684438f6a72007.tar.gz emacs-5f6c08ef2c52c7fe526cbe4f9a684438f6a72007.zip | |
* lisp/gnus/nnheader.el (mail-header-*): Define via cl-defstruct
This also has the side effect that the accessors are now defined as proper
functions rather than as macros, so they can be passed to `mapcar` etc..
* lisp/gnus/nnheader.el (mail-header-number, mail-header-subject)
(mail-header-from, mail-header-date, mail-header-id)
(mail-header-references, mail-header-chars, mail-header-lines)
(mail-header-xref, mail-header-extra): Define via cl-defstruct.
(mail-header-set-number, mail-header-set-subject)
(mail-header-set-from, mail-header-set-date, mail-header-set-id)
(mail-header-set-message-id, mail-header-set-references)
(mail-header-set-chars, mail-header-set-lines, mail-header-set-xref)
(mail-header-set-extra): Remove, use `setf` instead. All callers adjusted.
* lisp/gnus/gnus-sum.el (gnus-select-newsgroup)
(gnus-summary-pop-limit, gnus-summary-limit-mark-excluded-as-read)
(gnus-summary-find-matching, gnus-find-matching-articles):
* lisp/gnus/gnus-kill.el (gnus-apply-kill-file-internal, gnus-execute):
* lisp/gnus/gnus-score.el (gnus-score-adaptive):
Eta-reduce, now that mail-header-FIELD are functions.
| -rw-r--r-- | lisp/gnus/gnus-agent.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/gnus-cache.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus-kill.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus-salt.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus-score.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 47 | ||||
| -rw-r--r-- | lisp/gnus/nndiary.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/nnfolder.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/nnheader.el | 109 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/nnmairix.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/nnml.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/nnweb.el | 19 |
13 files changed, 73 insertions, 152 deletions
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index d6d2457dd98..bed480f5541 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -3929,7 +3929,7 @@ If REREAD is not nil, downloaded articles are marked as unread." | |||
| 3929 | (nnheader-insert-file-contents file) | 3929 | (nnheader-insert-file-contents file) |
| 3930 | (nnheader-remove-body) | 3930 | (nnheader-remove-body) |
| 3931 | (setq header (nnheader-parse-naked-head))) | 3931 | (setq header (nnheader-parse-naked-head))) |
| 3932 | (mail-header-set-number header (car downloaded)) | 3932 | (setf (mail-header-number header) (car downloaded)) |
| 3933 | (if nov-arts | 3933 | (if nov-arts |
| 3934 | (let ((key (concat "^" (int-to-string (car nov-arts)) | 3934 | (let ((key (concat "^" (int-to-string (car nov-arts)) |
| 3935 | "\t"))) | 3935 | "\t"))) |
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 5e6483d1053..afe8a8a416c 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el | |||
| @@ -187,9 +187,9 @@ it's not cached." | |||
| 187 | (setq lines-chars (nnheader-get-lines-and-char)) | 187 | (setq lines-chars (nnheader-get-lines-and-char)) |
| 188 | (nnheader-remove-body) | 188 | (nnheader-remove-body) |
| 189 | (setq headers (nnheader-parse-naked-head)) | 189 | (setq headers (nnheader-parse-naked-head)) |
| 190 | (mail-header-set-number headers number) | 190 | (setf (mail-header-number headers) number) |
| 191 | (mail-header-set-lines headers (car lines-chars)) | 191 | (setf (mail-header-lines headers) (car lines-chars)) |
| 192 | (mail-header-set-chars headers (cadr lines-chars)) | 192 | (setf (mail-header-chars headers) (cadr lines-chars)) |
| 193 | (gnus-cache-change-buffer group) | 193 | (gnus-cache-change-buffer group) |
| 194 | (set-buffer (cdr gnus-cache-buffer)) | 194 | (set-buffer (cdr gnus-cache-buffer)) |
| 195 | (goto-char (point-max)) | 195 | (goto-char (point-max)) |
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index a7ded393034..442d26cf4fb 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el | |||
| @@ -350,8 +350,7 @@ Returns the number of articles marked as read." | |||
| 350 | (let ((headers gnus-newsgroup-headers)) | 350 | (let ((headers gnus-newsgroup-headers)) |
| 351 | (if gnus-kill-killed | 351 | (if gnus-kill-killed |
| 352 | (setq gnus-newsgroup-kill-headers | 352 | (setq gnus-newsgroup-kill-headers |
| 353 | (mapcar (lambda (header) (mail-header-number header)) | 353 | (mapcar #'mail-header-number headers)) |
| 354 | headers)) | ||
| 355 | (while headers | 354 | (while headers |
| 356 | (unless (gnus-member-of-range | 355 | (unless (gnus-member-of-range |
| 357 | (mail-header-number (car headers)) | 356 | (mail-header-number (car headers)) |
| @@ -600,8 +599,7 @@ marked as read or ticked are ignored." | |||
| 600 | ((cond ((fboundp | 599 | ((cond ((fboundp |
| 601 | (setq function | 600 | (setq function |
| 602 | (intern-soft | 601 | (intern-soft |
| 603 | (concat "mail-header-" (downcase field))))) | 602 | (concat "mail-header-" (downcase field)))))) |
| 604 | (setq function `(lambda (h) (,function h)))) | ||
| 605 | ((when (setq extras | 603 | ((when (setq extras |
| 606 | (member (downcase field) | 604 | (member (downcase field) |
| 607 | (mapcar (lambda (header) | 605 | (mapcar (lambda (header) |
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 58c05e0716a..529cd8a337d 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el | |||
| @@ -573,9 +573,9 @@ Two predefined functions are available: | |||
| 573 | (header (if (vectorp header) header | 573 | (header (if (vectorp header) header |
| 574 | (progn | 574 | (progn |
| 575 | (setq header (make-mail-header "*****")) | 575 | (setq header (make-mail-header "*****")) |
| 576 | (mail-header-set-number header 0) | 576 | (setf (mail-header-number header) 0) |
| 577 | (mail-header-set-lines header 0) | 577 | (setf (mail-header-lines header) 0) |
| 578 | (mail-header-set-chars header 0) | 578 | (setf (mail-header-chars header) 0) |
| 579 | header))) | 579 | header))) |
| 580 | (gnus-tmp-from (mail-header-from header)) | 580 | (gnus-tmp-from (mail-header-from header)) |
| 581 | (gnus-tmp-subject (mail-header-subject header)) | 581 | (gnus-tmp-subject (mail-header-subject header)) |
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 2faf0f951db..476c36023ea 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el | |||
| @@ -2341,9 +2341,7 @@ score in `gnus-newsgroup-scored' by SCORE." | |||
| 2341 | "references" | 2341 | "references" |
| 2342 | (symbol-name (caar elem))) | 2342 | (symbol-name (caar elem))) |
| 2343 | (cdar elem))) | 2343 | (cdar elem))) |
| 2344 | (setcar (car elem) | 2344 | (setcar (car elem) func)) |
| 2345 | `(lambda (h) | ||
| 2346 | (,func h)))) | ||
| 2347 | (setq elem (cdr elem))) | 2345 | (setq elem (cdr elem))) |
| 2348 | (setq malist (cdr malist))) | 2346 | (setq malist (cdr malist))) |
| 2349 | ;; Then we score away. | 2347 | ;; Then we score away. |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9431b06b4f7..00f0de61d7f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -1014,10 +1014,9 @@ following hook: | |||
| 1014 | (add-hook gnus-select-group-hook | 1014 | (add-hook gnus-select-group-hook |
| 1015 | (lambda () | 1015 | (lambda () |
| 1016 | (mapcar (lambda (header) | 1016 | (mapcar (lambda (header) |
| 1017 | (mail-header-set-subject | 1017 | (setf (mail-header-subject header) |
| 1018 | header | 1018 | (gnus-simplify-subject |
| 1019 | (gnus-simplify-subject | 1019 | (mail-header-subject header) \\='re-only))) |
| 1020 | (mail-header-subject header) \\='re-only))) | ||
| 1021 | gnus-newsgroup-headers)))" | 1020 | gnus-newsgroup-headers)))" |
| 1022 | :group 'gnus-group-select | 1021 | :group 'gnus-group-select |
| 1023 | :type 'hook) | 1022 | :type 'hook) |
| @@ -4401,7 +4400,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." | |||
| 4401 | (setq id-dep (puthash (setq id (nnmail-message-id)) | 4400 | (setq id-dep (puthash (setq id (nnmail-message-id)) |
| 4402 | (list header) | 4401 | (list header) |
| 4403 | dependencies)) | 4402 | dependencies)) |
| 4404 | (mail-header-set-id header id)) | 4403 | (setf (mail-header-id header) id)) |
| 4405 | 4404 | ||
| 4406 | ;; The last case ignores an existing entry, except it adds any | 4405 | ;; The last case ignores an existing entry, except it adds any |
| 4407 | ;; additional Xrefs (in case the two articles came from different | 4406 | ;; additional Xrefs (in case the two articles came from different |
| @@ -4409,11 +4408,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." | |||
| 4409 | ;; Also sets `header' to nil meaning that the `dependencies' | 4408 | ;; Also sets `header' to nil meaning that the `dependencies' |
| 4410 | ;; table was *not* modified. | 4409 | ;; table was *not* modified. |
| 4411 | (t | 4410 | (t |
| 4412 | (mail-header-set-xref | 4411 | (setf (mail-header-xref (car id-dep)) |
| 4413 | (car id-dep) | 4412 | (concat (or (mail-header-xref (car id-dep)) |
| 4414 | (concat (or (mail-header-xref (car id-dep)) | 4413 | "") |
| 4415 | "") | 4414 | (or (mail-header-xref header) ""))) |
| 4416 | (or (mail-header-xref header) ""))) | ||
| 4417 | (setq header nil))) | 4415 | (setq header nil))) |
| 4418 | 4416 | ||
| 4419 | (when (and header (not replaced)) | 4417 | (when (and header (not replaced)) |
| @@ -4427,7 +4425,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." | |||
| 4427 | ;; Yuk! This is a reference loop. Make the article be a | 4425 | ;; Yuk! This is a reference loop. Make the article be a |
| 4428 | ;; root article. | 4426 | ;; root article. |
| 4429 | (progn | 4427 | (progn |
| 4430 | (mail-header-set-references (car id-dep) "none") | 4428 | (setf (mail-header-references (car id-dep)) "none") |
| 4431 | (setq ref nil) | 4429 | (setq ref nil) |
| 4432 | (setq parent-id nil)) | 4430 | (setq parent-id nil)) |
| 4433 | (setq ref (gnus-parent-id (mail-header-references ref-header))))) | 4431 | (setq ref (gnus-parent-id (mail-header-references ref-header))))) |
| @@ -4565,8 +4563,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." | |||
| 4565 | (when (and (string= references "") | 4563 | (when (and (string= references "") |
| 4566 | (setq in-reply-to (mail-header-extra header)) | 4564 | (setq in-reply-to (mail-header-extra header)) |
| 4567 | (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) | 4565 | (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) |
| 4568 | (mail-header-set-references | 4566 | (setf (mail-header-references header) |
| 4569 | header (gnus-extract-message-id-from-in-reply-to in-reply-to))) | 4567 | (gnus-extract-message-id-from-in-reply-to in-reply-to))) |
| 4570 | 4568 | ||
| 4571 | (when gnus-alter-header-function | 4569 | (when gnus-alter-header-function |
| 4572 | (funcall gnus-alter-header-function header)) | 4570 | (funcall gnus-alter-header-function header)) |
| @@ -5619,7 +5617,7 @@ or a straight list of headers." | |||
| 5619 | (setq subject | 5617 | (setq subject |
| 5620 | (concat (substring subject 0 (match-beginning 1)) | 5618 | (concat (substring subject 0 (match-beginning 1)) |
| 5621 | (substring subject (match-end 1))))) | 5619 | (substring subject (match-end 1))))) |
| 5622 | (mail-header-set-subject header subject)))))) | 5620 | (setf (mail-header-subject header) subject)))))) |
| 5623 | 5621 | ||
| 5624 | (defun gnus-fetch-headers (articles &optional limit force-new dependencies) | 5622 | (defun gnus-fetch-headers (articles &optional limit force-new dependencies) |
| 5625 | "Fetch headers of ARTICLES." | 5623 | "Fetch headers of ARTICLES." |
| @@ -5775,8 +5773,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5775 | (setq gnus-newsgroup-limit (copy-sequence articles)) | 5773 | (setq gnus-newsgroup-limit (copy-sequence articles)) |
| 5776 | ;; Remove canceled articles from the list of unread articles. | 5774 | ;; Remove canceled articles from the list of unread articles. |
| 5777 | (setq fetched-articles | 5775 | (setq fetched-articles |
| 5778 | (mapcar (lambda (headers) (mail-header-number headers)) | 5776 | (mapcar #'mail-header-number gnus-newsgroup-headers)) |
| 5779 | gnus-newsgroup-headers)) | ||
| 5780 | (setq gnus-newsgroup-articles fetched-articles) | 5777 | (setq gnus-newsgroup-articles fetched-articles) |
| 5781 | (setq gnus-newsgroup-unreads | 5778 | (setq gnus-newsgroup-unreads |
| 5782 | (gnus-sorted-nintersection | 5779 | (gnus-sorted-nintersection |
| @@ -6642,7 +6639,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." | |||
| 6642 | (search-forward "\nXref:" nil t)) | 6639 | (search-forward "\nXref:" nil t)) |
| 6643 | (goto-char (1+ (match-end 0))) | 6640 | (goto-char (1+ (match-end 0))) |
| 6644 | (setq xref (buffer-substring (point) (point-at-eol))) | 6641 | (setq xref (buffer-substring (point) (point-at-eol))) |
| 6645 | (mail-header-set-xref headers xref))))))) | 6642 | (setf (mail-header-xref headers) xref))))))) |
| 6646 | 6643 | ||
| 6647 | (defun gnus-summary-insert-subject (id &optional old-header use-old-header) | 6644 | (defun gnus-summary-insert-subject (id &optional old-header use-old-header) |
| 6648 | "Find article ID and insert the summary line for that article. | 6645 | "Find article ID and insert the summary line for that article. |
| @@ -6680,7 +6677,7 @@ too, instead of trying to fetch new headers." | |||
| 6680 | (let ((gnus-newsgroup-headers (list header))) | 6677 | (let ((gnus-newsgroup-headers (list header))) |
| 6681 | (gnus-summary-remove-list-identifiers)) | 6678 | (gnus-summary-remove-list-identifiers)) |
| 6682 | (when old-header | 6679 | (when old-header |
| 6683 | (mail-header-set-number header (mail-header-number old-header))) | 6680 | (setf (mail-header-number header) (mail-header-number old-header))) |
| 6684 | (setq gnus-newsgroup-sparse | 6681 | (setq gnus-newsgroup-sparse |
| 6685 | (delq (setq number (mail-header-number header)) | 6682 | (delq (setq number (mail-header-number header)) |
| 6686 | gnus-newsgroup-sparse)) | 6683 | gnus-newsgroup-sparse)) |
| @@ -8281,8 +8278,7 @@ If given a prefix, remove all limits." | |||
| 8281 | (interactive "P") | 8278 | (interactive "P") |
| 8282 | (when total | 8279 | (when total |
| 8283 | (setq gnus-newsgroup-limits | 8280 | (setq gnus-newsgroup-limits |
| 8284 | (list (mapcar (lambda (h) (mail-header-number h)) | 8281 | (list (mapcar #'mail-header-number gnus-newsgroup-headers)))) |
| 8285 | gnus-newsgroup-headers)))) | ||
| 8286 | (unless gnus-newsgroup-limits | 8282 | (unless gnus-newsgroup-limits |
| 8287 | (error "No limit to pop")) | 8283 | (error "No limit to pop")) |
| 8288 | (prog1 | 8284 | (prog1 |
| @@ -8790,8 +8786,7 @@ If ALL, mark even excluded ticked and dormants as read." | |||
| 8790 | (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) | 8786 | (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) |
| 8791 | (let ((articles (gnus-sorted-ndifference | 8787 | (let ((articles (gnus-sorted-ndifference |
| 8792 | (sort | 8788 | (sort |
| 8793 | (mapcar (lambda (h) (mail-header-number h)) | 8789 | (mapcar #'mail-header-number gnus-newsgroup-headers) |
| 8794 | gnus-newsgroup-headers) | ||
| 8795 | #'<) | 8790 | #'<) |
| 8796 | gnus-newsgroup-limit)) | 8791 | gnus-newsgroup-limit)) |
| 8797 | article) | 8792 | article) |
| @@ -9580,8 +9575,7 @@ Optional argument BACKWARD means do search for backward. | |||
| 9580 | This search includes all articles in the current group that Gnus has | 9575 | This search includes all articles in the current group that Gnus has |
| 9581 | fetched headers for, whether they are displayed or not." | 9576 | fetched headers for, whether they are displayed or not." |
| 9582 | (let ((articles nil) | 9577 | (let ((articles nil) |
| 9583 | ;; FIXME: Can't η-reduce because it's a macro (make it define-inline) | 9578 | (func (intern (concat "mail-header-" header))) |
| 9584 | (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) | ||
| 9585 | (case-fold-search t)) | 9579 | (case-fold-search t)) |
| 9586 | (dolist (header gnus-newsgroup-headers) | 9580 | (dolist (header gnus-newsgroup-headers) |
| 9587 | ;; FIXME: when called from gnus-summary-limit-include-thread via | 9581 | ;; FIXME: when called from gnus-summary-limit-include-thread via |
| @@ -9612,8 +9606,7 @@ not match REGEXP on HEADER." | |||
| 9612 | (error "%s is an invalid header" header)) | 9606 | (error "%s is an invalid header" header)) |
| 9613 | (unless (fboundp (intern (concat "mail-header-" header))) | 9607 | (unless (fboundp (intern (concat "mail-header-" header))) |
| 9614 | (error "%s is not a valid header" header)) | 9608 | (error "%s is not a valid header" header)) |
| 9615 | ;; FIXME: eta-reduce! | 9609 | (setq func (intern (concat "mail-header-" header)))) |
| 9616 | (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) | ||
| 9617 | (dolist (d (if (eq backward 'all) | 9610 | (dolist (d (if (eq backward 'all) |
| 9618 | gnus-newsgroup-data | 9611 | gnus-newsgroup-data |
| 9619 | (gnus-data-find-list | 9612 | (gnus-data-find-list |
| @@ -12650,7 +12643,7 @@ If REVERSE, save parts that do not match TYPE." | |||
| 12650 | ;; If we fetched by Message-ID and the article came from | 12643 | ;; If we fetched by Message-ID and the article came from |
| 12651 | ;; a different group (or server), we fudge some bogus | 12644 | ;; a different group (or server), we fudge some bogus |
| 12652 | ;; article numbers for this article. | 12645 | ;; article numbers for this article. |
| 12653 | (mail-header-set-number header gnus-reffed-article-number)) | 12646 | (setf (mail-header-number header) gnus-reffed-article-number)) |
| 12654 | (with-current-buffer gnus-summary-buffer | 12647 | (with-current-buffer gnus-summary-buffer |
| 12655 | (cl-decf gnus-reffed-article-number) | 12648 | (cl-decf gnus-reffed-article-number) |
| 12656 | (gnus-remove-header (mail-header-number header)) | 12649 | (gnus-remove-header (mail-header-number header)) |
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index c8b7eed9870..aca29fea570 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el | |||
| @@ -979,7 +979,7 @@ all. This may very well take some time.") | |||
| 979 | "Add a nov line for the GROUP base." | 979 | "Add a nov line for the GROUP base." |
| 980 | (with-current-buffer (nndiary-open-nov group) | 980 | (with-current-buffer (nndiary-open-nov group) |
| 981 | (goto-char (point-max)) | 981 | (goto-char (point-max)) |
| 982 | (mail-header-set-number headers article) | 982 | (setf (mail-header-number headers) article) |
| 983 | (nnheader-insert-nov headers))) | 983 | (nnheader-insert-nov headers))) |
| 984 | 984 | ||
| 985 | (defsubst nndiary-header-value () | 985 | (defsubst nndiary-header-value () |
| @@ -994,8 +994,8 @@ all. This may very well take some time.") | |||
| 994 | (goto-char (point-min)) | 994 | (goto-char (point-min)) |
| 995 | (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) | 995 | (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) |
| 996 | (let ((headers (nnheader-parse-naked-head))) | 996 | (let ((headers (nnheader-parse-naked-head))) |
| 997 | (mail-header-set-chars headers chars) | 997 | (setf (mail-header-chars headers) chars) |
| 998 | (mail-header-set-number headers number) | 998 | (setf (mail-header-number headers) number) |
| 999 | headers)))) | 999 | headers)))) |
| 1000 | 1000 | ||
| 1001 | (defun nndiary-open-nov (group) | 1001 | (defun nndiary-open-nov (group) |
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 1c83045e45e..41963f32efc 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el | |||
| @@ -1162,15 +1162,15 @@ This command does not work if you use short group names." | |||
| 1162 | (with-temp-buffer | 1162 | (with-temp-buffer |
| 1163 | (insert-buffer-substring buf b e) | 1163 | (insert-buffer-substring buf b e) |
| 1164 | (let ((headers (nnheader-parse-naked-head))) | 1164 | (let ((headers (nnheader-parse-naked-head))) |
| 1165 | (mail-header-set-chars headers chars) | 1165 | (setf (mail-header-chars headers) chars) |
| 1166 | (mail-header-set-number headers number) | 1166 | (setf (mail-header-number headers) number) |
| 1167 | headers))))) | 1167 | headers))))) |
| 1168 | 1168 | ||
| 1169 | (defun nnfolder-add-nov (group article headers) | 1169 | (defun nnfolder-add-nov (group article headers) |
| 1170 | "Add a nov line for the GROUP base." | 1170 | "Add a nov line for the GROUP base." |
| 1171 | (with-current-buffer (nnfolder-open-nov group) | 1171 | (with-current-buffer (nnfolder-open-nov group) |
| 1172 | (goto-char (point-max)) | 1172 | (goto-char (point-max)) |
| 1173 | (mail-header-set-number headers article) | 1173 | (setf (mail-header-number headers) article) |
| 1174 | (nnheader-insert-nov headers))) | 1174 | (nnheader-insert-nov headers))) |
| 1175 | 1175 | ||
| 1176 | (provide 'nnfolder) | 1176 | (provide 'nnfolder) |
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 090b8420842..e138f141c69 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el | |||
| @@ -136,97 +136,30 @@ on your system, you could say something like: | |||
| 136 | ;; (That next-to-last entry is defined as "misc" in the NOV format, | 136 | ;; (That next-to-last entry is defined as "misc" in the NOV format, |
| 137 | ;; but Gnus uses it for xrefs.) | 137 | ;; but Gnus uses it for xrefs.) |
| 138 | 138 | ||
| 139 | (defmacro mail-header-number (header) | 139 | (cl-defstruct (mail-header |
| 140 | "Return article number in HEADER." | 140 | (:type vector) |
| 141 | `(aref ,header 0)) | 141 | (:constructor nil) |
| 142 | 142 | (:constructor make-full-mail-header | |
| 143 | (defmacro mail-header-set-number (header number) | 143 | (&optional number subject from date id |
| 144 | "Set article number of HEADER to NUMBER." | 144 | references chars lines xref |
| 145 | `(aset ,header 0 ,number)) | 145 | extra))) |
| 146 | 146 | number | |
| 147 | (defmacro mail-header-subject (header) | 147 | subject |
| 148 | "Return subject string in HEADER." | 148 | from |
| 149 | `(aref ,header 1)) | 149 | date |
| 150 | 150 | id | |
| 151 | (defmacro mail-header-set-subject (header subject) | 151 | references |
| 152 | "Set article subject of HEADER to SUBJECT." | 152 | chars |
| 153 | `(aset ,header 1 ,subject)) | 153 | lines |
| 154 | 154 | xref | |
| 155 | (defmacro mail-header-from (header) | 155 | extra) |
| 156 | "Return author string in HEADER." | 156 | |
| 157 | `(aref ,header 2)) | 157 | (defalias 'mail-header-message-id #'mail-header-id) |
| 158 | |||
| 159 | (defmacro mail-header-set-from (header from) | ||
| 160 | "Set article author of HEADER to FROM." | ||
| 161 | `(aset ,header 2 ,from)) | ||
| 162 | |||
| 163 | (defmacro mail-header-date (header) | ||
| 164 | "Return date in HEADER." | ||
| 165 | `(aref ,header 3)) | ||
| 166 | |||
| 167 | (defmacro mail-header-set-date (header date) | ||
| 168 | "Set article date of HEADER to DATE." | ||
| 169 | `(aset ,header 3 ,date)) | ||
| 170 | |||
| 171 | (defalias 'mail-header-message-id 'mail-header-id) | ||
| 172 | (defmacro mail-header-id (header) | ||
| 173 | "Return Id in HEADER." | ||
| 174 | `(aref ,header 4)) | ||
| 175 | |||
| 176 | (defalias 'mail-header-set-message-id 'mail-header-set-id) | ||
| 177 | (defmacro mail-header-set-id (header id) | ||
| 178 | "Set article Id of HEADER to ID." | ||
| 179 | `(aset ,header 4 ,id)) | ||
| 180 | |||
| 181 | (defmacro mail-header-references (header) | ||
| 182 | "Return references in HEADER." | ||
| 183 | `(aref ,header 5)) | ||
| 184 | |||
| 185 | (defmacro mail-header-set-references (header ref) | ||
| 186 | "Set article references of HEADER to REF." | ||
| 187 | `(aset ,header 5 ,ref)) | ||
| 188 | |||
| 189 | (defmacro mail-header-chars (header) | ||
| 190 | "Return number of chars of article in HEADER." | ||
| 191 | `(aref ,header 6)) | ||
| 192 | |||
| 193 | (defmacro mail-header-set-chars (header chars) | ||
| 194 | "Set number of chars in article of HEADER to CHARS." | ||
| 195 | `(aset ,header 6 ,chars)) | ||
| 196 | |||
| 197 | (defmacro mail-header-lines (header) | ||
| 198 | "Return lines in HEADER." | ||
| 199 | `(aref ,header 7)) | ||
| 200 | |||
| 201 | (defmacro mail-header-set-lines (header lines) | ||
| 202 | "Set article lines of HEADER to LINES." | ||
| 203 | `(aset ,header 7 ,lines)) | ||
| 204 | |||
| 205 | (defmacro mail-header-xref (header) | ||
| 206 | "Return xref string in HEADER." | ||
| 207 | `(aref ,header 8)) | ||
| 208 | |||
| 209 | (defmacro mail-header-set-xref (header xref) | ||
| 210 | "Set article XREF of HEADER to xref." | ||
| 211 | `(aset ,header 8 ,xref)) | ||
| 212 | |||
| 213 | (defmacro mail-header-extra (header) | ||
| 214 | "Return the extra headers in HEADER." | ||
| 215 | `(aref ,header 9)) | ||
| 216 | |||
| 217 | (defun mail-header-set-extra (header extra) | ||
| 218 | "Set the extra headers in HEADER to EXTRA." | ||
| 219 | (aset header 9 extra)) | ||
| 220 | 158 | ||
| 221 | (defsubst make-mail-header (&optional init) | 159 | (defsubst make-mail-header (&optional init) |
| 222 | "Create a new mail header structure initialized with INIT." | 160 | "Create a new mail header structure initialized with INIT." |
| 223 | (make-vector 10 init)) | 161 | (make-full-mail-header init init init init init |
| 224 | 162 | init init init init init)) | |
| 225 | (defsubst make-full-mail-header (&optional number subject from date id | ||
| 226 | references chars lines xref | ||
| 227 | extra) | ||
| 228 | "Create a new mail header structure initialized with the parameters given." | ||
| 229 | (vector number subject from date id references chars lines xref extra)) | ||
| 230 | 163 | ||
| 231 | ;; fake message-ids: generation and detection | 164 | ;; fake message-ids: generation and detection |
| 232 | 165 | ||
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 37a38a58d46..9d59a4db0da 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el | |||
| @@ -723,7 +723,7 @@ skips all prompting." | |||
| 723 | (mail-header-number novitem))) | 723 | (mail-header-number novitem))) |
| 724 | (art (car (rassq artno articleids)))) | 724 | (art (car (rassq artno articleids)))) |
| 725 | (when art | 725 | (when art |
| 726 | (mail-header-set-number novitem art) | 726 | (setf (mail-header-number novitem) art) |
| 727 | (push novitem headers)) | 727 | (push novitem headers)) |
| 728 | (forward-line 1))))) | 728 | (forward-line 1))))) |
| 729 | (setq headers | 729 | (setq headers |
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 501ea1d3903..1b42d3b505f 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el | |||
| @@ -1419,12 +1419,12 @@ TYPE is either 'nov or 'headers." | |||
| 1419 | (setq cur (nnheader-parse-nov)) | 1419 | (setq cur (nnheader-parse-nov)) |
| 1420 | (when corr | 1420 | (when corr |
| 1421 | (setq article (+ (mail-header-number cur) numc)) | 1421 | (setq article (+ (mail-header-number cur) numc)) |
| 1422 | (mail-header-set-number cur article)) | 1422 | (setf (mail-header-number cur) article)) |
| 1423 | (setq xref (mail-header-xref cur)) | 1423 | (setq xref (mail-header-xref cur)) |
| 1424 | (when (and (stringp xref) | 1424 | (when (and (stringp xref) |
| 1425 | (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref)) | 1425 | (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref)) |
| 1426 | (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref)) | 1426 | (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref)) |
| 1427 | (mail-header-set-xref cur xref)) | 1427 | (setf (mail-header-xref cur) xref)) |
| 1428 | (set-buffer buf) | 1428 | (set-buffer buf) |
| 1429 | (nnheader-insert-nov cur) | 1429 | (nnheader-insert-nov cur) |
| 1430 | (set-buffer nntp-server-buffer) | 1430 | (set-buffer nntp-server-buffer) |
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 205e9e48034..1d9d166dbac 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el | |||
| @@ -792,14 +792,14 @@ article number. This function is called narrowed to an article." | |||
| 792 | "Add a nov line for the GROUP nov headers, incrementally." | 792 | "Add a nov line for the GROUP nov headers, incrementally." |
| 793 | (with-current-buffer (nnml-open-incremental-nov group) | 793 | (with-current-buffer (nnml-open-incremental-nov group) |
| 794 | (goto-char (point-max)) | 794 | (goto-char (point-max)) |
| 795 | (mail-header-set-number headers article) | 795 | (setf (mail-header-number headers) article) |
| 796 | (nnheader-insert-nov headers))) | 796 | (nnheader-insert-nov headers))) |
| 797 | 797 | ||
| 798 | (defun nnml-add-nov (group article headers) | 798 | (defun nnml-add-nov (group article headers) |
| 799 | "Add a nov line for the GROUP base." | 799 | "Add a nov line for the GROUP base." |
| 800 | (with-current-buffer (nnml-open-nov group) | 800 | (with-current-buffer (nnml-open-nov group) |
| 801 | (goto-char (point-max)) | 801 | (goto-char (point-max)) |
| 802 | (mail-header-set-number headers article) | 802 | (setf (mail-header-number headers) article) |
| 803 | (nnheader-insert-nov headers))) | 803 | (nnheader-insert-nov headers))) |
| 804 | 804 | ||
| 805 | (defsubst nnml-header-value () | 805 | (defsubst nnml-header-value () |
| @@ -816,8 +816,8 @@ article number. This function is called narrowed to an article." | |||
| 816 | (1- (point)) | 816 | (1- (point)) |
| 817 | (point-max)))) | 817 | (point-max)))) |
| 818 | (let ((headers (nnheader-parse-naked-head))) | 818 | (let ((headers (nnheader-parse-naked-head))) |
| 819 | (mail-header-set-chars headers chars) | 819 | (setf (mail-header-chars headers) chars) |
| 820 | (mail-header-set-number headers number) | 820 | (setf (mail-header-number headers) number) |
| 821 | headers)))) | 821 | headers)))) |
| 822 | 822 | ||
| 823 | (defun nnml-get-nov-buffer (group &optional incrementalp) | 823 | (defun nnml-get-nov-buffer (group &optional incrementalp) |
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 7b87502d0e0..b08b27dd1eb 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el | |||
| @@ -461,22 +461,21 @@ Valid types include `google', `dejanews', and `gmane'.") | |||
| 461 | (subject (mail-header-subject header)) | 461 | (subject (mail-header-subject header)) |
| 462 | (rfc2047-encoding-type 'mime)) | 462 | (rfc2047-encoding-type 'mime)) |
| 463 | (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) | 463 | (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) |
| 464 | (mail-header-set-xref | 464 | (setf (mail-header-xref header) |
| 465 | header | 465 | (format "http://article.gmane.org/%s/%s/raw" |
| 466 | (format "http://article.gmane.org/%s/%s/raw" | 466 | (match-string 1 xref) |
| 467 | (match-string 1 xref) | 467 | (match-string 2 xref)))) |
| 468 | (match-string 2 xref)))) | ||
| 469 | 468 | ||
| 470 | ;; Add host part to gmane-encrypted addresses | 469 | ;; Add host part to gmane-encrypted addresses |
| 471 | (when (string-match "@$" from) | 470 | (when (string-match "@$" from) |
| 472 | (mail-header-set-from header | 471 | (setf (mail-header-from header) |
| 473 | (concat from "public.gmane.org"))) | 472 | (concat from "public.gmane.org"))) |
| 474 | 473 | ||
| 475 | (mail-header-set-subject header | 474 | (setf (mail-header-subject header) |
| 476 | (rfc2047-encode-string subject)) | 475 | (rfc2047-encode-string subject)) |
| 477 | 476 | ||
| 478 | (unless (nnweb-get-hashtb (mail-header-xref header)) | 477 | (unless (nnweb-get-hashtb (mail-header-xref header)) |
| 479 | (mail-header-set-number header (cl-incf (cdr active))) | 478 | (setf (mail-header-number header) (cl-incf (cdr active))) |
| 480 | (push (list (mail-header-number header) header) map) | 479 | (push (list (mail-header-number header) header) map) |
| 481 | (nnweb-set-hashtb (cadar map) (car map)))))) | 480 | (nnweb-set-hashtb (cadar map) (car map)))))) |
| 482 | (forward-line 1))) | 481 | (forward-line 1))) |