Merge from emacs--devo--0
[gnus] / lisp / nnheader.el
index ab49c59..79783f5 100644 (file)
@@ -1,15 +1,18 @@
 ;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
+
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994,
+;;   1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;     Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
-;; These macros may look very much like the ones in GNUS 4.1.  They
-;; are, in a way, but you should note that the indices they use have
-;; been changed from the internal GNUS format to the NOV format.  The
-;; makes it possible to read headers from XOVER much faster.
-;;
-;; The format of a header is now:
-;; [number subject from date id references chars lines xref]
-;;
-;; (That last entry is defined as "misc" in the NOV format, but Gnus
-;; uses it for xrefs.)
-
 ;;; Code:
 
-(require 'mail-utils)
 (eval-when-compile (require 'cl))
 
-(defvar nnheader-max-head-length 4096
-  "*Max length of the head of articles.")
+(defvar nnmail-extra-headers)
+(defvar gnus-newsgroup-name)
+(defvar nnheader-file-coding-system)
+(defvar jka-compr-compression-info-list)
 
-(defvar nnheader-file-name-translation-alist nil
+;; Requiring `gnus-util' at compile time creates a circular
+;; dependency between nnheader.el and gnus-util.el.
+;;(eval-when-compile (require 'gnus-util))
+
+(require 'mail-utils)
+(require 'mm-util)
+(require 'gnus-util)
+(eval-and-compile
+  (autoload 'gnus-sorted-intersection "gnus-range")
+  (autoload 'gnus-intersection "gnus-range")
+  (autoload 'gnus-sorted-complement "gnus-range")
+  (autoload 'gnus-sorted-difference "gnus-range"))
+
+(defcustom gnus-verbose-backends 7
+  "Integer that says how verbose the Gnus backends should be.
+The higher the number, the more messages the Gnus backends will flash
+to say what it's doing.  At zero, the Gnus backends will be totally
+mute; at five, they will display most important messages; and at ten,
+they will keep on jabbering all the time."
+  :group 'gnus-start
+  :type 'integer)
+
+(defcustom gnus-nov-is-evil nil
+  "If non-nil, Gnus backends will never output headers in the NOV format."
+  :group 'gnus-server
+  :type 'boolean)
+
+(defvar nnheader-max-head-length 8192
+  "*Max length of the head of articles.
+
+Value is an integer, nil, or t.  nil means read in chunks of a file
+indefinitely until a complete head is found\; t means always read the
+entire file immediately, disregarding `nnheader-head-chop-length'.
+
+Integer values will in effect be rounded up to the nearest multiple of
+`nnheader-head-chop-length'.")
+
+(defvar nnheader-head-chop-length 2048
+  "*Length of each read operation when trying to fetch HEAD headers.")
+
+(defvar nnheader-read-timeout
+  (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+                   (symbol-name system-type))
+      ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
+      ;;
+      ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
+      ;;
+      ;; There should probably be a runtime test to determine the timing
+      ;; resolution, or a primitive to report it.  I don't know off-hand
+      ;; what's possible.  Perhaps better, maybe the Windows/DOS primitive
+      ;; could round up non-zero timeouts to a minimum of 1.0?
+      1.0
+    0.1)
+  "How long nntp should wait between checking for the end of output.
+Shorter values mean quicker response, but are more CPU intensive.")
+
+(defvar nnheader-file-name-translation-alist
+  (let ((case-fold-search t))
+    (cond
+     ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+                   (symbol-name system-type))
+      (append (mapcar (lambda (c) (cons c ?_))
+                     '(?: ?* ?\" ?< ?> ??))
+             (if (string-match "windows-nt\\|cygwin"
+                               (symbol-name system-type))
+                 nil
+               '((?+ . ?-)))))
+     (t nil)))
   "*Alist that says how to translate characters in file names.
-For instance, if \":\" is illegal as a file character in file names
+For instance, if \":\" is invalid as a file character in file names
 on your system, you could say something like:
 
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
 
+(defvar nnheader-directory-separator-character
+  (string-to-char (substring (file-name-as-directory ".") -1))
+  "*A character used to a directory separator.")
+
+(eval-and-compile
+  (autoload 'nnmail-message-id "nnmail")
+  (autoload 'mail-position-on-field "sendmail")
+  (autoload 'message-remove-header "message")
+  (autoload 'gnus-buffer-live-p "gnus-util"))
+
 ;;; Header access macros.
 
+;; These macros may look very much like the ones in GNUS 4.1.  They
+;; are, in a way, but you should note that the indices they use have
+;; been changed from the internal GNUS format to the NOV format.  The
+;; makes it possible to read headers from XOVER much faster.
+;;
+;; The format of a header is now:
+;; [number subject from date id references chars lines xref extra]
+;;
+;; (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))
@@ -123,126 +204,294 @@ on your system, you could say something like:
   `(aref ,header 8))
 
 (defmacro mail-header-set-xref (header xref)
-  "Set article xref of HEADER to xref."
+  "Set article XREF of HEADER to xref."
   `(aset ,header 8 ,xref))
 
-(defun make-mail-header (&optional init)
+(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)
   "Create a new mail header structure initialized with INIT."
-  (make-vector 9 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))
+
+;; fake message-ids: generation and detection
+
+(defvar nnheader-fake-message-id 1)
+
+(defsubst nnheader-generate-fake-message-id (&optional number)
+  (if (numberp number)
+      (format "fake+none+%s+%d" gnus-newsgroup-name number)
+    (format "fake+none+%s+%s"
+           gnus-newsgroup-name
+           (int-to-string (incf nnheader-fake-message-id)))))
+
+(defsubst nnheader-fake-message-id-p (id)
+  (save-match-data                    ; regular message-id's are <.*>
+    (string-match "\\`fake\\+none\\+.*\\+[0-9]+\\'" id)))
 
 ;; Parsing headers and NOV lines.
 
+(defsubst nnheader-remove-cr-followed-by-lf ()
+  (goto-char (point-max))
+  (while (search-backward "\r\n" nil t)
+    (delete-char 1)))
+
 (defsubst nnheader-header-value ()
-  (buffer-substring (match-end 0) (gnus-point-at-eol)))
+  (skip-chars-forward " \t")
+  (buffer-substring (point) (point-at-eol)))
 
-(defvar nnheader-newsgroup-none-id 1)
+(autoload 'ietf-drums-unfold-fws "ietf-drums")
 
-(defun nnheader-parse-head (&optional naked)
+(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)
-       (cur (current-buffer))
        (buffer-read-only nil)
-       end ref in-reply-to lines p)
-    (goto-char (point-min))
-    (when naked
-      (insert "\n"))
-    ;; Search to the beginning of the next header. Error messages
-    ;; do not begin with 2 or 3.
+       (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
-       (when (or naked (re-search-forward "^[23][0-9]+ " nil t))
-         ;; 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
-         ;; doesn't always go hand in hand.
-         (vector
-          ;; Number.
-          (if naked
-              (progn
-                (setq p (point-min))
-                0)
-            (prog1
-                (read cur)
-              (end-of-line)
-              (setq p (point))
-              (narrow-to-region (point)
-                                (or (and (search-forward "\n.\n" nil t)
-                                         (- (point) 2))
-                                    (point)))))
-          ;; 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)
-                (nnheader-header-value)
-              ;; If there was no message-id, we just fake one to make
-              ;; subsequent routines simpler.
-              (concat "none+"
-                      (int-to-string
-                       (incf nnheader-newsgroup-none-id)))))
-          ;; References.
-          (progn
-            (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 "<[^>]+>" in-reply-to))
-                  (substring in-reply-to (match-beginning 0)
-                             (match-end 0))
-                "")))
-          ;; Chars.
+       ;; 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
+          (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))
+           (goto-char (point-min))
+           ;; 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)
+             (end-of-line)
+             (setq num (read cur)
+                   beg (point)
+                   end (if (search-forward "\n.\n" nil t)
+                           (- (point) 2)
+                         (point)))))
+      (with-temp-buffer
+       (insert-buffer-substring cur beg end)
+       (nnheader-parse-naked-head num)))))
+
+(defmacro nnheader-nov-skip-field ()
+  '(search-forward "\t" eol 'move))
+
+(defmacro nnheader-nov-field ()
+  '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol)))
+
+(defmacro nnheader-nov-read-integer ()
+  '(prog1
+       (if (eq (char-after) ?\t)
           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)))))
-      (when naked
-       (goto-char (point-min))
-       (delete-char 1)))))
+        (let ((num (condition-case nil
+                       (read (current-buffer))
+                     (error nil))))
+          (if (numberp num) num 0)))
+     (or (eobp) (forward-char 1))))
+
+(defmacro nnheader-nov-parse-extra ()
+  '(let (out string)
+     (while (not (memq (char-after) '(?\n nil)))
+       (setq string (nnheader-nov-field))
+       (when (string-match "^\\([^ :]+\\): " string)
+        (push (cons (intern (match-string 1 string))
+                    (substring string (match-end 0)))
+              out)))
+     out))
+
+(eval-and-compile
+  (defvar nnheader-uniquify-message-id nil))
+
+(defmacro nnheader-nov-read-message-id (&optional number)
+  `(let ((id (nnheader-nov-field)))
+     (if (string-match "^<[^>]+>$" id)
+        ,(if nnheader-uniquify-message-id
+             `(if (string-match "__[^@]+@" id)
+                  (concat (substring id 0 (match-beginning 0))
+                          (substring id (1- (match-end 0))))
+                id)
+           'id)
+       (nnheader-generate-fake-message-id ,number))))
+
+(defun nnheader-parse-nov ()
+  (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
 
 (defun nnheader-insert-nov (header)
   (princ (mail-header-number header) (current-buffer))
-  (insert 
-   "\t"
-   (or (mail-header-subject header) "(none)") "\t"
-   (or (mail-header-from header) "(nobody)") "\t"
-   (or (mail-header-date header) "") "\t"
-   (or (mail-header-id header) 
-       (nnmail-message-id)) "\t"
-   (or (mail-header-references header) "") "\t")
-  (princ (or (mail-header-chars header) 0) (current-buffer))
-  (insert "\t")
+  (let ((p (point)))
+    (insert
+     "\t"
+     (or (mail-header-subject header) "(none)") "\t"
+     (or (mail-header-from header) "(nobody)") "\t"
+     (or (mail-header-date header) "") "\t"
+     (or (mail-header-id header)
+        (nnmail-message-id))
+     "\t"
+     (or (mail-header-references header) "") "\t")
+    (princ (or (mail-header-chars header) 0) (current-buffer))
+    (insert "\t")
+    (princ (or (mail-header-lines header) 0) (current-buffer))
+    (insert "\t")
+    (when (mail-header-xref header)
+      (insert "Xref: " (mail-header-xref header)))
+    (when (or (mail-header-xref header)
+             (mail-header-extra header))
+      (insert "\t"))
+    (when (mail-header-extra header)
+      (let ((extra (mail-header-extra header)))
+       (while extra
+         (insert (symbol-name (caar extra))
+                 ": " (cdar extra) "\t")
+         (pop extra))))
+    (insert "\n")
+    (backward-char 1)
+    (while (search-backward "\n" p t)
+      (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
+    (mapcar 'nnheader-insert-nov headers)))
+
+(defun nnheader-insert-header (header)
+  (insert
+   "Subject: " (or (mail-header-subject header) "(none)") "\n"
+   "From: " (or (mail-header-from header) "(nobody)") "\n"
+   "Date: " (or (mail-header-date header) "") "\n"
+   "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
+   "References: " (or (mail-header-references header) "") "\n"
+   "Lines: ")
   (princ (or (mail-header-lines header) 0) (current-buffer))
-  (insert "\t")
-  (when (mail-header-xref header) 
-    (insert "Xref: " (mail-header-xref header) "\t"))
-  (insert "\n"))
+  (insert "\n\n"))
 
 (defun nnheader-insert-article-line (article)
   (goto-char (point-min))
@@ -254,13 +503,68 @@ on your system, you could say something like:
   (forward-char -1)
   (insert "."))
 
+(defun nnheader-nov-delete-outside-range (beg end)
+  "Delete all NOV lines that lie outside the BEG to END range."
+  ;; First we find the first wanted line.
+  (nnheader-find-nov-line beg)
+  (delete-region (point-min) (point))
+  ;; Then we find the last wanted line.
+  (when (nnheader-find-nov-line end)
+    (forward-line 1))
+  (delete-region (point) (point-max)))
+
+(defun nnheader-find-nov-line (article)
+  "Put point at the NOV line that start with ARTICLE.
+If ARTICLE doesn't exist, put point where that line
+would have been.  The function will return non-nil if
+the line could be found."
+  ;; This function basically does a binary search.
+  (let ((max (point-max))
+       (min (goto-char (point-min)))
+       (cur (current-buffer))
+       (prev (point-min))
+       num found)
+    (while (not found)
+      (goto-char (+ min (/ (- max min) 2)))
+      (beginning-of-line)
+      (if (or (= (point) prev)
+             (eobp))
+         (setq found t)
+       (setq prev (point))
+       (while (and (not (numberp (setq num (read cur))))
+                   (not (eobp)))
+         (gnus-delete-line))
+       (cond ((> num article)
+              (setq max (point)))
+             ((< num article)
+              (setq min (point)))
+             (t
+              (setq found 'yes)))))
+    ;; We may be at the first line.
+    (when (and (not num)
+              (not (eobp)))
+      (setq num (read cur)))
+    ;; Now we may have found the article we're looking for, or we
+    ;; may be somewhere near it.
+    (when (and (not (eq found 'yes))
+              (not (eq num article)))
+      (setq found (point))
+      (while (and (< (point) max)
+                 (or (not (numberp num))
+                     (< num article)))
+       (forward-line 1)
+       (setq found (point))
+       (or (eobp)
+           (= (setq num (read cur)) article)))
+      (unless (eq num article)
+       (goto-char found)))
+    (beginning-of-line)
+    (eq num article)))
+
 ;; Various cruft the backends and Gnus need to communicate.
 
 (defvar nntp-server-buffer nil)
-(defvar gnus-verbose-backends 7
-  "*A number that says how talkative the Gnus backends should be.")
-(defvar gnus-nov-is-evil nil
-  "If non-nil, Gnus backends will never output headers in the NOV format.")
+(defvar nntp-process-response nil)
 (defvar news-reply-yank-from nil)
 (defvar news-reply-yank-message-id nil)
 
@@ -269,15 +573,16 @@ on your system, you could say something like:
 (defun nnheader-init-server-buffer ()
   "Initialize the Gnus-backend communication buffer."
   (save-excursion
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
+    (unless (gnus-buffer-live-p nntp-server-buffer)
+      (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
     (set-buffer nntp-server-buffer)
-    (buffer-disable-undo (current-buffer))
+    (mm-enable-multibyte)
     (erase-buffer)
     (kill-all-local-variables)
     (setq case-fold-search t)          ;Should ignore case.
+    (set (make-local-variable 'nntp-process-response) nil)
     t))
 
-
 ;;; Various functions the backends use.
 
 (defun nnheader-file-error (file)
@@ -297,17 +602,28 @@ on your system, you could say something like:
   (when (file-exists-p file)
     (if (eq nnheader-max-head-length t)
        ;; Just read the entire file.
-       (nnheader-insert-file-contents-literally file)
-      ;; Read 1K blocks until we find a separator.
+       (nnheader-insert-file-contents file)
+      ;; Read blocks of the size specified by `nnheader-head-chop-length'
+      ;; until we find a separator.
       (let ((beg 0)
-           format-alist 
-           (chop 1024))
-       (while (and (eq chop (nth 1 (insert-file-contents
-                                    file nil beg (incf beg chop))))
-                   (prog1 (not (search-forward "\n\n" nil t)) 
+           (start (point))
+           ;; Use `binary' to prevent the contents from being decoded,
+           ;; or it will change the number of characters that
+           ;; `insert-file-contents' returns.
+           (coding-system-for-read 'binary))
+       (while (and (eq nnheader-head-chop-length
+                       (nth 1 (mm-insert-file-contents
+                               file nil beg
+                               (incf beg nnheader-head-chop-length))))
+                   ;; CRLF or CR might be used for the line-break code.
+                   (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t))
                      (goto-char (point-max)))
                    (or (null nnheader-max-head-length)
-                       (< beg nnheader-max-head-length))))))
+                       (< beg nnheader-max-head-length))))
+       ;; Finally decode the contents.
+       (when (mm-coding-system-p nnheader-file-coding-system)
+         (mm-decode-coding-region start (point-max)
+                                  nnheader-file-coding-system))))
     t))
 
 (defun nnheader-article-p ()
@@ -317,23 +633,27 @@ on your system, you could say something like:
       nil
     (narrow-to-region (point-min) (1- (point)))
     (goto-char (point-min))
-    (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
+    (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
       (goto-char (match-end 0)))
     (prog1
        (eobp)
-      (widen))))    
+      (widen))))
 
 (defun nnheader-insert-references (references message-id)
   "Insert a References header based on REFERENCES and MESSAGE-ID."
-  (if (and (not references) (not message-id)) 
-      ()       ; This is illegal, but not all articles have Message-IDs.
+  (if (and (not references) (not message-id))
+      ;; This is invalid, but not all articles have Message-IDs.
+      ()
     (mail-position-on-field "References")
-    (let ((begin (save-excursion (beginning-of-line) (point)))
+    (let ((begin (point-at-bol))
          (fill-column 78)
          (fill-prefix "\t"))
-      (if references (insert references))
-      (if (and references message-id) (insert " "))
-      (if message-id (insert message-id))
+      (when references
+       (insert references))
+      (when (and references message-id)
+       (insert " "))
+      (when message-id
+       (insert message-id))
       ;; Fold long References lines to conform to RFC1036 (sort of).
       ;; The region must end with a newline to fill the region
       ;; without inserting extra newline.
@@ -359,43 +679,31 @@ on your system, you could say something like:
      (point-max)))
   (goto-char (point-min)))
 
-(defun nnheader-set-temp-buffer (name)
+(defun nnheader-get-lines-and-char ()
+  "Return the number of lines and chars in the article body."
+  (goto-char (point-min))
+  (if (not (re-search-forward "\n\r?\n" nil t))
+      (list 0 0)
+    (list (count-lines (point) (point-max))
+         (- (point-max) (point)))))
+
+(defun nnheader-remove-body ()
+  "Remove the body from an article in this current buffer."
+  (goto-char (point-min))
+  (when (re-search-forward "\n\r?\n" nil t)
+    (delete-region (point) (point-max))))
+
+(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))
-  (buffer-disable-undo (current-buffer))
-  (erase-buffer)
+  (buffer-disable-undo)
+  (unless noerase
+    (erase-buffer))
   (current-buffer))
 
-(defmacro nnheader-temp-write (file &rest forms)
-  "Create a new buffer, evaluate FORM there, and write the buffer to FILE."
-  `(save-excursion
-     (let ((nnheader-temp-file ,file)
-          (nnheader-temp-cur-buffer
-           (nnheader-set-temp-buffer
-            (generate-new-buffer-name " *nnheader temp*"))))
-       (when (and nnheader-temp-file 
-                 (not (file-directory-p (file-name-directory 
-                                         nnheader-temp-file))))
-        (make-directory (file-name-directory nnheader-temp-file) t))
-       (unwind-protect
-          (prog1
-              (progn
-                ,@forms)
-            (when nnheader-temp-file
-              (set-buffer nnheader-temp-cur-buffer)
-              (write-region (point-min) (point-max) 
-                            nnheader-temp-file nil 'nomesg)))
-        (when (buffer-name nnheader-temp-cur-buffer)
-          (kill-buffer nnheader-temp-cur-buffer))))))
-
-(put 'nnheader-temp-write 'lisp-indent-function 1)
-(put 'nnheader-temp-write 'lisp-indent-hook 1)
-(put 'nnheader-temp-write 'edebug-form-spec '(form body))
-
-(defvar jka-compr-compression-info-list)
 (defvar nnheader-numerical-files
   (if (boundp 'jka-compr-compression-info-list)
-      (concat "\\([0-9]+\\)\\(" 
+      (concat "\\([0-9]+\\)\\("
              (mapconcat (lambda (i) (aref i 0))
                         jka-compr-compression-info-list "\\|")
              "\\)?")
@@ -406,20 +714,25 @@ on your system, you could say something like:
   "Regexp that matches numerical file names.")
 
 (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
-  "Regexp that matches numerical full file paths.")
+  "Regexp that matches numerical full file names.")
 
 (defsubst nnheader-file-to-number (file)
-  "Take a file name and return the article number."
-  (if (not (boundp 'jka-compr-compression-info-list))
-      (string-to-int file)
+  "Take a FILE name and return the article number."
+  (if (string= nnheader-numerical-short-files "^[0-9]+$")
+      (string-to-number file)
     (string-match nnheader-numerical-short-files file)
-    (string-to-int (match-string 0 file))))
+    (string-to-number (match-string 0 file))))
+
+(defvar nnheader-directory-files-is-safe
+  (or (eq system-type 'windows-nt)
+      (not (featurep 'xemacs)))
+  "If non-nil, Gnus believes `directory-files' is safe.
+It has been reported numerous times that `directory-files' fails with
+an alarming frequency on NFS mounted file systems. If it is nil,
+`nnheader-directory-files-safe' is used.")
 
 (defun nnheader-directory-files-safe (&rest args)
-  ;; It has been reported numerous times that `directory-files'
-  ;; fails with an alarming frequency on NFS mounted file systems.
-  ;; This function executes that function twice and returns 
-  ;; the longest result.
+  "Execute `directory-files' twice and returns the longer result."
   (let ((first (apply 'directory-files args))
        (second (apply 'directory-files args)))
     (if (> (length first) (length second))
@@ -427,38 +740,66 @@ on your system, you could say something like:
       second)))
 
 (defun nnheader-directory-articles (dir)
-  "Return a list of all article files in a directory."
+  "Return a list of all article files in directory DIR."
   (mapcar 'nnheader-file-to-number
-         (nnheader-directory-files-safe
-          dir nil nnheader-numerical-short-files t)))
+         (if nnheader-directory-files-is-safe
+             (directory-files
+              dir nil nnheader-numerical-short-files t)
+           (nnheader-directory-files-safe
+            dir nil nnheader-numerical-short-files t))))
 
 (defun nnheader-article-to-file-alist (dir)
   "Return an alist of article/file pairs in DIR."
   (mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
-         (nnheader-directory-files-safe
-          dir nil nnheader-numerical-short-files t)))
+         (if nnheader-directory-files-is-safe
+             (directory-files
+              dir nil nnheader-numerical-short-files t)
+           (nnheader-directory-files-safe
+            dir nil nnheader-numerical-short-files t))))
 
 (defun nnheader-fold-continuation-lines ()
   "Fold continuation lines in the current buffer."
-  (goto-char (point-min))
-  (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-    (replace-match " " t t)))
+  (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
 
-(defun nnheader-translate-file-chars (file)
+(defun nnheader-translate-file-chars (file &optional full)
+  "Translate FILE into something that can be a file name.
+If FULL, translate everything."
   (if (null nnheader-file-name-translation-alist)
       ;; No translation is necessary.
-      file 
-    ;; We translate -- but only the file name.  We leave the directory
-    ;; alone.
+      file
     (let* ((i 0)
           trans leaf path len)
-      (if (string-match "/[^/]+\\'" file)
-         ;; This is needed on NT's and stuff.
-         (setq leaf (substring file (1+ (match-beginning 0)))
-               path (substring file 0 (1+ (match-beginning 0))))
-       ;; Fall back on this.
-       (setq leaf (file-name-nondirectory file)
-             path (file-name-directory file)))
+      (if full
+         ;; Do complete translation.
+         (setq leaf (copy-sequence file)
+               path ""
+               i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1)))
+                     2 0))
+       ;; We translate -- but only the file name.  We leave the directory
+       ;; alone.
+       (if (and (featurep 'xemacs)
+                (memq system-type '(cygwin32 win32 w32 mswindows windows-nt
+                                             cygwin)))
+           ;; This is needed on NT and stuff, because
+           ;; file-name-nondirectory is not enough to split
+           ;; file names, containing ':', e.g.
+           ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE"
+           ;;
+           ;; we are trying to correctly split such names:
+           ;; "d:file.name" -> "a:" "file.name"
+           ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc"
+           ;; "d:aaa\\bbb:ccc"   -> "d:aaa\\" "bbb:ccc"
+           ;; etc.
+           ;; to translate then only the file name part.
+           (progn
+             (setq leaf file
+                   path "")
+             (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file)
+                 (setq leaf (substring file (match-beginning 2))
+                       path (substring file 0 (match-beginning 2)))))
+         ;; Emacs DTRT, says andrewi.
+         (setq leaf (file-name-nondirectory file)
+               path (file-name-directory file))))
       (setq len (length leaf))
       (while (< i len)
        (when (setq trans (cdr (assq (aref leaf i)
@@ -477,10 +818,14 @@ The first string in ARGS can be a format string."
   nil)
 
 (defun nnheader-get-report (backend)
-  (message "%s" (symbol-value (intern (format "%s-status-string" backend)))))
+  "Get the most recent report from BACKEND."
+  (condition-case ()
+      (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
+                                                            backend))))
+    (error (nnheader-message 5 ""))))
 
 (defun nnheader-insert (format &rest args)
-  "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer.
+  "Clear the communication buffer and insert FORMAT and ARGS into the buffer.
 If FORMAT isn't a format string, it and all ARGS will be inserted
 without formatting."
   (save-excursion
@@ -491,49 +836,44 @@ without formatting."
       (apply 'insert format args))
     t))
 
-(defun nnheader-mail-file-mbox-p (file)
-  "Say whether FILE looks like an Unix mbox file."
-  (when (and (file-exists-p file)
-            (file-readable-p file)
-            (file-regular-p file))
-    (save-excursion
-      (nnheader-set-temp-buffer " *mail-file-mbox-p*")
-      (nnheader-insert-file-contents-literally file)
-      (goto-char (point-min))
-      (prog1
-         (looking-at message-unix-mail-delimiter)
-       (kill-buffer (current-buffer))))))
+(defsubst nnheader-replace-chars-in-string (string from to)
+  (mm-subst-char-in-string from to string))
 
-(defun nnheader-replace-chars-in-string (string from to)
+(defun nnheader-replace-duplicate-chars-in-string (string from to)
   "Replace characters in STRING from FROM to TO."
   (let ((string (substring string 0))  ;Copy string.
        (len (length string))
-       (idx 0))
+       (idx 0) prev i)
     ;; Replace all occurrences of FROM with TO.
     (while (< idx len)
-      (if (= (aref string idx) from)
-         (aset string idx to))
+      (setq i (aref string idx))
+      (when (and (eq prev from) (= i from))
+       (aset string (1- idx) to)
+       (aset string idx to))
+      (setq prev i)
       (setq idx (1+ idx)))
     string))
 
 (defun nnheader-file-to-group (file &optional top)
   "Return a group name based on FILE and TOP."
-  (nnheader-replace-chars-in-string 
+  (nnheader-replace-chars-in-string
    (if (not top)
        file
      (condition-case ()
         (substring (expand-file-name file)
-                   (length 
+                   (length
                     (expand-file-name
                      (file-name-as-directory top))))
        (error "")))
-   ?/ ?.))
+   nnheader-directory-separator-character ?.))
 
 (defun nnheader-message (level &rest args)
   "Message if the Gnus backends are talkative."
   (if (or (not (numberp gnus-verbose-backends))
          (<= level gnus-verbose-backends))
-      (apply 'message args)
+      (if gnus-add-timestamp-to-message
+         (apply 'gnus-message-with-timestamp args)
+       (apply 'message args))
     (apply 'format args)))
 
 (defun nnheader-be-verbose (level)
@@ -541,43 +881,48 @@ without formatting."
   (or (not (numberp gnus-verbose-backends))
       (<= level gnus-verbose-backends)))
 
+(defvar nnheader-pathname-coding-system 'iso-8859-1
+  "*Coding system for file name.")
+
 (defun nnheader-group-pathname (group dir &optional file)
-  "Make pathname for GROUP."
+  "Make file name for GROUP."
   (concat
    (let ((dir (file-name-as-directory (expand-file-name dir))))
      ;; If this directory exists, we use it directly.
-     (if (file-directory-p (concat dir group))
-        (concat dir group "/")
-       ;; If not, we translate dots into slashes.
-       (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
+     (file-name-as-directory
+      (if (file-directory-p (concat dir group))
+         (expand-file-name group dir)
+       ;; If not, we translate dots into slashes.
+       (expand-file-name (mm-encode-coding-string
+                          (nnheader-replace-chars-in-string group ?. ?/)
+                          nnheader-pathname-coding-system)
+                         dir))))
    (cond ((null file) "")
         ((numberp file) (int-to-string file))
         (t file))))
 
-(defun nnheader-functionp (form)
-  "Return non-nil if FORM is funcallable."
-  (or (and (symbolp form) (fboundp form))
-      (and (listp form) (eq (car form) 'lambda))))
-
-(defun nnheader-concat (dir file)
-  "Concat DIR as directory to FILE."
-  (concat (file-name-as-directory dir) file))
+(defun nnheader-concat (dir &rest files)
+  "Concat DIR as directory to FILES."
+  (apply 'concat (file-name-as-directory dir) files))
 
 (defun nnheader-ms-strip-cr ()
   "Strip ^M from the end of all lines."
   (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward "\r$" nil t)
-      (delete-backward-char 1))))
+    (nnheader-remove-cr-followed-by-lf)))
 
 (defun nnheader-file-size (file)
   "Return the file size of FILE or 0."
   (or (nth 7 (file-attributes file)) 0))
 
-(defun nnheader-find-etc-directory (package)
-  "Go through the path and find the \".../etc/PACKAGE\" directory."
+(defun nnheader-find-etc-directory (package &optional file first)
+  "Go through `load-path' and find the \"../etc/PACKAGE\" directory.
+This function will look in the parent directory of each `load-path'
+entry, and look for the \"etc\" directory there.
+If FILE, find the \".../etc/PACKAGE\" file instead.
+If FIRST is non-nil, return the directory or the file found at the
+first.  Otherwise, find the newest one, though it may take a time."
   (let ((path load-path)
-       dir result)
+       dir results)
     ;; We try to find the dir by looking at the load path,
     ;; stripping away the last component and adding "etc/".
     (while path
@@ -586,35 +931,151 @@ without formatting."
                (setq dir (concat
                           (file-name-directory
                            (directory-file-name (car path)))
-                          "etc/" package "/")))
-              (file-directory-p dir))
-         (setq result dir
-               path nil)
+                          "etc/" package
+                          (if file "" "/"))))
+              (or file (file-directory-p dir)))
+         (progn
+           (or (member dir results)
+               (push dir results))
+           (setq path (if first nil (cdr path))))
        (setq path (cdr path))))
-    result))
+    (if (or first (not (cdr results)))
+       (car results)
+      (car (sort results 'file-newer-than-file-p)))))
 
 (defvar ange-ftp-path-format)
 (defvar efs-path-regexp)
 (defun nnheader-re-read-dir (path)
   "Re-read directory PATH if PATH is on a remote system."
-    (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
-       (when (string-match efs-path-regexp path)
-         (efs-re-read-dir path))
-     (if (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
+  (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
+      (when (string-match efs-path-regexp path)
+       (efs-re-read-dir path))
+    (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
       (when (string-match (car ange-ftp-path-format) path)
        (ange-ftp-re-read-dir path)))))
 
-(fset 'nnheader-run-at-time 'run-at-time)
-(fset 'nnheader-cancel-timer 'cancel-timer)
-(fset 'nnheader-find-file-noselect 'find-file-noselect)
-(fset 'nnheader-insert-file-contents-literally
-      'insert-file-contents-literally)
-
-(when (string-match "XEmacs\\|Lucid" emacs-version)
+(defvar nnheader-file-coding-system 'raw-text
+  "Coding system used in file backends of Gnus.")
+
+(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+  This function ensures that none of these modifications will take place."
+  (let ((coding-system-for-read nnheader-file-coding-system))
+    (mm-insert-file-contents filename visit beg end replace)))
+
+(defun nnheader-insert-nov-file (file first)
+  (let ((size (nth 7 (file-attributes file)))
+       (cutoff (* 32 1024)))
+    (when size
+      (if (< size cutoff)
+          ;; If the file is small, we just load it.
+          (nnheader-insert-file-contents file)
+        ;; We start on the assumption that FIRST is pretty recent.  If
+        ;; not, we just insert the rest of the file as well.
+        (let (current)
+          (nnheader-insert-file-contents file nil (- size cutoff) size)
+          (goto-char (point-min))
+          (delete-region (point) (or (search-forward "\n" nil 'move) (point)))
+          (setq current (ignore-errors (read (current-buffer))))
+          (if (and (numberp current)
+                   (< current first))
+              t
+            (delete-region (point-min) (point-max))
+            (nnheader-insert-file-contents file)))))))
+
+(defun nnheader-find-file-noselect (&rest args)
+  "Open a file with some variables bound.
+See `find-file-noselect' for the arguments."
+  (let* ((format-alist nil)
+        (auto-mode-alist (mm-auto-mode-alist))
+        (default-major-mode 'fundamental-mode)
+        (enable-local-variables nil)
+        (after-insert-file-functions nil)
+        (enable-local-eval nil)
+        (coding-system-for-read nnheader-file-coding-system)
+        (version-control 'never)
+        (ffh (if (boundp 'find-file-hook)
+                 'find-file-hook
+               'find-file-hooks))
+        (val (symbol-value ffh)))
+    (set ffh nil)
+    (unwind-protect
+       (apply 'find-file-noselect args)
+      (set ffh val))))
+
+(defun nnheader-directory-regular-files (dir)
+  "Return a list of all regular files in DIR."
+  (let ((files (directory-files dir t))
+       out)
+    (while files
+      (when (file-regular-p (car files))
+       (push (car files) out))
+      (pop files))
+    (nreverse out)))
+
+(defun nnheader-directory-files (&rest args)
+  "Same as `directory-files', but prune \".\" and \"..\"."
+  (let ((files (apply 'directory-files args))
+       out)
+    (while files
+      (unless (member (file-name-nondirectory (car files)) '("." ".."))
+       (push (car files) out))
+      (pop files))
+    (nreverse out)))
+
+(defmacro nnheader-skeleton-replace (from &optional to regexp)
+  `(let ((new (generate-new-buffer " *nnheader replace*"))
+        (cur (current-buffer))
+        (start (point-min)))
+     (set-buffer cur)
+     (goto-char (point-min))
+     (while (,(if regexp 're-search-forward 'search-forward)
+            ,from nil t)
+       (insert-buffer-substring
+       cur start (prog1 (match-beginning 0) (set-buffer new)))
+       (goto-char (point-max))
+       ,(when to `(insert ,to))
+       (set-buffer cur)
+       (setq start (point)))
+     (insert-buffer-substring
+      cur start (prog1 (point-max) (set-buffer new)))
+     (copy-to-buffer cur (point-min) (point-max))
+     (kill-buffer (current-buffer))
+     (set-buffer cur)))
+
+(defun nnheader-replace-string (from to)
+  "Do a fast replacement of FROM to TO from point to `point-max'."
+  (nnheader-skeleton-replace from to))
+
+(defun nnheader-replace-regexp (from to)
+  "Do a fast regexp replacement of FROM to TO from point to `point-max'."
+  (nnheader-skeleton-replace from to t))
+
+(defun nnheader-strip-cr ()
+  "Strip all \r's from the current buffer."
+  (nnheader-skeleton-replace "\r"))
+
+(defalias 'nnheader-cancel-timer 'cancel-timer)
+(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
+(defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
+
+(defun nnheader-accept-process-output (process)
+  (accept-process-output
+   process
+   (truncate nnheader-read-timeout)
+   (truncate (* (- nnheader-read-timeout
+                  (truncate nnheader-read-timeout))
+               1000))))
+
+(when (featurep 'xemacs)
   (require 'nnheaderxm))
 
 (run-hooks 'nnheader-load-hook)
 
 (provide 'nnheader)
 
+;;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202
 ;;; nnheader.el ends here