home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / e20313sr.zip / emacs / 20.3.1 / src / charset.c < prev    next >
C/C++ Source or Header  |  1999-07-31  |  59KB  |  1,914 lines
  1. /* Basic multilingual character support.
  2.    Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
  3.    Licensed to the Free Software Foundation.
  4.  
  5. This file is part of GNU Emacs.
  6.  
  7. GNU Emacs is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Emacs is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Emacs; see the file COPYING.  If not, write to
  19. the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20. Boston, MA 02111-1307, USA.  */
  21.  
  22. /* At first, see the document in `charset.h' to understand the code in
  23.    this file.  */
  24.  
  25. #include <stdio.h>
  26.  
  27. #ifdef emacs
  28.  
  29. #include <sys/types.h>
  30. #include <config.h>
  31. #include "lisp.h"
  32. #include "buffer.h"
  33. #include "charset.h"
  34. #include "coding.h"
  35. #include "disptab.h"
  36.  
  37. #else  /* not emacs */
  38.  
  39. #include "mulelib.h"
  40.  
  41. #endif /* emacs */
  42.  
  43. Lisp_Object Qcharset, Qascii, Qcomposition;
  44.  
  45. /* Declaration of special leading-codes.  */
  46. int leading_code_composition;    /* for composite characters */
  47. int leading_code_private_11;    /* for private DIMENSION1 of 1-column */
  48. int leading_code_private_12;    /* for private DIMENSION1 of 2-column */
  49. int leading_code_private_21;    /* for private DIMENSION2 of 1-column */
  50. int leading_code_private_22;    /* for private DIMENSION2 of 2-column */
  51.  
  52. /* Declaration of special charsets.  */
  53. int charset_ascii;        /* ASCII */
  54. int charset_composition;    /* for a composite character */
  55. int charset_latin_iso8859_1;    /* ISO8859-1 (Latin-1) */
  56. int charset_jisx0208_1978;    /* JISX0208.1978 (Japanese Kanji old set) */
  57. int charset_jisx0208;        /* JISX0208.1983 (Japanese Kanji) */
  58. int charset_katakana_jisx0201;    /* JISX0201.Kana (Japanese Katakana) */
  59. int charset_latin_jisx0201;    /* JISX0201.Roman (Japanese Roman) */
  60. int charset_big5_1;        /* Big5 Level 1 (Chinese Traditional) */
  61. int charset_big5_2;        /* Big5 Level 2 (Chinese Traditional) */
  62.  
  63. int min_composite_char;
  64.  
  65. Lisp_Object Qcharset_table;
  66.  
  67. /* A char-table containing information of each character set.  */
  68. Lisp_Object Vcharset_table;
  69.  
  70. /* A vector of charset symbol indexed by charset-id.  This is used
  71.    only for returning charset symbol from C functions.  */
  72. Lisp_Object Vcharset_symbol_table;
  73.  
  74. /* A list of charset symbols ever defined.  */
  75. Lisp_Object Vcharset_list;
  76.  
  77. /* Vector of translation table ever defined.
  78.    ID of a translation table is used to index this vector.  */
  79. Lisp_Object Vtranslation_table_vector;
  80.  
  81. /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD.  */
  82. int bytes_by_char_head[256];
  83. int width_by_char_head[256];
  84.  
  85. /* Mapping table from ISO2022's charset (specified by DIMENSION,
  86.    CHARS, and FINAL-CHAR) to Emacs' charset.  */
  87. int iso_charset_table[2][2][128];
  88.  
  89. /* Table of pointers to the structure `cmpchar_info' indexed by
  90.    CMPCHAR-ID.  */
  91. struct cmpchar_info **cmpchar_table;
  92. /* The current size of `cmpchar_table'.  */
  93. static int cmpchar_table_size;
  94. /* Number of the current composite characters.  */
  95. int n_cmpchars;
  96.  
  97. /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR.  */
  98. unsigned char *_fetch_multibyte_char_p;
  99. int _fetch_multibyte_char_len;
  100.  
  101. /* Offset to add to a non-ASCII value when inserting it.  */
  102. int nonascii_insert_offset;
  103.  
  104. /* Translation table for converting non-ASCII unibyte characters
  105.    to multibyte codes, or nil.  */
  106. Lisp_Object Vnonascii_translation_table;
  107.  
  108. /* List of all possible generic characters.  */
  109. Lisp_Object Vgeneric_character_list;
  110.  
  111. #define min(X, Y) ((X) < (Y) ? (X) : (Y))
  112. #define max(X, Y) ((X) > (Y) ? (X) : (Y))
  113.  
  114. void
  115. invalid_character (c)
  116.      int c;
  117. {
  118.   error ("Invalid character: %o, %d, 0x%x", c);
  119. }
  120.  
  121.  
  122. /* Set STR a pointer to the multi-byte form of the character C.  If C
  123.    is not a composite character, the multi-byte form is set in WORKBUF
  124.    and STR points WORKBUF.  The caller should allocate at least 4-byte
  125.    area at WORKBUF in advance.  Returns the length of the multi-byte
  126.    form.  If C is an invalid character to have a multi-byte form,
  127.    signal an error.
  128.  
  129.    Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
  130.    function directly if C can be an ASCII character.  */
  131.  
  132. int
  133. non_ascii_char_to_string (c, workbuf, str)
  134.      int c;
  135.      unsigned char *workbuf, **str;
  136. {
  137.   int charset, c1, c2;
  138.  
  139.   if (COMPOSITE_CHAR_P (c))
  140.     {
  141.       int cmpchar_id = COMPOSITE_CHAR_ID (c);
  142.  
  143.       if (cmpchar_id < n_cmpchars)
  144.     {
  145.       *str = cmpchar_table[cmpchar_id]->data;
  146.       return cmpchar_table[cmpchar_id]->len;
  147.     }
  148.       else
  149.     {
  150.       invalid_character (c);
  151.     }
  152.     }
  153.  
  154.   SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
  155.   if (!charset
  156.       || ! CHARSET_DEFINED_P (charset)
  157.       || c1 >= 0 && c1 < 32
  158.       || c2 >= 0 && c2 < 32)
  159.     invalid_character (c);
  160.  
  161.   *str = workbuf;
  162.   *workbuf++ = CHARSET_LEADING_CODE_BASE (charset);
  163.   if (*workbuf = CHARSET_LEADING_CODE_EXT (charset))
  164.     workbuf++;
  165.   *workbuf++ = c1 | 0x80;
  166.   if (c2 >= 0)
  167.     *workbuf++ = c2 | 0x80;
  168.  
  169.   return (workbuf - *str);
  170. }
  171.  
  172. /* Return a non-ASCII character of which multi-byte form is at STR of
  173.    length LEN.  If ACTUAL_LEN is not NULL, the actual length of the
  174.    multibyte form is set to the address ACTUAL_LEN.
  175.  
  176.    If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
  177.    bytes following the non-ASCII character.
  178.  
  179.    Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
  180.    directly if STR can hold an ASCII character.  */
  181.  
  182. int
  183. string_to_non_ascii_char (str, len, actual_len, exclude_tail_garbage)
  184.      const unsigned char *str;
  185.      int len, *actual_len, exclude_tail_garbage;
  186. {
  187.   int charset;
  188.   unsigned char c1, c2;
  189.   register int c, bytes;
  190.  
  191.   c = *str;
  192.   bytes = 1;
  193.  
  194.   if (BASE_LEADING_CODE_P (c))
  195.     {
  196.       while (bytes < len && ! CHAR_HEAD_P (str[bytes])) bytes++;
  197.  
  198.       if (c == LEADING_CODE_COMPOSITION)
  199.     {
  200.       int cmpchar_id = str_cmpchar_id (str, bytes);
  201.  
  202.       if (cmpchar_id >= 0)
  203.         {
  204.           c = MAKE_COMPOSITE_CHAR (cmpchar_id);
  205.           if (exclude_tail_garbage)
  206.         bytes = cmpchar_table[cmpchar_id]->len;
  207.         }
  208.     }
  209.       else
  210.     {
  211.       int charset = c, c1, c2 = 0;
  212.       int char_bytes = BYTES_BY_CHAR_HEAD (c);
  213.  
  214.       str++;
  215.       if (c >= LEADING_CODE_PRIVATE_11)
  216.         charset = *str++;
  217.       if (char_bytes <= bytes && CHARSET_DEFINED_P (charset))
  218.         {
  219.           c1 = *str++ & 0x7f;
  220.           if (CHARSET_DIMENSION (charset) == 2)
  221.         c2 = *str & 0x7F;
  222.           c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
  223.           if (exclude_tail_garbage)
  224.         bytes = char_bytes;
  225.         }
  226.     }
  227.     }
  228.  
  229.   if (actual_len)
  230.     *actual_len = bytes;
  231.   return c;
  232. }
  233.  
  234. /* Return the length of the multi-byte form at string STR of length LEN.  */
  235. int
  236. multibyte_form_length (str, len)
  237.      const unsigned char *str;
  238.      int len;
  239. {
  240.   int bytes = 1;
  241.  
  242.   if (BASE_LEADING_CODE_P (*str))
  243.     while (bytes < len && ! CHAR_HEAD_P (str[bytes])) bytes++;
  244.  
  245.   return bytes;
  246. }
  247.  
  248. /* Check if string STR of length LEN contains valid multi-byte form of
  249.    a character.  If valid, charset and position codes of the character
  250.    is set at *CHARSET, *C1, and *C2, and return 0.  If not valid,
  251.    return -1.  This should be used only in the macro SPLIT_STRING
  252.    which checks range of STR in advance.  */
  253.  
  254. int
  255. split_non_ascii_string (str, len, charset, c1, c2)
  256.      register const unsigned char *str;
  257.      register unsigned char *c1, *c2;
  258.      register int len, *charset;
  259. {
  260.   register unsigned int cs = *str++;
  261.  
  262.   if (cs == LEADING_CODE_COMPOSITION)
  263.     {
  264.       int cmpchar_id = str_cmpchar_id (str - 1, len);
  265.  
  266.       if (cmpchar_id < 0)
  267.     return -1;
  268.       *charset = cs, *c1 = cmpchar_id >> 7, *c2 = cmpchar_id & 0x7F;
  269.     }
  270.   else if ((cs < LEADING_CODE_PRIVATE_11 || (cs = *str++) >= 0xA0)
  271.        && CHARSET_DEFINED_P (cs))
  272.     {
  273.       *charset = cs;
  274.       if (*str < 0xA0)
  275.     return -1;
  276.       *c1 = (*str++) & 0x7F;
  277.       if (CHARSET_DIMENSION (cs) == 2)
  278.     {
  279.       if (*str < 0xA0)
  280.         return -1;
  281.       *c2 = (*str++) & 0x7F;
  282.     }
  283.     }
  284.   else
  285.     return -1;
  286.   return 0;
  287. }
  288.  
  289. /* Translate character C by translation table TABLE.  If C
  290.    is negative, translate a character specified by CHARSET, C1, and C2
  291.    (C1 and C2 are code points of the character).  If no translation is
  292.    found in TABLE, return C.  */
  293. int
  294. translate_char (table, c, charset, c1, c2)
  295.      Lisp_Object table;
  296.      int c, charset, c1, c2;
  297. {
  298.   Lisp_Object ch;
  299.   int alt_charset, alt_c1, alt_c2, dimension;
  300.  
  301.   if (c < 0) c = MAKE_CHAR (charset, c1, c2);
  302.   if (!CHAR_TABLE_P (table)
  303.       || (ch = Faref (table, make_number (c)), !INTEGERP (ch))
  304.       || XINT (ch) < 0)
  305.     return c;
  306.  
  307.   SPLIT_CHAR (XFASTINT (ch), alt_charset, alt_c1, alt_c2);
  308.   dimension = CHARSET_DIMENSION (alt_charset);
  309.   if (dimension == 1 && alt_c1 > 0 || dimension == 2 && alt_c2 > 0)
  310.     /* CH is not a generic character, just return it.  */
  311.     return XFASTINT (ch);
  312.  
  313.   /* Since CH is a generic character, we must return a specific
  314.      charater which has the same position codes as C from CH.  */
  315.   if (charset < 0)
  316.     SPLIT_CHAR (c, charset, c1, c2);
  317.   if (dimension != CHARSET_DIMENSION (charset))
  318.     /* We can't make such a character because of dimension mismatch.  */
  319.     return c;
  320.   return MAKE_CHAR (alt_charset, c1, c2);
  321. }
  322.  
  323. /* Convert the unibyte character C to multibyte based on
  324.    Vnonascii_translation_table or nonascii_insert_offset.  If they can't
  325.    convert C to a valid multibyte character, convert it based on
  326.    DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character.  */
  327.  
  328. int
  329. unibyte_char_to_multibyte (c)
  330.      int c;
  331. {
  332.   if (c >= 0240 && c < 0400)
  333.     {
  334.       int c_save = c;
  335.  
  336.       if (! NILP (Vnonascii_translation_table))
  337.     c = XINT (Faref (Vnonascii_translation_table, make_number (c)));
  338.       else if (nonascii_insert_offset > 0)
  339.     c += nonascii_insert_offset;
  340.       if (c >= 0240 && (c < 0400 || ! VALID_MULTIBYTE_CHAR_P (c)))
  341.     c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
  342.     }
  343.   return c;
  344. }
  345.  
  346.  
  347. /* Convert the multibyte character C to unibyte 8-bit character based
  348.    on Vnonascii_translation_table or nonascii_insert_offset.  If
  349.    REV_TBL is non-nil, it should be a reverse table of
  350.    Vnonascii_translation_table, i.e. what given by:
  351.      Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0))  */
  352.  
  353. int
  354. multibyte_char_to_unibyte (c, rev_tbl)
  355.      int c;
  356.      Lisp_Object rev_tbl;
  357. {
  358.   if (!SINGLE_BYTE_CHAR_P (c))
  359.     {
  360.       int c_save = c;
  361.  
  362.       if (! CHAR_TABLE_P (rev_tbl)
  363.       && CHAR_TABLE_P (Vnonascii_translation_table))
  364.     rev_tbl = Fchar_table_extra_slot (Vnonascii_translation_table,
  365.                       make_number (0));
  366.       if (CHAR_TABLE_P (rev_tbl))
  367.     {
  368.       Lisp_Object temp;
  369.       temp = Faref (rev_tbl, make_number (c));
  370.       if (INTEGERP (temp))
  371.         c = XINT (temp);
  372.     }
  373.       else if (nonascii_insert_offset > 0)
  374.     c -= nonascii_insert_offset;
  375.       if (c < 128 || c >= 256)
  376.     c = (c_save & 0177) + 0200;
  377.     }
  378.  
  379.   return c;
  380. }
  381.  
  382.  
  383. /* Update the table Vcharset_table with the given arguments (see the
  384.    document of `define-charset' for the meaning of each argument).
  385.    Several other table contents are also updated.  The caller should
  386.    check the validity of CHARSET-ID and the remaining arguments in
  387.    advance.  */
  388.  
  389. void
  390. update_charset_table (charset_id, dimension, chars, width, direction,
  391.               iso_final_char, iso_graphic_plane,
  392.               short_name, long_name, description)
  393.      Lisp_Object charset_id, dimension, chars, width, direction;
  394.      Lisp_Object iso_final_char, iso_graphic_plane;
  395.      Lisp_Object short_name, long_name, description;
  396. {
  397.   int charset = XINT (charset_id);
  398.   int bytes;
  399.   unsigned char leading_code_base, leading_code_ext;
  400.  
  401.   if (NILP (CHARSET_TABLE_ENTRY (charset)))
  402.     CHARSET_TABLE_ENTRY (charset)
  403.       = Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil);
  404.  
  405.   /* Get byte length of multibyte form, base leading-code, and
  406.      extended leading-code of the charset.  See the comment under the
  407.      title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h.  */
  408.   bytes = XINT (dimension);
  409.   if (charset < MIN_CHARSET_PRIVATE_DIMENSION1)
  410.     {
  411.       /* Official charset, it doesn't have an extended leading-code.  */
  412.       if (charset != CHARSET_ASCII)
  413.     bytes += 1; /* For a base leading-code.  */
  414.       leading_code_base = charset;
  415.       leading_code_ext = 0;
  416.     }
  417.   else
  418.     {
  419.       /* Private charset.  */
  420.       bytes += 2; /* For base and extended leading-codes.  */
  421.       leading_code_base
  422.     = (charset < LEADING_CODE_EXT_12
  423.        ? LEADING_CODE_PRIVATE_11
  424.        : (charset < LEADING_CODE_EXT_21
  425.           ? LEADING_CODE_PRIVATE_12
  426.           : (charset < LEADING_CODE_EXT_22
  427.          ? LEADING_CODE_PRIVATE_21
  428.          : LEADING_CODE_PRIVATE_22)));
  429.       leading_code_ext = charset;
  430.     } 
  431.  
  432.   CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id;
  433.   CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes);
  434.   CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension;
  435.   CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars;
  436.   CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width;
  437.   CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction;
  438.   CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)
  439.     = make_number (leading_code_base);
  440.   CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)
  441.     = make_number (leading_code_ext);
  442.   CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char;
  443.   CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)
  444.     = iso_graphic_plane;
  445.   CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name;
  446.   CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name;
  447.   CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description;
  448.   CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil;
  449.  
  450.   {
  451.     /* If we have already defined a charset which has the same
  452.        DIMENSION, CHARS and ISO-FINAL-CHAR but the different
  453.        DIRECTION, we must update the entry REVERSE-CHARSET of both
  454.        charsets.  If there's no such charset, the value of the entry
  455.        is set to nil.  */
  456.     int i;
  457.  
  458.     for (i = 0; i <= MAX_CHARSET; i++)
  459.       if (!NILP (CHARSET_TABLE_ENTRY (i)))
  460.     {
  461.       if (CHARSET_DIMENSION (i) == XINT (dimension)
  462.           && CHARSET_CHARS (i) == XINT (chars)
  463.           && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char)
  464.           && CHARSET_DIRECTION (i) != XINT (direction))
  465.         {
  466.           CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
  467.         = make_number (i);
  468.           CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id;
  469.           break;
  470.         }
  471.     }
  472.     if (i > MAX_CHARSET)
  473.       /* No such a charset.  */
  474.       CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
  475.     = make_number (-1);
  476.   }
  477.  
  478.   if (charset != CHARSET_ASCII
  479.       && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
  480.     {
  481.       /* Update tables bytes_by_char_head and width_by_char_head.  */
  482.       bytes_by_char_head[leading_code_base] = bytes;
  483.       width_by_char_head[leading_code_base] = XINT (width);
  484.  
  485.       /* Update table emacs_code_class.  */
  486.       emacs_code_class[charset] = (bytes == 2
  487.                    ? EMACS_leading_code_2
  488.                    : (bytes == 3
  489.                       ? EMACS_leading_code_3
  490.                       : EMACS_leading_code_4));
  491.     }
  492.  
  493.   /* Update table iso_charset_table.  */
  494.   if (ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0)
  495.     ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset;
  496. }
  497.  
  498. #ifdef emacs
  499.  
  500. /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
  501.    is invalid.  */
  502. int
  503. get_charset_id (charset_symbol)
  504.      Lisp_Object charset_symbol;
  505. {
  506.   Lisp_Object val;
  507.   int charset;
  508.  
  509.   return ((SYMBOLP (charset_symbol)
  510.        && (val = Fget (charset_symbol, Qcharset), VECTORP (val))
  511.        && (charset = XINT (XVECTOR (val)->contents[CHARSET_ID_IDX]),
  512.            CHARSET_VALID_P (charset)))
  513.       ? charset : -1);
  514. }
  515.  
  516. /* Return an identification number for a new private charset of
  517.    DIMENSION and WIDTH.  If there's no more room for the new charset,
  518.    return 0.  */
  519. Lisp_Object
  520. get_new_private_charset_id (dimension, width)
  521.      int dimension, width;
  522. {
  523.   int charset, from, to;
  524.  
  525.   if (dimension == 1)
  526.     {
  527.       if (width == 1)
  528.     from = LEADING_CODE_EXT_11, to = LEADING_CODE_EXT_12;
  529.       else
  530.     from = LEADING_CODE_EXT_12, to = LEADING_CODE_EXT_21;
  531.     }
  532.   else
  533.     {
  534.       if (width == 1)
  535.     from = LEADING_CODE_EXT_21, to = LEADING_CODE_EXT_22;
  536.       else
  537.     from = LEADING_CODE_EXT_22, to = LEADING_CODE_EXT_MAX + 1;
  538.     }
  539.  
  540.   for (charset = from; charset < to; charset++)
  541.     if (!CHARSET_DEFINED_P (charset)) break;
  542.  
  543.   return make_number (charset < to ? charset : 0);
  544. }
  545.  
  546. DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0,
  547.   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
  548. If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
  549.  treated as a private charset.\n\
  550. INFO-VECTOR is a vector of the format:\n\
  551.    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
  552.     SHORT-NAME LONG-NAME DESCRIPTION]\n\
  553. The meanings of each elements is as follows:\n\
  554. DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
  555. CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
  556. WIDTH (integer) is the number of columns a character in the charset\n\
  557. occupies on the screen: one of 0, 1, and 2.\n\
  558. \n\
  559. DIRECTION (integer) is the rendering direction of characters in the\n\
  560. charset when rendering.  If 0, render from left to right, else\n\
  561. render from right to left.\n\
  562. \n\
  563. ISO-FINAL-CHAR (character) is the final character of the\n\
  564. corresponding ISO 2022 charset.\n\
  565. \n\
  566. ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
  567. while encoding to variants of ISO 2022 coding system, one of the\n\
  568. following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
  569. \n\
  570. SHORT-NAME (string) is the short name to refer to the charset.\n\
  571. \n\
  572. LONG-NAME (string) is the long name to refer to the charset.\n\
  573. \n\
  574. DESCRIPTION (string) is the description string of the charset.")
  575.   (charset_id, charset_symbol, info_vector)
  576.      Lisp_Object charset_id, charset_symbol, info_vector;
  577. {
  578.   Lisp_Object *vec;
  579.  
  580.   if (!NILP (charset_id))
  581.     CHECK_NUMBER (charset_id, 0);
  582.   CHECK_SYMBOL (charset_symbol, 1);
  583.   CHECK_VECTOR (info_vector, 2);
  584.  
  585.   if (! NILP (charset_id))
  586.     {
  587.       if (! CHARSET_VALID_P (XINT (charset_id)))
  588.     error ("Invalid CHARSET: %d", XINT (charset_id));
  589.       else if (CHARSET_DEFINED_P (XINT (charset_id)))
  590.     error ("Already defined charset: %d", XINT (charset_id));
  591.     }
  592.  
  593.   vec = XVECTOR (info_vector)->contents;
  594.   if (XVECTOR (info_vector)->size != 9
  595.       || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2)
  596.       || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96)
  597.       || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2)
  598.       || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1)
  599.       || !INTEGERP (vec[4]) || !(XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~')
  600.       || !INTEGERP (vec[5]) || !(XINT (vec[5]) == 0 || XINT (vec[5]) == 1)
  601.       || !STRINGP (vec[6])
  602.       || !STRINGP (vec[7])
  603.       || !STRINGP (vec[8]))
  604.     error ("Invalid info-vector argument for defining charset %s",
  605.        XSYMBOL (charset_symbol)->name->data);
  606.  
  607.   if (NILP (charset_id))
  608.     {
  609.       charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2]));
  610.       if (XINT (charset_id) == 0)
  611.     error ("There's no room for a new private charset %s",
  612.            XSYMBOL (charset_symbol)->name->data);
  613.     }
  614.  
  615.   update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3],
  616.             vec[4], vec[5], vec[6], vec[7], vec[8]);
  617.   Fput (charset_symbol, Qcharset, CHARSET_TABLE_ENTRY (XINT (charset_id)));
  618.   CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol;
  619.   Vcharset_list = Fcons (charset_symbol, Vcharset_list);
  620.   return Qnil;
  621. }
  622.  
  623. DEFUN ("generic-character-list", Fgeneric_character_list,
  624.        Sgeneric_character_list, 0, 0, 0,
  625.   "Return a list of all possible generic characters.\n\
  626. It includes a generic character for a charset not yet defined.")
  627.   ()
  628. {
  629.   return Vgeneric_character_list;
  630. }
  631.  
  632. DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
  633.        Sget_unused_iso_final_char, 2, 2, 0,
  634.   "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
  635. DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
  636. CHARS is the number of characters in a dimension: 94 or 96.\n\
  637. \n\
  638. This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
  639. If there's no unused final char for the specified kind of charset,\n\
  640. return nil.")
  641.   (dimension, chars)
  642.      Lisp_Object dimension, chars;
  643. {
  644.   int final_char;
  645.  
  646.   CHECK_NUMBER (dimension, 0);
  647.   CHECK_NUMBER (chars, 1);
  648.   if (XINT (dimension) != 1 && XINT (dimension) != 2)
  649.     error ("Invalid charset dimension %d, it should be 1 or 2",
  650.        XINT (dimension));
  651.   if (XINT (chars) != 94 && XINT (chars) != 96)
  652.     error ("Invalid charset chars %d, it should be 94 or 96",
  653.        XINT (chars));
  654.   for (final_char = '0'; final_char <= '?'; final_char++)
  655.     {
  656.       if (ISO_CHARSET_TABLE (dimension, chars, make_number (final_char)) < 0)
  657.     break;
  658.     }
  659.   return (final_char <= '?' ? make_number (final_char) : Qnil);
  660. }
  661.  
  662. DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
  663.        4, 4, 0,
  664.   "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
  665. CHARSET should be defined by `defined-charset' in advance.")
  666.   (dimension, chars, final_char, charset_symbol)
  667.      Lisp_Object dimension, chars, final_char, charset_symbol;
  668. {
  669.   int charset;
  670.  
  671.   CHECK_NUMBER (dimension, 0);
  672.   CHECK_NUMBER (chars, 1);
  673.   CHECK_NUMBER (final_char, 2);
  674.   CHECK_SYMBOL (charset_symbol, 3);
  675.  
  676.   if (XINT (dimension) != 1 && XINT (dimension) != 2)
  677.     error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension));
  678.   if (XINT (chars) != 94 && XINT (chars) != 96)
  679.     error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
  680.   if (XINT (final_char) < '0' || XFASTINT (final_char) > '~')
  681.     error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
  682.   if ((charset = get_charset_id (charset_symbol)) < 0)
  683.     error ("Invalid charset %s", XSYMBOL (charset_symbol)->name->data);
  684.  
  685.   ISO_CHARSET_TABLE (dimension, chars, final_char) = charset;
  686.   return Qnil;
  687. }
  688.  
  689. /* Return number of different charsets in STR of length LEN.  In
  690.    addition, for each found charset N, CHARSETS[N] is set 1.  The
  691.    caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
  692.    It may lookup a translation table TABLE if supplied.
  693.  
  694.    If CMPCHARP is nonzero and some composite character is found,
  695.    CHARSETS[128] is also set 1 and the returned number is incremented
  696.    by 1.  */
  697.  
  698. int
  699. find_charset_in_str (str, len, charsets, table, cmpcharp)
  700.      unsigned char *str;
  701.      int len, *charsets;
  702.      Lisp_Object table;
  703.      int cmpcharp;
  704. {
  705.   register int num = 0, c;
  706.  
  707.   if (! CHAR_TABLE_P (table))
  708.     table = Qnil;
  709.  
  710.   while (len > 0)
  711.     {
  712.       int bytes, charset;
  713.       c = *str;
  714.       
  715.       if (c == LEADING_CODE_COMPOSITION)
  716.     {
  717.       int cmpchar_id = str_cmpchar_id (str, len);
  718.       GLYPH *glyph;
  719.  
  720.       if (cmpchar_id >= 0)
  721.         {
  722.           struct cmpchar_info *cmpcharp = cmpchar_table[cmpchar_id];
  723.           int i;
  724.  
  725.           for (i = 0; i < cmpcharp->glyph_len; i++)
  726.         {
  727.           c = cmpcharp->glyph[i];
  728.           if (!NILP (table))
  729.             {
  730.               if ((c = translate_char (table, c, 0, 0, 0)) < 0)
  731.             c = cmpcharp->glyph[i];
  732.             }
  733.           if ((charset = CHAR_CHARSET (c)) < 0)
  734.             charset = CHARSET_ASCII;
  735.           if (!charsets[charset])
  736.             {
  737.               charsets[charset] = 1;
  738.               num += 1;
  739.             }
  740.         }
  741.           str += cmpcharp->len;
  742.           len -= cmpcharp->len;
  743.           continue;
  744.         }
  745.  
  746.       charset = CHARSET_ASCII;
  747.       bytes = 1;
  748.     }
  749.       else
  750.     {
  751.       c = STRING_CHAR_AND_LENGTH (str, len, bytes);
  752.       if (! NILP (table))
  753.         {
  754.           int c1 = translate_char (table, c, 0, 0, 0);
  755.           if (c1 >= 0)
  756.         c = c1;
  757.         }
  758.       charset = CHAR_CHARSET (c);
  759.     }
  760.  
  761.       if (!charsets[charset])
  762.     {
  763.       charsets[charset] = 1;
  764.       num += 1;
  765.     }
  766.       str += bytes;
  767.       len -= bytes;
  768.     }
  769.   return num;
  770. }
  771.  
  772. DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
  773.        2, 3, 0,
  774.   "Return a list of charsets in the region between BEG and END.\n\
  775. BEG and END are buffer positions.\n\
  776. Optional arg TABLE if non-nil is a translation table to look up.")
  777.   (beg, end, table)
  778.      Lisp_Object beg, end, table;
  779. {
  780.   int charsets[MAX_CHARSET + 1];
  781.   int from, from_byte, to, stop, stop_byte, i;
  782.   Lisp_Object val;
  783.  
  784.   validate_region (&beg, &end);
  785.   from = XFASTINT (beg);
  786.   stop = to = XFASTINT (end);
  787.  
  788.   if (from < GPT && GPT < to)
  789.     {
  790.       stop = GPT;
  791.       stop_byte = GPT_BYTE;
  792.     }
  793.   else
  794.     stop_byte = CHAR_TO_BYTE (stop);
  795.  
  796.   from_byte = CHAR_TO_BYTE (from);
  797.  
  798.   bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
  799.   while (1)
  800.     {
  801.       find_charset_in_str (BYTE_POS_ADDR (from_byte), stop_byte - from_byte,
  802.                charsets, table, 0);
  803.       if (stop < to)
  804.     {
  805.       from = stop, from_byte = stop_byte;
  806.       stop = to, stop_byte = CHAR_TO_BYTE (stop);
  807.     }
  808.       else
  809.     break;
  810.     }
  811.  
  812.   val = Qnil;
  813.   for (i = MAX_CHARSET; i >= 0; i--)
  814.     if (charsets[i])
  815.       val = Fcons (CHARSET_SYMBOL (i), val);
  816.   return val;
  817. }
  818.  
  819. DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string,
  820.        1, 2, 0,
  821.   "Return a list of charsets in STR.\n\
  822. Optional arg TABLE if non-nil is a translation table to look up.")
  823.   (str, table)
  824.      Lisp_Object str, table;
  825. {
  826.   int charsets[MAX_CHARSET + 1];
  827.   int i;
  828.   Lisp_Object val;
  829.  
  830.   CHECK_STRING (str, 0);
  831.  
  832.   if (! STRING_MULTIBYTE (str))
  833.     return Qnil;
  834.  
  835.   bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
  836.   find_charset_in_str (XSTRING (str)->data, STRING_BYTES (XSTRING (str)),
  837.                charsets, table, 0);
  838.   val = Qnil;
  839.   for (i = MAX_CHARSET; i >= 0; i--)
  840.     if (charsets[i])
  841.       val = Fcons (CHARSET_SYMBOL (i), val);
  842.   return val;
  843. }
  844.  
  845. DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0,
  846.   "")
  847.   (charset, code1, code2)
  848.      Lisp_Object charset, code1, code2;
  849. {
  850.   CHECK_NUMBER (charset, 0);
  851.  
  852.   if (NILP (code1))
  853.     XSETFASTINT (code1, 0);
  854.   else
  855.     CHECK_NUMBER (code1, 1);
  856.   if (NILP (code2))
  857.     XSETFASTINT (code2, 0);
  858.   else
  859.     CHECK_NUMBER (code2, 2);
  860.  
  861.   if (!CHARSET_DEFINED_P (XINT (charset)))
  862.     error ("Invalid charset: %d", XINT (charset));
  863.  
  864.   return make_number (MAKE_CHAR (XINT (charset), XINT (code1), XINT (code2)));
  865. }
  866.  
  867. DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
  868.   "Return list of charset and one or two position-codes of CHAR.")
  869.   (ch)
  870.      Lisp_Object ch;
  871. {
  872.   Lisp_Object val;
  873.   int charset, c1, c2;
  874.  
  875.   CHECK_NUMBER (ch, 0);
  876.   SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
  877.   return (c2 >= 0
  878.       ? Fcons (CHARSET_SYMBOL (charset),
  879.            Fcons (make_number (c1), Fcons (make_number (c2), Qnil)))
  880.       : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil)));
  881. }
  882.  
  883. DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
  884.   "Return charset of CHAR.")
  885.   (ch)
  886.      Lisp_Object ch;
  887. {
  888.   CHECK_NUMBER (ch, 0);
  889.  
  890.   return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch)));
  891. }
  892.  
  893. DEFUN ("charset-after", Fcharset_after, Scharset_after, 0, 1, 0,
  894.   "Return charset of a character in current buffer at position POS.\n\
  895. If POS is nil, it defauls to the current point.")
  896.   (pos)
  897.      Lisp_Object pos;
  898. {
  899.   register int pos_byte, c, charset;
  900.   register unsigned char *p;
  901.  
  902.   if (NILP (pos))
  903.     pos_byte = PT_BYTE;
  904.   else if (MARKERP (pos))
  905.     pos_byte = marker_byte_position (pos);
  906.   else
  907.     {
  908.       CHECK_NUMBER (pos, 0);
  909.       pos_byte = CHAR_TO_BYTE (XINT (pos));
  910.     }
  911.   p = BYTE_POS_ADDR (pos_byte);
  912.   c = STRING_CHAR (p, Z_BYTE - pos_byte);
  913.   charset = CHAR_CHARSET (c);
  914.   return CHARSET_SYMBOL (charset);
  915. }
  916.  
  917. DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
  918.   "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
  919. \n\
  920. ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
  921. by their DIMENSION, CHARS, and FINAL-CHAR,\n\
  922. where as Emacs distinguishes them by charset symbol.\n\
  923. See the documentation of the function `charset-info' for the meanings of\n\
  924. DIMENSION, CHARS, and FINAL-CHAR.")
  925.   (dimension, chars, final_char)
  926.      Lisp_Object dimension, chars, final_char;
  927. {
  928.   int charset;
  929.  
  930.   CHECK_NUMBER (dimension, 0);
  931.   CHECK_NUMBER (chars, 1);
  932.   CHECK_NUMBER (final_char, 2);
  933.  
  934.   if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0)
  935.     return Qnil;
  936.   return CHARSET_SYMBOL (charset);
  937. }
  938.  
  939. /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
  940.    generic character.  If GENERICP is zero, return nonzero iff C is a
  941.    valid normal character.  Do not call this function directly,
  942.    instead use macro CHAR_VALID_P.  */
  943. int
  944. char_valid_p (c, genericp)
  945.      int c, genericp;
  946. {
  947.   int charset, c1, c2;
  948.  
  949.   if (c < 0)
  950.     return 0;
  951.   if (SINGLE_BYTE_CHAR_P (c))
  952.     return 1;
  953.   SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
  954.   if (!CHARSET_VALID_P (charset))
  955.     return 0;
  956.   return (c < MIN_CHAR_COMPOSITION
  957.       ? ((c & CHAR_FIELD1_MASK) /* i.e. dimension of C is two.  */
  958.          ? (genericp && c1 == 0 && c2 == 0
  959.         || c1 >= 32 && c2 >= 32)
  960.          : (genericp && c1 == 0
  961.         || c1 >= 32))
  962.       : c < MIN_CHAR_COMPOSITION + n_cmpchars);
  963. }
  964.  
  965. DEFUN ("char-valid-p", Fchar_valid_p, Schar_valid_p, 1, 2, 0,
  966.   "Return t if OBJECT is a valid normal character.\n\
  967. If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
  968. a valid generic character.")
  969.   (object, genericp)
  970.      Lisp_Object object, genericp;
  971. {
  972.   if (! NATNUMP (object))
  973.     return Qnil;
  974.   return (CHAR_VALID_P (XFASTINT (object), !NILP (genericp)) ? Qt : Qnil);
  975. }
  976.  
  977. DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
  978.        Sunibyte_char_to_multibyte, 1, 1, 0,
  979.   "Convert the unibyte character CH to multibyte character.\n\
  980. The conversion is done based on `nonascii-translation-table' (which see)\n\
  981.  or `nonascii-insert-offset' (which see).")
  982.   (ch)
  983.      Lisp_Object ch;
  984. {
  985.   int c;
  986.  
  987.   CHECK_NUMBER (ch, 0);
  988.   c = XINT (ch);
  989.   if (c < 0 || c >= 0400)
  990.     error ("Invalid unibyte character: %d", c);
  991.   c = unibyte_char_to_multibyte (c);
  992.   if (c < 0)
  993.     error ("Can't convert to multibyte character: %d", XINT (ch));
  994.   return make_number (c);
  995. }
  996.  
  997. DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
  998.        Smultibyte_char_to_unibyte, 1, 1, 0,
  999.   "Convert the multibyte character CH to unibyte character.\n\
  1000. The conversion is done based on `nonascii-translation-table' (which see)\n\
  1001.  or `nonascii-insert-offset' (which see).")
  1002.   (ch)
  1003.      Lisp_Object ch;
  1004. {
  1005.   int c;
  1006.  
  1007.   CHECK_NUMBER (ch, 0);
  1008.   c = XINT (ch);
  1009.   if (c < 0)
  1010.     error ("Invalid multibyte character: %d", c);
  1011.   c = multibyte_char_to_unibyte (c, Qnil);
  1012.   if (c < 0)
  1013.     error ("Can't convert to unibyte character: %d", XINT (ch));
  1014.   return make_number (c);
  1015. }
  1016.  
  1017. DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
  1018.   "Return byte length of multi-byte form of CHAR.")
  1019.   (ch)
  1020.      Lisp_Object ch;
  1021. {
  1022.   Lisp_Object val;
  1023.   int bytes;
  1024.  
  1025.   CHECK_NUMBER (ch, 0);
  1026.   if (COMPOSITE_CHAR_P (XFASTINT (ch)))
  1027.     {
  1028.       unsigned int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
  1029.  
  1030.       bytes = (id < n_cmpchars ? cmpchar_table[id]->len : 1);
  1031.     }
  1032.   else
  1033.     {
  1034.       int charset = CHAR_CHARSET (XFASTINT (ch));
  1035.  
  1036.       bytes = CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1;
  1037.     }
  1038.  
  1039.   XSETFASTINT (val, bytes);
  1040.   return val;
  1041. }
  1042.  
  1043. /* Return the width of character of which multi-byte form starts with
  1044.    C.  The width is measured by how many columns occupied on the
  1045.    screen when displayed in the current buffer.  */
  1046.  
  1047. #define ONE_BYTE_CHAR_WIDTH(c)                             \
  1048.   (c < 0x20                                     \
  1049.    ? (c == '\t'                                     \
  1050.       ? XFASTINT (current_buffer->tab_width)                     \
  1051.       : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2)))    \
  1052.    : (c < 0x7f                                     \
  1053.       ? 1                                     \
  1054.       : (c == 0x7F                                 \
  1055.      ? (NILP (current_buffer->ctl_arrow) ? 4 : 2)                 \
  1056.      : ((! NILP (current_buffer->enable_multibyte_characters)        \
  1057.          && BASE_LEADING_CODE_P (c))                     \
  1058.         ? WIDTH_BY_CHAR_HEAD (c)                         \
  1059.         : 4))))
  1060.  
  1061. DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
  1062.   "Return width of CHAR when displayed in the current buffer.\n\
  1063. The width is measured by how many columns it occupies on the screen.")
  1064.   (ch)
  1065.        Lisp_Object ch;
  1066. {
  1067.   Lisp_Object val, disp;
  1068.   int c;
  1069.   struct Lisp_Char_Table *dp = buffer_display_table ();
  1070.  
  1071.   CHECK_NUMBER (ch, 0);
  1072.  
  1073.   c = XINT (ch);
  1074.  
  1075.   /* Get the way the display table would display it.  */
  1076.   disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil;
  1077.  
  1078.   if (VECTORP (disp))
  1079.     XSETINT (val, XVECTOR (disp)->size);
  1080.   else if (SINGLE_BYTE_CHAR_P (c))
  1081.     XSETINT (val, ONE_BYTE_CHAR_WIDTH (c));
  1082.   else if (COMPOSITE_CHAR_P (c))
  1083.     {
  1084.       int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
  1085.       XSETFASTINT (val, (id < n_cmpchars ? cmpchar_table[id]->width : 0));
  1086.     }
  1087.   else
  1088.     {
  1089.       int charset = CHAR_CHARSET (c);
  1090.  
  1091.       XSETFASTINT (val, CHARSET_WIDTH (charset));
  1092.     }
  1093.   return val;
  1094. }
  1095.  
  1096. /* Return width of string STR of length LEN when displayed in the
  1097.    current buffer.  The width is measured by how many columns it
  1098.    occupies on the screen.  */
  1099.  
  1100. int
  1101. strwidth (str, len)
  1102.      unsigned char *str;
  1103.      int len;
  1104. {
  1105.   unsigned char *endp = str + len;
  1106.   int width = 0;
  1107.   struct Lisp_Char_Table *dp = buffer_display_table ();
  1108.  
  1109.   while (str < endp)
  1110.     {
  1111.       if (*str == LEADING_CODE_COMPOSITION)
  1112.     {
  1113.       int id = str_cmpchar_id (str, endp - str);
  1114.  
  1115.       if (id < 0)
  1116.         {
  1117.           width += 4;
  1118.           str++;
  1119.         }
  1120.       else
  1121.         {
  1122.           width += cmpchar_table[id]->width;
  1123.           str += cmpchar_table[id]->len;
  1124.         }
  1125.     }
  1126.       else
  1127.     {
  1128.       Lisp_Object disp;
  1129.       int thislen;
  1130.       int c = STRING_CHAR_AND_LENGTH (str, endp - str, thislen);
  1131.  
  1132.       /* Get the way the display table would display it.  */
  1133.       if (dp)
  1134.         disp = DISP_CHAR_VECTOR (dp, c);
  1135.       else
  1136.         disp = Qnil;
  1137.  
  1138.       if (VECTORP (disp))
  1139.         width += XVECTOR (disp)->size;
  1140.       else
  1141.         width += ONE_BYTE_CHAR_WIDTH (*str);
  1142.  
  1143.       str += thislen;
  1144.     }
  1145.     }
  1146.   return width;
  1147. }
  1148.  
  1149. DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
  1150.   "Return width of STRING when displayed in the current buffer.\n\
  1151. Width is measured by how many columns it occupies on the screen.\n\
  1152. When calculating width of a multibyte character in STRING,\n\
  1153. only the base leading-code is considered; the validity of\n\
  1154. the following bytes is not checked.")
  1155.   (str)
  1156.      Lisp_Object str;
  1157. {
  1158.   Lisp_Object val;
  1159.  
  1160.   CHECK_STRING (str, 0);
  1161.   XSETFASTINT (val, strwidth (XSTRING (str)->data,
  1162.                   STRING_BYTES (XSTRING (str))));
  1163.   return val;
  1164. }
  1165.  
  1166. DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
  1167.   "Return the direction of CHAR.\n\
  1168. The returned value is 0 for left-to-right and 1 for right-to-left.")
  1169.   (ch)
  1170.      Lisp_Object ch;
  1171. {
  1172.   int charset;
  1173.  
  1174.   CHECK_NUMBER (ch, 0);
  1175.   charset = CHAR_CHARSET (XFASTINT (ch));
  1176.   if (!CHARSET_DEFINED_P (charset))
  1177.     invalid_character (XINT (ch));
  1178.   return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX);
  1179. }
  1180.  
  1181. DEFUN ("chars-in-region", Fchars_in_region, Schars_in_region, 2, 2, 0,
  1182.   "Return number of characters between BEG and END.")
  1183.   (beg, end)
  1184.      Lisp_Object beg, end;
  1185. {
  1186.   int from, to;
  1187.  
  1188.   CHECK_NUMBER_COERCE_MARKER (beg, 0);
  1189.   CHECK_NUMBER_COERCE_MARKER (end, 1);
  1190.  
  1191.   from = min (XFASTINT (beg), XFASTINT (end));
  1192.   to = max (XFASTINT (beg), XFASTINT (end));
  1193.  
  1194.   return make_number (to - from);
  1195. }
  1196.  
  1197. /* Return the number of characters in the NBYTES bytes at PTR.
  1198.    This works by looking at the contents and checking for multibyte sequences.
  1199.    However, if the current buffer has enable-multibyte-characters = nil,
  1200.    we treat each byte as a character.  */
  1201.  
  1202. int
  1203. chars_in_text (ptr, nbytes)
  1204.      unsigned char *ptr;
  1205.      int nbytes;
  1206. {
  1207.   unsigned char *endp, c;
  1208.   int chars;
  1209.  
  1210.   /* current_buffer is null at early stages of Emacs initialization.  */
  1211.   if (current_buffer == 0
  1212.       || NILP (current_buffer->enable_multibyte_characters))
  1213.     return nbytes;
  1214.  
  1215.   endp = ptr + nbytes;
  1216.   chars = 0;
  1217.  
  1218.   while (ptr < endp)
  1219.     {
  1220.       c = *ptr++;
  1221.  
  1222.       if (BASE_LEADING_CODE_P (c))
  1223.     while (ptr < endp && ! CHAR_HEAD_P (*ptr)) ptr++;
  1224.       chars++;
  1225.     }
  1226.  
  1227.   return chars;
  1228. }
  1229.  
  1230. /* Return the number of characters in the NBYTES bytes at PTR.
  1231.    This works by looking at the contents and checking for multibyte sequences.
  1232.    It ignores enable-multibyte-characters.  */
  1233.  
  1234. int
  1235. multibyte_chars_in_text (ptr, nbytes)
  1236.      unsigned char *ptr;
  1237.      int nbytes;
  1238. {
  1239.   unsigned char *endp, c;
  1240.   int chars;
  1241.  
  1242.   endp = ptr + nbytes;
  1243.   chars = 0;
  1244.  
  1245.   while (ptr < endp)
  1246.     {
  1247.       c = *ptr++;
  1248.  
  1249.       if (BASE_LEADING_CODE_P (c))
  1250.     while (ptr < endp && ! CHAR_HEAD_P (*ptr)) ptr++;
  1251.       chars++;
  1252.     }
  1253.  
  1254.   return chars;
  1255. }
  1256.  
  1257. DEFUN ("string", Fstring, Sstring, 1, MANY, 0,
  1258.   "Concatenate all the argument characters and make the result a string.")
  1259.   (n, args)
  1260.      int n;
  1261.      Lisp_Object *args;
  1262. {
  1263.   int i;
  1264.   unsigned char *buf
  1265.     = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM * n);
  1266.   unsigned char *p = buf;
  1267.   Lisp_Object val;
  1268.  
  1269.   for (i = 0; i < n; i++)
  1270.     {
  1271.       int c, len;
  1272.       unsigned char *str;
  1273.  
  1274.       if (!INTEGERP (args[i]))
  1275.     CHECK_NUMBER (args[i], 0);
  1276.       c = XINT (args[i]);
  1277.       len = CHAR_STRING (c, p, str);
  1278.       if (p != str)
  1279.     /* C is a composite character.  */
  1280.     bcopy (str, p, len);
  1281.       p += len;
  1282.     }
  1283.  
  1284.   val = make_string_from_bytes (buf, n, p - buf);
  1285.   return val;
  1286. }
  1287.  
  1288. #endif /* emacs */
  1289.  
  1290. /*** Composite characters staffs ***/
  1291.  
  1292. /* Each composite character is identified by CMPCHAR-ID which is
  1293.    assigned when Emacs needs the character code of the composite
  1294.    character (e.g. when displaying it on the screen).  See the
  1295.    document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
  1296.    composite character is represented in Emacs.  */
  1297.  
  1298. /* If `static' is defined, it means that it is defined to null string. */
  1299. #ifndef static
  1300. /* The following function is copied from lread.c.  */
  1301. static int
  1302. hash_string (ptr, len)
  1303.      unsigned char *ptr;
  1304.      int len;
  1305. {
  1306.   register unsigned char *p = ptr;
  1307.   register unsigned char *end = p + len;
  1308.   register unsigned char c;
  1309.   register int hash = 0;
  1310.  
  1311.   while (p != end)
  1312.     {
  1313.       c = *p++;
  1314.       if (c >= 0140) c -= 40;
  1315.       hash = ((hash<<3) + (hash>>28) + c);
  1316.     }
  1317.   return hash & 07777777777;
  1318. }
  1319. #endif
  1320.  
  1321. #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
  1322.  
  1323. static int *cmpchar_hash_table[CMPCHAR_HASH_TABLE_SIZE];
  1324.  
  1325. /* Each element of `cmpchar_hash_table' is a pointer to an array of
  1326.    integer, where the 1st element is the size of the array, the 2nd
  1327.    element is how many elements are actually used in the array, and
  1328.    the remaining elements are CMPCHAR-IDs of composite characters of
  1329.    the same hash value.  */
  1330. #define CMPCHAR_HASH_SIZE(table) table[0]
  1331. #define CMPCHAR_HASH_USED(table) table[1]
  1332. #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
  1333.  
  1334. /* Return CMPCHAR-ID of the composite character in STR of the length
  1335.    LEN.  If the composite character has not yet been registered,
  1336.    register it in `cmpchar_table' and assign new CMPCHAR-ID.  This
  1337.    is the sole function for assigning CMPCHAR-ID.  */
  1338. int
  1339. str_cmpchar_id (str, len)
  1340.      const unsigned char *str;
  1341.      int len;
  1342. {
  1343.   int hash_idx, *hashp;
  1344.   unsigned char *buf;
  1345.   int embedded_rule;        /* 1 if composition rule is embedded.  */
  1346.   int chars;            /* number of components.  */
  1347.   int i;
  1348.   struct cmpchar_info *cmpcharp;
  1349.  
  1350.   /* The second byte 0xFF means compostion rule is embedded.  */
  1351.   embedded_rule = (str[1] == 0xFF);
  1352.  
  1353.   /* At first, get the actual length of the composite character.  */
  1354.   {
  1355.     const unsigned char *p, *endp = str + 1, *lastp = str + len;
  1356.     int bytes;
  1357.  
  1358.     while (endp < lastp && ! CHAR_HEAD_P (*endp)) endp++;
  1359.     if (endp - str < 5)
  1360.       /* Any composite char have at least 5-byte length.  */
  1361.       return -1;
  1362.  
  1363.     chars = 0;
  1364.     p = str + 1;
  1365.     while (p < endp)
  1366.       {
  1367.     if (embedded_rule) p++;
  1368.     /* No need of checking if *P is 0xA0 because
  1369.        BYTES_BY_CHAR_HEAD (0x80) surely returns 2.  */
  1370.     p += BYTES_BY_CHAR_HEAD (*p - 0x20);
  1371.     chars++;
  1372.       }
  1373.     if (p > endp || chars < 2 || chars > MAX_COMPONENT_COUNT)
  1374.       /* Invalid components.  */
  1375.       return -1;
  1376.     len = p - str;
  1377.   }
  1378.   hash_idx = hash_string (str, len) % CMPCHAR_HASH_TABLE_SIZE;
  1379.   hashp = cmpchar_hash_table[hash_idx];
  1380.  
  1381.   /* Then, look into the hash table.  */
  1382.   if (hashp != NULL)
  1383.     /* Find the correct one among composite characters of the same
  1384.        hash value.  */
  1385.     for (i = 2; i < CMPCHAR_HASH_USED (hashp); i++)
  1386.       {
  1387.     cmpcharp = cmpchar_table[CMPCHAR_HASH_CMPCHAR_ID (hashp, i)];
  1388.     if (len == cmpcharp->len
  1389.         && ! bcmp (str, cmpcharp->data, len))
  1390.       return CMPCHAR_HASH_CMPCHAR_ID (hashp, i);
  1391.       }
  1392.  
  1393.   /* We have to register the composite character in cmpchar_table.  */
  1394.   if (n_cmpchars > (CHAR_FIELD2_MASK | CHAR_FIELD3_MASK))
  1395.     /* No, we have no more room for a new composite character.  */
  1396.     return -1;
  1397.  
  1398.   /* Make the entry in hash table.  */
  1399.   if (hashp == NULL)
  1400.     {
  1401.       /* Make a table for 8 composite characters initially.  */
  1402.       hashp = (cmpchar_hash_table[hash_idx]
  1403.            = (int *) xmalloc (sizeof (int) * (2 + 8)));
  1404.       CMPCHAR_HASH_SIZE (hashp) = 10;
  1405.       CMPCHAR_HASH_USED (hashp) = 2;
  1406.     }
  1407.   else if (CMPCHAR_HASH_USED (hashp) >= CMPCHAR_HASH_SIZE (hashp))
  1408.     {
  1409.       CMPCHAR_HASH_SIZE (hashp) += 8;
  1410.       hashp = (cmpchar_hash_table[hash_idx]
  1411.            = (int *) xrealloc (hashp, 
  1412.                    sizeof (int) * CMPCHAR_HASH_SIZE (hashp)));
  1413.     }
  1414.   CMPCHAR_HASH_CMPCHAR_ID (hashp, CMPCHAR_HASH_USED (hashp)) = n_cmpchars;
  1415.   CMPCHAR_HASH_USED (hashp)++;
  1416.  
  1417.   /* Set information of the composite character in cmpchar_table.  */
  1418.   if (cmpchar_table_size == 0)
  1419.     {
  1420.       /* This is the first composite character to be registered.  */
  1421.       cmpchar_table_size = 256;
  1422.       cmpchar_table
  1423.     = (struct cmpchar_info **) xmalloc (sizeof (cmpchar_table[0])
  1424.                         * cmpchar_table_size);
  1425.     }
  1426.   else if (cmpchar_table_size <= n_cmpchars)
  1427.     {
  1428.       cmpchar_table_size += 256;
  1429.       cmpchar_table
  1430.     = (struct cmpchar_info **) xrealloc (cmpchar_table,
  1431.                          sizeof (cmpchar_table[0])
  1432.                          * cmpchar_table_size);
  1433.     }
  1434.  
  1435.   cmpcharp = (struct cmpchar_info *) xmalloc (sizeof (struct cmpchar_info));
  1436.  
  1437.   cmpcharp->len = len;
  1438.   cmpcharp->data = (unsigned char *) xmalloc (len + 1);
  1439.   bcopy (str, cmpcharp->data, len);
  1440.   cmpcharp->data[len] = 0;
  1441.   cmpcharp->glyph_len = chars;
  1442.   cmpcharp->glyph = (GLYPH *) xmalloc (sizeof (GLYPH) * chars);
  1443.   if (embedded_rule)
  1444.     {
  1445.       cmpcharp->cmp_rule = (unsigned char *) xmalloc (chars);
  1446.       cmpcharp->col_offset = (float *) xmalloc (sizeof (float) * chars);
  1447.     }
  1448.   else
  1449.     {
  1450.       cmpcharp->cmp_rule = NULL;
  1451.       cmpcharp->col_offset = NULL;
  1452.     }
  1453.  
  1454.   /* Setup GLYPH data and composition rules (if any) so as not to make
  1455.      them every time on displaying.  */
  1456.   {
  1457.     unsigned char *bufp;
  1458.     int width;
  1459.     float leftmost = 0.0, rightmost = 1.0;
  1460.  
  1461.     if (embedded_rule)
  1462.       /* At first, col_offset[N] is set to relative to col_offset[0].  */
  1463.       cmpcharp->col_offset[0] = 0;
  1464.  
  1465.     for (i = 0, bufp = cmpcharp->data + 1; i < chars; i++)
  1466.       {
  1467.     if (embedded_rule)
  1468.       cmpcharp->cmp_rule[i] = *bufp++;
  1469.  
  1470.     if (*bufp == 0xA0)    /* This is an ASCII character.  */
  1471.       {
  1472.         cmpcharp->glyph[i] = FAST_MAKE_GLYPH ((*++bufp & 0x7F), 0);
  1473.         width = 1;
  1474.         bufp++;
  1475.       }
  1476.     else            /* Multibyte character.  */
  1477.       {
  1478.         /* Make `bufp' point normal multi-byte form temporally.  */
  1479.         *bufp -= 0x20;
  1480.         cmpcharp->glyph[i]
  1481.           = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp, 4, 0, 0), 0);
  1482.         width = WIDTH_BY_CHAR_HEAD (*bufp);
  1483.         *bufp += 0x20;
  1484.         bufp += BYTES_BY_CHAR_HEAD (*bufp - 0x20);
  1485.       }
  1486.  
  1487.     if (embedded_rule && i > 0)
  1488.       {
  1489.         /* Reference points (global_ref and new_ref) are
  1490.            encoded as below:
  1491.            
  1492.            0--1--2 -- ascent
  1493.            |     |
  1494.            |     |
  1495.            |  4 -+--- center
  1496.         -- 3     5 -- baseline
  1497.            |     |
  1498.            6--7--8 -- descent
  1499.  
  1500.            Now, we calculate the column offset of the new glyph
  1501.            from the left edge of the first glyph.  This can avoid
  1502.            the same calculation everytime displaying this
  1503.            composite character.  */
  1504.  
  1505.         /* Reference points of global glyph and new glyph.  */
  1506.         int global_ref = (cmpcharp->cmp_rule[i] - 0xA0) / 9;
  1507.         int new_ref = (cmpcharp->cmp_rule[i] - 0xA0) % 9;
  1508.         /* Column offset relative to the first glyph.  */
  1509.         float left = (leftmost
  1510.               + (global_ref % 3) * (rightmost - leftmost) / 2.0
  1511.               - (new_ref % 3) * width / 2.0);
  1512.  
  1513.         cmpcharp->col_offset[i] = left;
  1514.         if (left < leftmost)
  1515.           leftmost = left;
  1516.         if (left + width > rightmost)
  1517.           rightmost = left + width;
  1518.       }
  1519.     else
  1520.       {
  1521.         if (width > rightmost)
  1522.           rightmost = width;
  1523.       }
  1524.       }
  1525.     if (embedded_rule)
  1526.       {
  1527.     /* Now col_offset[N] are relative to the left edge of the
  1528.            first component.  Make them relative to the left edge of
  1529.            overall glyph.  */
  1530.     for (i = 0; i < chars; i++)
  1531.       cmpcharp->col_offset[i] -= leftmost;
  1532.     /* Make rightmost holds width of overall glyph.  */
  1533.     rightmost -= leftmost;
  1534.       }
  1535.  
  1536.     cmpcharp->width = rightmost;
  1537.     if (cmpcharp->width < rightmost)
  1538.       /* To get a ceiling integer value.  */
  1539.       cmpcharp->width++;
  1540.   }
  1541.  
  1542.   cmpchar_table[n_cmpchars] = cmpcharp;
  1543.  
  1544.   return n_cmpchars++;
  1545. }
  1546.  
  1547. /* Return the Nth element of the composite character C.  */
  1548. int
  1549. cmpchar_component (c, n)
  1550.      unsigned int c, n;
  1551. {
  1552.   int id = COMPOSITE_CHAR_ID (c);
  1553.  
  1554.   if (id >= n_cmpchars        /* C is not a valid composite character.  */
  1555.       || n >= cmpchar_table[id]->glyph_len) /* No such component.  */
  1556.     return -1;
  1557.   /* No face data is stored in glyph code.  */
  1558.   return ((int) (cmpchar_table[id]->glyph[n]));
  1559. }
  1560.  
  1561. DEFUN ("cmpcharp", Fcmpcharp, Scmpcharp, 1, 1, 0,
  1562.   "T if CHAR is a composite character.")
  1563.   (ch)
  1564.      Lisp_Object ch;
  1565. {
  1566.   CHECK_NUMBER (ch, 0);
  1567.   return (COMPOSITE_CHAR_P (XINT (ch)) ? Qt : Qnil);
  1568. }
  1569.  
  1570. DEFUN ("composite-char-component", Fcmpchar_component, Scmpchar_component,
  1571.        2, 2, 0,
  1572.   "Return the IDXth component character of composite character CHARACTER.")
  1573.   (character, idx)
  1574.      Lisp_Object character, idx;
  1575. {
  1576.   int c;
  1577.  
  1578.   CHECK_NUMBER (character, 0);
  1579.   CHECK_NUMBER (idx, 1);
  1580.  
  1581.   if ((c = cmpchar_component (XINT (character), XINT (idx))) < 0)
  1582.     args_out_of_range (character, idx);
  1583.  
  1584.   return make_number (c);
  1585. }
  1586.  
  1587. DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule, Scmpchar_cmp_rule,
  1588.        2, 2, 0,
  1589.   "Return the Nth composition rule embedded in composite character CHARACTER.\n\
  1590. The returned rule is for composing the Nth component\n\
  1591. on the (N-1)th component.  If N is 0, the returned value is always 255.")
  1592.   (character, n)
  1593.      Lisp_Object character, n;
  1594. {
  1595.   int id, i;
  1596.  
  1597.   CHECK_NUMBER (character, 0);
  1598.   CHECK_NUMBER (n, 1);
  1599.  
  1600.   id = COMPOSITE_CHAR_ID (XINT (character));
  1601.   if (id < 0 || id >= n_cmpchars)
  1602.     error ("Invalid composite character: %d", XINT (character));
  1603.   i = XINT (n);
  1604.   if (i > cmpchar_table[id]->glyph_len)
  1605.     args_out_of_range (character, n);
  1606.  
  1607.   return make_number (cmpchar_table[id]->cmp_rule[i]);
  1608. }
  1609.  
  1610. DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p,
  1611.        Scmpchar_cmp_rule_p, 1, 1, 0,
  1612.   "Return non-nil if composite character CHARACTER contains a embedded rule.")
  1613.   (character)
  1614.      Lisp_Object character;
  1615. {
  1616.   int id;
  1617.  
  1618.   CHECK_NUMBER (character, 0);
  1619.   id = COMPOSITE_CHAR_ID (XINT (character));
  1620.   if (id < 0 || id >= n_cmpchars)
  1621.     error ("Invalid composite character: %d", XINT (character));
  1622.  
  1623.   return (cmpchar_table[id]->cmp_rule ? Qt : Qnil);
  1624. }
  1625.  
  1626. DEFUN ("composite-char-component-count", Fcmpchar_cmp_count,
  1627.        Scmpchar_cmp_count, 1, 1, 0,
  1628.   "Return number of compoents of composite character CHARACTER.")
  1629.   (character)
  1630.      Lisp_Object character;
  1631. {
  1632.   int id;
  1633.  
  1634.   CHECK_NUMBER (character, 0);
  1635.   id = COMPOSITE_CHAR_ID (XINT (character));
  1636.   if (id < 0 || id >= n_cmpchars)
  1637.     error ("Invalid composite character: %d", XINT (character));
  1638.  
  1639.   return (make_number (cmpchar_table[id]->glyph_len));
  1640. }
  1641.  
  1642. DEFUN ("compose-string", Fcompose_string, Scompose_string,
  1643.        1, 1, 0,
  1644.   "Return one char string composed from all characters in STRING.")
  1645.   (str)
  1646.      Lisp_Object str;
  1647. {
  1648.   unsigned char buf[MAX_LENGTH_OF_MULTI_BYTE_FORM], *p, *pend, *ptemp;
  1649.   int len, i;
  1650.  
  1651.   CHECK_STRING (str, 0);
  1652.  
  1653.   buf[0] = LEADING_CODE_COMPOSITION;
  1654.   p = XSTRING (str)->data;
  1655.   pend = p + STRING_BYTES (XSTRING (str));
  1656.   i = 1;
  1657.   while (p < pend)
  1658.     {
  1659.       if (*p < 0x20 || *p == 127) /* control code */
  1660.     error ("Invalid component character: %d", *p);
  1661.       else if (*p < 0x80)    /* ASCII */
  1662.     {
  1663.       if (i + 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
  1664.         error ("Too long string to be composed: %s", XSTRING (str)->data);
  1665.       /* Prepend an ASCII charset indicator 0xA0, set MSB of the
  1666.              code itself.  */
  1667.       buf[i++] = 0xA0;
  1668.       buf[i++] = *p++ + 0x80;
  1669.     }
  1670.       else if (*p == LEADING_CODE_COMPOSITION) /* composite char */
  1671.     {
  1672.       /* Already composed.  Eliminate the heading
  1673.              LEADING_CODE_COMPOSITION, keep the remaining bytes
  1674.              unchanged.  */
  1675.       p++;
  1676.       ptemp = p;
  1677.       while (! CHAR_HEAD_P (*p)) p++;
  1678.       if (i + (p - ptemp) >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
  1679.         error ("Too long string to be composed: %s", XSTRING (str)->data);
  1680.       bcopy (ptemp, buf + i, p - ptemp);
  1681.       i += p - ptemp;
  1682.     }
  1683.       else            /* multibyte char */
  1684.     {
  1685.       /* Add 0x20 to the base leading-code, keep the remaining
  1686.              bytes unchanged.  */
  1687.       len = BYTES_BY_CHAR_HEAD (*p);
  1688.       if (i + len >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
  1689.         error ("Too long string to be composed: %s", XSTRING (str)->data);
  1690.       bcopy (p, buf + i, len);
  1691.       buf[i] += 0x20;
  1692.       p += len, i += len;
  1693.     }
  1694.     }
  1695.  
  1696.   if (i < 5)
  1697.     /* STR contains only one character, which can't be composed.  */
  1698.     error ("Too short string to be composed: %s", XSTRING (str)->data);
  1699.  
  1700.   return make_string_from_bytes (buf, 1, i);
  1701. }
  1702.  
  1703.  
  1704. int
  1705. charset_id_internal (charset_name)
  1706.      char *charset_name;
  1707. {
  1708.   Lisp_Object val;
  1709.  
  1710.   val= Fget (intern (charset_name), Qcharset);
  1711.   if (!VECTORP (val))
  1712.     error ("Charset %s is not defined", charset_name);
  1713.  
  1714.   return (XINT (XVECTOR (val)->contents[0]));
  1715. }
  1716.  
  1717. DEFUN ("setup-special-charsets", Fsetup_special_charsets,
  1718.        Ssetup_special_charsets, 0, 0, 0, "Internal use only.")
  1719.    ()
  1720. {
  1721.   charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1");
  1722.   charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978");
  1723.   charset_jisx0208 = charset_id_internal ("japanese-jisx0208");
  1724.   charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201");
  1725.   charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201");
  1726.   charset_big5_1 = charset_id_internal ("chinese-big5-1");
  1727.   charset_big5_2 = charset_id_internal ("chinese-big5-2");
  1728.   return Qnil;
  1729. }
  1730.  
  1731. void
  1732. init_charset_once ()
  1733. {
  1734.   int i, j, k;
  1735.  
  1736.   staticpro (&Vcharset_table);
  1737.   staticpro (&Vcharset_symbol_table);
  1738.   staticpro (&Vgeneric_character_list);
  1739.  
  1740.   /* This has to be done here, before we call Fmake_char_table.  */
  1741.   Qcharset_table = intern ("charset-table");
  1742.   staticpro (&Qcharset_table);
  1743.  
  1744.   /* Intern this now in case it isn't already done.
  1745.      Setting this variable twice is harmless.
  1746.      But don't staticpro it here--that is done in alloc.c.  */
  1747.   Qchar_table_extra_slots = intern ("char-table-extra-slots");
  1748.  
  1749.   /* Now we are ready to set up this property, so we can
  1750.      create the charset table.  */
  1751.   Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
  1752.   Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
  1753.  
  1754.   Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1), Qnil);
  1755.  
  1756.   /* Setup tables.  */
  1757.   for (i = 0; i < 2; i++)
  1758.     for (j = 0; j < 2; j++)
  1759.       for (k = 0; k < 128; k++)
  1760.     iso_charset_table [i][j][k] = -1;
  1761.  
  1762.   bzero (cmpchar_hash_table, sizeof cmpchar_hash_table);
  1763.   cmpchar_table_size = n_cmpchars = 0;
  1764.  
  1765.   for (i = 0; i < 256; i++)
  1766.     BYTES_BY_CHAR_HEAD (i) = 1;
  1767.   BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 3;
  1768.   BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 3;
  1769.   BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 4;
  1770.   BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 4;
  1771.   /* The following doesn't reflect the actual bytes, but just to tell
  1772.      that it is a start of a multibyte character.  */
  1773.   BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION) = 2;
  1774.  
  1775.   for (i = 0; i < 128; i++)
  1776.     WIDTH_BY_CHAR_HEAD (i) = 1;
  1777.   for (; i < 256; i++)
  1778.     WIDTH_BY_CHAR_HEAD (i) = 4;
  1779.   WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 1;
  1780.   WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 2;
  1781.   WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 1;
  1782.   WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 2;
  1783.  
  1784.   {
  1785.     Lisp_Object val;
  1786.  
  1787.     val = Qnil;
  1788.     for (i = 0x81; i < 0x90; i++)
  1789.       val = Fcons (make_number ((i - 0x70) << 7), val);
  1790.     for (; i < 0x9A; i++)
  1791.       val = Fcons (make_number ((i - 0x8F) << 14), val);
  1792.     for (i = 0xA0; i < 0xF0; i++)
  1793.       val = Fcons (make_number ((i - 0x70) << 7), val);
  1794.     for (; i < 0xFF; i++)
  1795.       val = Fcons (make_number ((i - 0xE0) << 14), val);
  1796.     val = Fcons (make_number (GENERIC_COMPOSITION_CHAR), val);
  1797.     Vgeneric_character_list = Fnreverse (val);
  1798.   }
  1799. }
  1800.  
  1801. #ifdef emacs
  1802.  
  1803. void
  1804. syms_of_charset ()
  1805. {
  1806.   Qascii = intern ("ascii");
  1807.   staticpro (&Qascii);
  1808.  
  1809.   Qcharset = intern ("charset");
  1810.   staticpro (&Qcharset);
  1811.  
  1812.   /* Define ASCII charset now.  */
  1813.   update_charset_table (make_number (CHARSET_ASCII),
  1814.             make_number (1), make_number (94),
  1815.             make_number (1),
  1816.             make_number (0),
  1817.             make_number ('B'),
  1818.             make_number (0),
  1819.             build_string ("ASCII"),
  1820.             build_string ("ASCII"),
  1821.             build_string ("ASCII (ISO646 IRV)"));
  1822.   CHARSET_SYMBOL (CHARSET_ASCII) = Qascii;
  1823.   Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII));
  1824.  
  1825.   Qcomposition = intern ("composition");
  1826.   staticpro (&Qcomposition);
  1827.   CHARSET_SYMBOL (CHARSET_COMPOSITION) = Qcomposition;
  1828.  
  1829.   defsubr (&Sdefine_charset);
  1830.   defsubr (&Sgeneric_character_list);
  1831.   defsubr (&Sget_unused_iso_final_char);
  1832.   defsubr (&Sdeclare_equiv_charset);
  1833.   defsubr (&Sfind_charset_region);
  1834.   defsubr (&Sfind_charset_string);
  1835.   defsubr (&Smake_char_internal);
  1836.   defsubr (&Ssplit_char);
  1837.   defsubr (&Schar_charset);
  1838.   defsubr (&Scharset_after);
  1839.   defsubr (&Siso_charset);
  1840.   defsubr (&Schar_valid_p);
  1841.   defsubr (&Sunibyte_char_to_multibyte);
  1842.   defsubr (&Smultibyte_char_to_unibyte);
  1843.   defsubr (&Schar_bytes);
  1844.   defsubr (&Schar_width);
  1845.   defsubr (&Sstring_width);
  1846.   defsubr (&Schar_direction);
  1847.   defsubr (&Schars_in_region);
  1848.   defsubr (&Sstring);
  1849.   defsubr (&Scmpcharp);
  1850.   defsubr (&Scmpchar_component);
  1851.   defsubr (&Scmpchar_cmp_rule);
  1852.   defsubr (&Scmpchar_cmp_rule_p);
  1853.   defsubr (&Scmpchar_cmp_count);
  1854.   defsubr (&Scompose_string);
  1855.   defsubr (&Ssetup_special_charsets);
  1856.  
  1857.   DEFVAR_LISP ("charset-list", &Vcharset_list,
  1858.     "List of charsets ever defined.");
  1859.   Vcharset_list = Fcons (Qascii, Qnil);
  1860.  
  1861.   DEFVAR_LISP ("translation-table-vector",  &Vtranslation_table_vector,
  1862.     "Vector of cons cell of a symbol and translation table ever defined.\n\
  1863. An ID of a translation table is an index of this vector.");
  1864.   Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil);
  1865.  
  1866.   DEFVAR_INT ("leading-code-composition", &leading_code_composition,
  1867.     "Leading-code of composite characters.");
  1868.   leading_code_composition = LEADING_CODE_COMPOSITION;
  1869.  
  1870.   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11,
  1871.     "Leading-code of private TYPE9N charset of column-width 1.");
  1872.   leading_code_private_11 = LEADING_CODE_PRIVATE_11;
  1873.  
  1874.   DEFVAR_INT ("leading-code-private-12", &leading_code_private_12,
  1875.     "Leading-code of private TYPE9N charset of column-width 2.");
  1876.   leading_code_private_12 = LEADING_CODE_PRIVATE_12;
  1877.  
  1878.   DEFVAR_INT ("leading-code-private-21", &leading_code_private_21,
  1879.     "Leading-code of private TYPE9Nx9N charset of column-width 1.");
  1880.   leading_code_private_21 = LEADING_CODE_PRIVATE_21;
  1881.  
  1882.   DEFVAR_INT ("leading-code-private-22", &leading_code_private_22,
  1883.     "Leading-code of private TYPE9Nx9N charset of column-width 2.");
  1884.   leading_code_private_22 = LEADING_CODE_PRIVATE_22;
  1885.  
  1886.   DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset,
  1887.     "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
  1888. This is used for converting unibyte text to multibyte,\n\
  1889. and for inserting character codes specified by number.\n\n\
  1890. This serves to convert a Latin-1 or similar 8-bit character code\n\
  1891. to the corresponding Emacs multibyte character code.\n\
  1892. Typically the value should be (- (make-char CHARSET 0) 128),\n\
  1893. for your choice of character set.\n\
  1894. If `nonascii-translation-table' is non-nil, it overrides this variable.");
  1895.   nonascii_insert_offset = 0;
  1896.  
  1897.   DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table,
  1898.     "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
  1899. This is used for converting unibyte text to multibyte,\n\
  1900. and for inserting character codes specified by number.\n\n\
  1901. Conversion is performed only when multibyte characters are enabled,\n\
  1902. and it serves to convert a Latin-1 or similar 8-bit character code\n\
  1903. to the corresponding Emacs character code.\n\n\
  1904. If this is nil, `nonascii-insert-offset' is used instead.\n\
  1905. See also the docstring of `make-translation-table'.");
  1906.   Vnonascii_translation_table = Qnil;
  1907.  
  1908.   DEFVAR_INT ("min-composite-char", &min_composite_char,
  1909.     "Minimum character code of a composite character.");
  1910.   min_composite_char = MIN_CHAR_COMPOSITION;
  1911. }
  1912.  
  1913. #endif /* emacs */
  1914.