* gnus-group.el (gnus-group-make-tool-bar): Remove duplicate check

[gnus] / lisp / nnheader.el

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index adc9c9d..dc1f090 100644 (file)
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1,8 +1,8 @@
 ;;; nnheader.el --- header access macros for Gnus and its backends
 
 ;;; 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
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994,
+;;   1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.

 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>


@@ -22,8 +22,8 @@
 
 ;; 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
 
 ;; 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:
 
 
 ;;; Commentary:
 


@@ -31,12 +31,15 @@
 
 (eval-when-compile (require 'cl))
 
 
 (eval-when-compile (require 'cl))
 

+(defvar nnmail-extra-headers)
+

 ;; 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)

+(require 'gnus-util)

 (eval-and-compile
   (autoload 'gnus-sorted-intersection "gnus-range")
   (autoload 'gnus-intersection "gnus-range")
 (eval-and-compile
   (autoload 'gnus-sorted-intersection "gnus-range")
   (autoload 'gnus-intersection "gnus-range")


@@ -57,7 +60,7 @@ they will keep on jabbering all the time."
   :group 'gnus-server
   :type 'boolean)
 
   :group 'gnus-server
   :type 'boolean)
 

-(defvar nnheader-max-head-length 4096
+(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
   "*Max length of the head of articles.
 
 Value is an integer, nil, or t.  nil means read in chunks of a file


@@ -70,6 +73,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-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
 (defvar nnheader-file-name-translation-alist
   (let ((case-fold-search t))
     (cond


@@ -88,11 +107,14 @@ 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")
   (autoload 'message-remove-header "message")
 (eval-and-compile
   (autoload 'nnmail-message-id "nnmail")
   (autoload 'mail-position-on-field "sendmail")
   (autoload 'message-remove-header "message")

-  (autoload 'gnus-point-at-eol "gnus-util")

   (autoload 'gnus-buffer-live-p "gnus-util"))
 
 ;;; Header access macros.
   (autoload 'gnus-buffer-live-p "gnus-util"))
 
 ;;; Header access macros.


@@ -186,9 +208,9 @@ on your system, you could say something like:
   "Return the extra headers in HEADER."
   `(aref ,header 9))
 
   "Return the extra headers in HEADER."
   `(aref ,header 9))
 

-(defmacro mail-header-set-extra (header extra)
+(defun mail-header-set-extra (header extra)

   "Set the extra headers in HEADER to EXTRA."
   "Set the extra headers in HEADER to EXTRA."

-  `(aset ,header 9 ',extra))
+  (aset header 9 extra))

 
 (defsubst make-mail-header (&optional init)
   "Create a new mail header structure initialized with INIT."
 
 (defsubst make-mail-header (&optional init)
   "Create a new mail header structure initialized with INIT."


@@ -204,12 +226,16 @@ on your system, you could say something like:
 
 (defvar nnheader-fake-message-id 1)
 
 
 (defvar nnheader-fake-message-id 1)
 

-(defsubst nnheader-generate-fake-message-id ()
-  (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
+(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 <.*>
 
 (defsubst nnheader-fake-message-id-p (id)
   (save-match-data                    ; regular message-id's are <.*>

-    (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
+    (string-match "\\`fake\\+none\\+.*\\+[0-9]+\\'" id)))

 
 ;; Parsing headers and NOV lines.
 
 
 ;; Parsing headers and NOV lines.
 


@@ -220,7 +246,7 @@ on your system, you could say something like:
 
 (defsubst nnheader-header-value ()
   (skip-chars-forward " \t")
 
 (defsubst nnheader-header-value ()
   (skip-chars-forward " \t")

-  (buffer-substring (point) (gnus-point-at-eol)))
+  (buffer-substring (point) (point-at-eol)))

 
 (defun nnheader-parse-naked-head (&optional number)
   ;; This function unfolds continuation lines in this buffer
 
 (defun nnheader-parse-naked-head (&optional number)
   ;; This function unfolds continuation lines in this buffer


@@ -266,12 +292,12 @@ on your system, you could say something like:
           (goto-char p)
           (if (search-forward "\nmessage-id:" nil t)
               (buffer-substring
           (goto-char p)
           (if (search-forward "\nmessage-id:" nil t)
               (buffer-substring

-               (1- (or (search-forward "<" (gnus-point-at-eol) t)
+               (1- (or (search-forward "<" (point-at-eol) t)

                        (point)))
                        (point)))

-               (or (search-forward ">" (gnus-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.
             ;; If there was no message-id, we just fake one to make
             ;; subsequent routines simpler.

-            (nnheader-generate-fake-message-id)))
+            (nnheader-generate-fake-message-id number)))

         ;; References.
         (progn
           (goto-char p)
         ;; References.
         (progn
           (goto-char p)


@@ -369,20 +395,28 @@ on your system, you could say something like:
               out)))
      out))
 
               out)))
      out))
 

-(defmacro nnheader-nov-read-message-id ()
-  '(let ((id (nnheader-nov-field)))
+(defvar nnheader-uniquify-message-id nil)
+
+(defmacro nnheader-nov-read-message-id (&optional number)
+  `(let ((id (nnheader-nov-field)))

      (if (string-match "^<[^>]+>$" id)
      (if (string-match "^<[^>]+>$" id)

-        id
-       (nnheader-generate-fake-message-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 ()
 
 (defun nnheader-parse-nov ()

-  (let ((eol (gnus-point-at-eol)))
+  (let ((eol (point-at-eol))
+       (number (nnheader-nov-read-integer)))

     (vector
     (vector

-     (nnheader-nov-read-integer)       ; number
+     number                            ; number

      (nnheader-nov-field)              ; subject
      (nnheader-nov-field)              ; from
      (nnheader-nov-field)              ; date
      (nnheader-nov-field)              ; subject
      (nnheader-nov-field)              ; from
      (nnheader-nov-field)              ; date

-     (nnheader-nov-read-message-id)    ; id
+     (nnheader-nov-read-message-id number) ; id

      (nnheader-nov-field)              ; refs
      (nnheader-nov-read-integer)       ; chars
      (nnheader-nov-read-integer)       ; lines
      (nnheader-nov-field)              ; refs
      (nnheader-nov-read-integer)       ; chars
      (nnheader-nov-read-integer)       ; lines


@@ -485,7 +519,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))


@@ -493,8 +527,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)


@@ -596,7 +629,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 (point-at-bol))

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


@@ -630,6 +663,14 @@ the line could be found."
      (point-max)))
   (goto-char (point-min)))
 
      (point-max)))
   (goto-char (point-min)))
 

+(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))
 (defun nnheader-remove-body ()
   "Remove the body from an article in this current buffer."
   (goto-char (point-min))


@@ -658,19 +699,18 @@ 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."
   (if (string= nnheader-numerical-short-files "^[0-9]+$")
 
 (defsubst nnheader-file-to-number (file)
   "Take a FILE name and return the article number."
   (if (string= nnheader-numerical-short-files "^[0-9]+$")

-      (string-to-int file)
+      (string-to-number file)

     (string-match nnheader-numerical-short-files 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)
 
 (defvar nnheader-directory-files-is-safe
   (or (eq system-type 'windows-nt)

-      (and (not (featurep 'xemacs))
-          (> emacs-major-version 20)))
+      (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,
   "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,


@@ -723,7 +763,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.


@@ -809,7 +850,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."


@@ -824,10 +865,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.


@@ -843,11 +884,6 @@ without formatting."
         ((numberp file) (int-to-string file))
         (t 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 &rest files)
   "Concat DIR as directory to FILES."
   (apply 'concat (file-name-as-directory dir) files))
 (defun nnheader-concat (dir &rest files)
   "Concat DIR as directory to FILES."
   (apply 'concat (file-name-as-directory dir) files))


@@ -861,11 +897,15 @@ without formatting."
   "Return the file size of FILE or 0."
   (or (nth 7 (file-attributes file)) 0))
 
   "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.
-If FILE, find the \".../etc/PACKAGE\" file instead."
+(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)
   (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
     ;; We try to find the dir by looking at the load path,
     ;; stripping away the last component and adding "etc/".
     (while path


@@ -877,10 +917,14 @@ If FILE, find the \".../etc/PACKAGE\" file instead."
                           "etc/" package
                           (if file "" "/"))))
               (or file (file-directory-p dir)))
                           "etc/" package
                           (if file "" "/"))))
               (or file (file-directory-p dir)))

-         (setq result dir
-               path nil)
+         (progn
+           (or (member dir results)
+               (push dir results))
+           (setq path (if first nil (cdr path))))

        (setq path (cdr path))))
        (setq path (cdr path))))

-    result))
+    (if (or first (not (cdr results)))
+       (car results)
+      (car (sort results 'file-newer-than-file-p)))))

 
 (eval-when-compile
   (defvar ange-ftp-path-format)
 
 (eval-when-compile
   (defvar ange-ftp-path-format)


@@ -927,15 +971,23 @@ find-file-hooks, etc.
             (nnheader-insert-file-contents file)))))))
 
 (defun nnheader-find-file-noselect (&rest args)
             (nnheader-insert-file-contents file)))))))
 
 (defun nnheader-find-file-noselect (&rest args)

-  (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)
-       (find-file-hooks nil)
-       (coding-system-for-read nnheader-file-coding-system))
-    (apply 'find-file-noselect 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)
+        (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."
 
 (defun nnheader-directory-regular-files (dir)
   "Return a list of all regular files in DIR."


@@ -989,11 +1041,18 @@ find-file-hooks, etc.
   "Strip all \r's from the current buffer."
   (nnheader-skeleton-replace "\r"))
 
   "Strip all \r's from the current buffer."
   (nnheader-skeleton-replace "\r"))
 

-(defalias 'nnheader-run-at-time 'run-at-time)

 (defalias 'nnheader-cancel-timer 'cancel-timer)
 (defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
 (defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
 
 (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))
 
 (when (featurep 'xemacs)
   (require 'nnheaderxm))
 


@@ -1001,4 +1060,5 @@ find-file-hooks, etc.
 
 (provide 'nnheader)
 
 
 (provide 'nnheader)
 

+;;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202

 ;;; nnheader.el ends here
 ;;; nnheader.el ends here