(LEADING_BYTE_DAIKANWA): New macro.

[chise/xemacs-chise.git] / src / mule-charset.c

diff --git a/src/mule-charset.c b/src/mule-charset.c
index 8b07535..0d6237b 100644 (file)
--- a/src/mule-charset.c
+++ b/src/mule-charset.c
@@ -62,6 +62,7 @@ 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_ethiopic_ucs;
 Lisp_Object Vcharset_hiragana_jisx0208;
 Lisp_Object Vcharset_katakana_jisx0208;
 #endif
@@ -380,14 +381,20 @@ put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table)
 
 Lisp_Object Vcharacter_attribute_table;
 Lisp_Object Vcharacter_composition_table;
+Lisp_Object Vcharacter_variant_table;
 
 Lisp_Object Q_decomposition;
-Lisp_Object Qwide;
-Lisp_Object Qnarrow;
+Lisp_Object Q_ucs;
 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)
@@ -396,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);
 }
@@ -446,6 +461,16 @@ Return character corresponding with list.
   signal_simple_error ("Invalid value for composition", list);
 }
 
+DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
+Return variants of CHARACTER.
+*/
+       (character))
+{
+  CHECK_CHAR (character);
+  return Fcopy_list (get_char_code_table (XCHAR (character),
+                                         Vcharacter_variant_table));
+}
+
 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
 Return the alist of attributes of CHARACTER.
 */
@@ -504,6 +529,7 @@ Store CHARACTER's ATTRIBUTE with VALUE.
 {
   Lisp_Object ccs;
 
+  CHECK_CHAR (character);
   ccs = Ffind_charset (attribute);
   if (!NILP (ccs))
     {
@@ -551,6 +577,8 @@ Store CHARACTER's ATTRIBUTE with VALUE.
          XCHARSET_DECODING_TABLE (ccs) = v = make_vector (ccs_len, Qnil);
        }
 
+      if (XCHARSET_GRAPHIC (ccs) == 1)
+       value = Fcopy_list (value);
       rest = value;
       i = -1;
       while (CONSP (rest))
@@ -558,9 +586,16 @@ Store CHARACTER's ATTRIBUTE with VALUE.
          Lisp_Object ei = Fcar (rest);
          
          if (!INTP (ei))
-           signal_simple_error ("Invalid value for coded-charset",
-                                value);
-         i = XINT (ei) - XCHARSET_BYTE_OFFSET (ccs);
+           signal_simple_error ("Invalid value for coded-charset", value);
+         i = XINT (ei);
+         if ((i < 0) || (255 < i))
+           signal_simple_error ("Invalid value for coded-charset", value);
+         if (XCHARSET_GRAPHIC (ccs) == 1)
+           {
+             i &= 0x7F;
+             Fsetcar (rest, make_int (i));
+           }
+         i -= XCHARSET_BYTE_OFFSET (ccs);
          nv = XVECTOR_DATA(v)[i];
          rest = Fcdr (rest);
          if (CONSP (rest))
@@ -610,6 +645,23 @@ Store CHARACTER's ATTRIBUTE with VALUE.
            }
        }
     }
+  else if (EQ (attribute, Q_ucs))
+    {
+      Lisp_Object ret;
+      Emchar c;
+
+      if (!INTP (value))
+       signal_simple_error ("Invalid value for ->ucs", value);
+
+      c = XINT (value);
+
+      ret = get_char_code_table (c, Vcharacter_variant_table);
+      if (NILP (Fmemq (character, ret)))
+       {
+         put_char_code_table (c, Fcons (character, ret),
+                              Vcharacter_variant_table);
+       }
+    }
   return put_char_attribute (character, attribute, value);
 }
 
@@ -764,6 +816,7 @@ Lisp_Object Qascii,
   Qlatin_viscii_upper,
   Qvietnamese_viscii_lower,
   Qvietnamese_viscii_upper,
+  Qethiopic_ucs,
   Qhiragana_jisx0208,
   Qkatakana_jisx0208,
 #endif
@@ -2130,7 +2183,16 @@ Set mapping-table of CHARSET to TABLE.
     }
   else if (VECTORP (table))
     {
-      if (XVECTOR_LENGTH (table) > CHARSET_CHARS (cs))
+      int ccs_len;
+
+      /* ad-hoc method for `ascii' */
+      if ((CHARSET_CHARS (cs) == 94) &&
+         (CHARSET_BYTE_OFFSET (cs) != 33))
+       ccs_len = 128 - CHARSET_BYTE_OFFSET (cs);
+      else
+       ccs_len = CHARSET_CHARS (cs);
+
+      if (XVECTOR_LENGTH (table) > ccs_len)
        args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
       old_table = CHARSET_DECODING_TABLE(cs);
       CHARSET_DECODING_TABLE(cs) = table;
@@ -2401,6 +2463,7 @@ syms_of_mule_charset (void)
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);
   DEFSUBR (Fdefine_char);
+  DEFSUBR (Fchar_variants);
   DEFSUBR (Fget_composite_char);
   DEFSUBR (Fcharset_mapping_table);
   DEFSUBR (Fset_charset_mapping_table);
@@ -2451,13 +2514,18 @@ syms_of_mule_charset (void)
   defsymbol (&Qchinese_cns11643_1,     "chinese-cns11643-1");
   defsymbol (&Qchinese_cns11643_2,     "chinese-cns11643-2");
 #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");
@@ -2465,6 +2533,7 @@ 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 (&Qethiopic_ucs,           "ethiopic-ucs");
   defsymbol (&Qhiragana_jisx0208,      "hiragana-jisx0208");
   defsymbol (&Qkatakana_jisx0208,      "katakana-jisx0208");
 #endif
@@ -2526,6 +2595,9 @@ Version number of UTF-2000.
   staticpro (&Vcharacter_composition_table);
   Vcharacter_composition_table = make_char_code_table (Qnil);
 
+  staticpro (&Vcharacter_variant_table);
+  Vcharacter_variant_table = make_char_code_table (Qnil);
+
   Vdefault_coded_charset_priority_list = Qnil;
   DEFVAR_LISP ("default-coded-charset-priority-list",
               &Vdefault_coded_charset_priority_list /*
@@ -2790,6 +2862,15 @@ complex_vars_of_mule_charset (void)
                  build_string ("VISCII 1.1 (Vietnamese)"),
                  build_string ("VISCII1\\.1"),
                  Qnil, 0, 0, 0, 0);
+  Vcharset_ethiopic_ucs =
+    make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs,
+                 CHARSET_TYPE_256X256, 2, 2, 0,
+                 CHARSET_LEFT_TO_RIGHT,
+                 build_string ("Ethiopic (UCS)"),
+                 build_string ("Ethiopic (UCS)"),
+                 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',