1 ;;; nnheader.el --- header access macros for Gnus and its backends
3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
4 ;; 1997, 1998, 2000, 2001, 2002, 2003
5 ;; Free Software Foundation, Inc.
7 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'cl))
34 ;; Requiring `gnus-util' at compile time creates a circular
35 ;; dependency between nnheader.el and gnus-util.el.
36 ;;(eval-when-compile (require 'gnus-util))
42 (autoload 'gnus-sorted-intersection "gnus-range")
43 (autoload 'gnus-intersection "gnus-range")
44 (autoload 'gnus-sorted-complement "gnus-range")
45 (autoload 'gnus-sorted-difference "gnus-range"))
47 (defcustom gnus-verbose-backends 7
48 "Integer that says how verbose the Gnus backends should be.
49 The higher the number, the more messages the Gnus backends will flash
50 to say what it's doing. At zero, the Gnus backends will be totally
51 mute; at five, they will display most important messages; and at ten,
52 they will keep on jabbering all the time."
56 (defcustom gnus-nov-is-evil nil
57 "If non-nil, Gnus backends will never output headers in the NOV format."
61 (defvar nnheader-max-head-length 4096
62 "*Max length of the head of articles.
64 Value is an integer, nil, or t. nil means read in chunks of a file
65 indefinitely until a complete head is found\; t means always read the
66 entire file immediately, disregarding `nnheader-head-chop-length'.
68 Integer values will in effect be rounded up to the nearest multiple of
69 `nnheader-head-chop-length'.")
71 (defvar nnheader-head-chop-length 2048
72 "*Length of each read operation when trying to fetch HEAD headers.")
74 (defvar nnheader-read-timeout
75 (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
76 (symbol-name system-type))
79 "How long nntp should wait between checking for the end of output.
80 Shorter values mean quicker response, but are more CPU intensive.")
82 (defvar nnheader-file-name-translation-alist
83 (let ((case-fold-search t))
85 ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
86 (symbol-name system-type))
87 (append (mapcar (lambda (c) (cons c ?_))
88 '(?: ?* ?\" ?< ?> ??))
89 (if (string-match "windows-nt\\|cygwin"
90 (symbol-name system-type))
94 "*Alist that says how to translate characters in file names.
95 For instance, if \":\" is invalid as a file character in file names
96 on your system, you could say something like:
98 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
100 (defvar nnheader-directory-separator-character
101 (string-to-char (substring (file-name-as-directory ".") -1))
102 "*A character used to a directory separator.")
105 (autoload 'nnmail-message-id "nnmail")
106 (autoload 'mail-position-on-field "sendmail")
107 (autoload 'message-remove-header "message")
108 (autoload 'gnus-point-at-eol "gnus-util")
109 (autoload 'gnus-buffer-live-p "gnus-util"))
111 ;;; Header access macros.
113 ;; These macros may look very much like the ones in GNUS 4.1. They
114 ;; are, in a way, but you should note that the indices they use have
115 ;; been changed from the internal GNUS format to the NOV format. The
116 ;; makes it possible to read headers from XOVER much faster.
118 ;; The format of a header is now:
119 ;; [number subject from date id references chars lines xref extra]
121 ;; (That next-to-last entry is defined as "misc" in the NOV format,
122 ;; but Gnus uses it for xrefs.)
124 (defmacro mail-header-number (header)
125 "Return article number in HEADER."
128 (defmacro mail-header-set-number (header number)
129 "Set article number of HEADER to NUMBER."
130 `(aset ,header 0 ,number))
132 (defmacro mail-header-subject (header)
133 "Return subject string in HEADER."
136 (defmacro mail-header-set-subject (header subject)
137 "Set article subject of HEADER to SUBJECT."
138 `(aset ,header 1 ,subject))
140 (defmacro mail-header-from (header)
141 "Return author string in HEADER."
144 (defmacro mail-header-set-from (header from)
145 "Set article author of HEADER to FROM."
146 `(aset ,header 2 ,from))
148 (defmacro mail-header-date (header)
149 "Return date in HEADER."
152 (defmacro mail-header-set-date (header date)
153 "Set article date of HEADER to DATE."
154 `(aset ,header 3 ,date))
156 (defalias 'mail-header-message-id 'mail-header-id)
157 (defmacro mail-header-id (header)
158 "Return Id in HEADER."
161 (defalias 'mail-header-set-message-id 'mail-header-set-id)
162 (defmacro mail-header-set-id (header id)
163 "Set article Id of HEADER to ID."
164 `(aset ,header 4 ,id))
166 (defmacro mail-header-references (header)
167 "Return references in HEADER."
170 (defmacro mail-header-set-references (header ref)
171 "Set article references of HEADER to REF."
172 `(aset ,header 5 ,ref))
174 (defmacro mail-header-chars (header)
175 "Return number of chars of article in HEADER."
178 (defmacro mail-header-set-chars (header chars)
179 "Set number of chars in article of HEADER to CHARS."
180 `(aset ,header 6 ,chars))
182 (defmacro mail-header-lines (header)
183 "Return lines in HEADER."
186 (defmacro mail-header-set-lines (header lines)
187 "Set article lines of HEADER to LINES."
188 `(aset ,header 7 ,lines))
190 (defmacro mail-header-xref (header)
191 "Return xref string in HEADER."
194 (defmacro mail-header-set-xref (header xref)
195 "Set article XREF of HEADER to xref."
196 `(aset ,header 8 ,xref))
198 (defmacro mail-header-extra (header)
199 "Return the extra headers in HEADER."
202 (defmacro mail-header-set-extra (header extra)
203 "Set the extra headers in HEADER to EXTRA."
204 `(aset ,header 9 ',extra))
206 (defsubst make-mail-header (&optional init)
207 "Create a new mail header structure initialized with INIT."
208 (make-vector 10 init))
210 (defsubst make-full-mail-header (&optional number subject from date id
211 references chars lines xref
213 "Create a new mail header structure initialized with the parameters given."
214 (vector number subject from date id references chars lines xref extra))
216 ;; fake message-ids: generation and detection
218 (defvar nnheader-fake-message-id 1)
220 (defsubst nnheader-generate-fake-message-id ()
221 (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
223 (defsubst nnheader-fake-message-id-p (id)
224 (save-match-data ; regular message-id's are <.*>
225 (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
227 ;; Parsing headers and NOV lines.
229 (defsubst nnheader-remove-cr-followed-by-lf ()
230 (goto-char (point-max))
231 (while (search-backward "\r\n" nil t)
234 (defsubst nnheader-header-value ()
235 (skip-chars-forward " \t")
236 (buffer-substring (point) (gnus-point-at-eol)))
238 (defun nnheader-parse-naked-head (&optional number)
239 ;; This function unfolds continuation lines in this buffer
240 ;; destructively. When this side effect is unwanted, use
241 ;; `nnheader-parse-head' instead of this function.
242 (let ((case-fold-search t)
243 (buffer-read-only nil)
244 (cur (current-buffer))
246 in-reply-to lines ref)
247 (nnheader-remove-cr-followed-by-lf)
248 (ietf-drums-unfold-fws)
249 (subst-char-in-region (point-min) (point-max) ?\t ? )
253 ;; This implementation of this function, with nine
254 ;; search-forwards instead of the one re-search-forward and a
255 ;; case (which basically was the old function) is actually
256 ;; about twice as fast, even though it looks messier. You
257 ;; can't have everything, I guess. Speed and elegance don't
258 ;; always go hand in hand.
265 (if (search-forward "\nsubject:" nil t)
266 (nnheader-header-value) "(none)"))
270 (if (search-forward "\nfrom:" nil t)
271 (nnheader-header-value) "(nobody)"))
275 (if (search-forward "\ndate:" nil t)
276 (nnheader-header-value) ""))
280 (if (search-forward "\nmessage-id:" nil t)
282 (1- (or (search-forward "<" (gnus-point-at-eol) t)
284 (or (search-forward ">" (gnus-point-at-eol) t) (point)))
285 ;; If there was no message-id, we just fake one to make
286 ;; subsequent routines simpler.
287 (nnheader-generate-fake-message-id)))
291 (if (search-forward "\nreferences:" nil t)
292 (nnheader-header-value)
293 ;; Get the references from the in-reply-to header if
294 ;; there were no references and the in-reply-to header
296 (if (and (search-forward "\nin-reply-to:" nil t)
297 (setq in-reply-to (nnheader-header-value))
298 (string-match "<[^\n>]+>" in-reply-to))
300 (setq ref (substring in-reply-to (match-beginning 0)
302 (while (string-match "<[^\n>]+>"
303 in-reply-to (match-end 0))
304 (setq ref2 (substring in-reply-to (match-beginning 0)
306 (when (> (length ref2) (length ref))
315 (if (search-forward "\nlines: " nil t)
316 (if (numberp (setq lines (read cur)))
322 (and (search-forward "\nxref:" nil t)
323 (nnheader-header-value)))
325 (when nnmail-extra-headers
326 (let ((extra nnmail-extra-headers)