Fix a typo in a comment.

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

diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 5228464..01c1b74 100644 (file)
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -304,7 +304,7 @@ Currently the only supported coded character set is `ucs' (ISO/IEC
 Optional argument RESTRICTION specifies a way to map the pair of CCS
 and CODE-POINT to a chracter.   Currently not supported and just ignored."
   (cond ((eq ccs 'ucs)
-        (cond ((< code-point 128)
+        (cond ((< code-point 160)
                code-point)
               ((< code-point 256)
                (make-char 'latin-iso8859-1 code-point))
@@ -312,7 +312,7 @@ and CODE-POINT to a chracter.   Currently not supported and just ignored."
                (setq code-point (- code-point #x0100))
                (make-char 'mule-unicode-0100-24ff 
                           (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
-              ((< code-point #x33ff)
+              ((< code-point #x3400)
                (setq code-point (- code-point #x2500))
                (make-char 'mule-unicode-2500-33ff
                           (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
@@ -330,7 +330,7 @@ Currently the only supported coded character set is `ucs' (ISO/IEC
 
 CHAR should be in one of these charsets:
   ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff,
-  mule-unicode-e000-ffff
+  mule-unicode-e000-ffff, eight-bit-control
 Otherwise, return nil.
 
 Optional argument RESTRICTION specifies a way to map CHAR to a
@@ -350,7 +350,9 @@ code-point in CCS.  Currently not supported and just ignored."
                               (- (nth 2 split) 32))))
                 ((eq charset 'mule-unicode-e000-ffff)
                  (+ #xe000 (+ (* (- (nth 1 split) 32) 96)
-                              (- (nth 2 split) 32)))))))))
+                              (- (nth 2 split) 32))))
+                ((eq charset 'eight-bit-control)
+                 char))))))
 
 \f
 ;; Coding system stuff
@@ -618,6 +620,33 @@ formats (e.g. iso-latin-1-unix, koi8-r-dos)."
       (setq i (1+ i)))
     subsidiaries))
 
+(defun transform-make-coding-system-args (name type &optional doc-string props)
+  "For internal use only.
+Transform XEmacs style args for `make-coding-system' to Emacs style.
+Value is a list of transformed arguments."
+  (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
+       (eol-type (plist-get props 'eol-type))
+       properties tmp)
+    (cond
+     ((eq eol-type 'lf) (setq eol-type 'unix))
+     ((eq eol-type 'crlf) (setq eol-type 'dos))
+     ((eq eol-type 'cr) (setq eol-type 'mac)))
+    (if (setq tmp (plist-get props 'post-read-conversion))
+       (setq properties (plist-put properties 'post-read-conversion tmp)))
+    (if (setq tmp (plist-get props 'pre-write-conversion))
+       (setq properties (plist-put properties 'pre-write-conversion tmp)))
+    (cond
+     ((eq type 'ccl)
+      `(,name 4
+             ,mnemonic
+             ,doc-string
+             (,(plist-get props 'decode) . ,(plist-get props 'encode))
+             ,properties
+             ,eol-type))
+     (t
+      (error "Unsupported XEmacs style arguments for make-coding-style: %S"
+            `(,name ,type ,doc-string ,props))))))
+
 (defun make-coding-system (coding-system type mnemonic doc-string
                                         &optional
                                         flags
@@ -712,6 +741,22 @@ treated as a compiled CCL code.
 
 2. If PROPERTIES is just a list of character sets, the list is set as
 a value of `safe-charsets' in PLIST."
+
+  ;; For compatiblity with XEmacs, we check the type of TYPE.  If it
+  ;; is a symbol, perhaps, this function is called with XEmacs-style
+  ;; arguments.  Here, try to transform that kind of arguments to
+  ;; Emacs style.
+  (if (symbolp type)
+      (let ((args (transform-make-coding-system-args coding-system type
+                                                    mnemonic doc-string)))
+       (setq coding-system (car args)
+             type (nth 1 args)
+             mnemonic (nth 2 args)
+             doc-string (nth 3 args)
+             flags (nth 4 args)
+             properties (nth 5 args)
+             eol-type (nth 6 args))))
+
   ;; Set a value of `coding-system' property.
   (let ((coding-spec (make-vector 5 nil))
        (no-initial-designation t)
@@ -1401,7 +1446,11 @@ FROM can be a generic character (see `make-char').  In this case, TO is
 a generic character containing the same number of characters, or a
 ordinary character.  If FROM and TO are both generic characters, all
 characters belonging to FROM are translated to characters belonging to TO
-without changing their position code(s)."
+without changing their position code(s).
+
+The arguments and forms in each argument are processed in the given
+order, and if a previous form already translates TO to some other
+character, say TO-ALT, FROM is also translated to TO-ALT."
   (let ((table (make-char-table 'translation-table))
        revlist)
     (while args