*** empty log message ***
[gnus] / lisp / nnheader.el
index 8e0caed..ab49c59 100644 (file)
@@ -38,7 +38,6 @@
 ;;; Code:
 
 (require 'mail-utils)
-(require 'sendmail)
 (eval-when-compile (require 'cl))
 
 (defvar nnheader-max-head-length 4096
@@ -138,92 +137,104 @@ on your system, you could say something like:
 
 (defvar nnheader-newsgroup-none-id 1)
 
-(defun nnheader-parse-head ()
+(defun nnheader-parse-head (&optional naked)
   (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.
-    (when (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.
-       (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.
-       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)))))))
+    (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.
+          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)))))
 
 (defun nnheader-insert-nov (header)
   (princ (mail-header-number header) (current-buffer))
   (insert 
    "\t"
-   (or (mail-header-subject header) "") "\t"
-   (or (mail-header-from header) "") "\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) "") "\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")
@@ -286,7 +297,7 @@ 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.
-       (insert-file-contents-literally file)
+       (nnheader-insert-file-contents-literally file)
       ;; Read 1K blocks until we find a separator.
       (let ((beg 0)
            format-alist 
@@ -379,7 +390,7 @@ on your system, you could say something like:
 
 (put 'nnheader-temp-write 'lisp-indent-function 1)
 (put 'nnheader-temp-write 'lisp-indent-hook 1)
-(put 'nnheader-temp-write 'edebug-form-spec '(file &rest form))
+(put 'nnheader-temp-write 'edebug-form-spec '(form body))
 
 (defvar jka-compr-compression-info-list)
 (defvar nnheader-numerical-files
@@ -404,15 +415,28 @@ on your system, you could say something like:
     (string-match nnheader-numerical-short-files file)
     (string-to-int (match-string 0 file))))
 
+(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.
+  (let ((first (apply 'directory-files args))
+       (second (apply 'directory-files args)))
+    (if (> (length first) (length second))
+       first
+      second)))
+
 (defun nnheader-directory-articles (dir)
   "Return a list of all article files in a directory."
   (mapcar 'nnheader-file-to-number
-         (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))
-         (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."
@@ -426,16 +450,22 @@ on your system, you could say something like:
       file 
     ;; We translate -- but only the file name.  We leave the directory
     ;; alone.
-    (let* ((new (file-name-nondirectory file))
-          (len (length new))
-          (i 0)
-         trans)
+    (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)))
+      (setq len (length leaf))
       (while (< i len)
-       (when (setq trans (cdr (assq (aref new i)
+       (when (setq trans (cdr (assq (aref leaf i)
                                     nnheader-file-name-translation-alist)))
-         (aset new i trans))
+         (aset leaf i trans))
        (incf i))
-      (concat (file-name-directory file) new))))
+      (concat path leaf))))
 
 (defun nnheader-report (backend &rest args)
   "Report an error from the BACKEND.
@@ -468,7 +498,7 @@ without formatting."
             (file-regular-p file))
     (save-excursion
       (nnheader-set-temp-buffer " *mail-file-mbox-p*")
-      (insert-file-contents-literally file)
+      (nnheader-insert-file-contents-literally file)
       (goto-char (point-min))
       (prog1
          (looking-at message-unix-mail-delimiter)
@@ -529,11 +559,62 @@ without formatting."
   (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-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))))
+
+(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."
+  (let ((path load-path)
+       dir result)
+    ;; We try to find the dir by looking at the load path,
+    ;; stripping away the last component and adding "etc/".
+    (while path
+      (if (and (car path)
+              (file-exists-p
+               (setq dir (concat
+                          (file-name-directory
+                           (directory-file-name (car path)))
+                          "etc/" package "/")))
+              (file-directory-p dir))
+         (setq result dir
+               path nil)
+       (setq path (cdr path))))
+    result))
+
+(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))
+      (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-raw-file-contents 'insert-file-contents)
+(fset 'nnheader-insert-file-contents-literally
+      'insert-file-contents-literally)
 
-(provide 'nnheader)
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+  (require 'nnheaderxm))
 
 (run-hooks 'nnheader-load-hook)
 
+(provide 'nnheader)
+
 ;;; nnheader.el ends here