* 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 d6d2457dd9895d450304aca7b99b4cab7b7784c1..bed480f5541e3b38f0e4947a42a64dd80d28cbc7 100644 (file)
--- 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 5e6483d10531c3761e02b43a828ddd9ddd9c462a..afe8a8a416c77aa729488fba83d0e32a290c03f3 100644 (file)
--- 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 a7ded393034a4d1f9d48429c17d55e6adedc6732..442d26cf4fbf3d91773b8737783cca511539e941 100644 (file)
--- 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 58c05e0716a12c7a185aa0a3ac9b4d49a2b27ae6..529cd8a337dc210a7706676f3908f253c1c80c64 100644 (file)
--- 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 2faf0f951dbce8398584d4a81fa7145ae28376fa..476c36023ea838c747f84ac4bf8be264c75cae57 100644 (file)
--- 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 9431b06b4f78c3fdab8f2f8283376a421f0472f6..00f0de61d7f6e5d47fb98b00b26e8d2dad5fd07c 100644 (file)
--- 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 c8b7eed9870ced458ef47bcfbb6fb1fd52c2463f..aca29fea5704bebed82fd0aa3932d048c1a8a77d 100644 (file)
--- 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 1c83045e45ea626648de8f904837c8ed1353e651..41963f32efc1bee5fbec8aaa7ae72cd9c201bca7 100644 (file)
--- 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 090b84208423a2d72c6501304644ce1f06a16a26..e138f141c69639991d04bfaa365711f870b1a13d 100644 (file)
--- 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 37a38a58d463fed3e47cf91b6333dec84344c992..9d59a4db0daceafb4ed7b1bc8be7888de6d635f7 100644 (file)
--- 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 501ea1d390398e5243d59b7da4abdbc1f0eac81e..1b42d3b505f1ca2922668d319d9fb0b474a67830 100644 (file)
--- 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 205e9e48034664eb10e0703cae6ddb0467cb4e7c..1d9d166dbacd11efe40b84e8e6f814b38b640633 100644 (file)
--- 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 7b87502d0e0c16ce1424252b7741307aa5be73cf..b08b27dd1eb73925f1699a58a64fa6456f879bc4 100644 (file)
--- 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)))