From: Stefan Monnier Date: Fri, 17 May 2019 01:50:16 +0000 (-0400) Subject: * lisp/gnus/nnheader.el (mail-header-*): Define via cl-defstruct X-Git-Tag: emacs-27.0.90~2863 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5f6c08ef2c52c7fe526cbe4f9a684438f6a72007;p=emacs.git * 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. --- 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." (nnheader-insert-file-contents file) (nnheader-remove-body) (setq header (nnheader-parse-naked-head))) - (mail-header-set-number header (car downloaded)) + (setf (mail-header-number header) (car downloaded)) (if nov-arts (let ((key (concat "^" (int-to-string (car nov-arts)) "\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." (setq lines-chars (nnheader-get-lines-and-char)) (nnheader-remove-body) (setq headers (nnheader-parse-naked-head)) - (mail-header-set-number headers number) - (mail-header-set-lines headers (car lines-chars)) - (mail-header-set-chars headers (cadr lines-chars)) + (setf (mail-header-number headers) number) + (setf (mail-header-lines headers) (car lines-chars)) + (setf (mail-header-chars headers) (cadr lines-chars)) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) (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." (let ((headers gnus-newsgroup-headers)) (if gnus-kill-killed (setq gnus-newsgroup-kill-headers - (mapcar (lambda (header) (mail-header-number header)) - headers)) + (mapcar #'mail-header-number headers)) (while headers (unless (gnus-member-of-range (mail-header-number (car headers)) @@ -600,8 +599,7 @@ marked as read or ticked are ignored." ((cond ((fboundp (setq function (intern-soft - (concat "mail-header-" (downcase field))))) - (setq function `(lambda (h) (,function h)))) + (concat "mail-header-" (downcase field)))))) ((when (setq extras (member (downcase field) (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: (header (if (vectorp header) header (progn (setq header (make-mail-header "*****")) - (mail-header-set-number header 0) - (mail-header-set-lines header 0) - (mail-header-set-chars header 0) + (setf (mail-header-number header) 0) + (setf (mail-header-lines header) 0) + (setf (mail-header-chars header) 0) header))) (gnus-tmp-from (mail-header-from header)) (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." "references" (symbol-name (caar elem))) (cdar elem))) - (setcar (car elem) - `(lambda (h) - (,func h)))) + (setcar (car elem) func)) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; 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: (add-hook gnus-select-group-hook (lambda () (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) \\='re-only))) + (setf (mail-header-subject header) + (gnus-simplify-subject + (mail-header-subject header) \\='re-only))) gnus-newsgroup-headers)))" :group 'gnus-group-select :type 'hook) @@ -4401,7 +4400,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq id-dep (puthash (setq id (nnmail-message-id)) (list header) dependencies)) - (mail-header-set-id header id)) + (setf (mail-header-id header) id)) ;; The last case ignores an existing entry, except it adds any ;; 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." ;; Also sets `header' to nil meaning that the `dependencies' ;; table was *not* modified. (t - (mail-header-set-xref - (car id-dep) - (concat (or (mail-header-xref (car id-dep)) - "") - (or (mail-header-xref header) ""))) + (setf (mail-header-xref (car id-dep)) + (concat (or (mail-header-xref (car id-dep)) + "") + (or (mail-header-xref header) ""))) (setq header nil))) (when (and header (not replaced)) @@ -4427,7 +4425,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; Yuk! This is a reference loop. Make the article be a ;; root article. (progn - (mail-header-set-references (car id-dep) "none") + (setf (mail-header-references (car id-dep)) "none") (setq ref nil) (setq parent-id nil)) (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." (when (and (string= references "") (setq in-reply-to (mail-header-extra header)) (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) - (mail-header-set-references - header (gnus-extract-message-id-from-in-reply-to in-reply-to))) + (setf (mail-header-references header) + (gnus-extract-message-id-from-in-reply-to in-reply-to))) (when gnus-alter-header-function (funcall gnus-alter-header-function header)) @@ -5619,7 +5617,7 @@ or a straight list of headers." (setq subject (concat (substring subject 0 (match-beginning 1)) (substring subject (match-end 1))))) - (mail-header-set-subject header subject)))))) + (setf (mail-header-subject header) subject)))))) (defun gnus-fetch-headers (articles &optional limit force-new dependencies) "Fetch headers of ARTICLES." @@ -5775,8 +5773,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. (setq fetched-articles - (mapcar (lambda (headers) (mail-header-number headers)) - gnus-newsgroup-headers)) + (mapcar #'mail-header-number gnus-newsgroup-headers)) (setq gnus-newsgroup-articles fetched-articles) (setq gnus-newsgroup-unreads (gnus-sorted-nintersection @@ -6642,7 +6639,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) (setq xref (buffer-substring (point) (point-at-eol))) - (mail-header-set-xref headers xref))))))) + (setf (mail-header-xref headers) xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) "Find article ID and insert the summary line for that article. @@ -6680,7 +6677,7 @@ too, instead of trying to fetch new headers." (let ((gnus-newsgroup-headers (list header))) (gnus-summary-remove-list-identifiers)) (when old-header - (mail-header-set-number header (mail-header-number old-header))) + (setf (mail-header-number header) (mail-header-number old-header))) (setq gnus-newsgroup-sparse (delq (setq number (mail-header-number header)) gnus-newsgroup-sparse)) @@ -8281,8 +8278,7 @@ If given a prefix, remove all limits." (interactive "P") (when total (setq gnus-newsgroup-limits - (list (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers)))) + (list (mapcar #'mail-header-number gnus-newsgroup-headers)))) (unless gnus-newsgroup-limits (error "No limit to pop")) (prog1 @@ -8790,8 +8786,7 @@ If ALL, mark even excluded ticked and dormants as read." (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) (let ((articles (gnus-sorted-ndifference (sort - (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers) + (mapcar #'mail-header-number gnus-newsgroup-headers) #'<) gnus-newsgroup-limit)) article) @@ -9580,8 +9575,7 @@ Optional argument BACKWARD means do search for backward. This search includes all articles in the current group that Gnus has fetched headers for, whether they are displayed or not." (let ((articles nil) - ;; FIXME: Can't η-reduce because it's a macro (make it define-inline) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) + (func (intern (concat "mail-header-" header))) (case-fold-search t)) (dolist (header gnus-newsgroup-headers) ;; FIXME: when called from gnus-summary-limit-include-thread via @@ -9612,8 +9606,7 @@ not match REGEXP on HEADER." (error "%s is an invalid header" header)) (unless (fboundp (intern (concat "mail-header-" header))) (error "%s is not a valid header" header)) - ;; FIXME: eta-reduce! - (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) + (setq func (intern (concat "mail-header-" header)))) (dolist (d (if (eq backward 'all) gnus-newsgroup-data (gnus-data-find-list @@ -12650,7 +12643,7 @@ If REVERSE, save parts that do not match TYPE." ;; If we fetched by Message-ID and the article came from ;; a different group (or server), we fudge some bogus ;; article numbers for this article. - (mail-header-set-number header gnus-reffed-article-number)) + (setf (mail-header-number header) gnus-reffed-article-number)) (with-current-buffer gnus-summary-buffer (cl-decf gnus-reffed-article-number) (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.") "Add a nov line for the GROUP base." (with-current-buffer (nndiary-open-nov group) (goto-char (point-max)) - (mail-header-set-number headers article) + (setf (mail-header-number headers) article) (nnheader-insert-nov headers))) (defsubst nndiary-header-value () @@ -994,8 +994,8 @@ all. This may very well take some time.") (goto-char (point-min)) (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) (let ((headers (nnheader-parse-naked-head))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) + (setf (mail-header-chars headers) chars) + (setf (mail-header-number headers) number) headers)))) (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." (with-temp-buffer (insert-buffer-substring buf b e) (let ((headers (nnheader-parse-naked-head))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) + (setf (mail-header-chars headers) chars) + (setf (mail-header-number headers) number) headers))))) (defun nnfolder-add-nov (group article headers) "Add a nov line for the GROUP base." (with-current-buffer (nnfolder-open-nov group) (goto-char (point-max)) - (mail-header-set-number headers article) + (setf (mail-header-number headers) article) (nnheader-insert-nov headers))) (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: ;; (That next-to-last entry is defined as "misc" in the NOV format, ;; but Gnus uses it for xrefs.) -(defmacro mail-header-number (header) - "Return article number in HEADER." - `(aref ,header 0)) - -(defmacro mail-header-set-number (header number) - "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) - -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) - -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) - -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) - -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) - -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) - -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) - -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) - -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) - -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) - -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article XREF of HEADER to xref." - `(aset ,header 8 ,xref)) - -(defmacro mail-header-extra (header) - "Return the extra headers in HEADER." - `(aref ,header 9)) - -(defun mail-header-set-extra (header extra) - "Set the extra headers in HEADER to EXTRA." - (aset header 9 extra)) +(cl-defstruct (mail-header + (:type vector) + (:constructor nil) + (:constructor make-full-mail-header + (&optional number subject from date id + references chars lines xref + extra))) + number + subject + from + date + id + references + chars + lines + xref + extra) + +(defalias 'mail-header-message-id #'mail-header-id) (defsubst make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." - (make-vector 10 init)) - -(defsubst make-full-mail-header (&optional number subject from date id - references chars lines xref - extra) - "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref extra)) + (make-full-mail-header init init init init init + init init init init init)) ;; fake message-ids: generation and detection 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." (mail-header-number novitem))) (art (car (rassq artno articleids)))) (when art - (mail-header-set-number novitem art) + (setf (mail-header-number novitem) art) (push novitem headers)) (forward-line 1))))) (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." (setq cur (nnheader-parse-nov)) (when corr (setq article (+ (mail-header-number cur) numc)) - (mail-header-set-number cur article)) + (setf (mail-header-number cur) article)) (setq xref (mail-header-xref cur)) (when (and (stringp xref) (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref)) (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref)) - (mail-header-set-xref cur xref)) + (setf (mail-header-xref cur) xref)) (set-buffer buf) (nnheader-insert-nov cur) (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." "Add a nov line for the GROUP nov headers, incrementally." (with-current-buffer (nnml-open-incremental-nov group) (goto-char (point-max)) - (mail-header-set-number headers article) + (setf (mail-header-number headers) article) (nnheader-insert-nov headers))) (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." (with-current-buffer (nnml-open-nov group) (goto-char (point-max)) - (mail-header-set-number headers article) + (setf (mail-header-number headers) article) (nnheader-insert-nov headers))) (defsubst nnml-header-value () @@ -816,8 +816,8 @@ article number. This function is called narrowed to an article." (1- (point)) (point-max)))) (let ((headers (nnheader-parse-naked-head))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) + (setf (mail-header-chars headers) chars) + (setf (mail-header-number headers) number) headers)))) (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'.") (subject (mail-header-subject header)) (rfc2047-encoding-type 'mime)) (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) - (mail-header-set-xref - header - (format "http://article.gmane.org/%s/%s/raw" - (match-string 1 xref) - (match-string 2 xref)))) + (setf (mail-header-xref header) + (format "http://article.gmane.org/%s/%s/raw" + (match-string 1 xref) + (match-string 2 xref)))) ;; Add host part to gmane-encrypted addresses (when (string-match "@$" from) - (mail-header-set-from header - (concat from "public.gmane.org"))) + (setf (mail-header-from header) + (concat from "public.gmane.org"))) - (mail-header-set-subject header - (rfc2047-encode-string subject)) + (setf (mail-header-subject header) + (rfc2047-encode-string subject)) (unless (nnweb-get-hashtb (mail-header-xref header)) - (mail-header-set-number header (cl-incf (cdr active))) + (setf (mail-header-number header) (cl-incf (cdr active))) (push (list (mail-header-number header) header) map) (nnweb-set-hashtb (cadar map) (car map)))))) (forward-line 1)))