Fix translations.

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

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 8a2aead..8888fc3 100644 (file)
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1,8 +1,8 @@
 ;;; nnheader.el --- header access macros for Semi-gnus and its backends
 
 ;;; nnheader.el --- header access macros for Semi-gnus and its backends
 

-;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
-;;        1997, 1998, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994,
+;;   1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
+;;   2004, 2005 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>

@@ -24,8 +24,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:
 

@@ -34,6 +34,8 @@
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
 

+(defvar nnmail-extra-headers)
+

 ;; Requiring `gnus-util' at compile time creates a circular
 ;; dependency between nnheader.el and gnus-util.el.
 ;;(eval-when-compile (require 'gnus-util))
 ;; Requiring `gnus-util' at compile time creates a circular
 ;; dependency between nnheader.el and gnus-util.el.
 ;;(eval-when-compile (require 'gnus-util))

@@ -67,7 +69,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

@@ -83,7 +85,15 @@ Integer values will in effect be rounded up to the nearest multiple of
 (defvar nnheader-read-timeout
   (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
                    (symbol-name system-type))
 (defvar nnheader-read-timeout
   (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
                    (symbol-name system-type))

-      1.0                              ; why?
+      ;; 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.")
     0.1)
   "How long nntp should wait between checking for the end of output.
 Shorter values mean quicker response, but are more CPU intensive.")

@@ -139,6 +149,8 @@ This variable is a substitute for `mm-text-coding-system-for-write'.")
   (autoload 'gnus-buffer-live-p "gnus-util"))
 
 ;; mm-util stuff.
   (autoload 'gnus-buffer-live-p "gnus-util"))
 
 ;; mm-util stuff.

+(defvar mm-emacs-mule t "True in Emacs with Mule.")
+

 (unless (featurep 'mm-util)
   ;; Should keep track of `mm-image-load-path' in mm-util.el.
   (defun nnheader-image-load-path (&optional package)
 (unless (featurep 'mm-util)
   ;; Should keep track of `mm-image-load-path' in mm-util.el.
   (defun nnheader-image-load-path (&optional package)

@@ -162,6 +174,9 @@ This variable is a substitute for `mm-text-coding-system-for-write'.")
       'ignore))
   (defalias 'mm-encode-coding-string 'encode-coding-string)
   (defalias 'mm-decode-coding-string 'decode-coding-string)
       'ignore))
   (defalias 'mm-encode-coding-string 'encode-coding-string)
   (defalias 'mm-decode-coding-string 'decode-coding-string)

+  (defalias 'mm-encode-coding-region 'encode-coding-region)
+  (defalias 'mm-decode-coding-region 'decode-coding-region)
+  (defalias 'mm-set-buffer-file-coding-system 'set-buffer-file-coding-system)

 
   ;; Should keep track of `mm-detect-coding-region' in mm-util.el.
   (defun nnheader-detect-coding-region (start end)
 
   ;; Should keep track of `mm-detect-coding-region' in mm-util.el.
   (defun nnheader-detect-coding-region (start end)

@@ -181,16 +196,28 @@ This variable is a substitute for `mm-text-coding-system-for-write'.")
 
   ;; Should keep track of `mm-with-unibyte-buffer' in mm-util.el.
   (defmacro nnheader-with-unibyte-buffer (&rest forms)
 
   ;; Should keep track of `mm-with-unibyte-buffer' in mm-util.el.
   (defmacro nnheader-with-unibyte-buffer (&rest forms)

-  "Create a temporary buffer, and evaluate FORMS there like `progn'.
+    "Create a temporary buffer, and evaluate FORMS there like `progn'.

 Use unibyte mode for this."
 Use unibyte mode for this."

-  `(let (default-enable-multibyte-characters)
-     (with-temp-buffer ,@forms)))
+    `(let (default-enable-multibyte-characters)
+       (with-temp-buffer ,@forms)))

   (put 'nnheader-with-unibyte-buffer 'lisp-indent-function 0)
   (put 'nnheader-with-unibyte-buffer 'edebug-form-spec '(body))
   (put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
   (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
   (defalias 'mm-with-unibyte-buffer 'nnheader-with-unibyte-buffer)
 
   (put 'nnheader-with-unibyte-buffer 'lisp-indent-function 0)
   (put 'nnheader-with-unibyte-buffer 'edebug-form-spec '(body))
   (put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
   (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
   (defalias 'mm-with-unibyte-buffer 'nnheader-with-unibyte-buffer)
 

+  ;; Should keep track of `mm-with-multibyte-buffer' in mm-util.el.
+  (defmacro nnheader-with-multibyte-buffer (&rest forms)
+    "Create a temporary buffer, and evaluate FORMS there like `progn'.
+Use multibyte mode for this."
+    `(let ((default-enable-multibyte-characters t))
+       (with-temp-buffer ,@forms)))
+  (put 'nnheader-with-multibyte-buffer 'lisp-indent-function 0)
+  (put 'nnheader-with-multibyte-buffer 'edebug-form-spec '(body))
+  (put 'mm-with-multibyte-buffer 'lisp-indent-function 0)
+  (put 'mm-with-multibyte-buffer 'edebug-form-spec '(body))
+  (defalias 'mm-with-multibyte-buffer 'nnheader-with-multibyte-buffer)
+

   ;; Should keep track of `mm-with-unibyte-current-buffer' in mm-util.el.
   (defmacro nnheader-with-unibyte-current-buffer (&rest forms)
     "Evaluate FORMS with current current buffer temporarily made unibyte.
   ;; Should keep track of `mm-with-unibyte-current-buffer' in mm-util.el.
   (defmacro nnheader-with-unibyte-current-buffer (&rest forms)
     "Evaluate FORMS with current current buffer temporarily made unibyte.

@@ -231,29 +258,29 @@ nil, ."
 
   ;; Should keep track of `mm-guess-mime-charset' in mm-util.el.
   (defun nnheader-guess-mime-charset ()
 
   ;; 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."
-  (let ((language-info
-        (and (boundp 'current-language-environment)
-             (assoc current-language-environment
-                    language-info-alist)))
-       item)
-    (cond
-     ((null language-info)
-      'iso-8859-1)
-     ((setq item
-           (cadr
-            (or (assq 'coding-priority language-info)
-                (assq 'coding-system language-info))))
-      (if (fboundp 'coding-system-get)
-         (or (coding-system-get item 'mime-charset)
-             item)
-       item))
-     ((setq item (car (last (assq 'charset language-info))))
-      (if (eq item 'ascii)
-         'iso-8859-1
-        (charsets-to-mime-charset (list item))))
-     (t
-      'iso-8859-1))))
+    "Guess the default MIME charset from the language environment."
+    (let ((language-info
+          (and (boundp 'current-language-environment)
+               (assoc current-language-environment
+                      language-info-alist)))
+         item)
+      (cond
+       ((null language-info)
+       'iso-8859-1)
+       ((setq item
+             (cadr
+              (or (assq 'coding-priority language-info)
+                  (assq 'coding-system language-info))))
+       (if (fboundp 'coding-system-get)
+           (or (coding-system-get item 'mime-charset)
+               item)
+         item))
+       ((setq item (car (last (assq 'charset language-info))))
+       (if (eq item 'ascii)
+           'iso-8859-1
+         (charsets-to-mime-charset (list item))))
+       (t
+       'iso-8859-1))))

   (defalias 'mm-guess-mime-charset 'nnheader-guess-mime-charset)
 
   (defalias 'mm-char-int 'char-int)
   (defalias 'mm-guess-mime-charset 'nnheader-guess-mime-charset)
 
   (defalias 'mm-char-int 'char-int)

@@ -303,7 +330,13 @@ nil, ."
   (defalias 'mm-string-make-unibyte
     (if (fboundp 'string-make-unibyte)
        'string-make-unibyte
   (defalias 'mm-string-make-unibyte
     (if (fboundp 'string-make-unibyte)
        'string-make-unibyte

-      'identity)))
+      'identity))
+
+  (defalias 'mm-char-or-char-int-p
+    (cond
+     ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
+     ((fboundp 'char-valid-p) 'char-valid-p)
+     (t 'identity))))

 
 ;; mail-parse stuff.
 (unless (featurep 'mail-parse)
 
 ;; mail-parse stuff.
 (unless (featurep 'mail-parse)

@@ -561,7 +594,10 @@ given, the return value will not contain the last newline."
   (mime-find-field-decoder 'From 'nov))
 
 (defalias 'mail-header-extra 'mime-gnus-entity-extra-internal)
   (mime-find-field-decoder 'From 'nov))
 
 (defalias 'mail-header-extra 'mime-gnus-entity-extra-internal)

-(defalias 'mail-header-set-extra 'mime-gnus-entity-set-extra-internal)
+
+(defun mail-header-set-extra (header extra)
+  "Set the extra headers in HEADER to EXTRA."
+  (mime-gnus-entity-set-extra-internal header extra))

 
 (defun nnheader-decode-field-body (field-body field-name
                                              &optional mode max-column)
 
 (defun nnheader-decode-field-body (field-body field-name
                                              &optional mode max-column)

@@ -788,15 +824,22 @@ given, the return value will not contain the last newline."
               out)))
      out))
 
               out)))
      out))
 

+(defvar nnheader-uniquify-message-id nil)
+

 (defmacro nnheader-nov-read-message-id (&optional number)
   `(let ((id (nnheader-nov-field)))
      (if (string-match "^<[^>]+>$" id)
 (defmacro nnheader-nov-read-message-id (&optional number)
   `(let ((id (nnheader-nov-field)))
      (if (string-match "^<[^>]+>$" id)

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

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

     (make-full-mail-header
      number                            ; number
      (nnheader-nov-field)              ; subject
     (make-full-mail-header
      number                            ; number
      (nnheader-nov-field)              ; subject

@@ -1274,9 +1317,9 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
 (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)

@@ -1529,15 +1572,21 @@ 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."
 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)
-       (enable-local-eval nil)
-       (find-file-hooks nil))
-    (insert-file-contents-as-coding-system
-     nnheader-file-coding-system filename visit beg end replace)))
+  (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)
+        (enable-local-eval nil)
+        (ffh (if (boundp 'find-file-hook)
+                 'find-file-hook
+               'find-file-hooks))
+        (val (symbol-value ffh)))
+    (set ffh nil)
+    (unwind-protect
+       (insert-file-contents-as-coding-system
+        nnheader-file-coding-system filename visit beg end replace)
+      (set ffh val))))

 
 (defun nnheader-insert-nov-file (file first)
   (let ((size (nth 7 (file-attributes file)))
 
 (defun nnheader-insert-nov-file (file first)
   (let ((size (nth 7 (file-attributes file)))

@@ -1560,15 +1609,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 (nnheader-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))
-    (apply 'find-file-noselect-as-coding-system
-          nnheader-file-coding-system args)))
+  "Open a file with some variables bound.
+See `find-file-noselect' for the arguments."
+  (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)
+        (enable-local-eval nil)
+        (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-as-coding-system
+              nnheader-file-coding-system args)
+      (set ffh val))))

 
 (defun nnheader-auto-mode-alist ()
   "Return an `auto-mode-alist' with only the .gz (etc) thingies."
 
 (defun nnheader-auto-mode-alist ()
   "Return an `auto-mode-alist' with only the .gz (etc) thingies."