(fullwidth *): Renamed from `FULLWIDTH *'; unify BIG5 and JIS X 0213
[chise/xemacs-chise.git] / src / mule-charset.c
index 7dc68f2..84a9de9 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.
 
@@ -65,11 +65,24 @@ 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_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;
@@ -1487,9 +1500,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,7 +1519,8 @@ 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);
        }
@@ -1533,36 +1544,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;
@@ -1608,6 +1594,7 @@ Lisp_Object Qascii,
   Qchinese_cns11643_2,
 #ifdef UTF2000
   Qucs_bmp,
+  Qucs_cns,
   Qlatin_viscii,
   Qlatin_tcvn5712,
   Qlatin_viscii_lower,
@@ -1615,6 +1602,18 @@ Lisp_Object Qascii,
   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,
@@ -2039,8 +2038,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,
@@ -2162,73 +2162,84 @@ get_unallocated_leading_byte (int dimension)
 #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
+       = (c1 - 0xA1) * BIG5_SAME_ROW
+       + c2 - (c2 < 0x7F ? 0x40 : 0x62);
+
+      if (c1 < 0xC9)
        {
-       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 ();
+         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')
     {
-      if (EQ (charset, Vcharset_chinese_big5))
+      if (XCHARSET_DIMENSION (charset) == 1)
        {
-         int B1 = c1, B2 = c2;
-         unsigned int I
-           = (B1 - 0xA1) * BIG5_SAME_ROW
-           + B2 - (B2 < 0x7F ? 0x40 : 0x62);
-
-         if (B1 < 0xC9)
-           {
-             charset = Vcharset_chinese_big5_1;
-           }
-         else
+         switch (XCHARSET_CHARS (charset))
            {
-             charset = Vcharset_chinese_big5_2;
-             I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);
+           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;
            }
-         c1 = I / 94 + 33;
-         c2 = I % 94 + 33;
        }
-      switch (XCHARSET_CHARS (charset))
+      else
        {
-       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_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
@@ -2388,17 +2399,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)
     {
@@ -2461,6 +2470,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;
@@ -2560,6 +2579,7 @@ Return the name of 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.
@@ -2932,7 +2952,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.
 */
@@ -2960,10 +2980,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 */
@@ -3133,7 +3151,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 ? make_char (c) : Qnil;
 }
 
 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
@@ -3142,69 +3161,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 ? make_char (c) : Fdecode_char (charset, code);
 }
 #endif
 
@@ -3538,12 +3529,25 @@ syms_of_mule_charset (void)
   defsymbol (&Qfont,                   "font");
   defsymbol (&Qucs,                    "ucs");
   defsymbol (&Qucs_bmp,                        "ucs-bmp");
+  defsymbol (&Qucs_cns,                        "ucs-cns");
   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");
@@ -3673,6 +3677,15 @@ 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);
 #else
 # define MIN_CHAR_THAI 0
 # define MAX_CHAR_THAI 0
@@ -3940,6 +3953,38 @@ complex_vars_of_mule_charset (void)
                  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,