diff options
Diffstat (limited to 'lisp/gnus/nnheader.el')
| -rw-r--r-- | lisp/gnus/nnheader.el | 355 |
1 files changed, 207 insertions, 148 deletions
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 03b08854b11..2952e20928b 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,166 @@ 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) + "Return a full mail header with article NUMBER. +Do this using data of type `head' in the current buffer." + (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. - (vector - ;; 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. +Modify 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 ?\s t) + (subst-char-in-region (point-min) (point-max) ?\r ?\s 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 +394,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 +465,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 @@ -487,8 +542,8 @@ the line could be found." (< num article))) (forward-line 1) (setq found (point)) - (or (eobp) - (= (setq num (read cur)) article))) + (unless (eobp) + (setq num (read cur)))) (unless (eq num article) (goto-char found))) (beginning-of-line) @@ -502,10 +557,12 @@ the line could be found." "Coding system used in file backends of Gnus.") (defvar nnheader-callback-function nil) +(autoload 'gnus-get-buffer-create "gnus") + (defun nnheader-init-server-buffer () "Initialize the Gnus-backend communication buffer." (unless (gnus-buffer-live-p nntp-server-buffer) - (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) + (setq nntp-server-buffer (gnus-get-buffer-create " *nntpd*"))) (with-current-buffer nntp-server-buffer (erase-buffer) (mm-enable-multibyte) @@ -630,7 +687,7 @@ the line could be found." (defun nnheader-set-temp-buffer (name &optional noerase) "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." - (set-buffer (get-buffer-create name)) + (set-buffer (gnus-get-buffer-create name)) (buffer-disable-undo) (unless noerase (erase-buffer)) @@ -1010,6 +1067,8 @@ See `find-file-noselect' for the arguments." (setq nnheader-last-message-time now) (apply 'nnheader-message args)))) +(make-obsolete-variable 'nnheader-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'nnheader-load-hook) (provide 'nnheader) |