Add 2008 to copyright years.
[bpt/emacs.git] / lisp / international / mule.el
index 2c7160b..4a4ad89 100644 (file)
@@ -1,8 +1,11 @@
 ;;; mule.el --- basic commands for mulitilingual environment
 
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;;   Free Software Foundation, Inc.
+;; 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
 
 ;; Keywords: mule, multilingual, character set, coding system
 
@@ -10,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
-;; 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,
@@ -20,8 +23,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
-;; 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:
 
@@ -36,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.
-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
- 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)
@@ -69,9 +72,10 @@ Return t if file exists."
          (let ((load-file-name fullname)
                (set-auto-coding-for-load t)
                (inhibit-file-name-operation nil))
-           (save-excursion
-             (set-buffer buffer)
-             (insert-file-contents fullname)
+           (with-current-buffer buffer
+             ;; Don't let deactivate-mark remain set.
+             (let (deactivate-mark)
+               (insert-file-contents fullname))
              ;; If the loaded file was inserted with no-conversion or
              ;; raw-text coding system, make the buffer unibyte.
              ;; Otherwise, eval-buffer might try to interpret random
@@ -83,7 +87,9 @@ Return t if file exists."
              ;; Make `kill-buffer' quiet.
              (set-buffer-modified-p nil))
            ;; Have the original buffer current while we eval.
-           (eval-buffer buffer nil file
+           (eval-buffer buffer nil
+                        ;; This is compatible with what `load' does.
+                        (if purify-flag file fullname)
                         ;; If this Emacs is running with --unibyte,
                         ;; convert multibyte strings to unibyte
                         ;; after reading them.
@@ -92,9 +98,9 @@ Return t if file exists."
                         ))
        (let (kill-buffer-hook kill-buffer-query-functions)
          (kill-buffer buffer)))
-      (let ((hook (assoc file after-load-alist)))
-       (when hook
-         (mapcar (function eval) (cdr hook))))
+      (unless purify-flag
+       (do-after-load-evaluation fullname))
+
       (unless (or nomessage noninteractive)
        (if source
            (message "Loading %s (source)...done" file)
@@ -112,7 +118,7 @@ Return t if file exists."
              (< (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)
@@ -262,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.
-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
@@ -277,16 +283,14 @@ would need to index the corresponding Emacs charset."
   (make-char-internal (charset-id charset) code1 code2))
 
 (put 'make-char 'byte-compile
-     (function
-      (lambda (form)
-       (let ((charset (nth 1 form)))
-         (if (charset-quoted-standard-p charset)
-             (byte-compile-normal-call
-              (cons 'make-char-internal
-                    (cons (charset-id (nth 1 charset)) (nthcdr 2 form))))
-           (byte-compile-normal-call
-            (cons 'make-char-internal
-                  (cons (list 'charset-id charset) (nthcdr 2 form)))))))))
+     (lambda (form)
+       (let ((charset (nth 1 form)))
+         (byte-compile-normal-call
+          (cons 'make-char-internal
+                (cons (if (charset-quoted-standard-p charset)
+                          (charset-id (nth 1 charset))
+                        (list 'charset-id charset))
+                      (nthcdr 2 form)))))))
 
 (defun charset-list ()
   "Return list of charsets ever defined.
@@ -309,15 +313,16 @@ Return nil if such a character is not supported.
 Currently the only supported coded character set is `ucs' (ISO/IEC
 10646: Universal Multi-Octet Coded Character Set), and the result is
 translated through the translation-table named
-`utf-translation-table-for-decode' or the translation-hash-table named
-`utf-subst-table-for-decode'.
+`utf-translation-table-for-decode', or through the
+translation-hash-table named `utf-subst-table-for-decode'
+\(if `utf-translate-cjk-mode' is non-nil).
 
 Optional argument RESTRICTION specifies a way to map the pair of CCS
 and CODE-POINT to a character.  Currently not supported and just ignored."
   (cond
    ((eq ccs 'ucs)
-    (or (gethash code-point
-                (get 'utf-subst-table-for-decode 'translation-hash-table))
+    (or (and utf-translate-cjk-mode
+            (utf-lookup-subst-table-for-decode code-point))
        (let ((c (cond
                  ((< code-point 160)
                   code-point)
@@ -347,8 +352,9 @@ Return nil if CHAR is not included in CCS.
 Currently the only supported coded character set is `ucs' (ISO/IEC
 10646: Universal Multi-Octet Coded Character Set), and CHAR is first
 translated through the translation-table named
-`utf-translation-table-for-encode' or the translation-hash-table named
-`utf-subst-table-for-encode'.
+`utf-translation-table-for-encode', or through the
+translation-hash-table named `utf-subst-table-for-encode' \(if
+`utf-translate-cjk-mode' is non-nil).
 
 CHAR should be in one of these charsets:
   ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff,
@@ -361,8 +367,8 @@ code-point in CCS.  Currently not supported and just ignored."
         (charset (car split))
         trans)
     (cond ((eq ccs 'ucs)
-          (or (gethash char (get 'utf-subst-table-for-encode
-                                 'translation-hash-table))
+          (or (and utf-translate-cjk-mode
+                   (utf-lookup-subst-table-for-encode char))
               (let ((table (get 'utf-translation-table-for-encode
                                 'translation-table)))
                 (setq trans (aref table char))
@@ -386,6 +392,20 @@ code-point in CCS.  Currently not supported and just ignored."
                        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'.
@@ -488,9 +508,6 @@ A base coding system is what made by `make-coding-system'.
 Any alias nor subsidiary coding systems are not base coding system."
   (car (coding-system-get coding-system 'alias-coding-systems)))
 
-(defalias 'coding-system-parent 'coding-system-base)
-(make-obsolete 'coding-system-parent 'coding-system-base "20.3")
-
 ;; Coding system also has a property `eol-type'.
 ;;
 ;; This property indicates how the coding system handles end-of-line
@@ -537,6 +554,18 @@ coding system whose eol-type is N."
                 (and (not (> (downcase c1) (downcase c2)))
                      (< c1 c2)))))))
 
+(defun coding-system-equal (coding-system-1 coding-system-2)
+  "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
+Two coding systems are identical if two symbols are equal
+or one is an alias of the other."
+  (or (eq coding-system-1 coding-system-2)
+      (and (equal (coding-system-spec coding-system-1)
+                 (coding-system-spec coding-system-2))
+          (let ((eol-type-1 (coding-system-eol-type coding-system-1))
+                (eol-type-2 (coding-system-eol-type coding-system-2)))
+            (or (eq eol-type-1 eol-type-2)
+                (and (vectorp eol-type-1) (vectorp eol-type-2)))))))
+
 (defun add-to-coding-system-list (coding-system)
   "Add CODING-SYSTEM to `coding-system-list' while keeping it sorted."
   (if (or (null coding-system-list)
@@ -592,11 +621,9 @@ character code range.  Thus FUNC should iterate over [START, END]."
                 (make-char charset (+ i start) start)
                 (make-char charset (+ i start) (+ start chars -1)))))))
 
-(defun register-char-codings (coding-system safe-chars)
-  "This is an obsolete function.
-It exists just for backward compatibility, and it does nothing.")
+(defalias 'register-char-codings 'ignore "")
 (make-obsolete 'register-char-codings
-              "Unnecessary function.  Calling it has no effect."
+               "it exists just for backward compatibility, and does nothing."
               "21.3")
 
 (defconst char-coding-system-table nil
@@ -609,16 +636,16 @@ It exists just for backward compatibility, and the value is always nil.")
        (subsidiaries (vector (intern (format "%s-unix" coding-system))
                              (intern (format "%s-dos" coding-system))
                              (intern (format "%s-mac" coding-system))))
-       (i 0)
-       temp)
-    (while (< i 3)
-      (put (aref subsidiaries i) 'coding-system coding-spec)
-      (put (aref subsidiaries i) 'eol-type i)
-      (add-to-coding-system-list (aref subsidiaries i))
-      (setq coding-system-alist
-           (cons (list (symbol-name (aref subsidiaries i)))
-                 coding-system-alist))
-      (setq i (1+ i)))
+       elt)
+    (dotimes (i 3)
+      (setq elt (aref subsidiaries i))
+      (put elt 'coding-system coding-spec)
+      (put elt 'eol-type i)
+      (put elt 'coding-system-define-form nil)
+      (add-to-coding-system-list elt)
+      (or (assoc (symbol-name elt) coding-system-alist)
+         (setq coding-system-alist
+               (cons (list (symbol-name elt)) coding-system-alist))))
     subsidiaries))
 
 (defun transform-make-coding-system-args (name type &optional doc-string props)
@@ -832,6 +859,12 @@ following properties are recognized:
   If the value is non-nil, the coding system preserves composition
   information.
 
+  o ascii-incompatible
+
+  If the value is non-nil, the coding system is not compatible
+  with ASCII, which means it encodes or decodes ASCII character
+  string to the different byte sequence.
+
 These properties are set in PLIST, a property list.  This function
 also sets properties `coding-category' and `alias-coding-systems'
 automatically.
@@ -1033,6 +1066,7 @@ a value of `safe-charsets' in PLIST."
       (setq coding-category (plist-get plist 'coding-category))
       (aset coding-spec coding-spec-plist-idx plist))
     (put coding-system 'coding-system coding-spec)
+    (put coding-system 'coding-system-define-form nil)
     (put coding-category 'coding-systems
         (cons coding-system (get coding-category 'coding-systems))))
 
@@ -1064,8 +1098,9 @@ a value of `safe-charsets' in PLIST."
   ;; At last, register CODING-SYSTEM in `coding-system-list' and
   ;; `coding-system-alist'.
   (add-to-coding-system-list coding-system)
-  (setq coding-system-alist (cons (list (symbol-name coding-system))
-                                 coding-system-alist))
+  (or (assoc (symbol-name coding-system) coding-system-alist)
+      (setq coding-system-alist (cons (list (symbol-name coding-system))
+                                     coding-system-alist)))
 
   ;; For a coding system of cateogory iso-8-1 and iso-8-2, create
   ;; XXX-with-esc variants.
@@ -1094,9 +1129,11 @@ a value of `safe-charsets' in PLIST."
 (defun define-coding-system-alias (alias coding-system)
   "Define ALIAS as an alias for coding system CODING-SYSTEM."
   (put alias 'coding-system (coding-system-spec coding-system))
+  (put alias 'coding-system-define-form nil)
   (add-to-coding-system-list alias)
-  (setq coding-system-alist (cons (list (symbol-name alias))
-                                 coding-system-alist))
+  (or (assoc (symbol-name alias) coding-system-alist)
+      (setq coding-system-alist (cons (list (symbol-name alias))
+                                     coding-system-alist)))
   (let ((eol-type (coding-system-eol-type coding-system)))
     (if (vectorp eol-type)
        (progn
@@ -1125,9 +1162,13 @@ Return the resulting coding system."
 FROM is a form to evaluate to define the coding-system."
   (put symbol 'coding-system-define-form form)
   (setq coding-system-alist (cons (list (symbol-name symbol))
-                                 coding-system-alist)))
+                                 coding-system-alist))
+  (dolist (elt '("-unix" "-dos" "-mac"))
+    (let ((name (concat (symbol-name symbol) elt)))
+      (put (intern name) 'coding-system-define-form form)
+      (setq coding-system-alist (cons (list name) coding-system-alist)))))
 
-(defun set-buffer-file-coding-system (coding-system &optional force)
+(defun set-buffer-file-coding-system (coding-system &optional force nomodify)
   "Set the file coding-system of the current buffer to CODING-SYSTEM.
 This means that when you save the buffer, it will be converted
 according to CODING-SYSTEM.  For a list of possible values of CODING-SYSTEM,
@@ -1141,9 +1182,10 @@ specified there).  Otherwise, leave it unspecified.
 
 This marks the buffer modified so that the succeeding \\[save-buffer]
 surely saves the buffer with CODING-SYSTEM.  From a program, if you
-don't want to mark the buffer modified, just set the variable
-`buffer-file-coding-system' directly."
-  (interactive "zCoding system for saving file (default, nil): \nP")
+don't want to mark the buffer modified, specify t for NOMODIFY.
+If you know exactly what coding system you want to use,
+just set the variable `buffer-file-coding-system' directly."
+  (interactive "zCoding system for saving file (default nil): \nP")
   (check-coding-system coding-system)
   (if (and coding-system buffer-file-coding-system (null force))
       (setq coding-system
@@ -1153,7 +1195,8 @@ don't want to mark the buffer modified, just set the variable
   ;; `set-buffer-major-mode-hook' take care of setting the table.
   (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
       (ucs-set-table-for-input))
-  (set-buffer-modified-p t)
+  (unless nomodify
+    (set-buffer-modified-p t))
   (force-mode-line-update))
 
 (defun revert-buffer-with-coding-system (coding-system &optional force)
@@ -1166,7 +1209,7 @@ do.  If FORCE is nil, get the unspecified aspect (or aspects) from the
 buffer's previous `buffer-file-coding-system' value (if it is
 specified there).  Otherwise, determine it from the file contents as
 usual for visiting a file."
-  (interactive "zCoding system for visited file (default, nil): \nP")
+  (interactive "zCoding system for visited file (default nil): \nP")
   (check-coding-system coding-system)
   (if (and coding-system buffer-file-coding-system (null force))
       (setq coding-system
@@ -1178,8 +1221,11 @@ usual for visiting a file."
   "Set coding system for decoding and encoding file names to CODING-SYSTEM.
 It actually just set the variable `file-name-coding-system' (which
 see) to CODING-SYSTEM."
-  (interactive "zCoding system for file names (default, nil): ")
+  (interactive "zCoding system for file names (default nil): ")
   (check-coding-system coding-system)
+  (if (and coding-system
+          (coding-system-get coding-system 'ascii-incompatible))
+      (error "%s is not ASCII-compatible" coding-system))
   (setq file-name-coding-system coding-system))
 
 (defvar default-terminal-coding-system nil
@@ -1199,7 +1245,7 @@ or by the previous use of this command."
                                 default-terminal-coding-system)
                            default-terminal-coding-system)))
           (read-coding-system
-           (format "Coding system for terminal display (default, %s): "
+           (format "Coding system for terminal display (default %s): "
                    default)
            default))))
   (if (and (not coding-system)
@@ -1228,7 +1274,7 @@ or by the previous use of this command."
                                 default-keyboard-coding-system)
                            default-keyboard-coding-system)))
           (read-coding-system
-           (format "Coding system for keyboard input (default, %s): "
+           (format "Coding system for keyboard input (default %s): "
                    default)
            default))))
   (if (and (not coding-system)
@@ -1236,6 +1282,9 @@ or by the previous use of this command."
       (setq coding-system default-keyboard-coding-system))
   (if coding-system
       (setq default-keyboard-coding-system coding-system))
+  (if (and coding-system
+          (coding-system-get coding-system 'ascii-incompatible))
+      (error "%s is not ASCII-compatible" coding-system))
   (set-keyboard-coding-system-internal coding-system)
   (setq keyboard-coding-system coding-system)
   (encoded-kbd-mode (if coding-system 1 0)))
@@ -1244,21 +1293,21 @@ or by the previous use of this command."
   "Specify coding system for keyboard input.
 If you set this on a terminal which can't distinguish Meta keys from
 8-bit characters, you will have to use ESC to type Meta characters.
-See Info node `Specify Coding' and Info node `Single-Byte Character Support'.
+See Info node `Terminal Coding' and Info node `Unibyte Mode'.
 
 On non-windowing terminals, this is set from the locale by default.
 
 Setting this variable directly does not take effect;
-use either M-x customize or \\[set-keyboard-coding-system]."
+use either \\[customize] or \\[set-keyboard-coding-system]."
   :type '(coding-system :tag "Coding system")
-  :link '(info-link "(emacs)Specify Coding")
-  :link '(info-link "(emacs)Single-Byte Character Support")
+  :link '(info-link "(emacs)Terminal Coding")
+  :link '(info-link "(emacs)Unibyte Mode")
   :set (lambda (symbol value)
         ;; Don't load encoded-kbd-mode unnecessarily.
         (if (or value (boundp 'encoded-kbd-mode))
             (set-keyboard-coding-system value)
           (set-default 'keyboard-coding-system nil))) ; must initialize
-  :version "21.4"
+  :version "22.1"
   :group 'keyboard
   :group 'mule)
 
@@ -1298,7 +1347,7 @@ This setting is effective for the next communication only."
   (interactive
    (list (read-coding-system
          (if last-next-selection-coding-system
-             (format "Coding system for the next X selection (default, %S): "
+             (format "Coding system for the next X selection (default %S): "
                      last-next-selection-coding-system)
            "Coding system for the next X selection: ")
          last-next-selection-coding-system)))
@@ -1330,12 +1379,42 @@ ARG is a list of coding categories ordered by priority."
 ;;; X selections
 
 (defvar ctext-non-standard-encodings-alist
-  '(("ISO8859-15" . iso-8859-15)
-    ("ISO8859-14" . iso-8859-14)
-    ("KOI8-R" . koi8-r)
-    ("BIG5-0" . big5))
-  "Alist of non-standard encoding names vs Emacs coding systems.
-This alist is used to decode an extened segment of a compound text.")
+  '(("big5-0" big5 2 (chinese-big5-1 chinese-big5-2))
+    ("ISO8859-14" iso-8859-14 1 latin-iso8859-14)
+    ("ISO8859-15" iso-8859-15 1 latin-iso8859-15))
+  "Alist of non-standard encoding names vs the corresponding usages in CTEXT.
+
+It controls how extended segments of a compound text are handled
+by the coding system `compound-text-with-extensions'.
+
+Each element has the form (ENCODING-NAME CODING-SYSTEM N-OCTET CHARSET).
+
+ENCODING-NAME is an encoding name of an \"extended segments\".
+
+CODING-SYSTEM is the coding-system to encode (or decode) the
+characters into (or from) the extended segment.
+
+N-OCTET is the number of octets (bytes) that encodes a character
+in the segment.  It can be 0 (meaning the number of octets per
+character is variable), 1, 2, 3, or 4.
+
+CHARSET is a charater set containing characters that are encoded
+in the segment.  It can be a list of character sets.  It can also
+be a char-table, in which case characters that have non-nil value
+in the char-table are the target.
+
+On decoding CTEXT, all encoding names listed here are recognized.
+
+On encoding CTEXT, encoding names in the variable
+`ctext-non-standard-encodings' (which see) and in the information
+listed for the current language environment under the key
+`ctext-non-standard-encodings' are used.")
+
+(defvar ctext-non-standard-encodings
+  '("big5-0")
+  "List of non-standard encoding names used in extended segments of CTEXT.
+Each element must be one of the names listed in the variable
+`ctext-non-standard-encodings-alist' (which see).")
 
 (defvar ctext-non-standard-encodings-regexp
   (string-to-multibyte
@@ -1347,13 +1426,9 @@ This alist is used to decode an extened segment of a compound text.")
     "\\(\e%G[^\e]*\e%@\\)")))
 
 ;; Functions to support "Non-Standard Character Set Encodings" defined
-;; by the COMPOUND-TEXT spec.
-;; We support that by decoding the whole data by `ctext' which just
-;; pertains byte sequences belonging to ``extended segment'', then
-;; decoding those byte sequences one by one in Lisp.
-;; This function also supports "The UTF-8 encoding" described in the
-;; section 7 of the documentation fo COMPOUND-TEXT distributed with
-;; XFree86.
+;; by the COMPOUND-TEXT spec.  They also support "The UTF-8 encoding"
+;; described in the section 7 of the documentation of COMPOUND-TEXT
+;; distributed with XFree86.
 
 (defun ctext-post-read-conversion (len)
   "Decode LEN characters encoded as Compound Text with Extended Segments."
@@ -1365,7 +1440,6 @@ This alist is used to decode an extened segment of a compound text.")
            pos bytes)
        (or in-workbuf
            (narrow-to-region (point) (+ (point) len)))
-       (decode-coding-region (point-min) (point-max) 'ctext)
        (if in-workbuf
            (set-buffer-multibyte t))
        (while (re-search-forward ctext-non-standard-encodings-regexp
@@ -1376,11 +1450,14 @@ This alist is used to decode an extened segment of a compound text.")
              (let* ((M (char-after (+ pos 4)))
                     (L (char-after (+ pos 5)))
                     (encoding (match-string 2))
-                    (coding (or (cdr (assoc-ignore-case 
-                                      encoding
-                                      ctext-non-standard-encodings-alist))
-                                (coding-system-p
-                                 (intern (downcase encoding))))))
+                    (encoding-info (assoc-string
+                                    encoding
+                                    ctext-non-standard-encodings-alist t))
+                    (coding (if encoding-info
+                                (nth 1 encoding-info)
+                              (setq encoding (intern (downcase encoding)))
+                              (and (coding-system-p encoding)
+                                   encoding))))
                (setq bytes (- (+ (* (- M 128) 128) (- L 128))
                               (- (point) (+ pos 6))))
                (when coding
@@ -1388,66 +1465,39 @@ This alist is used to decode an extened segment of a compound text.")
                  (forward-char bytes)
                  (decode-coding-region (- (point) bytes) (point) coding)))
            ;; ESC % G --UTF-8-BYTES-- ESC % @
-           (setq bytes (- (point) pos))
-           (decode-coding-region (- (point) bytes) (point) 'utf-8))))
+           (delete-char -3)
+           (delete-region pos (+ pos 3))
+           (decode-coding-region pos (point) 'utf-8))))
       (goto-char (point-min))
       (- (point-max) (point)))))
 
-;; From X registry 2001/06/01
-;; 20. NON-STANDARD CHARACTER SET ENCODINGS
-
-;; See Section 6 of the Compound Text standard.
-
-;; Name                                                Reference
-;; ----                                                ---------
-;; "DEC.CNS11643.1986-2"                               [53]
-;;     CNS11643 2-plane using the recommended
-;;     internal representation scheme
-;; "DEC.DTSCS.1990-2"                          [54]
-;;     DEC Taiwan Supplemental Character Set
-;; "fujitsu.u90x03"                            [87]
-;; "ILA"                                               [62]
-;;     registry prefix
-;; "IPSYS"                                             [59]
-;;     registry prefix
-;; "omron_UDC"                                 [45]
-;;         omron User Defined Charset
-;; "omron_UDC_ja"                                      [45]
-;;         omron User Defined Charset for Japanese
-;; "omron_UDC_zh"                                      [45]
-;;         omron User Defined Charset for Chinese(Main land)
-;; "omron_UDC_tw"                                      [45]
-;;         omron User Defined Charset for Chinese(Taiwan)
-
-;; If you add charsets here, be sure to modify the regexp used by
-;; ctext-pre-write-conversion to look up non-standard charsets.
-(defvar ctext-non-standard-designations-alist
-  '(("$(0" . (big5 "big5-0" 2))
-    ("$(1" . (big5 "big5-0" 2))
-    ;; The following are actually standard; generating extended
-    ;; segments for them is wrong and screws e.g. Latin-9 users.
-    ;; 8859-{10,13,16} aren't Emacs charsets anyhow.  -- fx
-;;     ("-V"  . (t "iso8859-10" 1))
-;;     ("-Y"  . (t "iso8859-13" 1))
-;;     ("-_"  . (t "iso8859-14" 1))
-;;     ("-b"  . (t "iso8859-15" 1))
-;;     ("-f"  . (t "iso8859-16" 1))
-    )
-  "Alist of ctext control sequences that introduce character sets which
-are not in the list of approved encodings, and the corresponding
-coding system, identifier string, and number of octets per encoded
-character.
-
-Each element has the form (CTLSEQ . (ENCODING CHARSET NOCTETS)).  CTLSEQ
-is the control sequence (sans the leading ESC) that introduces the character
-set in the text encoded by compound-text.  ENCODING is a coding system
-symbol; if it is t, it means that the ctext coding system already encodes
-the text correctly, and only the leading control sequence needs to be altered.
-If ENCODING is a coding system, we need to re-encode the text with that
-coding system.  CHARSET is the name of the charset we need to put into
-the leading control sequence.  NOCTETS is the number of octets (bytes) that
-encode each character in this charset.  NOCTETS can be 0 (meaning the number
-of octets per character is variable), 1, 2, 3, or 4.")
+;; Return a char table of extended segment usage for each character.
+;; Each value of the char table is nil, one of the elements of
+;; `ctext-non-standard-encodings-alist', or the symbol `utf-8'.
+
+(defun ctext-non-standard-encodings-table ()
+  (let ((table (make-char-table 'translation-table)))
+    (aset table (make-char 'mule-unicode-0100-24ff) 'utf-8)
+    (aset table (make-char 'mule-unicode-2500-33ff) 'utf-8)
+    (aset table (make-char 'mule-unicode-e000-ffff) 'utf-8)
+    (dolist (encoding (reverse
+                      (append
+                       (get-language-info current-language-environment
+                                          'ctext-non-standard-encodings)
+                       ctext-non-standard-encodings)))
+      (let* ((slot (assoc encoding ctext-non-standard-encodings-alist))
+            (charset (nth 3 slot)))
+       (if charset
+           (cond ((charsetp charset)
+                  (aset table (make-char charset) slot))
+                 ((listp charset)
+                  (dolist (elt charset)
+                    (aset table (make-char elt) slot)))
+                 ((char-table-p charset)
+                  (map-char-table #'(lambda (k v)
+                                  (if (and v (> k 128)) (aset table k slot)))
+                                  charset))))))
+    table))
 
 (defun ctext-pre-write-conversion (from to)
   "Encode characters between FROM and TO as Compound Text w/Extended Segments.
@@ -1456,61 +1506,72 @@ If FROM is a string, or if the current buffer is not the one set up for us
 by encode-coding-string, generate a new temp buffer, insert the
 text, and convert it in the temporary buffer.  Otherwise, convert in-place."
   (save-match-data
-    ;; Setup a working buffer if necessary.
-    (cond ((stringp from)
-          (let ((buf (current-buffer)))
-            (set-buffer (generate-new-buffer " *temp"))
+    (let ((workbuf (get-buffer-create " *code-conversion-work*")))
+      ;; Setup a working buffer if necessary.
+      (cond ((stringp from)
+            (set-buffer workbuf)
+            (erase-buffer)
             (set-buffer-multibyte (multibyte-string-p from))
-            (insert from)))
-         ((not (string= (buffer-name) " *code-converting-work*"))
-          (let ((buf (current-buffer))
-                (multibyte enable-multibyte-characters))
-            (set-buffer (generate-new-buffer " *temp"))
-            (set-buffer-multibyte multibyte)
-            (insert-buffer-substring buf from to))))
+            (insert from))
+           ((not (eq (current-buffer) workbuf))
+            (let ((buf (current-buffer))
+                  (multibyte enable-multibyte-characters))
+              (set-buffer workbuf)
+              (erase-buffer)
+              (set-buffer-multibyte multibyte)
+              (insert-buffer-substring buf from to)))))
 
     ;; Now we can encode the whole buffer.
-    (let ((case-fold-search nil)
+    (let ((encoding-table (ctext-non-standard-encodings-table))
          last-coding-system-used
-         pos posend desig encode-info encoding chset noctets textlen)
-      (goto-char (point-min))
-      ;; At first encode the whole buffer.
-      (encode-coding-region (point-min) (point-max) 'ctext-no-compositions)
-      ;; Then replace ISO-2022 charset designations with extended
-      ;; segments, for those charsets that are not part of the
-      ;; official X registry.  The regexp below finds the leading
-      ;; sequences for big5.
-      (while (re-search-forward "\e\\(\$([01]\\)" nil 'move)
-       (setq pos (match-beginning 0)
-             posend (point)
-             desig (match-string 1)
-             encode-info (cdr (assoc desig
-                                     ctext-non-standard-designations-alist))
-             encoding (car encode-info)
-             chset (cadr encode-info)
-             noctets (car (cddr encode-info)))
-       (skip-chars-forward "^\e")
-       (cond
-        ((eq encoding t)  ; only the leading sequence needs to be changed
-         (setq textlen (+ (- (point) posend) (length chset) 1))
-         ;; Generate the control sequence for an extended segment.
-         (replace-match (format "\e%%/%d%c%c%s\ 2"
-                                noctets
-                                (+ (/ textlen 128) 128)
-                                (+ (% textlen 128) 128)
-                                chset)
-                        t t))
-        ((coding-system-p encoding) ; need to recode the entire segment...
-         (decode-coding-region pos (point) 'ctext-no-compositions)
-         (encode-coding-region pos (point) encoding)
-         (setq textlen (+ (- (point) pos) (length chset) 1))
-         (save-excursion
-           (goto-char pos)
-           (insert (format "\e%%/%d%c%c%s\ 2"
-                           noctets
-                           (+ (/ textlen 128) 128)
-                           (+ (% textlen 128) 128)
-                           chset))))))
+         last-pos last-encoding-info
+         encoding-info end-pos)
+      (goto-char (setq last-pos (point-min)))
+      (setq end-pos (point-marker))
+      (while (re-search-forward "[^\000-\177]+" nil t)
+       ;; Found a sequence of non-ASCII characters.
+       (setq last-pos (match-beginning 0)
+             last-encoding-info (aref encoding-table (char-after last-pos)))
+       (set-marker end-pos (match-end 0))
+       (goto-char (1+ last-pos))
+       (catch 'tag
+         (while t
+           (setq encoding-info
+                 (if (< (point) end-pos)
+                     (aref encoding-table (following-char))))
+           (unless (eq last-encoding-info encoding-info)
+             (cond ((consp last-encoding-info)
+                    ;; Encode the previous range using an extended
+                    ;; segment.
+                    (let ((encoding-name (car last-encoding-info))
+                          (coding-system (nth 1 last-encoding-info))
+                          (noctets (nth 2 last-encoding-info))
+                          len)
+                      (encode-coding-region last-pos (point) coding-system)
+                      (setq len (+ (length encoding-name) 1
+                                   (- (point) last-pos)))
+                      (save-excursion
+                        (goto-char last-pos)
+                        (insert (string-to-multibyte
+                                 (format "\e%%/%d%c%c%s\ 2"
+                                         noctets
+                                         (+ (/ len 128) 128)
+                                         (+ (% len 128) 128)
+                                         encoding-name))))))
+                   ((eq last-encoding-info 'utf-8)
+                    ;; Encode the previous range using UTF-8 encoding
+                    ;; extention.
+                    (encode-coding-region last-pos (point) 'mule-utf-8)
+                    (save-excursion
+                      (goto-char last-pos)
+                      (insert "\e%G"))
+                    (insert "\e%@")))
+             (setq last-pos (point)
+                   last-encoding-info encoding-info))
+           (if (< (point) end-pos)
+               (forward-char 1)
+             (throw 'tag nil)))))
+      (set-marker end-pos nil)
       (goto-char (point-min))))
   ;; Must return nil, as build_annotations_2 expects that.
   nil)
@@ -1518,8 +1579,14 @@ text, and convert it in the temporary buffer.  Otherwise, convert in-place."
 ;;; FILE I/O
 
 (defcustom auto-coding-alist
-  '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|sx[dmicw]\\|tar\\|tgz\\)\\'" . 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)
+    ("\\.pdf\\'" . no-conversion)
     ("/#[^/]+#\\'" . emacs-mule))
   "Alist of filename patterns vs corresponding coding systems.
 Each element looks like (REGEXP . CODING-SYSTEM).
@@ -1534,7 +1601,10 @@ and the contents of `file-coding-system-alist'."
                       (symbol :tag "Coding system"))))
 
 (defcustom auto-coding-regexp-alist
-  '(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion))
+  '(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion)
+    ("\\`\xFE\xFF" . utf-16be-with-signature)
+    ("\\`\xFF\xFE" . utf-16le-with-signature)
+    ("\\`\xEF\xBB\xBF" . utf-8))
   "Alist of patterns vs corresponding coding systems.
 Each element looks like (REGEXP . CODING-SYSTEM).
 A file whose first bytes match REGEXP is decoded by CODING-SYSTEM on reading.
@@ -1547,6 +1617,23 @@ and the contents of `file-coding-system-alist'."
   :type '(repeat (cons (regexp :tag "Regexp")
                       (symbol :tag "Coding system"))))
 
+(defun auto-coding-regexp-alist-lookup (from to)
+  "Lookup `auto-coding-regexp-alist' for the contents of the current buffer.
+The value is a coding system is specified for the region FROM and TO,
+or nil."
+  (save-excursion
+    (goto-char from)
+    (let ((alist auto-coding-regexp-alist)
+         coding-system)
+      (while (and alist (not coding-system))
+       (let ((regexp (car (car alist))))
+         (if enable-multibyte-characters
+             (setq regexp (string-to-multibyte regexp)))
+         (if (re-search-forward regexp to t)
+             (setq coding-system (cdr (car alist)))
+           (setq alist (cdr alist)))))
+      coding-system)))
+
 ;; See the bottom of this file for built-in auto coding functions.
 (defcustom auto-coding-functions '(sgml-xml-auto-coding-function
                                   sgml-html-meta-auto-coding-function)
@@ -1583,8 +1670,11 @@ This is used for loading and byte-compiling Emacs Lisp files.")
        (setq alist (cdr alist))))
     coding-system))
 
-(defun set-auto-coding (filename size)
-  "Return coding system for a file FILENAME of which SIZE bytes follow point.
+(put 'enable-character-translation 'permanent-local t)
+(put 'enable-character-translation 'safe-local-variable        'booleanp)
+
+(defun find-auto-coding (filename size)
+  "Find a coding system for a file FILENAME of which SIZE bytes follow point.
 These bytes should include at least the first 1k of the file
 and the last 3k of the file, but the middle may be omitted.
 
@@ -1598,38 +1688,42 @@ contents of the current buffer following point against
 succeed, it checks to see if any function in `auto-coding-functions'
 gives a match.
 
-The return value is the specified coding system, or nil if nothing is
-specified.
-
-The variable `set-auto-coding-function' (which see) is set to this
-function by default."
-  (or (auto-coding-alist-lookup filename)
+If a coding system is specifed, the return value is a
+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
+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 coding-system
+           (cons coding-system 'auto-coding-alist)))
       ;; Try using `auto-coding-regexp-alist'.
-      (save-excursion
-       (let ((alist auto-coding-regexp-alist)
-             coding-system)
-         (while (and alist (not coding-system))
-           (let ((regexp (car (car alist))))
-             (when (re-search-forward regexp (+ (point) size) t)
-               (setq coding-system (cdr (car alist)))))
-           (setq alist (cdr alist)))
-         coding-system))
+      (let ((coding-system (auto-coding-regexp-alist-lookup (point)
+                                                           (+ (point) size))))
+       (if coding-system
+           (cons coding-system 'auto-coding-regexp-alist)))
       (let* ((case-fold-search t)
             (head-start (point))
             (head-end (+ head-start (min size 1024)))
             (tail-start (+ head-start (max (- size 3072) 0)))
             (tail-end (+ head-start size))
-            coding-system head-found tail-found pos)
+            coding-system head-found tail-found pos char-trans)
        ;; Try a short cut by searching for the string "coding:"
        ;; 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 "unibyte:" head-end t)
+                            (search-forward "enable-character-translation:"
+                                            head-end t)))
        (if (and head-found (> head-found tail-start))
            ;; Head and tail are overlapped.
            (setq tail-found head-found)
          (goto-char tail-start)
          (setq tail-found (or (search-forward "coding:" tail-end t)
-                              (search-forward "unibyte:" tail-end t))))
+                              (search-forward "unibyte:" tail-end t)
+                              (search-forward "enable-character-translation:"
+                                              tail-end t))))
 
        ;; At first check the head.
        (when head-found
@@ -1647,36 +1741,48 @@ function by default."
                       (re-search-forward
                        "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)"
                        head-end t))
-             (setq coding-system (intern (match-string 2)))
-             (or (coding-system-p coding-system)
-                 (setq coding-system nil)))))
+             (setq coding-system (intern (match-string 2))))
+           (when (re-search-forward
+                  "\\(.*;\\)?[ \t]*enable-character-translation:[ \t]*\\([^ ;]+\\)"
+                  head-end t)
+             (setq char-trans (match-string 2)))))
 
        ;; If no coding: tag in the head, check the tail.
-       (when (and tail-found (not coding-system))
+       ;; Here we must pay attention to the case that the end-of-line
+       ;; 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)
-         (search-forward "\n\^L" nil t)
+         (re-search-forward "[\r\n]\^L" tail-end t)
          (if (re-search-forward
-              "^\\(.*\\)[ \t]*Local Variables:[ \t]*\\(.*\\)$" tail-end t)
-         ;; The prefix is what comes before "local variables:" in its
-          ;; line.  The suffix is what comes after "local variables:"
+              "[\r\n]\\([^[\r\n]*\\)[ \t]*Local Variables:[ \t]*\\([^\r\n]*\\)[\r\n]"
+              tail-end t)
+             ;; The prefix is what comes before "local variables:" in its
+             ;; line.  The suffix is what comes after "local variables:"
              ;; in its line.
              (let* ((prefix (regexp-quote (match-string 1)))
                     (suffix (regexp-quote (match-string 2)))
                     (re-coding
                      (concat
-                      "^" prefix
+                      "[\r\n]" prefix
                       ;; N.B. without the \n below, the regexp can
                       ;; eat newlines.
-                      "[ \t]*coding[ \t]*:[ \t]*\\([^ \t\n]+\\)[ \t]*"
-                      suffix "$"))
+                      "[ \t]*coding[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
+                      suffix "[\r\n]"))
                     (re-unibyte
                      (concat
-                      "^" prefix
-                      "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\n]+\\)[ \t]*"
-                      suffix "$"))
+                      "[\r\n]" prefix
+                      "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
+                      suffix "[\r\n]"))
+                    (re-char-trans
+                     (concat
+                      "[\r\n]" prefix
+                      "[ \t]*enable-character-translation[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
+                      suffix "[\r\n]"))
                     (re-end
-                     (concat "^" prefix "[ \t]*End *:[ \t]*" suffix "$"))
-                    (pos (point)))
+                     (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix
+                             "[\r\n]?"))
+                    (pos (1- (point))))
+               (forward-char -1)       ; skip back \r or \n.
                (re-search-forward re-end tail-end 'move)
                (setq tail-end (point))
                (goto-char pos)
@@ -1685,10 +1791,23 @@ function by default."
                  (setq coding-system 'raw-text))
                (when (and (not coding-system)
                           (re-search-forward re-coding tail-end t))
-                 (setq coding-system (intern (match-string 1)))
-                 (or (coding-system-p coding-system)
-                     (setq coding-system nil))))))
-       coding-system)
+                 (setq coding-system (intern (match-string 1))))
+               (when (and (not char-trans)
+                          (re-search-forward re-char-trans tail-end t))
+                 (setq char-trans (match-string 1))))))
+       (if coding-system
+           ;; If the coding-system name ends with "!", remove it and
+           ;; set char-trans to "nil".
+           (let ((name (symbol-name coding-system)))
+             (if (= (aref name (1- (length name))) ?!)
+                 (setq coding-system (intern (substring name 0 -1))
+                       char-trans "nil"))))
+       (when (and char-trans
+                  (not (setq char-trans (intern char-trans))))
+         (make-local-variable 'enable-character-translation)
+         (setq enable-character-translation nil))
+       (if coding-system
+           (cons coding-system :coding)))
       ;; Finally, try all the `auto-coding-functions'.
       (let ((funcs auto-coding-functions)
            (coding-system nil))
@@ -1698,22 +1817,57 @@ function by default."
                                    (goto-char (point-min))
                                    (funcall (pop funcs) size))
                                (error nil))))
-       coding-system)))
+       (if coding-system
+           (cons coding-system 'auto-coding-functions)))))
+
+(defun set-auto-coding (filename size)
+  "Return coding system for a file FILENAME of which SIZE bytes follow point.
+See `find-auto-coding' for how the coding system is found.
+Return nil if an invalid coding system is found.
+
+The variable `set-auto-coding-function' (which see) is set to this
+function by default."
+  (let ((found (find-auto-coding filename size)))
+    (if (and found (coding-system-p (car found)))
+       (car found))))
 
 (setq set-auto-coding-function 'set-auto-coding)
 
-(defun after-insert-file-set-coding (inserted)
+;; This variable is set in these two cases:
+;;   (1) A file is read by a coding system specified explicitly.
+;;       after-insert-file-set-coding sets this value to
+;;       coding-system-for-read.
+;;   (2) A buffer is saved.
+;;       After writing, basic-save-buffer-1 sets this value to
+;;       last-coding-system-used.
+;; This variable is used for decoding in revert-buffer.
+(defvar buffer-file-coding-system-explicit nil
+  "The file coding system explicitly specified for the current buffer.
+Internal use only.")
+(make-variable-buffer-local 'buffer-file-coding-system-explicit)
+(put 'buffer-file-coding-system-explicit 'permanent-local t)
+
+(defun after-insert-file-set-coding (inserted &optional visit)
   "Set `buffer-file-coding-system' of current buffer after text is inserted.
 INSERTED is the number of characters that were inserted, as figured
 in the situation before this function.  Return the number of characters
 inserted, as figured in the situation after.  The two numbers can be
-different if the buffer has become unibyte."
+different if the buffer has become unibyte.
+The optional second arg VISIT non-nil means that we are visiting a file."
+  (if (and visit
+          coding-system-for-read
+          (not (eq coding-system-for-read 'auto-save-coding)))
+      (setq buffer-file-coding-system-explicit coding-system-for-read))
   (if last-coding-system-used
       (let ((coding-system
             (find-new-buffer-file-coding-system last-coding-system-used))
            (modified-p (buffer-modified-p)))
        (when coding-system
-         (set-buffer-file-coding-system coding-system t)
+         ;; Tell set-buffer-file-coding-system not to mark the file
+         ;; as modified; we just read it, and it's supposed to be unmodified.
+         ;; Marking it modified would try to lock it, which would
+         ;; check the modtime, and we don't want to do that again now.
+         (set-buffer-file-coding-system coding-system t t)
          (if (and enable-multibyte-characters
                   (or (eq coding-system 'no-conversion)
                       (eq (coding-system-type coding-system) 5))
@@ -1723,10 +1877,18 @@ different if the buffer has become unibyte."
                   (= (buffer-size) inserted))
              ;; For coding systems no-conversion and raw-text...,
              ;; edit the buffer as unibyte.
-             (let ((pos-marker (copy-marker (+ (point) inserted))))
-               (set-buffer-multibyte nil)
+             (let ((pos-marker (copy-marker (+ (point) inserted)))
+                   ;; Prevent locking.
+                   (buffer-file-name nil))
+               (if visit
+                   ;; If we're doing this for find-file,
+                   ;; don't record undo info; this counts as
+                   ;; part of producing the buffer's initial contents.
+                   (let ((buffer-undo-list t))
+                     (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
@@ -1847,28 +2009,71 @@ or a function symbol which, when called, returns such a cons cell."
 (defun decode-coding-inserted-region (from to filename
                                           &optional visit beg end replace)
   "Decode the region between FROM and TO as if it is read from file FILENAME.
+The idea is that the text between FROM and TO was just inserted somehow.
 Optional arguments VISIT, BEG, END, and REPLACE are the same as those
-of the function `insert-file-contents'."
+of the function `insert-file-contents'.
+Part of the job of this function is setting `buffer-undo-list' appropriately."
   (save-excursion
     (save-restriction
-      (narrow-to-region from to)
-      (goto-char (point-min))
-      (let ((coding coding-system-for-read))
+      (let ((coding coding-system-for-read)
+           undo-list-saved)
+       (if visit
+           ;; Temporarily turn off undo recording, if we're decoding the
+           ;; text of a visited file.
+           (setq buffer-undo-list t)
+         ;; Otherwise, if we can recognize the undo elt for the insertion,
+         ;; remove it and get ready to replace it later.
+         ;; In the mean time, turn off undo recording.
+         (let ((last (car-safe buffer-undo-list)))
+           (if (and (consp last) (eql (car last) from) (eql (cdr last) to))
+               (setq undo-list-saved (cdr buffer-undo-list)
+                     buffer-undo-list t))))
+       (narrow-to-region from to)
+       (goto-char (point-min))
        (or coding
            (setq coding (funcall set-auto-coding-function
                                  filename (- (point-max) (point-min)))))
        (or coding
            (setq coding (car (find-operation-coding-system
                               'insert-file-contents
-                              filename visit beg end replace))))
+                              (cons filename (current-buffer))
+                              visit beg end replace))))
        (if (coding-system-p coding)
            (or enable-multibyte-characters
                (setq coding
                      (coding-system-change-text-conversion coding 'raw-text)))
          (setq coding nil))
        (if coding
-           (decode-coding-region (point-min) (point-max) coding))
-       (setq last-coding-system-used coding)))))
+           (decode-coding-region (point-min) (point-max) coding)
+         (setq last-coding-system-used coding))
+       ;; If we're decoding the text of a visited file,
+       ;; the undo list should start out empty.
+       (if visit
+           (setq buffer-undo-list nil)
+         ;; If we decided to replace the undo entry for the insertion,
+         ;; do so now.
+         (if undo-list-saved
+             (setq buffer-undo-list
+                   (cons (cons from (point-max)) undo-list-saved))))))))
+
+(defun recode-region (start end new-coding coding)
+  "Re-decode the region (previously decoded by CODING) by NEW-CODING."
+  (interactive
+   (list (region-beginning) (region-end)
+        (read-coding-system "Text was really in: ")
+        (let ((coding (or buffer-file-coding-system last-coding-system-used)))
+          (read-coding-system
+           (concat "But was interpreted as"
+                   (if coding (format " (default %S): " coding) ": "))
+           coding))))
+  (or (and new-coding coding)
+      (error "Coding system not specified"))
+  ;; Check it before we encode the region.
+  (check-coding-system new-coding)
+  (save-restriction
+    (narrow-to-region start end)
+    (encode-coding-region (point-min) (point-max) coding)
+    (decode-coding-region (point-min) (point-max) new-coding)))
 
 (defun make-translation-table (&rest args)
   "Make a translation table from arguments.
@@ -1992,6 +2197,34 @@ the table in `translation-table-vector'."
     (put symbol 'translation-table-id id)
     id))
 
+(defun translate-region (start end table)
+  "From START to END, translate characters according to TABLE.
+TABLE is a string or a char-table.
+If TABLE is a string, the Nth character in it is the mapping
+for the character with code N.
+If TABLE is a char-table, the element for character N is the mapping
+for the character with code N.
+It returns the number of characters changed."
+  (interactive
+   (list (region-beginning)
+        (region-end)
+        (let (table l)
+          (dotimes (i (length translation-table-vector))
+            (if (consp (aref translation-table-vector i))
+                (push (list (symbol-name
+                             (car (aref translation-table-vector i)))) l)))
+          (if (not l)
+              (error "No translation table defined"))
+          (while (not table)
+            (setq table (completing-read "Translation table: " l nil t)))
+          (intern table))))
+  (if (symbolp table)
+      (let ((val (get table 'translation-table)))
+       (or (char-table-p val)
+           (error "Invalid translation table name: %s" table))
+       (setq table val)))
+  (translate-region-internal start end table))
+
 (put 'with-category-table 'lisp-indent-function 1)
 
 (defmacro with-category-table (table &rest body)
@@ -2007,8 +2240,7 @@ Value is what BODY returns."
           (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)
@@ -2056,9 +2288,9 @@ This function is intended to be added to `auto-coding-functions'."
   (when (re-search-forward "\\`[[:space:]\n]*<\\?xml" size t)
     (let ((end (save-excursion
                 ;; This is a hack.
-                (re-search-forward "\"\\s-*\\?>" size t))))
+                (re-search-forward "[\"']\\s-*\\?>" size t))))
       (when end
-       (if (re-search-forward "encoding=\"\\(.+?\\)\"" end t)
+       (if (re-search-forward "encoding=[\"']\\(.+?\\)[\"']" end t)
            (let* ((match (match-string 1))
                   (sym (intern (downcase match))))
              (if (coding-system-p sym)
@@ -2070,22 +2302,29 @@ 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)
-                 ;; Only search forward 10 lines
-                 (save-excursion
-                   (forward-line 10)
-                   (point))))
-  (when (and (search-forward "<html>" size t)
-            (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t))
+  (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))))
+         nil)))))
 
 ;;;
 (provide 'mule)
 
-;;; arch-tag: 9aebaa6e-0e8a-40a9-b857-cb5d04a39e7c
+;; arch-tag: 9aebaa6e-0e8a-40a9-b857-cb5d04a39e7c
 ;;; mule.el ends here