X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=b68ca94710ce8305649fdcdbf10f6cbd4fd3a83f;hb=3bf86bfe5121dbc4850ac9089c23e1b78e26e815;hp=24aa197489ef44b1e34d2f1d8a7f20a9703e2b0a;hpb=4e82d566924d807ea0927aa382f7f875e14f33be;p=gnus

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 24aa19748..b68ca9471 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1,5 +1,8 @@
 ;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc.
+
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
+;;        1997, 1998, 2000, 2001
+;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; 	Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -24,26 +27,30 @@
 
 ;;; 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:
 
 (eval-when-compile (require 'cl))
 
+;; 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)
+(eval-and-compile
+  (autoload 'gnus-sorted-intersection "gnus-range")
+  (autoload 'gnus-intersection "gnus-range")
+  (autoload 'gnus-sorted-complement "gnus-range"))
 
 (defvar nnheader-max-head-length 4096
-  "*Max length of the head of articles.")
+  "*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.")
@@ -56,16 +63,26 @@ on your system, you could say something like:
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
 
 (eval-and-compile
- (autoload 'nnmail-message-id "nnmail")
- (autoload 'mail-position-on-field "sendmail")
- (autoload 'message-remove-header "message")
- (autoload 'cancel-function-timers "timers")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-delete-line "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util"))
+  (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-delete-line "gnus-util" nil nil 'macro)
+  (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))
@@ -137,7 +154,7 @@ 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))
 
 (defmacro mail-header-extra (header)
@@ -148,13 +165,13 @@ on your system, you could say something like:
   "Set the extra headers in HEADER to EXTRA."
   `(aset ,header 9 ',extra))
 
-(defun make-mail-header (&optional init)
+(defsubst make-mail-header (&optional init)
   "Create a new mail header structure initialized with INIT."
   (make-vector 10 init))
 
-(defun make-full-mail-header (&optional number subject from date id
-					references chars lines xref
-					extra)
+(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))
 
@@ -166,13 +183,14 @@ on your system, you could say something like:
   (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
 
 (defsubst nnheader-fake-message-id-p (id)
-  (save-match-data			; regular message-id's are <.*>
+  (save-match-data		       ; regular message-id's are <.*>
     (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
 
 ;; Parsing headers and NOV lines.
 
 (defsubst nnheader-header-value ()
-  (buffer-substring (match-end 0) (gnus-point-at-eol)))
+  (skip-chars-forward " \t")
+  (buffer-substring (point) (gnus-point-at-eol)))
 
 (defun nnheader-parse-head (&optional naked)
   (let ((case-fold-search t)
@@ -209,17 +227,17 @@ on your system, you could say something like:
 	   ;; Subject.
 	   (progn
 	     (goto-char p)
-	     (if (search-forward "\nsubject: " nil t)
+	     (if (search-forward "\nsubject:" nil t)
 		 (nnheader-header-value) "(none)"))
 	   ;; From.
 	   (progn
 	     (goto-char p)
-	     (if (search-forward "\nfrom: " nil t)
+	     (if (search-forward "\nfrom:" nil t)
 		 (nnheader-header-value) "(nobody)"))
 	   ;; Date.
 	   (progn
 	     (goto-char p)
-	     (if (search-forward "\ndate: " nil t)
+	     (if (search-forward "\ndate:" nil t)
 		 (nnheader-header-value) ""))
 	   ;; Message-ID.
 	   (progn
@@ -235,23 +253,24 @@ on your system, you could say something like:
 	   ;; References.
 	   (progn
 	     (goto-char p)
-	     (if (search-forward "\nreferences: " nil t)
+	     (if (search-forward "\nreferences:" nil t)
 		 (nnheader-header-value)
-	       ;; Get the references from the in-reply-to header if there
+	    ;; 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)
+	       (if (and (search-forward "\nin-reply-to:" nil t)
 			(setq in-reply-to (nnheader-header-value))
-			(string-match "<[^>]+>" in-reply-to))
+			(string-match "<[^\n>]+>" in-reply-to))
 		   (let (ref2)
 		     (setq ref (substring in-reply-to (match-beginning 0)
 					  (match-end 0)))
-		     (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+		     (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)
+		     ref)
 		 nil)))
 	   ;; Chars.
 	   0
@@ -265,7 +284,7 @@ on your system, you could say something like:
 	   ;; Xref.
 	   (progn
 	     (goto-char p)
-	     (and (search-forward "\nxref: " nil t)
+	     (and (search-forward "\nxref:" nil t)
 		  (nnheader-header-value)))
 
 	   ;; Extra.
@@ -275,7 +294,7 @@ on your system, you could say something like:
 	       (while extra
 		 (goto-char p)
 		 (when (search-forward
-			(concat "\n" (symbol-name (car extra)) ": ") nil t)
+			(concat "\n" (symbol-name (car extra)) ":") nil t)
 		   (push (cons (car extra) (nnheader-header-value))
 			 out))
 		 (pop extra))
@@ -294,7 +313,9 @@ on your system, you could say something like:
   '(prog1
        (if (eq (char-after) ?\t)
 	   0
-	 (let ((num (ignore-errors (read (current-buffer)))))
+	 (let ((num (condition-case nil
+			(read (current-buffer))
+		      (error nil))))
 	   (if (numberp num) num 0)))
      (or (eobp) (forward-char 1))))
 
@@ -327,36 +348,54 @@ on your system, you could say something like:
      (nnheader-nov-read-integer)	; lines
      (if (eq (char-after) ?\n)
 	 nil
-       (nnheader-nov-field))		; misc
+       (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))
+  (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-insert-header (header)
   (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")
+   "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)))
-  (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"))
+  (insert "\n\n"))
 
 (defun nnheader-insert-article-line (article)
   (goto-char (point-min))
@@ -443,8 +482,8 @@ the line could be found."
   (save-excursion
     (unless (gnus-buffer-live-p nntp-server-buffer)
       (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
-    (mm-enable-multibyte)
     (set-buffer nntp-server-buffer)
+    (mm-enable-multibyte)
     (erase-buffer)
     (kill-all-local-variables)
     (setq case-fold-search t)		;Should ignore case.
@@ -544,7 +583,7 @@ the line could be found."
     (erase-buffer))
   (current-buffer))
 
-(defvar jka-compr-compression-info-list)
+(eval-when-compile (defvar jka-compr-compression-info-list))
 (defvar nnheader-numerical-files
   (if (boundp 'jka-compr-compression-info-list)
       (concat "\\([0-9]+\\)\\("
@@ -561,17 +600,23 @@ the line could be found."
   "Regexp that matches numerical full file paths.")
 
 (defsubst nnheader-file-to-number (file)
-  "Take a file name and return the article number."
+  "Take a FILE name and return the article number."
   (if (string= nnheader-numerical-short-files "^[0-9]+$")
       (string-to-int file)
     (string-match nnheader-numerical-short-files file)
     (string-to-int (match-string 0 file))))
 
+(defvar nnheader-directory-files-is-safe
+  (or (eq system-type 'windows-nt)
+      (and (not (featurep 'xemacs))
+	   (> emacs-major-version 20)))
+  "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))
@@ -579,16 +624,22 @@ the line could be found."
       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."
@@ -605,14 +656,31 @@ If FULL, translate everything."
       (if full
 	  ;; Do complete translation.
 	  (setq leaf (copy-sequence file)
-		path "")
-	;; We translate -- but only the file name.  We leave the directory
+		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 (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.
+	(if (and (featurep 'xemacs)
+		 (memq system-type '(cygwin32 win32 w32 mswindows windows-nt)))
+	    ;; 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))
@@ -636,7 +704,7 @@ The first string in ARGS can be a format string."
   "Get the most recent report from BACKEND."
   (condition-case ()
       (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
-						  backend))))
+							     backend))))
     (error (nnheader-message 5 ""))))
 
 (defun nnheader-insert (format &rest args)
@@ -651,15 +719,21 @@ without formatting."
       (apply 'insert format args))
     t))
 
-(defun nnheader-replace-chars-in-string (string from to)
+(defsubst nnheader-replace-chars-in-string (string from to)
+  (mm-subst-char-in-string from to string))
+
+(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)
-      (when (= (aref string idx) from)
+      (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))
 
@@ -688,7 +762,7 @@ without formatting."
   (or (not (numberp gnus-verbose-backends))
       (<= level gnus-verbose-backends)))
 
-(defvar nnheader-pathname-coding-system 'binary
+(defvar nnheader-pathname-coding-system 'iso-8859-1
   "*Coding system for pathname.")
 
 (defun nnheader-group-pathname (group dir &optional file)
@@ -696,14 +770,14 @@ without formatting."
   (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
-	       (mm-encode-coding-string
-		(nnheader-replace-chars-in-string group ?. ?/)
-		nnheader-pathname-coding-system)
-	       "/")))
+     (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))))
@@ -714,7 +788,7 @@ without formatting."
       (and (listp form) (eq (car form) 'lambda))))
 
 (defun nnheader-concat (dir &rest files)
-  "Concat DIR as directory to FILE."
+  "Concat DIR as directory to FILES."
   (apply 'concat (file-name-as-directory dir) files))
 
 (defun nnheader-ms-strip-cr ()
@@ -749,8 +823,9 @@ If FILE, find the \".../etc/PACKAGE\" file instead."
 	(setq path (cdr path))))
     result))
 
-(defvar ange-ftp-path-format)
-(defvar efs-path-regexp)
+(eval-when-compile
+  (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))
@@ -760,7 +835,7 @@ If FILE, find the \".../etc/PACKAGE\" file instead."
       (when (string-match (car ange-ftp-path-format) path)
 	(ange-ftp-re-read-dir path)))))
 
-(defvar nnheader-file-coding-system 'binary
+(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)
@@ -769,35 +844,20 @@ 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 ((format-alist nil)
-	(auto-mode-alist (nnheader-auto-mode-alist))
-	(default-major-mode 'fundamental-mode)
-	(enable-local-variables nil)
-        (after-insert-file-functions nil)
-	(find-file-hooks nil)
-	(coding-system-for-read nnheader-file-coding-system))
-    (insert-file-contents filename visit beg end replace)))
+  (let ((coding-system-for-read nnheader-file-coding-system))
+    (mm-insert-file-contents filename visit beg end replace)))
 
 (defun nnheader-find-file-noselect (&rest args)
   (let ((format-alist nil)
-	(auto-mode-alist (nnheader-auto-mode-alist))
+	(auto-mode-alist (mm-auto-mode-alist))
 	(default-major-mode 'fundamental-mode)
 	(enable-local-variables nil)
-        (after-insert-file-functions 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)))
 
-(defun nnheader-auto-mode-alist ()
-  "Return an `auto-mode-alist' with only the .gz (etc) thingies."
-  (let ((alist auto-mode-alist)
-	out)
-    (while alist
-      (when (listp (cdar alist))
-	(push (car alist) out))
-      (pop alist))
-    (nreverse out)))
-
 (defun nnheader-directory-regular-files (dir)
   "Return a list of all regular files in DIR."
   (let ((files (directory-files dir t))
@@ -839,22 +899,23 @@ find-file-hooks, etc.
      (set-buffer cur)))
 
 (defun nnheader-replace-string (from to)
-  "Do a fast replacement of FROM to TO from point to point-max."
+  "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."
+  "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"))
 
-(fset 'nnheader-run-at-time 'run-at-time)
-(fset 'nnheader-cancel-timer 'cancel-timer)
-(fset 'nnheader-cancel-function-timers 'cancel-function-timers)
+(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)
 
-(when (string-match "XEmacs\\|Lucid" emacs-version)
+(when (featurep 'xemacs)
   (require 'nnheaderxm))
 
 (run-hooks 'nnheader-load-hook)