Commit 5f6c08ef authored by Stefan Monnier's avatar Stefan Monnier

* 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.
parent ca3c5914
Pipeline #1691 failed with stage
in 90 minutes and 4 seconds
...@@ -3929,7 +3929,7 @@ If REREAD is not nil, downloaded articles are marked as unread." ...@@ -3929,7 +3929,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
(nnheader-insert-file-contents file) (nnheader-insert-file-contents file)
(nnheader-remove-body) (nnheader-remove-body)
(setq header (nnheader-parse-naked-head))) (setq header (nnheader-parse-naked-head)))
(mail-header-set-number header (car downloaded)) (setf (mail-header-number header) (car downloaded))
(if nov-arts (if nov-arts
(let ((key (concat "^" (int-to-string (car nov-arts)) (let ((key (concat "^" (int-to-string (car nov-arts))
"\t"))) "\t")))
......
...@@ -187,9 +187,9 @@ it's not cached." ...@@ -187,9 +187,9 @@ it's not cached."
(setq lines-chars (nnheader-get-lines-and-char)) (setq lines-chars (nnheader-get-lines-and-char))
(nnheader-remove-body) (nnheader-remove-body)
(setq headers (nnheader-parse-naked-head)) (setq headers (nnheader-parse-naked-head))
(mail-header-set-number headers number) (setf (mail-header-number headers) number)
(mail-header-set-lines headers (car lines-chars)) (setf (mail-header-lines headers) (car lines-chars))
(mail-header-set-chars headers (cadr lines-chars)) (setf (mail-header-chars headers) (cadr lines-chars))
(gnus-cache-change-buffer group) (gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer)) (set-buffer (cdr gnus-cache-buffer))
(goto-char (point-max)) (goto-char (point-max))
......
...@@ -350,8 +350,7 @@ Returns the number of articles marked as read." ...@@ -350,8 +350,7 @@ Returns the number of articles marked as read."
(let ((headers gnus-newsgroup-headers)) (let ((headers gnus-newsgroup-headers))
(if gnus-kill-killed (if gnus-kill-killed
(setq gnus-newsgroup-kill-headers (setq gnus-newsgroup-kill-headers
(mapcar (lambda (header) (mail-header-number header)) (mapcar #'mail-header-number headers))
headers))
(while headers (while headers
(unless (gnus-member-of-range (unless (gnus-member-of-range
(mail-header-number (car headers)) (mail-header-number (car headers))
...@@ -600,8 +599,7 @@ marked as read or ticked are ignored." ...@@ -600,8 +599,7 @@ marked as read or ticked are ignored."
((cond ((fboundp ((cond ((fboundp
(setq function (setq function
(intern-soft (intern-soft
(concat "mail-header-" (downcase field))))) (concat "mail-header-" (downcase field))))))
(setq function `(lambda (h) (,function h))))
((when (setq extras ((when (setq extras
(member (downcase field) (member (downcase field)
(mapcar (lambda (header) (mapcar (lambda (header)
......
...@@ -573,9 +573,9 @@ Two predefined functions are available: ...@@ -573,9 +573,9 @@ Two predefined functions are available:
(header (if (vectorp header) header (header (if (vectorp header) header
(progn (progn
(setq header (make-mail-header "*****")) (setq header (make-mail-header "*****"))
(mail-header-set-number header 0) (setf (mail-header-number header) 0)
(mail-header-set-lines header 0) (setf (mail-header-lines header) 0)
(mail-header-set-chars header 0) (setf (mail-header-chars header) 0)
header))) header)))
(gnus-tmp-from (mail-header-from header)) (gnus-tmp-from (mail-header-from header))
(gnus-tmp-subject (mail-header-subject header)) (gnus-tmp-subject (mail-header-subject header))
......
...@@ -2341,9 +2341,7 @@ score in `gnus-newsgroup-scored' by SCORE." ...@@ -2341,9 +2341,7 @@ score in `gnus-newsgroup-scored' by SCORE."
"references" "references"
(symbol-name (caar elem))) (symbol-name (caar elem)))
(cdar elem))) (cdar elem)))
(setcar (car elem) (setcar (car elem) func))
`(lambda (h)
(,func h))))
(setq elem (cdr elem))) (setq elem (cdr elem)))
(setq malist (cdr malist))) (setq malist (cdr malist)))
;; Then we score away. ;; Then we score away.
......
...@@ -1014,10 +1014,9 @@ following hook: ...@@ -1014,10 +1014,9 @@ following hook:
(add-hook gnus-select-group-hook (add-hook gnus-select-group-hook
(lambda () (lambda ()
(mapcar (lambda (header) (mapcar (lambda (header)
(mail-header-set-subject (setf (mail-header-subject header)
header (gnus-simplify-subject
(gnus-simplify-subject (mail-header-subject header) \\='re-only)))
(mail-header-subject header) \\='re-only)))
gnus-newsgroup-headers)))" gnus-newsgroup-headers)))"
:group 'gnus-group-select :group 'gnus-group-select
:type 'hook) :type 'hook)
...@@ -4401,7 +4400,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ...@@ -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)) (setq id-dep (puthash (setq id (nnmail-message-id))
(list header) (list header)
dependencies)) dependencies))
(mail-header-set-id header id)) (setf (mail-header-id header) id))
;; The last case ignores an existing entry, except it adds any ;; The last case ignores an existing entry, except it adds any
;; additional Xrefs (in case the two articles came from different ;; 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,11 +4408,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
;; Also sets `header' to nil meaning that the `dependencies' ;; Also sets `header' to nil meaning that the `dependencies'
;; table was *not* modified. ;; table was *not* modified.
(t (t
(mail-header-set-xref (setf (mail-header-xref (car id-dep))
(car id-dep) (concat (or (mail-header-xref (car id-dep))
(concat (or (mail-header-xref (car id-dep)) "")
"") (or (mail-header-xref header) "")))
(or (mail-header-xref header) "")))
(setq header nil))) (setq header nil)))
(when (and header (not replaced)) (when (and header (not replaced))
...@@ -4427,7 +4425,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ...@@ -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 ;; Yuk! This is a reference loop. Make the article be a
;; root article. ;; root article.
(progn (progn
(mail-header-set-references (car id-dep) "none") (setf (mail-header-references (car id-dep)) "none")
(setq ref nil) (setq ref nil)
(setq parent-id nil)) (setq parent-id nil))
(setq ref (gnus-parent-id (mail-header-references ref-header))))) (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,8 +4563,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(when (and (string= references "") (when (and (string= references "")
(setq in-reply-to (mail-header-extra header)) (setq in-reply-to (mail-header-extra header))
(setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
(mail-header-set-references (setf (mail-header-references header)
header (gnus-extract-message-id-from-in-reply-to in-reply-to))) (gnus-extract-message-id-from-in-reply-to in-reply-to)))
(when gnus-alter-header-function (when gnus-alter-header-function
(funcall gnus-alter-header-function header)) (funcall gnus-alter-header-function header))
...@@ -5619,7 +5617,7 @@ or a straight list of headers." ...@@ -5619,7 +5617,7 @@ or a straight list of headers."
(setq subject (setq subject
(concat (substring subject 0 (match-beginning 1)) (concat (substring subject 0 (match-beginning 1))
(substring subject (match-end 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) (defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES." "Fetch headers of ARTICLES."
...@@ -5775,8 +5773,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ...@@ -5775,8 +5773,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(setq gnus-newsgroup-limit (copy-sequence articles)) (setq gnus-newsgroup-limit (copy-sequence articles))
;; Remove canceled articles from the list of unread articles. ;; Remove canceled articles from the list of unread articles.
(setq fetched-articles (setq fetched-articles
(mapcar (lambda (headers) (mail-header-number headers)) (mapcar #'mail-header-number gnus-newsgroup-headers))
gnus-newsgroup-headers))
(setq gnus-newsgroup-articles fetched-articles) (setq gnus-newsgroup-articles fetched-articles)
(setq gnus-newsgroup-unreads (setq gnus-newsgroup-unreads
(gnus-sorted-nintersection (gnus-sorted-nintersection
...@@ -6642,7 +6639,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." ...@@ -6642,7 +6639,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'."
(search-forward "\nXref:" nil t)) (search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0))) (goto-char (1+ (match-end 0)))
(setq xref (buffer-substring (point) (point-at-eol))) (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) (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article. "Find article ID and insert the summary line for that article.
...@@ -6680,7 +6677,7 @@ too, instead of trying to fetch new headers." ...@@ -6680,7 +6677,7 @@ too, instead of trying to fetch new headers."
(let ((gnus-newsgroup-headers (list header))) (let ((gnus-newsgroup-headers (list header)))
(gnus-summary-remove-list-identifiers)) (gnus-summary-remove-list-identifiers))
(when old-header (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 (setq gnus-newsgroup-sparse
(delq (setq number (mail-header-number header)) (delq (setq number (mail-header-number header))
gnus-newsgroup-sparse)) gnus-newsgroup-sparse))
...@@ -8281,8 +8278,7 @@ If given a prefix, remove all limits." ...@@ -8281,8 +8278,7 @@ If given a prefix, remove all limits."
(interactive "P") (interactive "P")
(when total (when total
(setq gnus-newsgroup-limits (setq gnus-newsgroup-limits
(list (mapcar (lambda (h) (mail-header-number h)) (list (mapcar #'mail-header-number gnus-newsgroup-headers))))
gnus-newsgroup-headers))))
(unless gnus-newsgroup-limits (unless gnus-newsgroup-limits
(error "No limit to pop")) (error "No limit to pop"))
(prog1 (prog1
...@@ -8790,8 +8786,7 @@ If ALL, mark even excluded ticked and dormants as read." ...@@ -8790,8 +8786,7 @@ If ALL, mark even excluded ticked and dormants as read."
(setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<))
(let ((articles (gnus-sorted-ndifference (let ((articles (gnus-sorted-ndifference
(sort (sort
(mapcar (lambda (h) (mail-header-number h)) (mapcar #'mail-header-number gnus-newsgroup-headers)
gnus-newsgroup-headers)
#'<) #'<)
gnus-newsgroup-limit)) gnus-newsgroup-limit))
article) article)
...@@ -9580,8 +9575,7 @@ Optional argument BACKWARD means do search for backward. ...@@ -9580,8 +9575,7 @@ Optional argument BACKWARD means do search for backward.
This search includes all articles in the current group that Gnus has This search includes all articles in the current group that Gnus has
fetched headers for, whether they are displayed or not." fetched headers for, whether they are displayed or not."
(let ((articles nil) (let ((articles nil)
;; FIXME: Can't η-reduce because it's a macro (make it define-inline) (func (intern (concat "mail-header-" header)))
(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search t)) (case-fold-search t))
(dolist (header gnus-newsgroup-headers) (dolist (header gnus-newsgroup-headers)
;; FIXME: when called from gnus-summary-limit-include-thread via ;; FIXME: when called from gnus-summary-limit-include-thread via
...@@ -9612,8 +9606,7 @@ not match REGEXP on HEADER." ...@@ -9612,8 +9606,7 @@ not match REGEXP on HEADER."
(error "%s is an invalid header" header)) (error "%s is an invalid header" header))
(unless (fboundp (intern (concat "mail-header-" header))) (unless (fboundp (intern (concat "mail-header-" header)))
(error "%s is not a valid header" header)) (error "%s is not a valid header" header))
;; FIXME: eta-reduce! (setq func (intern (concat "mail-header-" header))))
(setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
(dolist (d (if (eq backward 'all) (dolist (d (if (eq backward 'all)
gnus-newsgroup-data gnus-newsgroup-data
(gnus-data-find-list (gnus-data-find-list
...@@ -12650,7 +12643,7 @@ If REVERSE, save parts that do not match TYPE." ...@@ -12650,7 +12643,7 @@ If REVERSE, save parts that do not match TYPE."
;; If we fetched by Message-ID and the article came from ;; If we fetched by Message-ID and the article came from
;; a different group (or server), we fudge some bogus ;; a different group (or server), we fudge some bogus
;; article numbers for this article. ;; 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 (with-current-buffer gnus-summary-buffer
(cl-decf gnus-reffed-article-number) (cl-decf gnus-reffed-article-number)
(gnus-remove-header (mail-header-number header)) (gnus-remove-header (mail-header-number header))
......
...@@ -979,7 +979,7 @@ all. This may very well take some time.") ...@@ -979,7 +979,7 @@ all. This may very well take some time.")
"Add a nov line for the GROUP base." "Add a nov line for the GROUP base."
(with-current-buffer (nndiary-open-nov group) (with-current-buffer (nndiary-open-nov group)
(goto-char (point-max)) (goto-char (point-max))
(mail-header-set-number headers article) (setf (mail-header-number headers) article)
(nnheader-insert-nov headers))) (nnheader-insert-nov headers)))
(defsubst nndiary-header-value () (defsubst nndiary-header-value ()
...@@ -994,8 +994,8 @@ all. This may very well take some time.") ...@@ -994,8 +994,8 @@ all. This may very well take some time.")
(goto-char (point-min)) (goto-char (point-min))
(if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
(let ((headers (nnheader-parse-naked-head))) (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars) (setf (mail-header-chars headers) chars)
(mail-header-set-number headers number) (setf (mail-header-number headers) number)
headers)))) headers))))
(defun nndiary-open-nov (group) (defun nndiary-open-nov (group)
......
...@@ -1162,15 +1162,15 @@ This command does not work if you use short group names." ...@@ -1162,15 +1162,15 @@ This command does not work if you use short group names."
(with-temp-buffer (with-temp-buffer
(insert-buffer-substring buf b e) (insert-buffer-substring buf b e)
(let ((headers (nnheader-parse-naked-head))) (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars) (setf (mail-header-chars headers) chars)
(mail-header-set-number headers number) (setf (mail-header-number headers) number)
headers))))) headers)))))
(defun nnfolder-add-nov (group article headers) (defun nnfolder-add-nov (group article headers)
"Add a nov line for the GROUP base." "Add a nov line for the GROUP base."
(with-current-buffer (nnfolder-open-nov group) (with-current-buffer (nnfolder-open-nov group)
(goto-char (point-max)) (goto-char (point-max))
(mail-header-set-number headers article) (setf (mail-header-number headers) article)
(nnheader-insert-nov headers))) (nnheader-insert-nov headers)))
(provide 'nnfolder) (provide 'nnfolder)
......
...@@ -136,97 +136,30 @@ on your system, you could say something like: ...@@ -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, ;; (That next-to-last entry is defined as "misc" in the NOV format,
;; but Gnus uses it for xrefs.) ;; but Gnus uses it for xrefs.)
(defmacro mail-header-number (header) (cl-defstruct (mail-header
"Return article number in HEADER." (:type vector)
`(aref ,header 0)) (:constructor nil)
(:constructor make-full-mail-header
(defmacro mail-header-set-number (header number) (&optional number subject from date id
"Set article number of HEADER to NUMBER." references chars lines xref
`(aset ,header 0 ,number)) extra)))
number
(defmacro mail-header-subject (header) subject
"Return subject string in HEADER." from
`(aref ,header 1)) date
id
(defmacro mail-header-set-subject (header subject) references
"Set article subject of HEADER to SUBJECT." chars
`(aset ,header 1 ,subject)) lines
xref
(defmacro mail-header-from (header) extra)
"Return author string in HEADER."
`(aref ,header 2)) (defalias 'mail-header-message-id #'mail-header-id)
(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))
(defsubst make-mail-header (&optional init) (defsubst make-mail-header (&optional init)
"Create a new mail header structure initialized with INIT." "Create a new mail header structure initialized with INIT."
(make-vector 10 init)) (make-full-mail-header init init init init init
init init init init 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))
;; fake message-ids: generation and detection ;; fake message-ids: generation and detection
......
...@@ -723,7 +723,7 @@ skips all prompting." ...@@ -723,7 +723,7 @@ skips all prompting."
(mail-header-number novitem))) (mail-header-number novitem)))
(art (car (rassq artno articleids)))) (art (car (rassq artno articleids))))
(when art (when art
(mail-header-set-number novitem art) (setf (mail-header-number novitem) art)
(push novitem headers)) (push novitem headers))
(forward-line 1))))) (forward-line 1)))))
(setq headers (setq headers
......
...@@ -1419,12 +1419,12 @@ TYPE is either 'nov or 'headers." ...@@ -1419,12 +1419,12 @@ TYPE is either 'nov or 'headers."
(setq cur (nnheader-parse-nov)) (setq cur (nnheader-parse-nov))
(when corr (when corr
(setq article (+ (mail-header-number cur) numc)) (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)) (setq xref (mail-header-xref cur))
(when (and (stringp xref) (when (and (stringp xref)
(string-match (format "[ \t]%s:[0-9]+" backendgroup) xref)) (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
(setq xref (replace-match (format " %s:%d" mairixgroup article) t nil 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) (set-buffer buf)
(nnheader-insert-nov cur) (nnheader-insert-nov cur)
(set-buffer nntp-server-buffer) (set-buffer nntp-server-buffer)
......
...@@ -792,14 +792,14 @@ article number. This function is called narrowed to an article." ...@@ -792,14 +792,14 @@ article number. This function is called narrowed to an article."
"Add a nov line for the GROUP nov headers, incrementally." "Add a nov line for the GROUP nov headers, incrementally."
(with-current-buffer (nnml-open-incremental-nov group) (with-current-buffer (nnml-open-incremental-nov group)
(goto-char (point-max)) (goto-char (point-max))
(mail-header-set-number headers article) (setf (mail-header-number headers) article)
(nnheader-insert-nov headers))) (nnheader-insert-nov headers)))
(defun nnml-add-nov (group article headers) (defun nnml-add-nov (group article headers)
"Add a nov line for the GROUP base." "Add a nov line for the GROUP base."
(with-current-buffer (nnml-open-nov group) (with-current-buffer (nnml-open-nov group)
(goto-char (point-max)) (goto-char (point-max))
(mail-header-set-number headers article) (setf (mail-header-number headers) article)
(nnheader-insert-nov headers))) (nnheader-insert-nov headers)))
(defsubst nnml-header-value () (defsubst nnml-header-value ()
...@@ -816,8 +816,8 @@ article number. This function is called narrowed to an article." ...@@ -816,8 +816,8 @@ article number. This function is called narrowed to an article."
(1- (point)) (1- (point))
(point-max)))) (point-max))))
(let ((headers (nnheader-parse-naked-head))) (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars) (setf (mail-header-chars headers) chars)
(mail-header-set-number headers number) (setf (mail-header-number headers) number)
headers)))) headers))))
(defun nnml-get-nov-buffer (group &optional incrementalp) (defun nnml-get-nov-buffer (group &optional incrementalp)
......
...@@ -461,22 +461,21 @@ Valid types include `google', `dejanews', and `gmane'.") ...@@ -461,22 +461,21 @@ Valid types include `google', `dejanews', and `gmane'.")
(subject (mail-header-subject header)) (subject (mail-header-subject header))
(rfc2047-encoding-type 'mime)) (rfc2047-encoding-type 'mime))
(when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
(mail-header-set-xref (setf (mail-header-xref header)
header (format "http://article.gmane.org/%s/%s/raw"
(format "http://article.gmane.org/%s/%s/raw" (match-string 1 xref)
(match-string 1 xref) (match-string 2 xref))))
(match-string 2 xref))))
;; Add host part to gmane-encrypted addresses ;; Add host part to gmane-encrypted addresses
(when (string-match "@$" from) (when (string-match "@$" from)
(mail-header-set-from header (setf (mail-header-from header)
(concat from "public.gmane.org"))) (concat from "public.gmane.org")))
(mail-header-set-subject header (setf (mail-header-subject header)
(rfc2047-encode-string subject)) (rfc2047-encode-string subject))
(unless (nnweb-get-hashtb (mail-header-xref header)) (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) (push (list (mail-header-number header) header) map)
(nnweb-set-hashtb (cadar map) (car map)))))) (nnweb-set-hashtb (cadar map) (car map))))))
(forward-line 1))) (forward-line 1)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment