mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/gnus/nnheader.el (mail-header-*): Define via cl-defstruct

Browse source 
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.
This commit is contained in:
Stefan Monnier 2019-05-16 21:50:16 -04:00
parent ca3c59146b
commit 5f6c08ef2c
13 changed files with 72 additions and 151 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/gnus/gnus-agent.el
View file

@ -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")))

6
lisp/gnus/gnus-cache.el
View file

@ -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))

6
lisp/gnus/gnus-kill.el
View file

@ -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)

6
lisp/gnus/gnus-salt.el
View file

@ -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))

4
lisp/gnus/gnus-score.el
View file

@ -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.

47
lisp/gnus/gnus-sum.el
View file

@ -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))

6
lisp/gnus/nndiary.el
View file

@ -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)

6
lisp/gnus/nnfolder.el
View file

@ -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)

107
lisp/gnus/nnheader.el
View file

@ -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))
(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)
(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))
(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

2
lisp/gnus/nnir.el
View file

@ -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

4
lisp/gnus/nnmairix.el
View file

@ -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)

8
lisp/gnus/nnml.el
View file

@ -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)

19
lisp/gnus/nnweb.el
View file

@ -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)))