/* 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.
#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;
Lisp_Object rest = attributes;
Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
Lisp_Object character;
-#if 0
- Lisp_Object daikanwa = Qnil;
-#endif
if (NILP (code))
{
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);
}
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;
Qchinese_cns11643_2,
#ifdef UTF2000
Qucs_bmp,
+ Qucs_cns,
Qlatin_viscii,
Qlatin_tcvn5712,
Qlatin_viscii_lower,
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,
/* 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
{
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);
}
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,
#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
*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)
{
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;
}
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.
else if (EQ (keyword, Qccl_program))
{
- CHECK_VECTOR (value);
+ struct ccl_program test_ccl;
+
+ if (setup_ccl_program (&test_ccl, value) < 0)
+ signal_simple_error ("Invalid value for 'ccl-program", value);
ccl_program = value;
}
}
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.
*/
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 */
*/
(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;
}
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, /*
(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
}
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);
}
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))
{
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");
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
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,