(gnus-version-number): Bump.

[gnus] / lisp / nnheader.el

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index b5b29f4..61797df 100644 (file)
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1,7 +1,7 @@
 ;;; nnheader.el --- header access macros for Gnus and its backends
 
 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
 ;;; nnheader.el --- header access macros for Gnus and its backends
 
 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,

-;;        1997, 1998, 2000, 2001, 2002
+;;        1997, 1998, 2000, 2001, 2002, 2003

 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>


@@ -33,7 +33,7 @@
 
 ;; Requiring `gnus-util' at compile time creates a circular
 ;; dependency between nnheader.el and gnus-util.el.
 
 ;; Requiring `gnus-util' at compile time creates a circular
 ;; dependency between nnheader.el and gnus-util.el.

-                            ;(eval-when-compile (require 'gnus-util))
+;;(eval-when-compile (require 'gnus-util))

 
 (require 'mail-utils)
 (require 'mm-util)
 
 (require 'mail-utils)
 (require 'mm-util)


@@ -70,14 +70,22 @@ Integer values will in effect be rounded up to the nearest multiple of
 (defvar nnheader-head-chop-length 2048
   "*Length of each read operation when trying to fetch HEAD headers.")
 
 (defvar nnheader-head-chop-length 2048
   "*Length of each read operation when trying to fetch HEAD headers.")
 

-(defvar nnheader-file-name-translation-alist 
+(defvar nnheader-read-timeout
+  (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+                   (symbol-name system-type))
+      1.0
+    0.1)
+  "How long nntp should wait between checking for the end of output.
+Shorter values mean quicker response, but is more CPU intensive.")
+
+(defvar nnheader-file-name-translation-alist

   (let ((case-fold-search t))
     (cond
   (let ((case-fold-search t))
     (cond

-     ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
+     ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"

                    (symbol-name system-type))
       (append (mapcar (lambda (c) (cons c ?_))
                      '(?: ?* ?\" ?< ?> ??))
                    (symbol-name system-type))
       (append (mapcar (lambda (c) (cons c ?_))
                      '(?: ?* ?\" ?< ?> ??))

-             (if (string-match "windows-nt\\|cygwin32"
+             (if (string-match "windows-nt\\|cygwin"

                                (symbol-name system-type))
                  nil
                '((?+ . ?-)))))
                                (symbol-name system-type))
                  nil
                '((?+ . ?-)))))


@@ -88,6 +96,10 @@ on your system, you could say something like:
 
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
 
 
 \(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")
 (eval-and-compile
   (autoload 'nnmail-message-id "nnmail")
   (autoload 'mail-position-on-field "sendmail")


@@ -213,120 +225,135 @@ on your system, you could say something like:
 
 ;; Parsing headers and NOV lines.
 
 
 ;; 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 ()
   (skip-chars-forward " \t")
   (buffer-substring (point) (gnus-point-at-eol)))
 
 (defsubst nnheader-header-value ()
   (skip-chars-forward " \t")
   (buffer-substring (point) (gnus-point-at-eol)))
 

-(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)
   (let ((case-fold-search t)

-       (cur (current-buffer))

        (buffer-read-only nil)
        (buffer-read-only nil)

-       in-reply-to lines p ref)
-    (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
     (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
-         ;; don'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)
-                (buffer-substring
-                 (1- (or (search-forward "<" (gnus-point-at-eol) t)
-                         (point)))
-                 (or (search-forward ">" (gnus-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)))
-          ;; 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))))
-      (when naked
-       (goto-char (point-min))
-       (delete-char 1)))))
+       ;; 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 "<" (gnus-point-at-eol) t)
+                       (point)))
+               (or (search-forward ">" (gnus-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)))
+        ;; 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-skip-field ()
   '(search-forward "\t" eol 'move))


@@ -470,7 +497,7 @@ the line could be found."
        (prev (point-min))
        num found)
     (while (not found)
        (prev (point-min))
        num found)
     (while (not found)

-      (goto-char (/ (+ max min) 2))
+      (goto-char (+ min (/ (- max min) 2)))

       (beginning-of-line)
       (if (or (= (point) prev)
              (eobp))
       (beginning-of-line)
       (if (or (= (point) prev)
              (eobp))


@@ -478,8 +505,7 @@ the line could be found."
        (setq prev (point))
        (while (and (not (numberp (setq num (read cur))))
                    (not (eobp)))
        (setq prev (point))
        (while (and (not (numberp (setq num (read cur))))
                    (not (eobp)))

-         (delete-region (progn (beginning-of-line) (point))
-                        (progn (forward-line 1) (point))))
+         (gnus-delete-line))

        (cond ((> num article)
               (setq max (point)))
              ((< num article)
        (cond ((> num article)
               (setq max (point)))
              ((< num article)


@@ -581,7 +607,7 @@ the line could be found."
       ;; This is invalid, but not all articles have Message-IDs.
       ()
     (mail-position-on-field "References")
       ;; 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 (gnus-point-at-bol))

          (fill-column 78)
          (fill-prefix "\t"))
       (when references
          (fill-column 78)
          (fill-prefix "\t"))
       (when references


@@ -615,6 +641,12 @@ the line could be found."
      (point-max)))
   (goto-char (point-min)))
 
      (point-max)))
   (goto-char (point-min)))
 

+(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))
 (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))


@@ -637,7 +669,7 @@ the line could be found."
   "Regexp that matches numerical file names.")
 
 (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
   "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."
 
 (defsubst nnheader-file-to-number (file)
   "Take a FILE name and return the article number."


@@ -702,7 +734,8 @@ If FULL, translate everything."
        ;; We translate -- but only the file name.  We leave the directory
        ;; alone.
        (if (and (featurep 'xemacs)
        ;; 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)))
+                (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.
            ;; This is needed on NT and stuff, because
            ;; file-name-nondirectory is not enough to split
            ;; file names, containing ':', e.g.


@@ -788,7 +821,7 @@ without formatting."
                     (expand-file-name
                      (file-name-as-directory top))))
        (error "")))
                     (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."
 
 (defun nnheader-message (level &rest args)
   "Message if the Gnus backends are talkative."


@@ -803,10 +836,10 @@ without formatting."
       (<= level gnus-verbose-backends)))
 
 (defvar nnheader-pathname-coding-system 'iso-8859-1
       (<= level gnus-verbose-backends)))
 
 (defvar nnheader-pathname-coding-system 'iso-8859-1

-  "*Coding system for pathname.")
+  "*Coding system for file name.")

 
 (defun nnheader-group-pathname (group dir &optional file)
 
 (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.
   (concat
    (let ((dir (file-name-as-directory (expand-file-name dir))))
      ;; If this directory exists, we use it directly.


@@ -834,16 +867,16 @@ without formatting."
 (defun nnheader-ms-strip-cr ()
   "Strip ^M from the end of all lines."
   (save-excursion
 (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 &optional file)
 
 (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 &optional file)

-  "Go through the path and find the \".../etc/PACKAGE\" directory.
+  "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."
   (let ((path load-path)
        dir result)
 If FILE, find the \".../etc/PACKAGE\" file instead."
   (let ((path load-path)
        dir result)


@@ -890,21 +923,22 @@ find-file-hooks, etc.
 (defun nnheader-insert-nov-file (file first)
   (let ((size (nth 7 (file-attributes file)))
        (cutoff (* 32 1024)))
 (defun nnheader-insert-nov-file (file first)
   (let ((size (nth 7 (file-attributes file)))
        (cutoff (* 32 1024)))

-    (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))))))
+    (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)
   (let ((format-alist nil)
 
 (defun nnheader-find-file-noselect (&rest args)
   (let ((format-alist nil)


@@ -974,6 +1008,14 @@ find-file-hooks, etc.
 (defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
 (defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
 
 (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))
 
 (when (featurep 'xemacs)
   (require 'nnheaderxm))