update.
[chise/xemacs-chise.git-] / src / mule-charset.c
index 870a6f5..1d148f4 100644 (file)
@@ -53,6 +53,7 @@ Lisp_Object Vcharset_latin_iso8859_9;
 Lisp_Object Vcharset_japanese_jisx0208_1978;
 Lisp_Object Vcharset_chinese_gb2312;
 Lisp_Object Vcharset_japanese_jisx0208;
+Lisp_Object Vcharset_japanese_jisx0208_1990;
 Lisp_Object Vcharset_korean_ksc5601;
 Lisp_Object Vcharset_japanese_jisx0212;
 Lisp_Object Vcharset_chinese_cns11643_1;
@@ -62,9 +63,8 @@ Lisp_Object Vcharset_ucs_bmp;
 Lisp_Object Vcharset_latin_viscii;
 Lisp_Object Vcharset_latin_viscii_lower;
 Lisp_Object Vcharset_latin_viscii_upper;
+Lisp_Object Vcharset_ideograph_daikanwa;
 Lisp_Object Vcharset_ethiopic_ucs;
-Lisp_Object Vcharset_hiragana_jisx0208;
-Lisp_Object Vcharset_katakana_jisx0208;
 #endif
 Lisp_Object Vcharset_chinese_big5_1;
 Lisp_Object Vcharset_chinese_big5_2;
@@ -385,12 +385,16 @@ Lisp_Object Vcharacter_variant_table;
 
 Lisp_Object Q_decomposition;
 Lisp_Object Q_ucs;
-Lisp_Object Qwide;
-Lisp_Object Qnarrow;
 Lisp_Object Qcompat;
 Lisp_Object QnoBreak;
-Lisp_Object Qsuper;
 Lisp_Object Qfraction;
+Lisp_Object Qsuper;
+Lisp_Object Qsub;
+Lisp_Object Qcircle;
+Lisp_Object Qsquare;
+Lisp_Object Qwide;
+Lisp_Object Qnarrow;
+Lisp_Object Qfont;
 
 Emchar
 to_char_code (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
@@ -399,18 +403,26 @@ to_char_code (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
     return XINT (v);
   if (CHARP (v))
     return XCHAR (v);
-  else if (EQ (v, Qwide))
+  else if (EQ (v, Qcompat))
     return -1;
-  else if (EQ (v, Qnarrow))
+  else if (EQ (v, QnoBreak))
     return -2;
-  else if (EQ (v, Qcompat))
+  else if (EQ (v, Qfraction))
     return -3;
-  else if (EQ (v, QnoBreak))
-    return -4;
   else if (EQ (v, Qsuper))
+    return -4;
+  else if (EQ (v, Qsub))
     return -5;
-  else if (EQ (v, Qfraction))
+  else if (EQ (v, Qcircle))
     return -6;
+  else if (EQ (v, Qsquare))
+    return -7;
+  else if (EQ (v, Qwide))
+    return -8;
+  else if (EQ (v, Qnarrow))
+    return -9;
+  else if (EQ (v, Qfont))
+    return -10;
   else 
     signal_simple_error (err_msg, err_arg);
 }
@@ -474,10 +486,12 @@ Return the value of CHARACTER's ATTRIBUTE.
 */
        (character, attribute))
 {
-  Lisp_Object ret
-    = get_char_code_table (XCHAR (character), Vcharacter_attribute_table);
+  Lisp_Object ret;
   Lisp_Object ccs;
 
+  CHECK_CHAR (character);
+  ret = get_char_code_table (XCHAR (character),
+                            Vcharacter_attribute_table);
   if (EQ (ret, Qnil))
     return Qnil;
 
@@ -517,6 +531,7 @@ Store CHARACTER's ATTRIBUTE with VALUE.
 {
   Lisp_Object ccs;
 
+  CHECK_CHAR (character);
   ccs = Ffind_charset (attribute);
   if (!NILP (ccs))
     {
@@ -654,6 +669,8 @@ Store CHARACTER's ATTRIBUTE with VALUE.
 
 Lisp_Object Qucs;
 
+EXFUN (Fmake_char, 3);
+
 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
 Store character's ATTRIBUTES.
 */
@@ -672,71 +689,23 @@ Store character's ATTRIBUTES.
 
          if (!LISTP (cell))
            signal_simple_error ("Invalid argument", attributes);
-         if (!NILP (ccs = Ffind_charset (Fcar (cell)))
-             && XCHARSET_FINAL (ccs))
+         if (!NILP (ccs = Ffind_charset (Fcar (cell))))
            {
-             Emchar code;
-
-             if (XCHARSET_DIMENSION (ccs) == 1)
-               {
-                 Lisp_Object eb1 = Fcar (Fcdr (cell));
-                 int b1;
-
-                 if (!INTP (eb1))
-                   signal_simple_error ("Invalid argument", attributes);
-                 b1 = XINT (eb1);
-                 switch (XCHARSET_CHARS (ccs))
-                   {
-                   case 94:
-                     code = MIN_CHAR_94
-                       + (XCHARSET_FINAL (ccs) - '0') * 94 + (b1 - 33);
-                     break;
-                   case 96:
-                     code = MIN_CHAR_96
-                       + (XCHARSET_FINAL (ccs) - '0') * 96 + (b1 - 32);
-                     break;
-                   default:
-                     abort ();
-                   }
-               }
-             else if (XCHARSET_DIMENSION (ccs) == 2)
-               {
-                 Lisp_Object eb1 = Fcar (Fcdr (cell));
-                 Lisp_Object eb2 = Fcar (Fcdr (Fcdr (cell)));
-                 int b1, b2;
-
-                 if (!INTP (eb1))
-                   signal_simple_error ("Invalid argument", attributes);
-                 b1 = XINT (eb1);
-                 if (!INTP (eb2))
-                   signal_simple_error ("Invalid argument", attributes);
-                 b2 = XINT (eb2);
-                 switch (XCHARSET_CHARS (ccs))
-                   {
-                   case 94:
-                     code = MIN_CHAR_94x94
-                       + (XCHARSET_FINAL (ccs) - '0') * 94 * 94
-                       + (b1 - 33) * 94 + (b2 - 33);
-                     break;
-                   case 96:
-                     code = MIN_CHAR_96x96
-                       + (XCHARSET_FINAL (ccs) - '0') * 96 * 96
-                       + (b1 - 32) * 96 + (b2 - 32);
-                     break;
-                   default:
-                     abort ();
-                   }
-               }
-             else
-               {
-                 rest = Fcdr (rest);
-                 continue;
-               }
-             character = make_char (code);
+             cell = Fcdr (cell);
+             character = Fmake_char (ccs, Fcar (cell),
+                                     Fcar (Fcdr (cell)));
              goto setup_attributes;
            }
          rest = Fcdr (rest);
        }
+      if (!NILP (code = Fcdr (Fassq (Q_ucs, attributes))))
+       {
+         if (!INTP (code))
+           signal_simple_error ("Invalid argument", attributes);
+         else
+           character = make_char (XINT (code) + 0x100000);
+         goto setup_attributes;
+       }
       return Qnil;
     }
   else if (!INTP (code))
@@ -792,6 +761,7 @@ Lisp_Object Qascii,
   Qjapanese_jisx0208_1978,
   Qchinese_gb2312,
   Qjapanese_jisx0208,
+  Qjapanese_jisx0208_1990,
   Qkorean_ksc5601,
   Qjapanese_jisx0212,
   Qchinese_cns11643_1,
@@ -803,9 +773,8 @@ Lisp_Object Qascii,
   Qlatin_viscii_upper,
   Qvietnamese_viscii_lower,
   Qvietnamese_viscii_upper,
+  Qideograph_daikanwa,
   Qethiopic_ucs,
-  Qhiragana_jisx0208,
-  Qkatakana_jisx0208,
 #endif
   Qchinese_big5_1,
   Qchinese_big5_2,
@@ -1533,6 +1502,12 @@ split_builtin_char (Emchar c)
                    make_int ((((c - MIN_CHAR_OBS_94x94) / 94) % 94) + 33),
                    make_int (((c - MIN_CHAR_OBS_94x94) % 94) + 33));
     }
+  else if (c <= MAX_CHAR_DAIKANWA)
+    {
+      return list3 (Vcharset_ideograph_daikanwa,
+                   make_int ((c - MIN_CHAR_DAIKANWA) >> 8),
+                   make_int ((c - MIN_CHAR_DAIKANWA) & 255));
+    }
   else if (c <= MAX_CHAR_94)
     {
       return list2 (CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94,
@@ -2321,6 +2296,18 @@ Return list of charset and one or two position-codes of CHAR.
 */
        (character))
 {
+#ifdef UTF2000
+  Lisp_Object ret;
+  Lisp_Object charset;
+
+  CHECK_CHAR_COERCE_INT (character);
+  ret = SPLIT_CHAR (XCHAR (character));
+  charset = Fcar (ret);
+  if (CHARSETP (charset))
+    return Fcons (XCHARSET_NAME (charset), Fcopy_list (Fcdr (ret)));
+  else
+    return ret;
+#else
   /* This function can GC */
   struct gcpro gcpro1, gcpro2;
   Lisp_Object charset = Qnil;
@@ -2341,8 +2328,8 @@ Return list of charset and one or two position-codes of CHAR.
       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
     }
   UNGCPRO;
-
   return rc;
+#endif
 }
 
 \f
@@ -2496,6 +2483,7 @@ syms_of_mule_charset (void)
   defsymbol (&Qjapanese_jisx0208_1978, "japanese-jisx0208-1978");
   defsymbol (&Qchinese_gb2312,         "chinese-gb2312");
   defsymbol (&Qjapanese_jisx0208,      "japanese-jisx0208");
+  defsymbol (&Qjapanese_jisx0208_1990,         "japanese-jisx0208-1990");
   defsymbol (&Qkorean_ksc5601,         "korean-ksc5601");
   defsymbol (&Qjapanese_jisx0212,      "japanese-jisx0212");
   defsymbol (&Qchinese_cns11643_1,     "chinese-cns11643-1");
@@ -2503,12 +2491,16 @@ syms_of_mule_charset (void)
 #ifdef UTF2000
   defsymbol (&Q_ucs,                   "->ucs");
   defsymbol (&Q_decomposition,         "->decomposition");
-  defsymbol (&Qwide,                   "wide");
-  defsymbol (&Qnarrow,                 "narrow");
   defsymbol (&Qcompat,                 "compat");
   defsymbol (&QnoBreak,                        "noBreak");
-  defsymbol (&Qsuper,                  "super");
   defsymbol (&Qfraction,               "fraction");
+  defsymbol (&Qsuper,                  "super");
+  defsymbol (&Qsub,                    "sub");
+  defsymbol (&Qcircle,                 "circle");
+  defsymbol (&Qsquare,                 "square");
+  defsymbol (&Qwide,                   "wide");
+  defsymbol (&Qnarrow,                 "narrow");
+  defsymbol (&Qfont,                   "font");
   defsymbol (&Qucs,                    "ucs");
   defsymbol (&Qucs_bmp,                        "ucs-bmp");
   defsymbol (&Qlatin_viscii,           "latin-viscii");
@@ -2516,9 +2508,8 @@ syms_of_mule_charset (void)
   defsymbol (&Qlatin_viscii_upper,     "latin-viscii-upper");
   defsymbol (&Qvietnamese_viscii_lower,        "vietnamese-viscii-lower");
   defsymbol (&Qvietnamese_viscii_upper,        "vietnamese-viscii-upper");
+  defsymbol (&Qideograph_daikanwa,     "ideograph-daikanwa");
   defsymbol (&Qethiopic_ucs,           "ethiopic-ucs");
-  defsymbol (&Qhiragana_jisx0208,      "hiragana-jisx0208");
-  defsymbol (&Qkatakana_jisx0208,      "katakana-jisx0208");
 #endif
   defsymbol (&Qchinese_big5_1,         "chinese-big5-1");
   defsymbol (&Qchinese_big5_2,         "chinese-big5-2");
@@ -2777,6 +2768,18 @@ complex_vars_of_mule_charset (void)
                  build_string ("JIS X0208:1983 Japanese Kanji"),
                  build_string ("jisx0208\\.1983"),
                  Qnil, 0, 0, 0, 33);
+  Vcharset_japanese_jisx0208_1990 =
+    make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
+                 Qjapanese_jisx0208_1990,
+                 CHARSET_TYPE_94X94, 2, 0, 0,
+                 CHARSET_LEFT_TO_RIGHT,
+                 build_string ("JISX0208-1990"),
+                 build_string ("JIS X0208:1990 (Japanese)"),
+                 build_string ("JIS X0208:1990 Japanese Kanji"),
+                 build_string ("jisx0208\\.1990"),
+                 Qnil,
+                 MIN_CHAR_JIS_X0208_1990,
+                 MAX_CHAR_JIS_X0208_1990, 0, 33);
   Vcharset_korean_ksc5601 =
     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601,
                  CHARSET_TYPE_94X94, 2, 0, 'C',
@@ -2845,6 +2848,15 @@ complex_vars_of_mule_charset (void)
                  build_string ("VISCII 1.1 (Vietnamese)"),
                  build_string ("VISCII1\\.1"),
                  Qnil, 0, 0, 0, 0);
+  Vcharset_ideograph_daikanwa =
+    make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa,
+                 CHARSET_TYPE_256X256, 2, 2, 0,
+                 CHARSET_LEFT_TO_RIGHT,
+                 build_string ("Daikanwa"),
+                 build_string ("Morohashi's Daikanwa"),
+                 build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
+                 build_string ("Daikanwa"),
+                 Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
   Vcharset_ethiopic_ucs =
     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs,
                  CHARSET_TYPE_256X256, 2, 2, 0,
@@ -2854,26 +2866,6 @@ complex_vars_of_mule_charset (void)
                  build_string ("Ethiopic of UCS"),
                  build_string ("Ethiopic-Unicode"),
                  Qnil, 0x1200, 0x137F, 0x1200, 0);
-  Vcharset_hiragana_jisx0208 =
-    make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208,
-                 CHARSET_TYPE_94X94, 2, 0, 'B',
-                 CHARSET_LEFT_TO_RIGHT,
-                 build_string ("Hiragana"),
-                 build_string ("Hiragana of JIS X0208"),
-                 build_string ("Japanese Hiragana of JIS X0208"),
-                 build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
-                 Qnil, MIN_CHAR_HIRAGANA, MAX_CHAR_HIRAGANA,
-                 (0x24 - 33) * 94 + (0x21 - 33), 33);
-  Vcharset_katakana_jisx0208 =
-    make_charset (LEADING_BYTE_KATAKANA_JISX0208, Qkatakana_jisx0208,
-                 CHARSET_TYPE_94X94, 2, 0, 'B',
-                 CHARSET_LEFT_TO_RIGHT,
-                 build_string ("Katakana"),
-                 build_string ("Katakana of JIS X0208"),
-                 build_string ("Japanese Katakana of JIS X0208"),
-                 build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
-                 Qnil, MIN_CHAR_KATAKANA, MAX_CHAR_KATAKANA,
-                 (0x25 - 33) * 94 + (0x21 - 33), 33);
 #endif
   Vcharset_chinese_big5_1 =
     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1,