(M31170): Separate U+83D4.
[chise/xemacs-chise.git] / src / mule-charset.c
index aba97b7..611a09d 100644 (file)
@@ -66,6 +66,7 @@ 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_mojikyo;
 Lisp_Object Vcharset_mojikyo_pj_1;
 Lisp_Object Vcharset_mojikyo_pj_2;
 Lisp_Object Vcharset_mojikyo_pj_3;
@@ -571,7 +572,38 @@ put_char_attribute (Lisp_Object character, Lisp_Object attribute,
   put_char_code_table (char_code, ret, Vcharacter_attribute_table);
   return ret;
 }
-  
+
+Lisp_Object
+remove_char_attribute (Lisp_Object character, Lisp_Object attribute)
+{
+  Emchar char_code = XCHAR (character);
+  Lisp_Object alist
+    = get_char_code_table (char_code, Vcharacter_attribute_table);
+
+  if (EQ (attribute, Fcar (Fcar (alist))))
+    {
+      alist = Fcdr (alist);
+    }
+  else
+    {
+      Lisp_Object pr = alist;
+      Lisp_Object r = Fcdr (alist);
+
+      while (!NILP (r))
+       {
+         if (EQ (attribute, Fcar (Fcar (r))))
+           {
+             XCDR (pr) = Fcdr (r);
+             break;
+           }
+         pr = r;
+         r = Fcdr (r);
+       }
+    }
+  put_char_code_table (char_code, alist, Vcharacter_attribute_table);
+  return alist;
+}
+
 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
 Store CHARACTER's ATTRIBUTE with VALUE.
 */
@@ -733,10 +765,64 @@ Store CHARACTER's ATTRIBUTE with VALUE.
     }
   return put_char_attribute (character, attribute, value);
 }
+  
+DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
+Remove CHARACTER's ATTRIBUTE.
+*/
+       (character, attribute))
+{
+  Lisp_Object ccs;
+
+  CHECK_CHAR (character);
+  ccs = Ffind_charset (attribute);
+  if (!NILP (ccs))
+    {
+      Lisp_Object cpos;
+      Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
+      Lisp_Object nv;
+      int i = -1;
+      int ccs_len;
+      int dim;
+      int code_point;
+             
+      /* ad-hoc method for `ascii' */
+      if ((XCHARSET_CHARS (ccs) == 94) &&
+         (XCHARSET_BYTE_OFFSET (ccs) != 33))
+       ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs);
+      else
+       ccs_len = XCHARSET_CHARS (ccs);
+
+      attribute = ccs;
+      cpos = Fget_char_attribute (character, attribute);
+      if (VECTORP (v))
+       {
+         if (!NILP (cpos))
+           {
+             dim = XCHARSET_DIMENSION (ccs);
+             code_point = XINT (cpos);
+             while (dim > 0)
+               {
+                 dim--;
+                 i = ((code_point >> (8 * dim)) & 255)
+                   - XCHARSET_BYTE_OFFSET (ccs);
+                 nv = XVECTOR_DATA(v)[i];
+                 if (!VECTORP (nv))
+                   break;
+                 v = nv;
+               }
+             if (i >= 0)
+               XVECTOR_DATA(v)[i] = Qnil;
+             v = XCHARSET_DECODING_TABLE (ccs);
+           }
+       }
+    }
+  return remove_char_attribute (character, attribute);
+}
 
 Lisp_Object Qucs;
 
 EXFUN (Fmake_char, 3);
+EXFUN (Fdecode_char, 2);
 
 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
 Store character's ATTRIBUTES.
@@ -756,11 +842,15 @@ Store character's ATTRIBUTES.
 
          if (!LISTP (cell))
            signal_simple_error ("Invalid argument", attributes);
-         if (!NILP (ccs = Ffind_charset (Fcar (cell))))
+         if (!NILP (ccs = Ffind_charset (Fcar (cell)))
+             && ((XCHARSET_FINAL (ccs) != 0) ||
+                 (XCHARSET_UCS_MAX (ccs) > 0)) )
            {
              cell = Fcdr (cell);
-             character = Fmake_char (ccs, Fcar (cell),
-                                     Fcar (Fcdr (cell)));
+             if (CONSP (cell))
+               character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+             else
+               character = Fdecode_char (ccs, cell);
              goto setup_attributes;
            }
          rest = Fcdr (rest);
@@ -834,7 +924,6 @@ Lisp_Object Qascii,
   Qchinese_cns11643_1,
   Qchinese_cns11643_2,
 #ifdef UTF2000
-  Qucs,
   Qucs_bmp,
   Qlatin_viscii,
   Qlatin_viscii_lower,
@@ -842,6 +931,7 @@ Lisp_Object Qascii,
   Qvietnamese_viscii_lower,
   Qvietnamese_viscii_upper,
   Qideograph_daikanwa,
+  Qmojikyo,
   Qmojikyo_pj_1,
   Qmojikyo_pj_2,
   Qmojikyo_pj_3,
@@ -1462,6 +1552,57 @@ get_unallocated_leading_byte (int dimension)
 }
 
 #ifdef UTF2000
+Emchar
+make_builtin_char (Lisp_Object charset, int c1, int c2)
+{
+  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)
+    {
+      switch (XCHARSET_CHARS (charset))
+       {
+       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 ();
+       }
+    }
+  else
+    {
+      switch (XCHARSET_CHARS (charset))
+       {
+       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 ();
+       }
+    }
+}
+
 int
 range_charset_code_point (Lisp_Object charset, Emchar ch)
 {
@@ -1565,12 +1706,12 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
       *charset = Vcharset_latin_iso8859_1;
       return c & 0x7F;
     }
+  /*
   else if ((MIN_CHAR_GREEK <= c) && (c <= MAX_CHAR_GREEK))
     {
       *charset = Vcharset_greek_iso8859_7;
       return c - MIN_CHAR_GREEK + 0x20;
     }
-  /*
   else if ((MIN_CHAR_CYRILLIC <= c) && (c <= MAX_CHAR_CYRILLIC))
     {
       *charset = Vcharset_cyrillic_iso8859_5;
@@ -1620,14 +1761,26 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
       *charset = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94,
                                        ((c - MIN_CHAR_94) / 94) + '0',
                                        CHARSET_LEFT_TO_RIGHT);
-      return ((c - MIN_CHAR_94) % 94) + 33;
+      if (!NILP (*charset))
+       return ((c - MIN_CHAR_94) % 94) + 33;
+      else
+       {
+         *charset = Vcharset_ucs;
+         return c;
+       }
     }
   else if (c <= MAX_CHAR_96)
     {
       *charset = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_96,
                                        ((c - MIN_CHAR_96) / 96) + '0',
                                        CHARSET_LEFT_TO_RIGHT);
-      return ((c - MIN_CHAR_96) % 96) + 32;
+      if (!NILP (*charset))
+       return ((c - MIN_CHAR_96) % 96) + 32;
+      else
+       {
+         *charset = Vcharset_ucs;
+         return c;
+       }
     }
   else if (c <= MAX_CHAR_94x94)
     {
@@ -1635,8 +1788,14 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
        = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94X94,
                                 ((c - MIN_CHAR_94x94) / (94 * 94)) + '0',
                                 CHARSET_LEFT_TO_RIGHT);
-      return (((((c - MIN_CHAR_94x94) / 94) % 94) + 33) << 8)
-       | (((c - MIN_CHAR_94x94) % 94) + 33);
+      if (!NILP (*charset))
+       return (((((c - MIN_CHAR_94x94) / 94) % 94) + 33) << 8)
+         | (((c - MIN_CHAR_94x94) % 94) + 33);
+      else
+       {
+         *charset = Vcharset_ucs;
+         return c;
+       }
     }
   else if (c <= MAX_CHAR_96x96)
     {
@@ -1644,8 +1803,14 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
        = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_96X96,
                                 ((c - MIN_CHAR_96x96) / (96 * 96)) + '0',
                                 CHARSET_LEFT_TO_RIGHT);
-      return ((((c - MIN_CHAR_96x96) / 96) % 96) + 32) << 8
-       | (((c - MIN_CHAR_96x96) % 96) + 32);
+      if (!NILP (*charset))
+       return ((((c - MIN_CHAR_96x96) / 96) % 96) + 32) << 8
+         | (((c - MIN_CHAR_96x96) % 96) + 32);
+      else
+       {
+         *charset = Vcharset_ucs;
+         return c;
+       }
     }
   else
     {
@@ -2268,7 +2433,7 @@ Set mapping-table of CHARSET to TABLE.
          if (CHARP (c))
            put_char_attribute
              (c, charset,
-              list1 (make_int (i + CHARSET_BYTE_OFFSET (cs))));
+              make_int (i + CHARSET_BYTE_OFFSET (cs)));
        }
       break;
     case 2:
@@ -2290,18 +2455,15 @@ Set mapping-table of CHARSET to TABLE.
                  Lisp_Object c = XVECTOR_DATA(v)[j];
 
                  if (CHARP (c))
-                   put_char_attribute (c, charset,
-                                       list2
-                                       (make_int
-                                        (i + CHARSET_BYTE_OFFSET (cs)),
-                                        make_int
-                                        (j + CHARSET_BYTE_OFFSET (cs))));
+                   put_char_attribute
+                     (c, charset,
+                      make_int ( ((i + CHARSET_BYTE_OFFSET (cs)) << 8)
+                                 | (j + CHARSET_BYTE_OFFSET (cs)) ));
                }
            }
          else if (CHARP (v))
            put_char_attribute (v, charset,
-                               list1
-                               (make_int (i + CHARSET_BYTE_OFFSET (cs))));
+                               make_int (i + CHARSET_BYTE_OFFSET (cs)));
        }
       break;
     }
@@ -2314,6 +2476,23 @@ Set mapping-table of CHARSET to TABLE.
 /*              Lisp primitives for working with characters             */
 /************************************************************************/
 
+#ifdef UTF2000
+DEFUN ("decode-char", Fdecode_char, 2, 2, 0, /*
+Make a character from CHARSET and code-point CODE.
+*/
+       (charset, code))
+{
+  int c;
+
+  charset = Fget_charset (charset);
+  CHECK_INT (code);
+  c = XINT (code);
+  if (XCHARSET_GRAPHIC (charset) == 1)
+    c &= 0x7F7F7F7F;
+  return make_char (DECODE_CHAR (charset, c));
+}
+#endif
+
 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
 Make a character from CHARSET and octets ARG1 and ARG2.
 ARG2 is required only for characters from two-dimensional charsets.
@@ -2555,6 +2734,7 @@ syms_of_mule_charset (void)
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);
+  DEFSUBR (Fremove_char_attribute);
   DEFSUBR (Fdefine_char);
   DEFSUBR (Fchar_variants);
   DEFSUBR (Fget_composite_char);
@@ -2562,6 +2742,9 @@ syms_of_mule_charset (void)
   DEFSUBR (Fset_charset_mapping_table);
 #endif
 
+#ifdef UTF2000
+  DEFSUBR (Fdecode_char);
+#endif
   DEFSUBR (Fmake_char);
   DEFSUBR (Fchar_charset);
   DEFSUBR (Fchar_octet);
@@ -2635,6 +2818,7 @@ syms_of_mule_charset (void)
   defsymbol (&Qvietnamese_viscii_lower,        "vietnamese-viscii-lower");
   defsymbol (&Qvietnamese_viscii_upper,        "vietnamese-viscii-upper");
   defsymbol (&Qideograph_daikanwa,     "ideograph-daikanwa");
+  defsymbol (&Qmojikyo,                        "mojikyo");
   defsymbol (&Qmojikyo_pj_1,           "mojikyo-pj-1");
   defsymbol (&Qmojikyo_pj_2,           "mojikyo-pj-2");
   defsymbol (&Qmojikyo_pj_3,           "mojikyo-pj-3");
@@ -2762,14 +2946,10 @@ complex_vars_of_mule_charset (void)
 #else
 # define MIN_CHAR_THAI 0
 # define MAX_CHAR_THAI 0
-# define MIN_CHAR_GREEK 0
-# define MAX_CHAR_GREEK 0
 # define MIN_CHAR_HEBREW 0
 # define MAX_CHAR_HEBREW 0
 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
-# define MIN_CHAR_CYRILLIC 0
-# define MAX_CHAR_CYRILLIC 0
 #endif
   staticpro (&Vcharset_ascii);
   Vcharset_ascii =
@@ -2842,7 +3022,9 @@ complex_vars_of_mule_charset (void)
                  build_string ("ISO8859-7 (Greek)"),
                  build_string ("ISO8859-7 (Greek)"),
                  build_string ("iso8859-7"),
-                 Qnil, MIN_CHAR_GREEK, MAX_CHAR_GREEK, 0, 32);
+                 Qnil,
+                 0 /* MIN_CHAR_GREEK */,
+                 0 /* MAX_CHAR_GREEK */, 0, 32);
   staticpro (&Vcharset_arabic_iso8859_6);
   Vcharset_arabic_iso8859_6 =
     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
@@ -2887,7 +3069,9 @@ complex_vars_of_mule_charset (void)
                  build_string ("ISO8859-5 (Cyrillic)"),
                  build_string ("ISO8859-5 (Cyrillic)"),
                  build_string ("iso8859-5"),
-                 Qnil, MIN_CHAR_CYRILLIC, MAX_CHAR_CYRILLIC, 0, 32);
+                 Qnil,
+                 0 /* MIN_CHAR_CYRILLIC */,
+                 0 /* MAX_CHAR_CYRILLIC */, 0, 32);
   staticpro (&Vcharset_latin_iso8859_9);
   Vcharset_latin_iso8859_9 =
     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
@@ -3017,6 +3201,15 @@ complex_vars_of_mule_charset (void)
                  build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
                  build_string ("Daikanwa"),
                  Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
+  staticpro (&Vcharset_mojikyo);
+  Vcharset_mojikyo =
+    make_charset (LEADING_BYTE_MOJIKYO, Qmojikyo, 256, 3,
+                 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("Mojikyo"),
+                 build_string ("Mojikyo"),
+                 build_string ("Konjaku-Mojikyo"),
+                 build_string (""),
+                 Qnil, MIN_CHAR_MOJIKYO, MAX_CHAR_MOJIKYO, 0, 0);
   staticpro (&Vcharset_mojikyo_pj_1);
   Vcharset_mojikyo_pj_1 =
     make_charset (LEADING_BYTE_MOJIKYO_PJ_1, Qmojikyo_pj_1, 94, 2,