Synch with Gnus.
[elisp/gnus.git-] / lisp / nnheader.el
index f1bf79b..c2100c4 100644 (file)
@@ -1,7 +1,8 @@
 ;;; nnheader.el --- header access macros for Semi-gnus and its backends
 
-;; Copyright (C) 1987, 88, 89, 90, 93, 94, 95, 96, 97, 98, 99
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
+;;        1997, 1998, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -31,6 +32,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
 
 (require 'mail-utils)
 (require 'mime)
@@ -48,11 +50,21 @@ on your system, you could say something like:
 
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
 
+(defvar nnheader-text-coding-system
+  (if (memq system-type '(windows-nt ms-dos ms-windows))
+      'raw-text-dos
+    'raw-text)
+  "Text-safe coding system (For removing ^M).
+This variable is a substitute for `mm-text-coding-system'.")
+
+(defvar nnheader-text-coding-system-for-write nil
+  "Text coding system for write.
+This variable is a substitute for `mm-text-coding-system-for-write'.")
+
 (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"))
@@ -341,31 +353,36 @@ on your system, you could say something like:
 
 (defun nnheader-insert-nov (header)
   (princ (mail-header-number header) (current-buffer))
-  (insert
-   "\t"
-   (or (mime-entity-fetch-field header 'Subject) "(none)") "\t"
-   (or (mime-entity-fetch-field header 'From) "(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"))
+  (let ((p (point)))
+    (insert
+     "\t"
+     (or (mime-entity-fetch-field header 'Subject) "(none)") "\t"
+     (or (mime-entity-fetch-field header 'From) "(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
@@ -455,6 +472,7 @@ the line could be found."
     (let* ((file nil)
           (number (length articles))
           (count 0)
+          (file-name-coding-system 'binary)
           (pathname-coding-system 'binary)
           (case-fold-search t)
           (cur (current-buffer))
@@ -750,7 +768,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
     (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]+\\)\\("
@@ -767,7 +785,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
   "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)
@@ -785,7 +803,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
       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)))
@@ -812,7 +830,7 @@ If FULL, translate everything."
          ;; Do complete translation.
          (setq leaf (copy-sequence file)
                path ""
-               i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1))) 
+               i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1)))
                      2 0))
        ;; We translate -- but only the file name.  We leave the directory
        ;; alone.
@@ -859,17 +877,20 @@ without formatting."
       (apply 'insert format args))
     t))
 
-(defun nnheader-replace-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))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (when (= (aref string idx) from)
-       (aset string idx to))
-      (setq idx (1+ idx)))
-    string))
+(static-if (fboundp 'subst-char-in-string)
+    (defsubst nnheader-replace-chars-in-string (string from to)
+      (subst-char-in-string from to string))
+  (defun nnheader-replace-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))
+      ;; Replace all occurrences of FROM with TO.
+      (while (< idx len)
+       (when (= (aref string idx) from)
+         (aset string idx to))
+       (setq idx (1+ idx)))
+      string)))
 
 (defun nnheader-replace-duplicate-chars-in-string (string from to)
   "Replace characters in STRING from FROM to TO."
@@ -937,7 +958,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 ()
@@ -1064,20 +1085,20 @@ 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)
 
 (defun nnheader-Y-or-n-p (prompt)
   "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"."
@@ -1096,7 +1117,7 @@ find-file-hooks, etc.
       (message "%s(Y/n) Yes" prompt)
       t)))
 
-(when (string-match "XEmacs\\|Lucid" emacs-version)
+(when (string-match "XEmacs" emacs-version)
   (require 'nnheaderxm))
 
 (run-hooks 'nnheader-load-hook)