]> code.delx.au - gnu-emacs/blobdiff - lisp/international/mule.el
Merged from emacs@sv.gnu.org
[gnu-emacs] / lisp / international / mule.el
index d86ce458bf4226d822dd6a5cf4576f5d8c29e191..4ed05dd1d367b83db24c72a6d0f2826d12376000 100644 (file)
@@ -1,8 +1,10 @@
 ;;; 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
+;;   Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;;   National Institute of Advanced Industrial Science and Technology (AIST)
+;;   Registration Number H14PRO021
 
 ;; Keywords: mule, multilingual, character set, coding system
 
@@ -20,8 +22,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:
 
@@ -71,7 +73,9 @@ Return t if file exists."
                (inhibit-file-name-operation nil))
            (save-excursion
              (set-buffer buffer)
-             (insert-file-contents fullname)
+             ;; 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.
@@ -309,14 +315,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 (utf-lookup-subst-table-for-decode code-point)
+    (or (and utf-translate-cjk-mode
+            (utf-lookup-subst-table-for-decode code-point))
        (let ((c (cond
                  ((< code-point 160)
                   code-point)
@@ -346,8 +354,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,
@@ -360,7 +369,8 @@ code-point in CCS.  Currently not supported and just ignored."
         (charset (car split))
         trans)
     (cond ((eq ccs 'ucs)
-          (or (utf-lookup-subst-table-for-encode char)
+          (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))
@@ -486,9 +496,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
@@ -617,16 +624,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)
@@ -840,6 +847,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.
@@ -1073,8 +1086,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.
@@ -1105,8 +1119,9 @@ a value of `safe-charsets' in PLIST."
   (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
@@ -1135,7 +1150,11 @@ 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 nomodify)
   "Set the file coding-system of the current buffer to CODING-SYSTEM.
@@ -1154,7 +1173,7 @@ surely saves the buffer with CODING-SYSTEM.  From a program, if you
 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")
+  (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
@@ -1178,7 +1197,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
@@ -1190,8 +1209,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
@@ -1215,7 +1237,7 @@ The setting has no effect on graphical displays."
                                 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)
@@ -1233,9 +1255,8 @@ See also the command `set-keyboard-coding-system'.")
 
 (defun set-keyboard-coding-system (coding-system &optional display)
   "Set coding system for keyboard input on DISPLAY to CODING-SYSTEM.
-In addition, this command enables Encoded-kbd minor mode.
-\(If CODING-SYSTEM is nil, Encoded-kbd mode is turned off -- see
-`encoded-kbd-mode'.)
+In addition, this command calls `encoded-kbd-setup-display' to set up the
+translation of keyboard input events to the specified coding system.
 
 For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
 The default is determined by the selected language environment
@@ -1248,7 +1269,7 @@ The setting has no effect on graphical displays."
                                 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)
@@ -1256,26 +1277,29 @@ The setting has no effect on graphical displays."
       (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 display)
   (setq keyboard-coding-system coding-system)
-  (encoded-kbd-mode (if coding-system 1 0)))
+  (encoded-kbd-setup-display display))
 
 (defcustom keyboard-coding-system nil
   "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 \\[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))
+        ;; Don't load encoded-kb unnecessarily.
+        (if (or value (boundp 'encoded-kbd-setup-display))
             (set-keyboard-coding-system value)
           (set-default 'keyboard-coding-system nil))) ; must initialize
   :version "22.1"
@@ -1318,7 +1342,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)))
@@ -1552,7 +1576,7 @@ text, and convert it in the temporary buffer.  Otherwise, convert in-place."
 (defcustom auto-coding-alist
   '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|[jew]ar\\|xpi\\)\\'" . no-conversion)
     ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion)
-    ("\\.\\(sx[dmicw]\\|tar\\|tgz\\)\\'" . 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)
     ("/#[^/]+#\\'" . emacs-mule))
@@ -1569,7 +1593,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.
@@ -1582,6 +1609,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)
@@ -1618,8 +1662,8 @@ 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.
+(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.
 
@@ -1633,22 +1677,23 @@ 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 callers 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)))
@@ -1682,9 +1727,7 @@ 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))))))
 
        ;; If no coding: tag in the head, check the tail.
        ;; Here we must pay attention to the case that the end-of-line
@@ -1725,10 +1768,9 @@ 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)))))))
+       (if coding-system
+           (cons coding-system :coding)))
       ;; Finally, try all the `auto-coding-functions'.
       (let ((funcs auto-coding-functions)
            (coding-system nil))
@@ -1738,7 +1780,19 @@ 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)
 
@@ -2191,9 +2245,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)