summaryrefslogtreecommitdiff
path: root/lisp/gnus/nnheader.el
diff options
context:
space:
mode:
authorAndrew G Cohen <cohen@andy.bu.edu>2020-09-05 08:46:43 +0800
committerAndrew G Cohen <cohen@andy.bu.edu>2020-09-05 08:46:43 +0800
commitecfc13e41627511769e00a2d0a7568d5bdbe8a0d (patch)
tree0594654501fdfb3ded9233a01fecd96ef9924e5a /lisp/gnus/nnheader.el
parentf450798cb0b9bedfa73efff14605a04eec4f1d9e (diff)
downloademacs-ecfc13e41627511769e00a2d0a7568d5bdbe8a0d.tar.gz
Introduce nnselect backend for gnus
This new backend allows gnus to handle arbitrary sets of messages spanning multiple groups, even when these groups are from different backends and different servers. All gnus glue is removed from nnir (leaving only the backend search functions) and gnus search-related processing is done through nnselect. In appropriate places 'nnir' has been replaced by 'nnselect' or 'search'. * etc/NEWS: Document the change. * doc/misc/gnus.texi: New documentation for nnselect and update searching and thread-referral sections. * lisp/gnus/nnselect.el: New file. * lisp/gnus/nnir.el: Remove all gnus glue, leaving only searching capability. Improve documentation strings. * lisp/gnus/gnus-group.el (gnus-group-read-ephemeral-search-group, gnus-group-make-search-group): New functions. * lisp/gnus/gnus-msg.el (gnus-setup-message, gnus-group-news, gnus-summary-news-other-window): Update to work for nnselect. Fix gnus-newsgroup-name wrangling. *lisp/gnus/gnus-registry.el (gnus-registry-action,gnus-registry-ignore-group-p): Make work from nnselect. * lisp/gnus/nnheader.el (nnheader-parse-head, nnheader-parse-nov): Rework and consolidate header parsing. * lisp/gnus/gnus-agent.el (gnus-agent-regenerate-group): * lisp/gnus/gnus-cache.el (gnus-possibly-enter-article): * lisp/gnus/gnus-cloud.el (gnus-cloud-available-chunks): * lisp/gnus/gnus-msg.el (gnus-inews-yank-articles): * lisp/gnus/gnus-sum. (gnus-get-newsgroup-headers): * lisp/gnus/nndiary.el (nndiary-parse-head): * lisp/gnus/nnfolder.el (nnfolder-parse-head): * lisp/gnus/nnmaildir.el (nnmaildir--update-nov): * lisp/gnus/nnml.el (nnml-parse-head): * lisp/gnus/nnspool.el (nnspool-insert-nov-head): Use new header parsing. * lisp/gnus/gnus-start.el (gnus-read-active-for-groups): Rescan on activation by default. * lisp/gnus/gnus-sum.el (gnus-summary-line-format-alist): New specs for virtual groups. (gnus-article-sort-by-rsv, gnus-thread-sort-by-rsv): New functions to allow sorting by search RSV.
Diffstat (limited to 'lisp/gnus/nnheader.el')
-rw-r--r--lisp/gnus/nnheader.el344
1 files changed, 200 insertions, 144 deletions
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index fee7a169ff9..1a50697bf5d 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -28,6 +28,10 @@
(eval-when-compile (require 'cl-lib))
+(defvar gnus-decode-encoded-word-function)
+(defvar gnus-decode-encoded-address-function)
+(defvar gnus-alter-header-function)
+
(defvar nnmail-extra-headers)
(defvar gnus-newsgroup-name)
(defvar jka-compr-compression-info-list)
@@ -39,6 +43,7 @@
(require 'mail-utils)
(require 'mm-util)
(require 'gnus-util)
+(autoload 'gnus-remove-odd-characters "gnus-sum")
(autoload 'gnus-range-add "gnus-range")
(autoload 'gnus-remove-from-range "gnus-range")
;; FIXME none of these are used explicitly in this file.
@@ -188,124 +193,167 @@ on your system, you could say something like:
(autoload 'ietf-drums-unfold-fws "ietf-drums")
-(defun nnheader-parse-naked-head (&optional number)
- ;; This function unfolds continuation lines in this buffer
- ;; destructively. When this side effect is unwanted, use
- ;; `nnheader-parse-head' instead of this function.
- (let ((case-fold-search t)
- (buffer-read-only nil)
+
+(defsubst nnheader-head-make-header (number)
+ "Using data of type 'head in the current buffer
+ return a full mail header with article NUMBER."
+ (let ((p (point-min))
(cur (current-buffer))
- (p (point-min))
- in-reply-to lines ref)
- (nnheader-remove-cr-followed-by-lf)
- (ietf-drums-unfold-fws)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (goto-char p)
- (insert "\n")
- (prog1
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and a
- ;; case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance don't
- ;; always go hand in hand.
- (make-full-mail-header
- ;; Number.
- (or number 0)
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (nnheader-header-value) "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (nnheader-header-value) "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (if (search-forward "\nmessage-id:" nil t)
- (buffer-substring
- (1- (or (search-forward "<" (point-at-eol) t)
- (point)))
- (or (search-forward ">" (point-at-eol) t) (point)))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (nnheader-generate-fake-message-id number)))
- ;; References.
- (progn
+ in-reply-to chars lines end ref)
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and a
+ ;; case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance don't
+ ;; always go hand in hand.
+ (make-full-mail-header
+ ;; Number.
+ number
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject:" nil t)
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
+ "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom:" nil t)
+ (funcall gnus-decode-encoded-address-function
+ (nnheader-header-value))
+ "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (if (re-search-forward
+ "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
+ ;; If there was no message-id, we just fake one to make
+ ;; subsequent routines simpler.
+ (nnheader-generate-fake-message-id number)))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences:" nil t)
+ (progn
+ (setq end (point))
+ (prog1
+ (nnheader-header-value)
+ (setq ref
+ (buffer-substring
+ (progn
+ (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nin-reply-to:" nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ nil)))
+ ;; Chars.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nchars: " nil t)
+ (if (numberp (setq chars (ignore-errors (read cur))))
+ chars -1)
+ -1))
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (ignore-errors (read cur))))
+ lines -1)
+ -1))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref:" nil t)
+ (nnheader-header-value)))
+ ;; Extra.
+ (when nnmail-extra-headers
+ (let ((extra nnmail-extra-headers)
+ out)
+ (while extra
(goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (nnheader-header-value)
- ;; Get the references from the in-reply-to header if
- ;; there were no references and the in-reply-to header
- ;; looks promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^\n>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^\n>]+>"
- in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- nil)))
- ;; Chars.
- 0
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
- lines 0)
- 0))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when nnmail-extra-headers
- (let ((extra nnmail-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out)))
- (goto-char p)
- (delete-char 1))))
-
-(defun nnheader-parse-head (&optional naked)
- (let ((cur (current-buffer)) num beg end)
- (when (if naked
- (setq num 0
- beg (point-min)
- end (point-max))
- ;; Search to the beginning of the next header. Error
- ;; messages do not begin with 2 or 3.
- (when (re-search-forward "^[23][0-9]+ " nil t)
- (setq num (read cur)
- beg (point)
- end (if (search-forward "\n.\n" nil t)
- (goto-char (- (point) 2))
- (point)))))
- (with-temp-buffer
- (insert-buffer-substring cur beg end)
- (nnheader-parse-naked-head num)))))
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out)))))
+
+(defun nnheader-parse-head (&optional naked temp)
+ "Parse data of type 'header in the current buffer and return a
+ mail header, modifying the buffer contents in the process. The
+ buffer is assumed to begin each header with an \"Article
+ retrieved\" line with an article number; If NAKED is non-nil
+ this line is assumed absent, and the buffer should contain a
+ single header's worth of data. If TEMP is non-nil the data is
+ first copied to a temporary buffer leaving the original buffer
+ untouched."
+ (let ((cur (current-buffer))
+ (num 0)
+ (beg (point-min))
+ (end (point-max))
+ buf)
+ (when (or naked
+ ;; Search to the beginning of the next header. Error
+ ;; messages do not begin with 2 or 3.
+ (when (re-search-forward "^[23][0-9]+ " nil t)
+ (setq num (read cur)
+ beg (point)
+ end (if (search-forward "\n.\n" nil t)
+ (goto-char (- (point) 2))
+ (point)))))
+ ;; When TEMP copy the data to a temporary buffer
+ (if temp
+ (progn
+ (set-buffer (setq buf (generate-new-buffer " *nnheader-temp*")))
+ (insert-buffer-substring cur beg end))
+ ;; Otherwise just narrow to the data
+ (narrow-to-region beg end))
+ (let ((case-fold-search t)
+ (buffer-read-only nil)
+ header)
+ (nnheader-remove-cr-followed-by-lf)
+ (ietf-drums-unfold-fws)
+ (subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (subst-char-in-region (point-min) (point-max) ?\r ? t)
+ (goto-char (point-min))
+ (insert "\n")
+ (setq header (nnheader-head-make-header num))
+ (goto-char (point-min))
+ (delete-char 1)
+ (if temp
+ (kill-buffer buf)
+ (goto-char (point-max))
+ (widen))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header))
+ header))))
(defmacro nnheader-nov-skip-field ()
'(search-forward "\t" eol 'move))
@@ -347,24 +395,43 @@ on your system, you could say something like:
'id)
(nnheader-generate-fake-message-id ,number))))
-(defun nnheader-parse-nov ()
+(defalias 'nnheader-nov-make-header 'nnheader-parse-nov)
+(autoload 'gnus-extract-message-id-from-in-reply-to "gnus-sum")
+
+(defun nnheader-parse-nov (&optional number)
(let ((eol (point-at-eol))
- (number (nnheader-nov-read-integer)))
- (vector
- number ; number
- (nnheader-nov-field) ; subject
- (nnheader-nov-field) ; from
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id number) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (if (eq (char-after) ?\n)
- nil
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
+ references in-reply-to x header)
+ (setq header
+ (make-full-mail-header
+ (or number (nnheader-nov-read-integer)) ; number
+ (condition-case () ; subject
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (condition-case () ; from
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-address-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id number) ; id
+ (setq references (nnheader-nov-field)) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (if (looking-at "Xref: ")
+ (goto-char (match-end 0)))
+ (nnheader-nov-field)) ; Xref
+ (nnheader-nov-parse-extra))) ; extra
+
+ (when (and (string= references "")
+ (setq in-reply-to (mail-header-extra header))
+ (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
+ (setf (mail-header-references header)
+ (gnus-extract-message-id-from-in-reply-to in-reply-to)))
+ header))
+
(defun nnheader-insert-nov (header)
(princ (mail-header-number header) (current-buffer))
@@ -399,17 +466,6 @@ on your system, you could say something like:
(delete-char 1))
(forward-line 1)))
-(defun nnheader-parse-overview-file (file)
- "Parse FILE and return a list of headers."
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let (headers)
- (while (not (eobp))
- (push (nnheader-parse-nov) headers)
- (forward-line 1))
- (nreverse headers))))
-
(defun nnheader-write-overview-file (file headers)
"Write HEADERS to FILE."
(with-temp-file file