Synch with Oort Gnus.

[elisp/gnus.git-] / lisp / nnheader.el

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 22c9cee..7290f6a 100644 (file)
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -79,7 +79,18 @@ 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-file-name-translation-alist nil
+(defvar nnheader-file-name-translation-alist
+  (let ((case-fold-search t))
+    (cond
+     ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+                   (symbol-name system-type))
+      (append (mapcar (lambda (c) (cons c ?_))
+                     '(?: ?* ?\" ?< ?> ??))
+             (if (string-match "windows-nt\\|cygwin"
+                               (symbol-name system-type))
+                 nil
+               '((?+ . ?-)))))
+     (t nil)))
   "*Alist that says how to translate characters in file names.
 For instance, if \":\" is invalid as a file character in file names
 on your system, you could say something like:
@@ -97,6 +108,18 @@ This variable is a substitute for `mm-text-coding-system'.")
   "Text coding system for write.
 This variable is a substitute for `mm-text-coding-system-for-write'.")
 
+(defvar nnheader-auto-save-coding-system
+  (cond
+   ((boundp 'MULE) '*internal*)
+   ((not (fboundp 'find-coding-system)) nil)
+   ((find-coding-system 'emacs-mule)
+    (if (memq system-type '(windows-nt ms-dos ms-windows))
+       'emacs-mule-dos 'emacs-mule))
+   ((find-coding-system 'escape-quoted) 'escape-quoted)
+   ((find-coding-system 'no-conversion) 'no-conversion)
+   (t nil))
+  "Coding system of auto save file.")
+
 (eval-and-compile
   (autoload 'nnmail-message-id "nnmail")
   (autoload 'mail-position-on-field "sendmail")
@@ -104,7 +127,7 @@ This variable is a substitute for `mm-text-coding-system-for-write'.")
   (autoload 'gnus-point-at-eol "gnus-util")
   (autoload 'gnus-buffer-live-p "gnus-util"))
 
-;; mm- stuff.
+;; mm-util stuff.
 (unless (featurep 'mm-util)
   ;; Should keep track of `mm-image-load-path' in mm-util.el.
   (defun nnheader-image-load-path (&optional package)
@@ -201,6 +224,18 @@ Equivalent to `progn' in XEmacs"
   (defalias 'mm-with-unibyte-current-buffer
     'nnheader-with-unibyte-current-buffer)
 
+  ;; Should keep track of `mm-with-unibyte' in mm-util.el.
+  (defmacro nnheader-with-unibyte (&rest forms)
+    "Eval the FORMS with the default value of `enable-multibyte-characters'
+nil, ."
+    `(let (default-enable-multibyte-characters)
+       ,@forms))
+  (put 'nnheader-with-unibyte 'lisp-indent-function 0)
+  (put 'nnheader-with-unibyte 'edebug-form-spec '(body))
+  (put 'mm-with-unibyte 'lisp-indent-function 0)
+  (put 'mm-with-unibyte 'edebug-form-spec '(body))
+  (defalias 'mm-with-unibyte 'nnheader-with-unibyte)
+
   ;; Should keep track of `mm-guess-mime-charset' in mm-util.el.
   (defun nnheader-guess-mime-charset ()
   "Guess the default MIME charset from the language environment."
@@ -226,7 +261,34 @@ Equivalent to `progn' in XEmacs"
         (charsets-to-mime-charset (list item))))
      (t
       'iso-8859-1))))
-  (defalias 'mm-guess-mime-charset 'nnheader-guess-mime-charset))
+  (defalias 'mm-guess-mime-charset 'nnheader-guess-mime-charset)
+
+  (defalias 'mm-char-int 'char-int)
+
+  ;; Should keep track of the same alias in mm-util.el.
+  (defalias 'mm-multibyte-p
+    (static-cond ((and (featurep 'xemacs) (featurep 'mule))
+                 (lambda nil t))
+                ((featurep 'xemacs)
+                 (lambda nil nil))
+                ((boundp 'MULE)
+                 (lambda nil mc-flag))
+                (t
+                 (lambda nil enable-multibyte-characters))))
+
+  ;; Should keep track of the same alias in mm-util.el.
+  (defalias 'mm-make-temp-file
+    (if (fboundp 'make-temp-file)
+       'make-temp-file
+      (lambda (prefix &optional dir-flag)
+       (let ((file (expand-file-name
+                    (make-temp-name prefix)
+                    (if (fboundp 'temp-directory)
+                        (temp-directory)
+                      temporary-file-directory))))
+         (if dir-flag
+             (make-directory file))
+         file)))))
 
 ;; mail-parse stuff.
 (unless (featurep 'mail-parse)
@@ -384,7 +446,7 @@ If no name can be extracted, FULL-NAME will be nil."
            (std11-extract-addresses-components string)))
 
   ;; Should keep track of `rfc2047-field-value' in rfc2047.el.
-  (defun-maybe std11-field-value (&optional dont-include-last-newline)
+  (defun std11-field-value (&optional dont-include-last-newline)
     "Return the value of the field at point.  If the optional argument is
 given, the return value will not contain the last newline."
     (let ((begin (point))
@@ -394,7 +456,7 @@ given, the return value will not contain the last newline."
       (unless (eobp)
        (while (and (memq (char-after) '(?\t ?\ ))
                    (zerop (forward-line -1))))
-       (when (looking-at ".+:[\t\n ]+")
+       (when (looking-at "[^\t\n ]+:[\t\n ]+")
          (goto-char (setq start (match-end 0)))
          (forward-line 1)
          (while (and (memq (char-after) '(?\t ?\ ))
@@ -407,6 +469,18 @@ given, the return value will not contain the last newline."
 
   (defalias 'mail-header-field-value 'std11-field-value))
 
+;; ietf-drums stuff.
+(unless (featurep 'ietf-drums)
+  ;; Should keep track of `ietf-drums-unfold-fws' in ietf-drums.el.
+  (defun nnheader-unfold-fws ()
+    "Unfold folding white space in the current buffer."
+    (goto-char (point-min))
+    (while (re-search-forward "[ \t]*\n[ \t]+" nil t)
+      (replace-match " " t t))
+    (goto-char (point-min)))
+
+  (defalias 'ietf-drums-unfold-fws 'nnheader-unfold-fws))
+
 ;;; Header access macros.
 
 ;; These macros may look very much like the ones in GNUS 4.1.  They