Use `=>ucs' instead of `->ucs'.
[chise/xemacs-chise.git] / src / mule-charset.c
index 1795c8c..c254ffe 100644 (file)
@@ -1,7 +1,7 @@
 /* Functions to handle multilingual characters.
    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
-   Copyright (C) 1999,2000 MORIOKA Tomohiko
+   Copyright (C) 1999,2000,2001 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
@@ -20,10 +20,10 @@ along with XEmacs; see the file COPYING.  If not, write to
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
-/* Synched up with: FSF 20.3.  Not in FSF. */
-
 /* Rewritten by Ben Wing <ben@xemacs.org>. */
 
+/* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs UTF-2000. */
+
 #include <config.h>
 #ifdef UTF2000
 #include <limits.h>
@@ -56,6 +56,7 @@ Lisp_Object Vcharset_cyrillic_iso8859_5;
 Lisp_Object Vcharset_latin_iso8859_9;
 Lisp_Object Vcharset_japanese_jisx0208_1978;
 Lisp_Object Vcharset_chinese_gb2312;
+Lisp_Object Vcharset_chinese_gb12345;
 Lisp_Object Vcharset_japanese_jisx0208;
 Lisp_Object Vcharset_japanese_jisx0208_1990;
 Lisp_Object Vcharset_korean_ksc5601;
@@ -65,10 +66,25 @@ Lisp_Object Vcharset_chinese_cns11643_2;
 #ifdef UTF2000
 Lisp_Object Vcharset_ucs;
 Lisp_Object Vcharset_ucs_bmp;
+Lisp_Object Vcharset_ucs_cns;
+Lisp_Object Vcharset_ucs_big5;
 Lisp_Object Vcharset_latin_viscii;
 Lisp_Object Vcharset_latin_tcvn5712;
 Lisp_Object Vcharset_latin_viscii_lower;
 Lisp_Object Vcharset_latin_viscii_upper;
+Lisp_Object Vcharset_chinese_big5;
+Lisp_Object Vcharset_ideograph_gt;
+Lisp_Object Vcharset_ideograph_gt_pj_1;
+Lisp_Object Vcharset_ideograph_gt_pj_2;
+Lisp_Object Vcharset_ideograph_gt_pj_3;
+Lisp_Object Vcharset_ideograph_gt_pj_4;
+Lisp_Object Vcharset_ideograph_gt_pj_5;
+Lisp_Object Vcharset_ideograph_gt_pj_6;
+Lisp_Object Vcharset_ideograph_gt_pj_7;
+Lisp_Object Vcharset_ideograph_gt_pj_8;
+Lisp_Object Vcharset_ideograph_gt_pj_9;
+Lisp_Object Vcharset_ideograph_gt_pj_10;
+Lisp_Object Vcharset_ideograph_gt_pj_11;
 Lisp_Object Vcharset_ideograph_daikanwa;
 Lisp_Object Vcharset_mojikyo;
 Lisp_Object Vcharset_mojikyo_2022_1;
@@ -872,6 +888,7 @@ Lisp_Object Vcharacter_variant_table;
 Lisp_Object Qideograph_daikanwa;
 Lisp_Object Q_decomposition;
 Lisp_Object Qucs;
+Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs;
 Lisp_Object Qcompat;
 Lisp_Object Qisolated;
@@ -1104,10 +1121,11 @@ Return the alist of attributes of CHARACTER.
   return alist;
 }
 
-DEFUN ("get-char-attribute", Fget_char_attribute, 2, 2, 0, /*
+DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
 Return the value of CHARACTER's ATTRIBUTE.
+Return DEFAULT-VALUE if the value is not exist.
 */
-       (character, attribute))
+       (character, attribute, default_value))
 {
   Lisp_Object ccs;
 
@@ -1118,8 +1136,6 @@ Return the value of CHARACTER's ATTRIBUTE.
 
       if (CHAR_ID_TABLE_P (encoding_table))
        return get_char_id_table (XCHAR (character), encoding_table);
-      else
-       return Qnil;
     }
   else
     {
@@ -1133,7 +1149,7 @@ Return the value of CHARACTER's ATTRIBUTE.
            return ret;
        }
     }
-  return Qnil;
+  return default_value;
 }
 
 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
@@ -1216,7 +1232,7 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        }
       value = seq;
     }
-  else if (EQ (attribute, Q_ucs))
+  else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
     {
       Lisp_Object ret;
       Emchar c;
@@ -1232,6 +1248,10 @@ Store CHARACTER's ATTRIBUTE with VALUE.
          put_char_id_table (c, Fcons (character, ret),
                             Vcharacter_variant_table);
        }
+#if 0
+      if (EQ (attribute, Q_ucs))
+       attribute = Qto_ucs;
+#endif
     }
   {
     Lisp_Object table = Fgethash (attribute,
@@ -1428,7 +1448,7 @@ put_char_ccs_code_point (Lisp_Object character,
 
       if (VECTORP (v))
        {
-         Lisp_Object cpos = Fget_char_attribute (character, ccs);
+         Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
          if (!NILP (cpos))
            {
              decoding_table_remove_char (v, dim, byte_offset, XINT (cpos));
@@ -1459,7 +1479,7 @@ remove_char_ccs (Lisp_Object character, Lisp_Object ccs)
 
   if (VECTORP (decoding_table))
     {
-      Lisp_Object cpos = Fget_char_attribute (character, ccs);
+      Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 
       if (!NILP (cpos))
        {
@@ -1487,9 +1507,6 @@ Store character's ATTRIBUTES.
   Lisp_Object rest = attributes;
   Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
   Lisp_Object character;
-#if 0
-  Lisp_Object daikanwa = Qnil;
-#endif
 
   if (NILP (code))
     {
@@ -1509,11 +1526,14 @@ Store character's ATTRIBUTES.
                character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
              else
                character = Fdecode_char (ccs, cell);
-             goto setup_attributes;
+             if (!NILP (character))
+               goto setup_attributes;
            }
          rest = Fcdr (rest);
        }
-      if (!NILP (code = Fcdr (Fassq (Q_ucs, attributes))))
+      if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
+          (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
+       
        {
          if (!INTP (code))
            signal_simple_error ("Invalid argument", attributes);
@@ -1533,36 +1553,11 @@ Store character's ATTRIBUTES.
   while (CONSP (rest))
     {
       Lisp_Object cell = Fcar (rest);
-#if 0
-      Lisp_Object key = Fcar (cell);
-      Lisp_Object value = Fcdr (cell);
-#endif
 
       if (!LISTP (cell))
        signal_simple_error ("Invalid argument", attributes);
 
-#if 0
-      if (EQ (key, Qmorohashi_daikanwa))
-       {
-         size_t len;
-         GET_EXTERNAL_LIST_LENGTH (value, len);
-
-         if (len == 1)
-           {
-             if (NILP (daikanwa))
-               daikanwa = Fcdr (Fassq (Qideograph_daikanwa, rest));
-             if (EQ (Fcar (value), daikanwa))
-               goto ignored;
-           }
-       }
-      else if (EQ (key, Qideograph_daikanwa))
-       daikanwa = value;
-#endif
-
       Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
-#if 0
-    ignored:
-#endif
       rest = Fcdr (rest);
     }
   return character;
@@ -1600,6 +1595,7 @@ Lisp_Object Qascii,
   Qlatin_iso8859_9,
   Qjapanese_jisx0208_1978,
   Qchinese_gb2312,
+  Qchinese_gb12345,
   Qjapanese_jisx0208,
   Qjapanese_jisx0208_1990,
   Qkorean_ksc5601,
@@ -1608,12 +1604,27 @@ Lisp_Object Qascii,
   Qchinese_cns11643_2,
 #ifdef UTF2000
   Qucs_bmp,
+  Qucs_cns,
+  Qucs_big5,
   Qlatin_viscii,
   Qlatin_tcvn5712,
   Qlatin_viscii_lower,
   Qlatin_viscii_upper,
   Qvietnamese_viscii_lower,
   Qvietnamese_viscii_upper,
+  Qchinese_big5,
+  Qideograph_gt,
+  Qideograph_gt_pj_1,
+  Qideograph_gt_pj_2,
+  Qideograph_gt_pj_3,
+  Qideograph_gt_pj_4,
+  Qideograph_gt_pj_5,
+  Qideograph_gt_pj_6,
+  Qideograph_gt_pj_7,
+  Qideograph_gt_pj_8,
+  Qideograph_gt_pj_9,
+  Qideograph_gt_pj_10,
+  Qideograph_gt_pj_11,
   Qmojikyo,
   Qmojikyo_2022_1,
   Qmojikyo_pj_1,
@@ -1908,30 +1919,18 @@ non_ascii_valid_char_p (Emchar ch)
 /*                       Basic string functions                         */
 /************************************************************************/
 
-/* Copy the character pointed to by PTR into STR, assuming it's
-   non-ASCII.  Do not call this directly.  Use the macro
-   charptr_copy_char() instead. */
+/* Copy the character pointed to by SRC into DST.  Do not call this
+   directly.  Use the macro charptr_copy_char() instead.
+   Return the number of bytes copied.  */
 
 Bytecount
-non_ascii_charptr_copy_char (const Bufbyte *ptr, Bufbyte *str)
+non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst)
 {
-  Bufbyte *strptr = str;
-  *strptr = *ptr++;
-  switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
-    {
-      /* Notice fallthrough. */
-#ifdef UTF2000
-    case 6: *++strptr = *ptr++;
-    case 5: *++strptr = *ptr++;
-#endif
-    case 4: *++strptr = *ptr++;
-    case 3: *++strptr = *ptr++;
-    case 2: *++strptr = *ptr;
-      break;
-    default:
-      abort ();
-    }
-  return strptr + 1 - str;
+  unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src);
+  unsigned int i;
+  for (i = bytes; i; i--, dst++, src++)
+    *dst = *src;
+  return bytes;
 }
 
 \f
@@ -1948,36 +1947,15 @@ Lstream_get_emchar_1 (Lstream *stream, int ch)
 {
   Bufbyte str[MAX_EMCHAR_LEN];
   Bufbyte *strptr = str;
+  unsigned int bytes;
 
   str[0] = (Bufbyte) ch;
-  switch (REP_BYTES_BY_FIRST_BYTE (ch))
+
+  for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--)
     {
-      /* Notice fallthrough. */
-#ifdef UTF2000
-    case 6:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-    case 5:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-#endif
-    case 4:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-    case 3:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-    case 2:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-      break;
-    default:
-      abort ();
+      int c = Lstream_getc (stream);
+      bufpos_checking_assert (c >= 0);
+      *++strptr = (Bufbyte) c;
     }
   return charptr_emchar (str);
 }
@@ -2071,8 +2049,9 @@ DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
                                mark_charset, print_charset, 0, 0, 0,
                               charset_description,
                               Lisp_Charset);
-/* Make a new charset. */
 
+/* Make a new charset. */
+/* #### SJT Should generic properties be allowed? */
 static Lisp_Object
 make_charset (Charset_ID id, Lisp_Object name,
              unsigned short chars, unsigned char dimension,
@@ -2189,55 +2168,96 @@ get_unallocated_leading_byte (int dimension)
 }
 
 #ifdef UTF2000
+/* Number of Big5 characters which have the same code in 1st byte.  */
+
+#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
+
 Emchar
-make_builtin_char (Lisp_Object charset, int c1, int c2)
+decode_builtin_char (Lisp_Object charset, int code_point)
 {
-  if (XCHARSET_UCS_MAX (charset))
-    {
-      Emchar code
-       = (XCHARSET_DIMENSION (charset) == 1
-          ?
-          c1 - XCHARSET_BYTE_OFFSET (charset)
-          :
-          (c1 - XCHARSET_BYTE_OFFSET (charset)) * XCHARSET_CHARS (charset)
-          + c2  - XCHARSET_BYTE_OFFSET (charset))
-       - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset);
-      if ((code < XCHARSET_UCS_MIN (charset))
-         || (XCHARSET_UCS_MAX (charset) < code))
-       signal_simple_error ("Arguments makes invalid character",
-                            make_char (code));
-      return code;
-    }
-  else if (XCHARSET_DIMENSION (charset) == 1)
+  int final;
+
+  if (EQ (charset, Vcharset_chinese_big5))
     {
-      switch (XCHARSET_CHARS (charset))
+      int c1 = code_point >> 8;
+      int c2 = code_point & 0xFF;
+      unsigned int I;
+
+      if ( (  (0xA1 <= c1) && (c1 <= 0xFE)  )
+          &&
+          ( ((0x40 <= c2) && (c2 <= 0x7E)) ||
+            ((0xA1 <= c2) && (c2 <= 0xFE)) ) )
        {
-       case 94:
-         return MIN_CHAR_94
-           + (XCHARSET_FINAL (charset) - '0') * 94 + (c1 - 33);
-       case 96:
-         return MIN_CHAR_96
-           + (XCHARSET_FINAL (charset) - '0') * 96 + (c1 - 32);
-       default:
-         abort ();
+         I = (c1 - 0xA1) * BIG5_SAME_ROW
+           + c2 - (c2 < 0x7F ? 0x40 : 0x62);
+
+         if (c1 < 0xC9)
+           {
+             charset = Vcharset_chinese_big5_1;
+           }
+         else
+           {
+             charset = Vcharset_chinese_big5_2;
+             I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);
+           }
+         code_point = ((I / 94 + 33) << 8) | (I % 94 + 33);
        }
     }
-  else
+  if ((final = XCHARSET_FINAL (charset)) >= '0')
     {
-      switch (XCHARSET_CHARS (charset))
+      if (XCHARSET_DIMENSION (charset) == 1)
        {
-       case 94:
-         return MIN_CHAR_94x94
-           + (XCHARSET_FINAL (charset) - '0') * 94 * 94
-           + (c1 - 33) * 94 + (c2 - 33);
-       case 96:
-         return MIN_CHAR_96x96
-           + (XCHARSET_FINAL (charset) - '0') * 96 * 96
-           + (c1 - 32) * 96 + (c2 - 32);
-       default:
-         abort ();
+         switch (XCHARSET_CHARS (charset))
+           {
+           case 94:
+             return MIN_CHAR_94
+               + (final - '0') * 94 + ((code_point & 0x7F) - 33);
+           case 96:
+             return MIN_CHAR_96
+               + (final - '0') * 96 + ((code_point & 0x7F) - 32);
+           default:
+             abort ();
+             return -1;
+           }
+       }
+      else
+       {
+         switch (XCHARSET_CHARS (charset))
+           {
+           case 94:
+             return MIN_CHAR_94x94
+               + (final - '0') * 94 * 94
+               + (((code_point >> 8) & 0x7F) - 33) * 94
+               + ((code_point & 0x7F) - 33);
+           case 96:
+             return MIN_CHAR_96x96
+               + (final - '0') * 96 * 96
+               + (((code_point >> 8) & 0x7F) - 32) * 96
+               + ((code_point & 0x7F) - 32);
+           default:
+             abort ();
+             return -1;
+           }
        }
     }
+  else if (XCHARSET_UCS_MAX (charset))
+    {
+      Emchar cid
+       = (XCHARSET_DIMENSION (charset) == 1
+          ?
+          code_point - XCHARSET_BYTE_OFFSET (charset)
+          :
+          ((code_point >> 8) - XCHARSET_BYTE_OFFSET (charset))
+          * XCHARSET_CHARS (charset)
+          + (code_point & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
+       - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset);
+      if ((cid < XCHARSET_UCS_MIN (charset))
+         || (XCHARSET_UCS_MAX (charset) < cid))
+       return -1;
+      return cid;
+    }
+  else
+    return -1;
 }
 
 int
@@ -2397,17 +2417,15 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
       *charset = Vcharset_ucs;
       return c;
     }
-  /*
   else if (c <= MAX_CHAR_DAIKANWA)
     {
       *charset = Vcharset_ideograph_daikanwa;
       return c - MIN_CHAR_DAIKANWA;
     }
-  */
-  else if (c <= MAX_CHAR_MOJIKYO)
+  else if (c <= MAX_CHAR_MOJIKYO_0)
     {
       *charset = Vcharset_mojikyo;
-      return c - MIN_CHAR_MOJIKYO;
+      return c - MIN_CHAR_MOJIKYO_0;
     }
   else if (c < MIN_CHAR_94)
     {
@@ -2470,6 +2488,16 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
          return c;
        }
     }
+  else if (c < MIN_CHAR_MOJIKYO)
+    {
+      *charset = Vcharset_ucs;
+      return c;
+    }
+  else if (c <= MAX_CHAR_MOJIKYO)
+    {
+      *charset = Vcharset_mojikyo;
+      return c - MIN_CHAR_MOJIKYO;
+    }
   else
     {
       *charset = Vcharset_ucs;
@@ -2562,13 +2590,14 @@ Return a list of the names of all defined charsets.
 }
 
 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
-Return the name of the given charset.
+Return the name of charset CHARSET.
 */
        (charset))
 {
   return XCHARSET_NAME (Fget_charset (charset));
 }
 
+/* #### SJT Should generic properties be allowed? */
 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
 Define a new character set.
 This function is for use with Mule support.
@@ -2622,7 +2651,6 @@ character set.  Recognized properties are:
   int direction = CHARSET_LEFT_TO_RIGHT;
   Lisp_Object registry = Qnil;
   Lisp_Object charset;
-  Lisp_Object rest, keyword, value;
   Lisp_Object ccl_program = Qnil;
   Lisp_Object short_name = Qnil, long_name = Qnil;
   int byte_offset = -1;
@@ -2635,89 +2663,94 @@ character set.  Recognized properties are:
   if (!NILP (charset))
     signal_simple_error ("Cannot redefine existing charset", name);
 
-  EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
-    {
-      if (EQ (keyword, Qshort_name))
-       {
-         CHECK_STRING (value);
-         short_name = value;
-       }
+  {
+    EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props)
+      {
+       if (EQ (keyword, Qshort_name))
+         {
+           CHECK_STRING (value);
+           short_name = value;
+         }
 
-      if (EQ (keyword, Qlong_name))
-       {
-         CHECK_STRING (value);
-         long_name = value;
-       }
+       if (EQ (keyword, Qlong_name))
+         {
+           CHECK_STRING (value);
+           long_name = value;
+         }
 
-      else if (EQ (keyword, Qdimension))
-       {
-         CHECK_INT (value);
-         dimension = XINT (value);
-         if (dimension < 1 || dimension > 2)
-           signal_simple_error ("Invalid value for 'dimension", value);
-       }
+       else if (EQ (keyword, Qdimension))
+         {
+           CHECK_INT (value);
+           dimension = XINT (value);
+           if (dimension < 1 || dimension > 2)
+             signal_simple_error ("Invalid value for 'dimension", value);
+         }
 
-      else if (EQ (keyword, Qchars))
-       {
-         CHECK_INT (value);
-         chars = XINT (value);
-         if (chars != 94 && chars != 96)
-           signal_simple_error ("Invalid value for 'chars", value);
-       }
+       else if (EQ (keyword, Qchars))
+         {
+           CHECK_INT (value);
+           chars = XINT (value);
+           if (chars != 94 && chars != 96)
+             signal_simple_error ("Invalid value for 'chars", value);
+         }
 
-      else if (EQ (keyword, Qcolumns))
-       {
-         CHECK_INT (value);
-         columns = XINT (value);
-         if (columns != 1 && columns != 2)
-           signal_simple_error ("Invalid value for 'columns", value);
-       }
+       else if (EQ (keyword, Qcolumns))
+         {
+           CHECK_INT (value);
+           columns = XINT (value);
+           if (columns != 1 && columns != 2)
+             signal_simple_error ("Invalid value for 'columns", value);
+         }
 
-      else if (EQ (keyword, Qgraphic))
-       {
-         CHECK_INT (value);
-         graphic = XINT (value);
+       else if (EQ (keyword, Qgraphic))
+         {
+           CHECK_INT (value);
+           graphic = XINT (value);
 #ifdef UTF2000
-         if (graphic < 0 || graphic > 2)
+           if (graphic < 0 || graphic > 2)
 #else
-         if (graphic < 0 || graphic > 1)
+           if (graphic < 0 || graphic > 1)
 #endif
-           signal_simple_error ("Invalid value for 'graphic", value);
-       }
+             signal_simple_error ("Invalid value for 'graphic", value);
+         }
 
-      else if (EQ (keyword, Qregistry))
-       {
-         CHECK_STRING (value);
-         registry = value;
-       }
+       else if (EQ (keyword, Qregistry))
+         {
+           CHECK_STRING (value);
+           registry = value;
+         }
 
-      else if (EQ (keyword, Qdirection))
-       {
-         if (EQ (value, Ql2r))
-           direction = CHARSET_LEFT_TO_RIGHT;
-         else if (EQ (value, Qr2l))
-           direction = CHARSET_RIGHT_TO_LEFT;
-         else
-           signal_simple_error ("Invalid value for 'direction", value);
-       }
+       else if (EQ (keyword, Qdirection))
+         {
+           if (EQ (value, Ql2r))
+             direction = CHARSET_LEFT_TO_RIGHT;
+           else if (EQ (value, Qr2l))
+             direction = CHARSET_RIGHT_TO_LEFT;
+           else
+             signal_simple_error ("Invalid value for 'direction", value);
+         }
 
-      else if (EQ (keyword, Qfinal))
-       {
-         CHECK_CHAR_COERCE_INT (value);
-         final = XCHAR (value);
-         if (final < '0' || final > '~')
-           signal_simple_error ("Invalid value for 'final", value);
-       }
+       else if (EQ (keyword, Qfinal))
+         {
+           CHECK_CHAR_COERCE_INT (value);
+           final = XCHAR (value);
+           if (final < '0' || final > '~')
+             signal_simple_error ("Invalid value for 'final", value);
+         }
 
-      else if (EQ (keyword, Qccl_program))
-       {
-         CHECK_VECTOR (value);
-         ccl_program = value;
-       }
+       else if (EQ (keyword, Qccl_program))
+         {
+           struct ccl_program test_ccl;
 
-      else
-       signal_simple_error ("Unrecognized property", keyword);
-    }
+           if (setup_ccl_program (&test_ccl, value) < 0)
+             signal_simple_error ("Invalid value for 'ccl-program", value);
+           ccl_program = value;
+         }
+
+       else
+         signal_simple_error ("Unrecognized property", keyword);
+      }
+  }
 
   if (!final)
     error ("'final must be specified");
@@ -2937,7 +2970,7 @@ Return dimension of CHARSET.
 }
 
 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
-Return property PROP of CHARSET.
+Return property PROP of CHARSET, a charset object or symbol naming a charset.
 Recognized properties are those listed in `make-charset', as well as
 'name and 'doc-string.
 */
@@ -2965,10 +2998,8 @@ Recognized properties are those listed in `make-charset', as well as
   if (EQ (prop, Qreverse_direction_charset))
     {
       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
-      if (NILP (obj))
-       return Qnil;
-      else
-       return XCHARSET_NAME (obj);
+      /* #### Is this translation OK?  If so, error checking sufficient? */
+      return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj;
     }
   signal_simple_error ("Unrecognized charset property name", prop);
   return Qnil; /* not reached */
@@ -2990,8 +3021,11 @@ Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
 */
        (charset, ccl_program))
 {
+  struct ccl_program test_ccl;
+
   charset = Fget_charset (charset);
-  CHECK_VECTOR (ccl_program);
+  if (setup_ccl_program (&test_ccl, ccl_program) < 0)
+    signal_simple_error ("Invalid ccl-program", ccl_program);
   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
   return Qnil;
 }
@@ -3135,7 +3169,8 @@ Make a character from CHARSET and code-point CODE.
   c = XINT (code);
   if (XCHARSET_GRAPHIC (charset) == 1)
     c &= 0x7F7F7F7F;
-  return make_char (DECODE_CHAR (charset, c));
+  c = DECODE_CHAR (charset, c);
+  return c >= 0 ? make_char (c) : Qnil;
 }
 
 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
@@ -3144,69 +3179,41 @@ Make a builtin character from CHARSET and code-point CODE.
        (charset, code))
 {
   int c;
-  int final;
 
   charset = Fget_charset (charset);
   CHECK_INT (code);
-  c = XINT (code);
-
-  if ((final = XCHARSET_FINAL (charset)) >= '0')
+  if (EQ (charset, Vcharset_latin_viscii))
     {
-      if (XCHARSET_DIMENSION (charset) == 1)
+      Lisp_Object chr = Fdecode_char (charset, code);
+      Lisp_Object ret;
+
+      if (!NILP (chr))
        {
-         switch (XCHARSET_CHARS (charset))
+         if (!NILP
+             (ret = Fget_char_attribute (chr,
+                                         Vcharset_latin_viscii_lower,
+                                         Qnil)))
            {
-           case 94:
-             return
-               make_char (MIN_CHAR_94 + (final - '0') * 94
-                          + ((c & 0x7F) - 33));
-           case 96:
-             return
-               make_char (MIN_CHAR_96 + (final - '0') * 96
-                          + ((c & 0x7F) - 32));
-           default:
-             return Fdecode_char (charset, code);
+             charset = Vcharset_latin_viscii_lower;
+             code = ret;
            }
-       }
-      else
-       {
-         switch (XCHARSET_CHARS (charset))
+         else if (!NILP
+                  (ret = Fget_char_attribute (chr,
+                                              Vcharset_latin_viscii_upper,
+                                              Qnil)))
            {
-           case 94:
-             return
-               make_char (MIN_CHAR_94x94
-                          + (final - '0') * 94 * 94
-                          + (((c >> 8) & 0x7F) - 33) * 94
-                          + ((c & 0x7F) - 33));
-           case 96:
-             return
-               make_char (MIN_CHAR_96x96
-                          + (final - '0') * 96 * 96
-                          + (((c >> 8) & 0x7F) - 32) * 96
-                          + ((c & 0x7F) - 32));
-           default:
-             return Fdecode_char (charset, code);
+             charset = Vcharset_latin_viscii_upper;
+             code = ret;
            }
        }
     }
-  else if (XCHARSET_UCS_MAX (charset))
-    {
-      Emchar cid
-       = (XCHARSET_DIMENSION (charset) == 1
-          ?
-          c - XCHARSET_BYTE_OFFSET (charset)
-          :
-          ((c >> 8) - XCHARSET_BYTE_OFFSET (charset))
-          * XCHARSET_CHARS (charset)
-          + (c & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
-       - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset);
-      if ((cid < XCHARSET_UCS_MIN (charset))
-         || (XCHARSET_UCS_MAX (charset) < cid))
-       return Fdecode_char (charset, code);
-      return make_char (cid);
-    }
-  else
-    return Fdecode_char (charset, code);
+  c = XINT (code);
+#if 0
+  if (XCHARSET_GRAPHIC (charset) == 1)
+    c &= 0x7F7F7F7F;
+#endif
+  c = decode_builtin_char (charset, c);
+  return c >= 0 ? make_char (c) : Fdecode_char (charset, code);
 }
 #endif
 
@@ -3235,7 +3242,7 @@ character s with caron.
 
   CHECK_INT (arg1);
   /* It is useful (and safe, according to Olivier Galibert) to strip
-     the 8th bit off ARG1 and ARG2 becaue it allows programmers to
+     the 8th bit off ARG1 and ARG2 because it allows programmers to
      write (make-char 'latin-iso8859-2 CODE) where code is the actual
      Latin 2 code of the character.  */
 #ifdef UTF2000
@@ -3271,27 +3278,27 @@ character s with caron.
 }
 
 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
-Return the character set of char CH.
+Return the character set of CHARACTER.
 */
-       (ch))
+       (character))
 {
-  CHECK_CHAR_COERCE_INT (ch);
+  CHECK_CHAR_COERCE_INT (character);
 
-  return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
+  return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character)));
 }
 
 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
-Return the octet numbered N (should be 0 or 1) of char CH.
+Return the octet numbered N (should be 0 or 1) of CHARACTER.
 N defaults to 0 if omitted.
 */
-       (ch, n))
+       (character, n))
 {
   Lisp_Object charset;
   int octet0, octet1;
 
-  CHECK_CHAR_COERCE_INT (ch);
+  CHECK_CHAR_COERCE_INT (character);
 
-  BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1);
+  BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
 
   if (NILP (n) || EQ (n, Qzero))
     return make_int (octet0);
@@ -3302,7 +3309,7 @@ N defaults to 0 if omitted.
 }
 
 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
-Return list of charset and one or two position-codes of CHAR.
+Return list of charset and one or two position-codes of CHARACTER.
 */
        (character))
 {
@@ -3513,6 +3520,7 @@ syms_of_mule_charset (void)
   defsymbol (&Qlatin_iso8859_9,                "latin-iso8859-9");
   defsymbol (&Qjapanese_jisx0208_1978, "japanese-jisx0208-1978");
   defsymbol (&Qchinese_gb2312,         "chinese-gb2312");
+  defsymbol (&Qchinese_gb12345,                "chinese-gb12345");
   defsymbol (&Qjapanese_jisx0208,      "japanese-jisx0208");
   defsymbol (&Qjapanese_jisx0208_1990,         "japanese-jisx0208-1990");
   defsymbol (&Qkorean_ksc5601,         "korean-ksc5601");
@@ -3520,6 +3528,7 @@ syms_of_mule_charset (void)
   defsymbol (&Qchinese_cns11643_1,     "chinese-cns11643-1");
   defsymbol (&Qchinese_cns11643_2,     "chinese-cns11643-2");
 #ifdef UTF2000
+  defsymbol (&Qto_ucs,                 "=>ucs");
   defsymbol (&Q_ucs,                   "->ucs");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
@@ -3540,13 +3549,28 @@ syms_of_mule_charset (void)
   defsymbol (&Qfont,                   "font");
   defsymbol (&Qucs,                    "ucs");
   defsymbol (&Qucs_bmp,                        "ucs-bmp");
+  defsymbol (&Qucs_cns,                        "ucs-cns");
+  defsymbol (&Qucs_big5,               "ucs-big5");
   defsymbol (&Qlatin_viscii,           "latin-viscii");
   defsymbol (&Qlatin_tcvn5712,         "latin-tcvn5712");
   defsymbol (&Qlatin_viscii_lower,     "latin-viscii-lower");
   defsymbol (&Qlatin_viscii_upper,     "latin-viscii-upper");
   defsymbol (&Qvietnamese_viscii_lower,        "vietnamese-viscii-lower");
   defsymbol (&Qvietnamese_viscii_upper,        "vietnamese-viscii-upper");
+  defsymbol (&Qideograph_gt,           "ideograph-gt");
+  defsymbol (&Qideograph_gt_pj_1,      "ideograph-gt-pj-1");
+  defsymbol (&Qideograph_gt_pj_2,      "ideograph-gt-pj-2");
+  defsymbol (&Qideograph_gt_pj_3,      "ideograph-gt-pj-3");
+  defsymbol (&Qideograph_gt_pj_4,      "ideograph-gt-pj-4");
+  defsymbol (&Qideograph_gt_pj_5,      "ideograph-gt-pj-5");
+  defsymbol (&Qideograph_gt_pj_6,      "ideograph-gt-pj-6");
+  defsymbol (&Qideograph_gt_pj_7,      "ideograph-gt-pj-7");
+  defsymbol (&Qideograph_gt_pj_8,      "ideograph-gt-pj-8");
+  defsymbol (&Qideograph_gt_pj_9,      "ideograph-gt-pj-9");
+  defsymbol (&Qideograph_gt_pj_10,     "ideograph-gt-pj-10");
+  defsymbol (&Qideograph_gt_pj_11,     "ideograph-gt-pj-11");
   defsymbol (&Qideograph_daikanwa,     "ideograph-daikanwa");
+  defsymbol (&Qchinese_big5,           "chinese-big5");
   defsymbol (&Qmojikyo,                        "mojikyo");
   defsymbol (&Qmojikyo_2022_1,         "mojikyo-2022-1");
   defsymbol (&Qmojikyo_pj_1,           "mojikyo-pj-1");
@@ -3674,6 +3698,24 @@ complex_vars_of_mule_charset (void)
                  build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
                  build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
                  Qnil, 0, 0xFFFF, 0, 0);
+  staticpro (&Vcharset_ucs_cns);
+  Vcharset_ucs_cns =
+    make_charset (LEADING_BYTE_UCS_CNS, Qucs_cns, 256, 3,
+                 1, 2, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("UCS for CNS"),
+                 build_string ("UCS for CNS 11643"),
+                 build_string ("ISO/IEC 10646 for CNS 11643"),
+                 build_string (""),
+                 Qnil, 0, 0, 0, 0);
+  staticpro (&Vcharset_ucs_big5);
+  Vcharset_ucs_big5 =
+    make_charset (LEADING_BYTE_UCS_BIG5, Qucs_big5, 256, 3,
+                 1, 2, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("UCS for Big5"),
+                 build_string ("UCS for Big5"),
+                 build_string ("ISO/IEC 10646 for Big5"),
+                 build_string (""),
+                 Qnil, 0, 0, 0, 0);
 #else
 # define MIN_CHAR_THAI 0
 # define MAX_CHAR_THAI 0
@@ -3832,6 +3874,15 @@ complex_vars_of_mule_charset (void)
                  build_string ("GB2312 Chinese simplified"),
                  build_string ("gb2312"),
                  Qnil, 0, 0, 0, 33);
+  staticpro (&Vcharset_chinese_gb12345);
+  Vcharset_chinese_gb12345 =
+    make_charset (LEADING_BYTE_CHINESE_GB12345, Qchinese_gb12345, 94, 2,
+                 2, 0, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("G1"),
+                 build_string ("GB 12345)"),
+                 build_string ("GB 12345-1990"),
+                 build_string ("GB12345\\(\\.1990\\)?-0"),
+                 Qnil, 0, 0, 0, 33);
   staticpro (&Vcharset_japanese_jisx0208);
   Vcharset_japanese_jisx0208 =
     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 94, 2,
@@ -3903,7 +3954,7 @@ complex_vars_of_mule_charset (void)
                  build_string ("TCVN 5712"),
                  build_string ("TCVN 5712 (VSCII-2)"),
                  build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
-                 build_string ("tcvn5712-1"),
+                 build_string ("tcvn5712\\(\\.1993\\)?-1"),
                  Qnil, 0, 0, 0, 32);
   staticpro (&Vcharset_latin_viscii_lower);
   Vcharset_latin_viscii_lower =
@@ -3932,6 +3983,47 @@ complex_vars_of_mule_charset (void)
                  build_string ("VISCII 1.1 (Vietnamese)"),
                  build_string ("VISCII1\\.1"),
                  Qnil, 0, 0, 0, 0);
+  staticpro (&Vcharset_chinese_big5);
+  Vcharset_chinese_big5 =
+    make_charset (LEADING_BYTE_CHINESE_BIG5, Qchinese_big5, 256, 2,
+                 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("Big5"),
+                 build_string ("Big5"),
+                 build_string ("Big5 Chinese traditional"),
+                 build_string ("big5"),
+                 Qnil, 0, 0, 0, 0);
+  staticpro (&Vcharset_ideograph_gt);
+  Vcharset_ideograph_gt =
+    make_charset (LEADING_BYTE_GT, Qideograph_gt, 256, 3,
+                 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("GT"),
+                 build_string ("GT"),
+                 build_string ("GT"),
+                 build_string (""),
+                 Qnil, MIN_CHAR_GT, MAX_CHAR_GT, 0, 0);
+#define DEF_GT_PJ(n)                                                   \
+  staticpro (&Vcharset_ideograph_gt_pj_##n);                           \
+  Vcharset_ideograph_gt_pj_##n =                                       \
+    make_charset (LEADING_BYTE_GT_PJ_##n, Qideograph_gt_pj_##n, 94, 2, \
+                 2, 0, 0, CHARSET_LEFT_TO_RIGHT,                       \
+                 build_string ("GT-PJ-"#n),                            \
+                 build_string ("GT (pseudo JIS encoding) part "#n),    \
+                 build_string ("GT 2000 (pseudo JIS encoding) part "#n), \
+                 build_string                                          \
+                 ("\\(GT2000PJ-"#n "\\|jisx0208\\.GT2000-"#n "\\)$"),  \
+                 Qnil, 0, 0, 0, 33);
+  DEF_GT_PJ (1);
+  DEF_GT_PJ (2);
+  DEF_GT_PJ (3);
+  DEF_GT_PJ (4);
+  DEF_GT_PJ (5);
+  DEF_GT_PJ (6);
+  DEF_GT_PJ (7);
+  DEF_GT_PJ (8);
+  DEF_GT_PJ (9);
+  DEF_GT_PJ (10);
+  DEF_GT_PJ (11);
+
   staticpro (&Vcharset_ideograph_daikanwa);
   Vcharset_ideograph_daikanwa =
     make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa, 256, 2,