[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 5f6c08e: * lisp/gnus/nnheader.el (mail-header-*): D
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 5f6c08e: * lisp/gnus/nnheader.el (mail-header-*): Define via cl-defstruct |
|
Date: |
Thu, 16 May 2019 21:50:22 -0400 (EDT) |
branch: master
commit 5f6c08ef2c52c7fe526cbe4f9a684438f6a72007
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* 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.
---
lisp/gnus/gnus-agent.el | 2 +-
lisp/gnus/gnus-cache.el | 6 +--
lisp/gnus/gnus-kill.el | 6 +--
lisp/gnus/gnus-salt.el | 6 +--
lisp/gnus/gnus-score.el | 4 +-
lisp/gnus/gnus-sum.el | 47 +++++++++------------
lisp/gnus/nndiary.el | 6 +--
lisp/gnus/nnfolder.el | 6 +--
lisp/gnus/nnheader.el | 109 ++++++++++--------------------------------------
lisp/gnus/nnir.el | 2 +-
lisp/gnus/nnmairix.el | 4 +-
lisp/gnus/nnml.el | 8 ++--
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 d6d2457..bed480f 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 5e6483d..afe8a8a 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 a7ded39..442d26c 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 58c05e0..529cd8a 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 2faf0f9..476c360 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 9431b06..00f0de6 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 c8b7eed..aca29fe 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 1c83045..41963f3 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 090b842..e138f14 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 37a38a5..9d59a4d 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 501ea1d..1b42d3b 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 205e9e4..1d9d166 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 7b87502..b08b27d 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)))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 5f6c08e: * lisp/gnus/nnheader.el (mail-header-*): Define via cl-defstruct,
Stefan Monnier <=