Add 2008 to copyright years.

[bpt/emacs.git] / lisp / international / mule.el

diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index cea1a91..4a4ad89 100644 (file)
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1,8 +1,9 @@
 ;;; mule.el --- basic commands for mulitilingual environment
 
 ;;; mule.el --- basic commands for mulitilingual environment
 

-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008

 ;;   Free Software Foundation, Inc.
 ;;   Free Software Foundation, Inc.

-;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008

 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 


@@ -12,7 +13,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)

 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,


@@ -38,10 +39,10 @@ Distribution date of this version of MULE (multilingual environment).")
 (defun load-with-code-conversion (fullname file &optional noerror nomessage)
   "Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
 The file contents are decoded before evaluation if necessary.
 (defun load-with-code-conversion (fullname file &optional noerror nomessage)
   "Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
 The file contents are decoded before evaluation if necessary.

-If optional second arg NOERROR is non-nil,
+If optional third arg NOERROR is non-nil,

  report no error if FILE doesn't exist.
 Print messages at start and end of loading unless
  report no error if FILE doesn't exist.
 Print messages at start and end of loading unless

- optional third arg NOMESSAGE is non-nil.
+ optional fourth arg NOMESSAGE is non-nil.

 Return t if file exists."
   (if (null (file-readable-p fullname))
       (and (null noerror)
 Return t if file exists."
   (if (null (file-readable-p fullname))
       (and (null noerror)


@@ -71,8 +72,7 @@ Return t if file exists."
          (let ((load-file-name fullname)
                (set-auto-coding-for-load t)
                (inhibit-file-name-operation nil))
          (let ((load-file-name fullname)
                (set-auto-coding-for-load t)
                (inhibit-file-name-operation nil))

-           (save-excursion
-             (set-buffer buffer)
+           (with-current-buffer buffer

              ;; Don't let deactivate-mark remain set.
              (let (deactivate-mark)
                (insert-file-contents fullname))
              ;; Don't let deactivate-mark remain set.
              (let (deactivate-mark)
                (insert-file-contents fullname))


@@ -100,7 +100,7 @@ Return t if file exists."
          (kill-buffer buffer)))
       (unless purify-flag
        (do-after-load-evaluation fullname))
          (kill-buffer buffer)))
       (unless purify-flag
        (do-after-load-evaluation fullname))

-      
+

       (unless (or nomessage noninteractive)
        (if source
            (message "Loading %s (source)...done" file)
       (unless (or nomessage noninteractive)
        (if source
            (message "Loading %s (source)...done" file)


@@ -118,7 +118,7 @@ Return t if file exists."
              (< (aref vector 0) 160)))))
 
 (defsubst charsetp (object)
              (< (aref vector 0) 160)))))
 
 (defsubst charsetp (object)

-  "T if OBJECT is a charset."
+  "Return t if OBJECT is a charset."

   (and (symbolp object) (vectorp (get object 'charset))))
 
 (defsubst charset-info (charset)
   (and (symbolp object) (vectorp (get object 'charset))))
 
 (defsubst charset-info (charset)


@@ -268,7 +268,7 @@ See the function `charset-info' for more detail."
 CODE1 and CODE2 are optional, but if you don't supply
 sufficient position codes, return a generic character which stands for
 all characters or group of characters in the character set.
 CODE1 and CODE2 are optional, but if you don't supply
 sufficient position codes, return a generic character which stands for
 all characters or group of characters in the character set.

-A generic character can be used to index a char table (e.g. syntax-table).
+A generic character can be used to index a char table (e.g. `syntax-table').

 
 Such character sets as ascii, eight-bit-control, and eight-bit-graphic
 don't have corresponding generic characters.  If CHARSET is one of
 
 Such character sets as ascii, eight-bit-control, and eight-bit-graphic
 don't have corresponding generic characters.  If CHARSET is one of


@@ -392,6 +392,20 @@ code-point in CCS.  Currently not supported and just ignored."
                        char))))))))
 
 \f
                        char))))))))
 
 \f

+;; Save the ASCII case table in case we need it later.  Some locales
+;; (such as Turkish) modify the case behavior of ASCII characters,
+;; which can interfere with networking code that uses ASCII strings.
+
+(defvar ascii-case-table
+  ;; Code copied from copy-case-table to avoid requiring case-table.el
+  (let ((tbl (copy-sequence (standard-case-table)))
+       (up  (char-table-extra-slot (standard-case-table) 0)))
+    (if up (set-char-table-extra-slot tbl 0 (copy-sequence up)))
+    (set-char-table-extra-slot tbl 1 nil)
+    (set-char-table-extra-slot tbl 2 nil)
+    tbl)
+  "Case table for the ASCII character set.")
+\f

 ;; Coding system stuff
 
 ;; Coding system is a symbol that has the property `coding-system'.
 ;; Coding system stuff
 
 ;; Coding system is a symbol that has the property `coding-system'.


@@ -1565,11 +1579,14 @@ text, and convert it in the temporary buffer.  Otherwise, convert in-place."
 ;;; FILE I/O
 
 (defcustom auto-coding-alist
 ;;; FILE I/O
 
 (defcustom auto-coding-alist

-  '(("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . no-conversion)
-    ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion)
+  ;; .exe and .EXE are added to support archive-mode looking at DOS
+  ;; self-extracting exe archives.
+  '(("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|exe\\)\\'" . no-conversion)
+    ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|EXE\\)\\'" . no-conversion)

     ("\\.\\(sx[dmicw]\\|odt\\|tar\\|tgz\\)\\'" . no-conversion)
     ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
     ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion)
     ("\\.\\(sx[dmicw]\\|odt\\|tar\\|tgz\\)\\'" . no-conversion)
     ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
     ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion)

+    ("\\.pdf\\'" . no-conversion)

     ("/#[^/]+#\\'" . emacs-mule))
   "Alist of filename patterns vs corresponding coding systems.
 Each element looks like (REGEXP . CODING-SYSTEM).
     ("/#[^/]+#\\'" . emacs-mule))
   "Alist of filename patterns vs corresponding coding systems.
 Each element looks like (REGEXP . CODING-SYSTEM).


@@ -1676,8 +1693,7 @@ cons (CODING . SOURCE), where CODING is the specified coding
 system and SOURCE is a symbol `auto-coding-alist',
 `auto-coding-regexp-alist', `coding:', or `auto-coding-functions'
 indicating by what CODING is specified.  Note that the validity
 system and SOURCE is a symbol `auto-coding-alist',
 `auto-coding-regexp-alist', `coding:', or `auto-coding-functions'
 indicating by what CODING is specified.  Note that the validity

-of CODING is not checked; it's callers responsibility to check
-it.
+of CODING is not checked; it's the caller's responsibility to check it.

 
 If nothing is specified, the return value is nil."
   (or (let ((coding-system (auto-coding-alist-lookup filename)))
 
 If nothing is specified, the return value is nil."
   (or (let ((coding-system (auto-coding-alist-lookup filename)))


@@ -1698,7 +1714,7 @@ If nothing is specified, the return value is nil."
        ;; and for "unibyte:" at the head and tail of SIZE bytes.
        (setq head-found (or (search-forward "coding:" head-end t)
                             (search-forward "unibyte:" head-end t)
        ;; and for "unibyte:" at the head and tail of SIZE bytes.
        (setq head-found (or (search-forward "coding:" head-end t)
                             (search-forward "unibyte:" head-end t)

-                            (search-forward "enable-character-translation:" 
+                            (search-forward "enable-character-translation:"

                                             head-end t)))
        (if (and head-found (> head-found tail-start))
            ;; Head and tail are overlapped.
                                             head-end t)))
        (if (and head-found (> head-found tail-start))
            ;; Head and tail are overlapped.


@@ -1736,7 +1752,7 @@ If nothing is specified, the return value is nil."
        ;; is just "\r" and we can't use "^" nor "$" in regexp.
        (when (and tail-found (or (not coding-system) (not char-trans)))
          (goto-char tail-start)
        ;; is just "\r" and we can't use "^" nor "$" in regexp.
        (when (and tail-found (or (not coding-system) (not char-trans)))
          (goto-char tail-start)

-         (re-search-forward "[\r\n]\^L" nil t)
+         (re-search-forward "[\r\n]\^L" tail-end t)

          (if (re-search-forward
               "[\r\n]\\([^[\r\n]*\\)[ \t]*Local Variables:[ \t]*\\([^\r\n]*\\)[\r\n]"
               tail-end t)
          (if (re-search-forward
               "[\r\n]\\([^[\r\n]*\\)[ \t]*Local Variables:[ \t]*\\([^\r\n]*\\)[\r\n]"
               tail-end t)


@@ -1872,7 +1888,7 @@ The optional second arg VISIT non-nil means that we are visiting a file."
                      (set-buffer-multibyte nil))
                  (set-buffer-multibyte nil))
                (setq inserted (- pos-marker (point)))))
                      (set-buffer-multibyte nil))
                  (set-buffer-multibyte nil))
                (setq inserted (- pos-marker (point)))))

-         (set-buffer-modified-p modified-p))))
+         (restore-buffer-modified-p modified-p))))

   inserted)
 
 ;; The coding-spec and eol-type of coding-system returned is decided
   inserted)
 
 ;; The coding-spec and eol-type of coding-system returned is decided


@@ -2224,8 +2240,7 @@ Value is what BODY returns."
           (progn
             (set-category-table ,table)
             ,@body)
           (progn
             (set-category-table ,table)
             ,@body)

-        (save-current-buffer
-          (set-buffer ,old-buffer)
+        (with-current-buffer ,old-buffer

           (set-category-table ,old-table))))))
 
 (defun define-translation-hash-table (symbol table)
           (set-category-table ,old-table))))))
 
 (defun define-translation-hash-table (symbol table)


@@ -2287,20 +2302,26 @@ This function is intended to be added to `auto-coding-functions'."
 (defun sgml-html-meta-auto-coding-function (size)
   "If the buffer has an HTML meta tag, use it to determine encoding.
 This function is intended to be added to `auto-coding-functions'."
 (defun sgml-html-meta-auto-coding-function (size)
   "If the buffer has an HTML meta tag, use it to determine encoding.
 This function is intended to be added to `auto-coding-functions'."

-  (setq size (min (+ (point) size)
-                 (save-excursion
-                   ;; Limit the search by the end of the HTML header.
-                   (or (search-forward "</head>" size t)
-                       ;; In case of no header, search only 10 lines.
-                       (forward-line 10))
-                   (point))))
-  (when (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t)
-    (let* ((match (match-string 1))
-          (sym (intern (downcase match))))
-      (if (coding-system-p sym)
-         sym
-       (message "Warning: unknown coding system \"%s\"" match)
-       nil))))
+  (let ((case-fold-search t))
+    (setq size (min (+ (point) size)
+                   (save-excursion
+                     ;; Limit the search by the end of the HTML header.
+                     (or (search-forward "</head>" size t)
+                         ;; In case of no header, search only 10 lines.
+                         (forward-line 10))
+                     (point))))
+    ;; Make sure that the buffer really contains an HTML document, by
+    ;; checking that it starts with a doctype or a <HTML> start tag
+    ;; (allowing for whitespace at bob).  Note: 'DOCTYPE NETSCAPE' is
+    ;; useful for Mozilla bookmark files.
+    (when (and (re-search-forward "\\`[[:space:]\n]*\\(<!doctype[[:space:]\n]+\\(html\\|netscape\\)\\|<html\\)" size t)
+              (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t))
+      (let* ((match (match-string 1))
+            (sym (intern (downcase match))))
+       (if (coding-system-p sym)
+           sym
+         (message "Warning: unknown coding system \"%s\"" match)
+         nil)))))

 
 ;;;
 (provide 'mule)
 
 ;;;
 (provide 'mule)