/* Basic character set support.
Copyright (C) 1995, 97, 98, 2000, 2001 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
+ Licensed to the Free Software Foundation.
Copyright (C) 2001 Free Software Foundation, Inc.
- Copyright (C) 2001, 2002
+ Copyright (C) 2003
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-#ifdef emacs
#include <config.h>
-#endif
#include <stdio.h>
#include <unistd.h>
#include <ctype.h>
-
-#ifdef emacs
-
#include <sys/types.h>
#include "lisp.h"
#include "character.h"
#include "disptab.h"
#include "buffer.h"
-#else /* not emacs */
-
-#include "mulelib.h"
-
-#endif /* emacs */
-
-
-/*** GENERAL NOTE on CODED CHARACTER SET (CHARSET) ***
+/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
A coded character set ("charset" hereafter) is a meaningful
- collection (i.e. language, culture, functionality, etc) of
+ collection (i.e. language, culture, functionality, etc.) of
characters. Emacs handles multiple charsets at once. In Emacs Lisp
- code, a charset is represented by symbol. In C code, a charset is
- represented by its ID number or by a pointer the struct charset.
+ code, a charset is represented by a symbol. In C code, a charset is
+ represented by its ID number or by a pointer to a struct charset.
The actual information about each charset is stored in two places.
Lispy information is stored in the hash table Vcharset_hash_table as
a vector (charset attributes). The other information is stored in
- charset_table as struct charset.
+ charset_table as a struct charset.
*/
struct charset *charset_table;
static int charset_table_size;
-int charset_table_used;
+static int charset_table_used;
Lisp_Object Qcharsetp;
/* Special charset symbols. */
Lisp_Object Qascii;
-Lisp_Object Qeight_bit_control;
-Lisp_Object Qeight_bit_graphic;
+Lisp_Object Qeight_bit;
Lisp_Object Qiso_8859_1;
Lisp_Object Qunicode;
/* The corresponding charsets. */
int charset_ascii;
-int charset_8_bit_control;
-int charset_8_bit_graphic;
+int charset_eight_bit;
int charset_iso_8859_1;
int charset_unicode;
+/* The other special charsets. */
+int charset_jisx0201_roman;
+int charset_jisx0208_1978;
+int charset_jisx0208;
+
/* Value of charset attribute `charset-iso-plane'. */
Lisp_Object Qgl, Qgr;
-/* The primary charset. It is a charset of unibyte characters. */
-int charset_primary;
+/* Charset of unibyte characters. */
+int charset_unibyte;
/* List of charsets ordered by the priority. */
Lisp_Object Vcharset_ordered_list;
+/* Incremented everytime we change Vcharset_ordered_list. This is
+ unsigned short so that it fits in Lisp_Int and never matches
+ -1. */
+unsigned short charset_ordered_list_tick;
+
/* List of iso-2022 charsets. */
Lisp_Object Viso_2022_charset_list;
CHARS, and FINAL-CHAR) to Emacs' charset. */
int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
-Lisp_Object Vcharset_map_directory;
+Lisp_Object Vcharset_map_path;
Lisp_Object Vchar_unified_charset_table;
-#define CODE_POINT_TO_INDEX(charset, code) \
- ((charset)->code_linear_p \
- ? (code) - (charset)->min_code \
- : ((((code) >> 24) <= (charset)->code_space[13]) \
- && ((((code) >> 16) & 0xFF) <= (charset)->code_space[9]) \
- && ((((code) >> 8) & 0xFF) <= (charset)->code_space[5]) \
- && (((code) & 0xFF) <= (charset)->code_space[1])) \
- ? (((((code) >> 24) - (charset)->code_space[12]) \
- * (charset)->code_space[11]) \
- + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
- * (charset)->code_space[7]) \
- + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
- * (charset)->code_space[3]) \
- + (((code) & 0xFF) - (charset)->code_space[0])) \
+/* Defined in chartab.c */
+extern void
+map_char_table_for_charset P_ ((void (*c_function) (Lisp_Object, Lisp_Object),
+ Lisp_Object function, Lisp_Object table,
+ Lisp_Object arg, struct charset *charset,
+ unsigned from, unsigned to));
+
+#define CODE_POINT_TO_INDEX(charset, code) \
+ ((charset)->code_linear_p \
+ ? (code) - (charset)->min_code \
+ : (((charset)->code_space_mask[(code) >> 24] & 0x8) \
+ && ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
+ && ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
+ && ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
+ ? (((((code) >> 24) - (charset)->code_space[12]) \
+ * (charset)->code_space[11]) \
+ + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
+ * (charset)->code_space[7]) \
+ + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
+ * (charset)->code_space[3]) \
+ + (((code) & 0xFF) - (charset)->code_space[0]) \
+ - ((charset)->char_index_offset)) \
: -1)
/* Convert the character index IDX to code-point CODE for CHARSET.
It is assumed that IDX is in a valid range. */
-#define INDEX_TO_CODE_POINT(charset, idx) \
- ((charset)->code_linear_p \
- ? (idx) + (charset)->min_code \
- : (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
- | (((charset)->code_space[4] \
- + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
- << 8) \
- | (((charset)->code_space[8] \
- + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
- << 16) \
- | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
- << 24)))
+#define INDEX_TO_CODE_POINT(charset, idx) \
+ ((charset)->code_linear_p \
+ ? (idx) + (charset)->min_code \
+ : (idx += (charset)->char_index_offset, \
+ (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
+ | (((charset)->code_space[4] \
+ + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
+ << 8) \
+ | (((charset)->code_space[8] \
+ + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
+ << 16) \
+ | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
+ << 24))))
+
\f
-/* Set to 1 when a charset map is loaded to warn that a buffer text
- and a string data may be relocated. */
+/* Set to 1 to warn that a charset map is loaded and thus a buffer
+ text and a string data may be relocated. */
int charset_map_loaded;
-/* Parse the mapping vector MAP which has this form:
- [CODE0 CHAR0 CODE1 CHAR1 ... ]
+struct charset_map_entries
+{
+ struct {
+ unsigned from, to;
+ int c;
+ } entry[0x10000];
+ struct charset_map_entries *next;
+};
+
+/* Load the mapping information for CHARSET from ENTRIES.
If CONTROL_FLAG is 0, setup CHARSET->min_char and CHARSET->max_char.
setup it too. */
static void
-parse_charset_map (charset, map, control_flag)
+load_charset_map (charset, entries, n_entries, control_flag)
struct charset *charset;
- Lisp_Object map;
+ struct charset_map_entries *entries;
+ int n_entries;
int control_flag;
{
Lisp_Object vec, table;
- unsigned min_code = CHARSET_MIN_CODE (charset);
unsigned max_code = CHARSET_MAX_CODE (charset);
int ascii_compatible_p = charset->ascii_compatible_p;
int min_char, max_char, nonascii_min_char;
- int size;
int i;
- int first;
unsigned char *fast_map = charset->fast_map;
- if (control_flag)
+ if (n_entries <= 0)
+ return;
+
+ if (control_flag > 0)
{
int n = CODE_POINT_TO_INDEX (charset, max_code) + 1;
- unsigned invalid_code = CHARSET_INVALID_CODE (charset);
- table = Fmake_char_table (Qnil, make_number (invalid_code));
+ table = Fmake_char_table (Qnil, Qnil);
if (control_flag == 1)
vec = Fmake_vector (make_number (n), make_number (-1));
else if (! CHAR_TABLE_P (Vchar_unify_table))
- Vchar_unify_table = Fmake_char_table (Qnil, make_number (-1));
+ Vchar_unify_table = Fmake_char_table (Qnil, Qnil);
charset_map_loaded = 1;
}
- size = ASIZE (map);
+ min_char = max_char = entries->entry[0].c;
nonascii_min_char = MAX_CHAR;
- CHARSET_COMPACT_CODES_P (charset) = 1;
- for (first = 1, i = 0; i < size; i += 2)
+ for (i = 0; i < n_entries; i++)
{
- Lisp_Object val;
- unsigned code;
- int c, char_index;
-
- val = AREF (map, i);
- CHECK_NATNUM (val);
- code = XFASTINT (val);
- val = AREF (map, i + 1);
- CHECK_NATNUM (val);
- c = XFASTINT (val);
-
- if (code < min_code || code > max_code)
- continue;
- char_index = CODE_POINT_TO_INDEX (charset, code);
- if (char_index < 0
- || c > MAX_CHAR)
+ unsigned from, to;
+ int from_index, to_index;
+ int from_c, to_c;
+ int idx = i % 0x10000;
+
+ if (i > 0 && idx == 0)
+ entries = entries->next;
+ from = entries->entry[idx].from;
+ to = entries->entry[idx].to;
+ from_c = entries->entry[idx].c;
+ from_index = CODE_POINT_TO_INDEX (charset, from);
+ if (from == to)
+ {
+ to_index = from_index;
+ to_c = from_c;
+ }
+ else
+ {
+ to_index = CODE_POINT_TO_INDEX (charset, to);
+ to_c = from_c + (to_index - from_index);
+ }
+ if (from_index < 0 || to_index < 0)
continue;
-
+
if (control_flag < 2)
{
- if (first)
+ int c;
+
+ if (to_c > max_char)
+ max_char = to_c;
+ else if (from_c < min_char)
+ min_char = from_c;
+ if (ascii_compatible_p)
{
- min_char = max_char = c;
- first = 0;
+ if (! ASCII_BYTE_P (from_c))
+ {
+ if (from_c < nonascii_min_char)
+ nonascii_min_char = from_c;
+ }
+ else if (! ASCII_BYTE_P (to_c))
+ {
+ nonascii_min_char = 0x80;
+ }
}
- else if (c > max_char)
- max_char = c;
- else if (c < min_char)
- min_char = c;
- if (ascii_compatible_p && ! ASCII_BYTE_P (c)
- && c < nonascii_min_char)
- nonascii_min_char = c;
-
- CHARSET_FAST_MAP_SET (c, fast_map);
- }
- if (control_flag)
- {
+ for (c = from_c; c <= to_c; c++)
+ CHARSET_FAST_MAP_SET (c, fast_map);
+
if (control_flag == 1)
{
- if (char_index >= ASIZE (vec))
- abort ();
- ASET (vec, char_index, make_number (c));
- if (code > 0x7FFFFFF)
- {
- CHAR_TABLE_SET (table, c,
- Fcons (make_number (code >> 16),
- make_number (code & 0xFFFF)));
- CHARSET_COMPACT_CODES_P (charset) = 0;
- }
+ unsigned code = from;
+
+ if (CHARSET_COMPACT_CODES_P (charset))
+ while (1)
+ {
+ ASET (vec, from_index, make_number (from_c));
+ if (NILP (CHAR_TABLE_REF (table, from_c)))
+ CHAR_TABLE_SET (table, from_c, make_number (code));
+ if (from_index == to_index)
+ break;
+ from_index++, from_c++;
+ code = INDEX_TO_CODE_POINT (charset, from_index);
+ }
else
- CHAR_TABLE_SET (table, c, make_number (code));
+ for (; from_index <= to_index; from_index++, from_c++)
+ {
+ ASET (vec, from_index, make_number (from_c));
+ if (NILP (CHAR_TABLE_REF (table, from_c)))
+ CHAR_TABLE_SET (table, from_c, make_number (from_index));
+ }
}
- else
+ }
+ else
+ {
+ unsigned code = from;
+
+ while (1)
{
int c1 = DECODE_CHAR (charset, code);
+
if (c1 >= 0)
{
- CHAR_TABLE_SET (table, c, make_number (c1));
- CHAR_TABLE_SET (Vchar_unify_table, c1, c);
+ CHAR_TABLE_SET (table, from_c, make_number (c1));
+ CHAR_TABLE_SET (Vchar_unify_table, c1, make_number (from_c));
if (CHAR_TABLE_P (Vchar_unified_charset_table))
CHAR_TABLE_SET (Vchar_unified_charset_table, c1,
CHARSET_NAME (charset));
}
+ if (from_index == to_index)
+ break;
+ from_index++, from_c++;
+ code = INDEX_TO_CODE_POINT (charset, from_index);
}
}
}
CHARSET_MIN_CHAR (charset) = (ascii_compatible_p
? nonascii_min_char : min_char);
CHARSET_MAX_CHAR (charset) = max_char;
- if (control_flag)
+ if (control_flag == 1)
{
CHARSET_DECODER (charset) = vec;
CHARSET_ENCODER (charset) = table;
}
}
else
- CHARSET_DEUNIFIER (charset) = table;
+ CHARSET_DEUNIFIER (charset) = table;
}
while ((c = getc (fp)) != EOF)
{
- if (c == '#' || c == ' ')
+ if (c == '#')
{
while ((c = getc (fp)) != EOF && c != '\n');
}
if ((c = getc (fp)) == EOF || c == 'x')
break;
}
- }
+ }
if (c == EOF)
{
*eof = 1;
else
while ((c = getc (fp)) != EOF && isdigit (c))
n = (n * 10) + c - '0';
+ if (c != EOF)
+ ungetc (c, fp);
return n;
}
/* Return a mapping vector for CHARSET loaded from MAPFILE.
- Each line of MAPFILE has this form:
- 0xAAAA 0xBBBB
- where 0xAAAA is a code-point and 0xBBBB is the corresponding
- character code.
+ Each line of MAPFILE has this form
+ 0xAAAA 0xCCCC
+ where 0xAAAA is a code-point and 0xCCCC is the corresponding
+ character code, or this form
+ 0xAAAA-0xBBBB 0xCCCC
+ where 0xAAAA and 0xBBBB are code-points specifying a range, and
+ 0xCCCC is the first character code of the range.
+
The returned vector has this form:
[ CODE1 CHAR1 CODE2 CHAR2 .... ]
-*/
+ where CODE1 is a code-point or a cons of code-points specifying a
+ range. */
extern void add_to_log P_ ((char *, Lisp_Object, Lisp_Object));
-static Lisp_Object
-load_charset_map (charset, mapfile)
+static void
+load_charset_map_from_file (charset, mapfile, control_flag)
struct charset *charset;
Lisp_Object mapfile;
+ int control_flag;
{
+ unsigned min_code = CHARSET_MIN_CODE (charset);
+ unsigned max_code = CHARSET_MAX_CODE (charset);
int fd;
FILE *fp;
- int num;
- unsigned *numbers_table[256];
- int numbers_table_used;
- unsigned *numbers;
int eof;
Lisp_Object suffixes;
- Lisp_Object vec;
- int i;
+ struct charset_map_entries *head, *entries;
+ int n_entries;
suffixes = Fcons (build_string (".map"),
Fcons (build_string (".TXT"), Qnil));
- fd = openp (Fcons (Vcharset_map_directory, Qnil), mapfile, suffixes,
- NULL, 0);
+ fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil);
if (fd < 0
|| ! (fp = fdopen (fd, "r")))
{
add_to_log ("Failure in loading charset map: %S", mapfile, Qnil);
- return Qnil;
+ return;
}
- numbers_table_used = 0;
- num = 0;
+ head = entries = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ n_entries = 0;
eof = 0;
while (1)
{
- unsigned n = read_hex (fp, &eof);
+ unsigned from, to;
+ int c;
+ int idx;
+ from = read_hex (fp, &eof);
if (eof)
break;
- if ((num % 0x10000) == 0)
+ if (getc (fp) == '-')
+ to = read_hex (fp, &eof);
+ else
+ to = from;
+ c = (int) read_hex (fp, &eof);
+
+ if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
+ continue;
+
+ if (n_entries > 0 && (n_entries % 0x10000) == 0)
{
- if (numbers_table_used == 256)
- break;
- numbers = (unsigned *) alloca (sizeof (unsigned) * 0x10000);
- numbers_table[numbers_table_used++] = numbers;
+ entries->next = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ entries = entries->next;
}
- *numbers++ = n;
- num++;
+ idx = n_entries % 0x10000;
+ entries->entry[idx].from = from;
+ entries->entry[idx].to = to;
+ entries->entry[idx].c = c;
+ n_entries++;
}
fclose (fp);
close (fd);
- vec = Fmake_vector (make_number (num), Qnil);
- for (i = 0; i < num; i++, numbers++)
+ load_charset_map (charset, head, n_entries, control_flag);
+}
+
+static void
+load_charset_map_from_vector (charset, vec, control_flag)
+ struct charset *charset;
+ Lisp_Object vec;
+ int control_flag;
+{
+ unsigned min_code = CHARSET_MIN_CODE (charset);
+ unsigned max_code = CHARSET_MAX_CODE (charset);
+ struct charset_map_entries *head, *entries;
+ int n_entries;
+ int len = ASIZE (vec);
+ int i;
+
+ if (len % 2 == 1)
{
- if ((i % 0x10000) == 0)
- numbers = numbers_table[i / 0x10000];
- ASET (vec, i, make_number (*numbers));
+ add_to_log ("Failure in loading charset map: %V", vec, Qnil);
+ return;
}
- charset_map_loaded = 1;
+ head = entries = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ n_entries = 0;
+ for (i = 0; i < len; i += 2)
+ {
+ Lisp_Object val, val2;
+ unsigned from, to;
+ int c;
+ int idx;
+
+ val = AREF (vec, i);
+ if (CONSP (val))
+ {
+ val2 = XCDR (val);
+ val = XCAR (val);
+ CHECK_NATNUM (val);
+ CHECK_NATNUM (val2);
+ from = XFASTINT (val);
+ to = XFASTINT (val2);
+ }
+ else
+ {
+ CHECK_NATNUM (val);
+ from = to = XFASTINT (val);
+ }
+ val = AREF (vec, i + 1);
+ CHECK_NATNUM (val);
+ c = XFASTINT (val);
+
+ if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
+ continue;
- return vec;
+ if ((n_entries % 0x10000) == 0)
+ {
+ entries->next = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ entries = entries->next;
+ }
+ idx = n_entries % 0x10000;
+ entries->entry[idx].from = from;
+ entries->entry[idx].to = to;
+ entries->entry[idx].c = c;
+ n_entries++;
+ }
+
+ load_charset_map (charset, head, n_entries, control_flag);
}
static void
map = CHARSET_MAP (charset);
if (STRINGP (map))
- map = load_charset_map (charset, map);
- parse_charset_map (charset, map, 1);
+ load_charset_map_from_file (charset, map, 1);
+ else
+ load_charset_map_from_vector (charset, map, 1);
CHARSET_METHOD (charset) = CHARSET_METHOD_MAP;
}
}
void
-map_charset_chars (c_function, function, charset_symbol, arg)
- void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object);
- Lisp_Object function, charset_symbol, arg;
+map_charset_chars (c_function, function, arg,
+ charset, from, to)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object));
+ Lisp_Object function, arg;
+ struct charset *charset;
+ unsigned from, to;
{
- int id;
- struct charset *charset;
Lisp_Object range;
+ int partial;
- CHECK_CHARSET_GET_ID (charset_symbol, id);
- charset = CHARSET_FROM_ID (id);
-
- if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED)
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED)
load_charset (charset);
+ partial = (from > CHARSET_MIN_CODE (charset)
+ || to < CHARSET_MAX_CODE (charset));
+
+ if (CHARSET_UNIFIED_P (charset)
+ && CHAR_TABLE_P (CHARSET_DEUNIFIER (charset)))
+ {
+ map_char_table_for_charset (c_function, function,
+ CHARSET_DEUNIFIER (charset), arg,
+ partial ? charset : NULL, from, to);
+ }
+
if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
{
- range = Fcons (make_number (CHARSET_MIN_CHAR (charset)),
- make_number (CHARSET_MAX_CHAR (charset)));
+ int from_idx = CODE_POINT_TO_INDEX (charset, from);
+ int to_idx = CODE_POINT_TO_INDEX (charset, to);
+ int from_c = from_idx + CHARSET_CODE_OFFSET (charset);
+ int to_c = to_idx + CHARSET_CODE_OFFSET (charset);
+
+ range = Fcons (make_number (from_c), make_number (to_c));
if (NILP (function))
- (*c_function) (arg, range, Qnil);
+ (*c_function) (arg, range);
else
call2 (function, range, arg);
}
{
if (! CHAR_TABLE_P (CHARSET_ENCODER (charset)))
return;
- if (CHARSET_ASCII_COMPATIBLE_P (charset))
+ if (CHARSET_ASCII_COMPATIBLE_P (charset) && from <= 127)
{
- range = Fcons (make_number (0), make_number (127));
+ range = Fcons (make_number (from), make_number (to));
+ if (to >= 128)
+ XSETCAR (range, make_number (127));
+
if (NILP (function))
- (*c_function) (arg, range, Qnil);
+ (*c_function) (arg, range);
else
call2 (function, range, arg);
}
- map_char_table (c_function, function, CHARSET_ENCODER (charset), arg,
- 0, NULL);
+ map_char_table_for_charset (c_function, function,
+ CHARSET_ENCODER (charset), arg,
+ partial ? charset : NULL, from, to);
}
- else /* i.e. CHARSET_METHOD_PARENT */
+ else if (CHARSET_METHOD (charset) == CHARSET_METHOD_SUBSET)
{
- int from, to, c;
- unsigned code;
- int i, j, k, l;
- int *code_space = CHARSET_CODE_SPACE (charset);
- Lisp_Object val;
+ Lisp_Object subset_info;
+ int offset;
+
+ subset_info = CHARSET_SUBSET (charset);
+ charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
+ offset = XINT (AREF (subset_info, 3));
+ from -= offset;
+ if (from < XFASTINT (AREF (subset_info, 1)))
+ from = XFASTINT (AREF (subset_info, 1));
+ to -= offset;
+ if (to > XFASTINT (AREF (subset_info, 2)))
+ to = XFASTINT (AREF (subset_info, 2));
+ map_charset_chars (c_function, function, arg, charset, from, to);
+ }
+ else /* i.e. CHARSET_METHOD_SUPERSET */
+ {
+ Lisp_Object parents;
- range = Fcons (Qnil, Qnil);
- from = to = -2;
- for (i = code_space[12]; i <= code_space[13]; i++)
- for (j = code_space[8]; j <= code_space[9]; j++)
- for (k = code_space[4]; k <= code_space[5]; k++)
- for (l = code_space[0]; l <= code_space[1]; l++)
- {
- code = (i << 24) | (j << 16) | (k << 8) | l;
- c = DECODE_CHAR (charset, code);
- if (c == to + 1)
- {
- to++;
- continue;
- }
- if (from >= 0)
- {
- if (from < to)
- {
- XSETCAR (range, make_number (from));
- XSETCDR (range, make_number (to));
- val = range;
- }
- else
- val = make_number (from);
- if (NILP (function))
- (*c_function) (arg, val, Qnil);
- else
- call2 (function, val, arg);
- }
- from = to = (c < 0 ? -2 : c);
- }
- if (from >= 0)
+ for (parents = CHARSET_SUPERSET (charset); CONSP (parents);
+ parents = XCDR (parents))
{
- if (from < to)
- {
- XSETCAR (range, make_number (from));
- XSETCDR (range, make_number (to));
- val = range;
- }
- else
- val = make_number (from);
- if (NILP (function))
- (*c_function) (arg, val, Qnil);
- else
- call2 (function, val, arg);
+ int offset;
+ unsigned this_from, this_to;
+
+ charset = CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents))));
+ offset = XINT (XCDR (XCAR (parents)));
+ this_from = from - offset;
+ this_to = to - offset;
+ if (this_from < CHARSET_MIN_CODE (charset))
+ this_from = CHARSET_MIN_CODE (charset);
+ if (this_to > CHARSET_MAX_CODE (charset))
+ this_to = CHARSET_MAX_CODE (charset);
+ map_charset_chars (c_function, function, arg, charset,
+ this_from, this_to);
}
}
}
-
-DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 3, 0,
- doc: /* Call FUNCTION for each characters in CHARSET.
-FUNCTION is called with three arguments; FROM, TO, and the 3rd optional
+
+DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 5, 0,
+ doc: /* Call FUNCTION for all characters in CHARSET.
+FUNCTION is called with an argument RANGE and the optional 3rd
argument ARG.
-FROM and TO indicates a range of character sequence that are contained
-in CHARSET. */)
- (function, charset, arg)
- Lisp_Object function, charset, arg;
+
+RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
+characters contained in CHARSET.
+
+The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
+range of code points of target characters. */)
+ (function, charset, arg, from_code, to_code)
+ Lisp_Object function, charset, arg, from_code, to_code;
{
- map_charset_chars (NULL, function, charset, arg);
+ struct charset *cs;
+ unsigned from, to;
+
+ CHECK_CHARSET_GET_CHARSET (charset, cs);
+ if (NILP (from_code))
+ from = CHARSET_MIN_CODE (cs);
+ else
+ {
+ CHECK_NATNUM (from_code);
+ from = XINT (from_code);
+ if (from < CHARSET_MIN_CODE (cs))
+ from = CHARSET_MIN_CODE (cs);
+ }
+ if (NILP (to_code))
+ to = CHARSET_MAX_CODE (cs);
+ else
+ {
+ CHECK_NATNUM (to_code);
+ to = XINT (to_code);
+ if (to > CHARSET_MAX_CODE (cs))
+ to = CHARSET_MAX_CODE (cs);
+ }
+ map_charset_chars (NULL, function, arg, cs, from, to);
return Qnil;
}
DEFUN ("define-charset-internal", Fdefine_charset_internal,
Sdefine_charset_internal, charset_arg_max, MANY, 0,
- doc: /* For internal use only. */)
+ doc: /* For internal use only.
+usage: (define-charset-internal ...) */)
(nargs, args)
int nargs;
Lisp_Object *args;
Lisp_Object val;
unsigned hash_code;
struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table);
- int i;
+ int i, j;
struct charset charset;
int id;
int dimension;
&& (charset.dimension == 3
|| charset.code_space[10] == 256)))));
+ if (! charset.code_linear_p)
+ {
+ charset.code_space_mask = (unsigned char *) xmalloc (256);
+ bzero (charset.code_space_mask, 256);
+ for (i = 0; i < 4; i++)
+ for (j = charset.code_space[i * 4]; j <= charset.code_space[i * 4 + 1];
+ j++)
+ charset.code_space_mask[j] |= (1 << i);
+ }
+
charset.iso_chars_96 = charset.code_space[2] == 96;
charset.min_code = (charset.code_space[0]
| (charset.code_space[5] << 8)
| (charset.code_space[9] << 16)
| (charset.code_space[13] << 24));
+ charset.char_index_offset = 0;
+
+ val = args[charset_arg_min_code];
+ if (! NILP (val))
+ {
+ unsigned code;
+
+ if (INTEGERP (val))
+ code = XINT (val);
+ else
+ {
+ CHECK_CONS (val);
+ CHECK_NUMBER_CAR (val);
+ CHECK_NUMBER_CDR (val);
+ code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
+ }
+ if (code < charset.min_code
+ || code > charset.max_code)
+ args_out_of_range_3 (make_number (charset.min_code),
+ make_number (charset.max_code), val);
+ charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code);
+ charset.min_code = code;
+ }
+
+ val = args[charset_arg_max_code];
+ if (! NILP (val))
+ {
+ unsigned code;
+
+ if (INTEGERP (val))
+ code = XINT (val);
+ else
+ {
+ CHECK_CONS (val);
+ CHECK_NUMBER_CAR (val);
+ CHECK_NUMBER_CDR (val);
+ code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
+ }
+ if (code < charset.min_code
+ || code > charset.max_code)
+ args_out_of_range_3 (make_number (charset.min_code),
+ make_number (charset.max_code), val);
+ charset.max_code = code;
+ }
+
+ charset.compact_codes_p = charset.max_code < 0x1000000;
val = args[charset_arg_invalid_code];
if (NILP (val))
error ("Invalid iso-final-char: %d", XINT (val));
charset.iso_final = XINT (val);
}
-
+
val = args[charset_arg_iso_revision];
if (NILP (val))
charset.iso_revision = -1;
if (charset.max_char > MAX_CHAR)
error ("Unsupported max char: %d", charset.max_char);
- for (i = charset.min_char; i < 0x10000 && i <= charset.max_char;
- i += 128)
+ i = (charset.min_char >> 7) << 7;
+ for (; i < 0x10000 && i <= charset.max_char; i += 128)
CHARSET_FAST_MAP_SET (i, charset.fast_map);
+ i = (i >> 12) << 12;
for (; i <= charset.max_char; i += 0x1000)
CHARSET_FAST_MAP_SET (i, charset.fast_map);
}
val = args[charset_arg_map];
ASET (attrs, charset_map, val);
if (STRINGP (val))
- val = load_charset_map (&charset, val);
- CHECK_VECTOR (val);
- parse_charset_map (&charset, val, 0);
+ load_charset_map_from_file (&charset, val, 0);
+ else
+ load_charset_map_from_vector (&charset, val, 0);
charset.method = CHARSET_METHOD_MAP_DEFERRED;
}
- else if (! NILP (args[charset_arg_parents]))
+ else if (! NILP (args[charset_arg_subset]))
{
- val = args[charset_arg_parents];
- CHECK_LIST (val);
- charset.method = CHARSET_METHOD_INHERIT;
+ Lisp_Object parent;
+ Lisp_Object parent_min_code, parent_max_code, parent_code_offset;
+ struct charset *parent_charset;
+
+ val = args[charset_arg_subset];
+ parent = Fcar (val);
+ CHECK_CHARSET_GET_CHARSET (parent, parent_charset);
+ parent_min_code = Fnth (make_number (1), val);
+ CHECK_NATNUM (parent_min_code);
+ parent_max_code = Fnth (make_number (2), val);
+ CHECK_NATNUM (parent_max_code);
+ parent_code_offset = Fnth (make_number (3), val);
+ CHECK_NUMBER (parent_code_offset);
+ val = Fmake_vector (make_number (4), Qnil);
+ ASET (val, 0, make_number (parent_charset->id));
+ ASET (val, 1, parent_min_code);
+ ASET (val, 2, parent_max_code);
+ ASET (val, 3, parent_code_offset);
+ ASET (attrs, charset_subset, val);
+
+ charset.method = CHARSET_METHOD_SUBSET;
+ /* Here, we just copy the parent's fast_map. It's not accurate,
+ but at least it works for quickly detecting which character
+ DOESN'T belong to this charset. */
+ for (i = 0; i < 190; i++)
+ charset.fast_map[i] = parent_charset->fast_map[i];
+
+ /* We also copy these for parents. */
+ charset.min_char = parent_charset->min_char;
+ charset.max_char = parent_charset->max_char;
+ }
+ else if (! NILP (args[charset_arg_superset]))
+ {
+ val = args[charset_arg_superset];
+ charset.method = CHARSET_METHOD_SUPERSET;
val = Fcopy_sequence (val);
- ASET (attrs, charset_parents, val);
+ ASET (attrs, charset_superset, val);
charset.min_char = MAX_CHAR;
charset.max_char = 0;
if (charset.hash_index >= 0)
{
new_definition_p = 0;
+ id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
HASH_VALUE (hash_table, charset.hash_index) = attrs;
}
else
hash_code);
if (charset_table_used == charset_table_size)
{
- charset_table_size += 256;
- charset_table
- = ((struct charset *)
- xrealloc (charset_table,
- sizeof (struct charset) * charset_table_size));
+ struct charset *new_table
+ = (struct charset *) xmalloc (sizeof (struct charset)
+ * (charset_table_size + 16));
+ bcopy (charset_table, new_table,
+ sizeof (struct charset) * charset_table_size);
+ charset_table_size += 16;
+ charset_table = new_table;
}
id = charset_table_used++;
- ASET (attrs, charset_id, make_number (id));
new_definition_p = 1;
}
-
+ ASET (attrs, charset_id, make_number (id));
charset.id = id;
charset_table[id] = charset;
if (new_definition_p)
Viso_2022_charset_list = nconc2 (Viso_2022_charset_list,
Fcons (make_number (id), Qnil));
+ if (ISO_CHARSET_TABLE (1, 0, 'J') == id)
+ charset_jisx0201_roman = id;
+ else if (ISO_CHARSET_TABLE (2, 0, '@') == id)
+ charset_jisx0208_1978 = id;
+ else if (ISO_CHARSET_TABLE (2, 0, 'B') == id)
+ charset_jisx0208 = id;
}
if (charset.emacs_mule_id >= 0)
{
emacs_mule_charset[charset.emacs_mule_id] = CHARSET_FROM_ID (id);
+ if (charset.emacs_mule_id < 0xA0)
+ emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 1;
if (new_definition_p)
Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list,
Fcons (make_number (id), Qnil));
if (new_definition_p)
{
Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list);
- Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
+ Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
Fcons (make_number (id), Qnil));
+ charset_ordered_list_tick++;
}
return Qnil;
}
+/* Same as Fdefine_charset_internal but arguments are more convenient
+ to call from C (typically in syms_of_charset). This can define a
+ charset of `offset' method only. Return the ID of the new
+ charset. */
+
+static int
+define_charset_internal (name, dimension, code_space, min_code, max_code,
+ iso_final, iso_revision, emacs_mule_id,
+ ascii_compatible, supplementary,
+ code_offset)
+ Lisp_Object name;
+ int dimension;
+ unsigned char *code_space;
+ unsigned min_code, max_code;
+ int iso_final, iso_revision, emacs_mule_id;
+ int ascii_compatible, supplementary;
+ int code_offset;
+{
+ Lisp_Object args[charset_arg_max];
+ Lisp_Object plist[14];
+ Lisp_Object val;
+ int i;
+
+ args[charset_arg_name] = name;
+ args[charset_arg_dimension] = make_number (dimension);
+ val = Fmake_vector (make_number (8), make_number (0));
+ for (i = 0; i < 8; i++)
+ ASET (val, i, make_number (code_space[i]));
+ args[charset_arg_code_space] = val;
+ args[charset_arg_min_code] = make_number (min_code);
+ args[charset_arg_max_code] = make_number (max_code);
+ args[charset_arg_iso_final]
+ = (iso_final < 0 ? Qnil : make_number (iso_final));
+ args[charset_arg_iso_revision] = make_number (iso_revision);
+ args[charset_arg_emacs_mule_id]
+ = (emacs_mule_id < 0 ? Qnil : make_number (emacs_mule_id));
+ args[charset_arg_ascii_compatible_p] = ascii_compatible ? Qt : Qnil;
+ args[charset_arg_supplementary_p] = supplementary ? Qt : Qnil;
+ args[charset_arg_invalid_code] = Qnil;
+ args[charset_arg_code_offset] = make_number (code_offset);
+ args[charset_arg_map] = Qnil;
+ args[charset_arg_subset] = Qnil;
+ args[charset_arg_superset] = Qnil;
+ args[charset_arg_unify_map] = Qnil;
+
+ plist[0] = intern (":name");
+ plist[1] = args[charset_arg_name];
+ plist[2] = intern (":dimension");
+ plist[3] = args[charset_arg_dimension];
+ plist[4] = intern (":code-space");
+ plist[5] = args[charset_arg_code_space];
+ plist[6] = intern (":iso-final-char");
+ plist[7] = args[charset_arg_iso_final];
+ plist[8] = intern (":emacs-mule-id");
+ plist[9] = args[charset_arg_emacs_mule_id];
+ plist[10] = intern (":ascii-compatible-p");
+ plist[11] = args[charset_arg_ascii_compatible_p];
+ plist[12] = intern (":code-offset");
+ plist[13] = args[charset_arg_code_offset];
+
+ args[charset_arg_plist] = Flist (14, plist);
+ Fdefine_charset_internal (charset_arg_max, args);
+
+ return XINT (CHARSET_SYMBOL_ID (name));
+}
+
+
DEFUN ("define-charset-alias", Fdefine_charset_alias,
Sdefine_charset_alias, 2, 2, 0,
doc: /* Define ALIAS as an alias for charset CHARSET. */)
CHECK_CHARSET_GET_ATTR (charset, attr);
Fputhash (alias, attr, Vcharset_hash_table);
+ Vcharset_list = Fcons (alias, Vcharset_list);
return Qnil;
}
-DEFUN ("primary-charset", Fprimary_charset, Sprimary_charset, 0, 0, 0,
- doc: /* Return the primary charset. */)
+DEFUN ("unibyte-charset", Funibyte_charset, Sunibyte_charset, 0, 0, 0,
+ doc: /* Return the unibyte charset (set by `set-unibyte-charset'). */)
()
{
- return CHARSET_NAME (CHARSET_FROM_ID (charset_primary));
+ return CHARSET_NAME (CHARSET_FROM_ID (charset_unibyte));
}
-DEFUN ("set-primary-charset", Fset_primary_charset, Sset_primary_charset,
+DEFUN ("set-unibyte-charset", Fset_unibyte_charset, Sset_unibyte_charset,
1, 1, 0,
- doc: /* Set the primary charset to CHARSET. */)
+ doc: /* Set the unibyte charset to CHARSET.
+This determines how unibyte/multibyte conversion is done. See also
+function `unibyte-charset'. */)
(charset)
Lisp_Object charset;
{
- int id;
+ struct charset *cs;
+ int i, c;
+
+ CHECK_CHARSET_GET_CHARSET (charset, cs);
+ if (! cs->ascii_compatible_p
+ || cs->dimension != 1)
+ error ("Inappropriate unibyte charset: %s", SDATA (SYMBOL_NAME (charset)));
+ charset_unibyte = cs->id;
+ for (i = 128; i < 256; i++)
+ {
+ c = DECODE_CHAR (cs, i);
+ unibyte_to_multibyte_table[i] = (c < 0 ? BYTE8_TO_CHAR (i) : c);
+ }
- CHECK_CHARSET_GET_ID (charset, id);
- charset_primary = id;
return Qnil;
}
DEFUN ("charset-plist", Fcharset_plist, Scharset_plist, 1, 1, 0,
- doc: /* Return a property list of CHARSET. */)
+ doc: /* Return the property list of CHARSET. */)
(charset)
Lisp_Object charset;
{
}
-DEFUN ("unify-charset", Funify_charset, Sunify_charset, 1, 2, 0,
- doc: /* Unify characters of CHARSET with Unicode. */)
- (charset, unify_map)
- Lisp_Object charset, unify_map;
+DEFUN ("unify-charset", Funify_charset, Sunify_charset, 1, 3, 0,
+ doc: /* Unify characters of CHARSET with Unicode.
+This means reading the relevant file and installing the table defined
+by CHARSET's `:unify-map' property.
+
+Optional second arg UNIFY-MAP is a file name string or a vector. It has
+the same meaning as the `:unify-map' attribute in the function
+`define-charset' (which see).
+
+Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
+ (charset, unify_map, deunify)
+ Lisp_Object charset, unify_map, deunify;
{
int id;
struct charset *cs;
-
+
CHECK_CHARSET_GET_ID (charset, id);
cs = CHARSET_FROM_ID (id);
if (CHARSET_METHOD (cs) == CHARSET_METHOD_MAP_DEFERRED)
load_charset (cs);
- if (CHARSET_UNIFIED_P (cs)
- && CHAR_TABLE_P (CHARSET_DEUNIFIER (cs)))
+ if (NILP (deunify)
+ ? CHARSET_UNIFIED_P (cs) && ! NILP (CHARSET_DEUNIFIER (cs))
+ : ! CHARSET_UNIFIED_P (cs))
return Qnil;
+
CHARSET_UNIFIED_P (cs) = 0;
- if (NILP (unify_map))
- unify_map = CHARSET_UNIFY_MAP (cs);
- if (STRINGP (unify_map))
- unify_map = load_charset_map (cs, unify_map);
- parse_charset_map (cs, unify_map, 2);
- CHARSET_UNIFIED_P (cs) = 1;
+ if (NILP (deunify))
+ {
+ if (CHARSET_METHOD (cs) != CHARSET_METHOD_OFFSET)
+ error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset)));
+ if (NILP (unify_map))
+ unify_map = CHARSET_UNIFY_MAP (cs);
+ if (STRINGP (unify_map))
+ load_charset_map_from_file (cs, unify_map, 2);
+ else if (VECTORP (unify_map))
+ load_charset_map_from_vector (cs, unify_map, 2);
+ else if (NILP (unify_map))
+ error ("No unify-map for charset");
+ else
+ error ("Bad unify-map arg");
+ CHARSET_UNIFIED_P (cs) = 1;
+ }
+ else if (CHAR_TABLE_P (Vchar_unify_table))
+ {
+ int min_code = CHARSET_MIN_CODE (cs);
+ int max_code = CHARSET_MAX_CODE (cs);
+ int min_char = DECODE_CHAR (cs, min_code);
+ int max_char = DECODE_CHAR (cs, max_code);
+
+ char_table_set_range (Vchar_unify_table, min_char, max_char, Qnil);
+ }
+
return Qnil;
}
DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
Sget_unused_iso_final_char, 2, 2, 0,
doc: /*
-Return an unsed ISO's final char for a charset of DIMENISION and CHARS.
+Return an unsed ISO final char for a charset of DIMENISION and CHARS.
DIMENSION is the number of bytes to represent a character: 1 or 2.
CHARS is the number of characters in a dimension: 94 or 96.
This final char is for private use, thus the range is `0' (48) .. `?' (63).
-If there's no unused final char for the attrified kind of charset,
+If there's no unused final char for the specified kind of charset,
return nil. */)
(dimension, chars)
Lisp_Object dimension, chars;
4, 4, 0,
doc: /*
Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.
-CHARSET should be defined by `defined-charset' in advance. */)
+CHARSET should be defined by `define-charset' in advance. */)
(dimension, chars, final_char, charset)
Lisp_Object dimension, chars, final_char, charset;
{
CHECK_CHARSET_GET_ID (charset, id);
check_iso_charset_parameter (dimension, chars, final_char);
- ISO_CHARSET_TABLE (dimension, chars, final_char) = id;
+ ISO_CHARSET_TABLE (XINT (dimension), XINT (chars), XINT (final_char)) = id;
return Qnil;
}
true for a unibyte string. For a multibyte string, true if
it contains only ASCII characters.
- 1: No charsets other than ascii, eight-bit-control, and
- latin-1 are found.
+ 1: No charsets other than ascii, control-1, and latin-1 are
+ found.
2: Otherwise.
*/
string_xstring_p (string)
Lisp_Object string;
{
- unsigned char *p = XSTRING (string)->data;
- unsigned char *endp = p + STRING_BYTES (XSTRING (string));
- struct charset *charset;
+ const unsigned char *p = SDATA (string);
+ const unsigned char *endp = p + SBYTES (string);
- if (XSTRING (string)->size == STRING_BYTES (XSTRING (string)))
+ if (SCHARS (string) == SBYTES (string))
return 0;
- charset = CHARSET_FROM_ID (charset_iso_8859_1);
while (p < endp)
{
int c = STRING_CHAR_ADVANCE (p);
- if (ENCODE_CHAR (charset, c) < 0)
+ if (c >= 0x100)
return 2;
}
return 1;
/* Find charsets in the string at PTR of NCHARS and NBYTES.
- CHARSETS is a vector. Each element is a cons of CHARSET and
- FOUND-FLAG. CHARSET is a charset id, and FOUND-FLAG is nil or t.
- FOUND-FLAG t (or nil) means that the corresponding charset is
- already found (or not yet found).
+ CHARSETS is a vector. If Nth element is non-nil, it means the
+ charset whose id is N is already found.
It may lookup a translation table TABLE if supplied. */
static void
-find_charsets_in_text (ptr, nchars, nbytes, charsets, table)
- unsigned char *ptr;
- int nchars, nbytes;
+find_charsets_in_text (ptr, nchars, nbytes, charsets, table, multibyte)
+ const unsigned char *ptr;
+ EMACS_INT nchars, nbytes;
Lisp_Object charsets, table;
+ int multibyte;
{
- unsigned char *pend = ptr + nbytes;
- int ncharsets = ASIZE (charsets);
+ const unsigned char *pend = ptr + nbytes;
if (nchars == nbytes)
- return;
-
- while (ptr < pend)
{
- int c = STRING_CHAR_ADVANCE (ptr);
- int i;
- int all_found = 1;
- Lisp_Object elt;
-
- if (!NILP (table))
- c = translate_char (table, c);
- for (i = 0; i < ncharsets; i++)
+ if (multibyte)
+ ASET (charsets, charset_ascii, Qt);
+ else
+ while (ptr < pend)
+ {
+ int c = *ptr++;
+
+ if (!NILP (table))
+ c = translate_char (table, c);
+ if (ASCII_BYTE_P (c))
+ ASET (charsets, charset_ascii, Qt);
+ else
+ ASET (charsets, charset_eight_bit, Qt);
+ }
+ }
+ else
+ {
+ while (ptr < pend)
{
- elt = AREF (charsets, i);
- if (NILP (XCDR (elt)))
- {
- struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (elt)));
+ int c = STRING_CHAR_ADVANCE (ptr);
+ struct charset *charset;
- if (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset))
- XCDR (elt) = Qt;
- else
- all_found = 0;
- }
+ if (!NILP (table))
+ c = translate_char (table, c);
+ charset = CHAR_CHARSET (c);
+ ASET (charsets, CHARSET_ID (charset), Qt);
}
- if (all_found)
- break;
}
}
-
DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
2, 3, 0,
doc: /* Return a list of charsets in the region between BEG and END.
BEG and END are buffer positions.
Optional arg TABLE if non-nil is a translation table to look up.
-If the region contains invalid multibyte characters,
-`unknown' is included in the returned list.
-
If the current buffer is unibyte, the returned list may contain
only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
(beg, end, table)
Lisp_Object beg, end, table;
{
Lisp_Object charsets;
- int from, from_byte, to, stop, stop_byte, i;
+ EMACS_INT from, from_byte, to, stop, stop_byte;
+ int i;
Lisp_Object val;
+ int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
validate_region (&beg, &end);
from = XFASTINT (beg);
from_byte = CHAR_TO_BYTE (from);
charsets = Fmake_vector (make_number (charset_table_used), Qnil);
- for (i = 0; i < charset_table_used; i++)
- ASET (charsets, i, Fcons (make_number (i), Qnil));
-
while (1)
{
find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from,
- stop_byte - from_byte, charsets, table);
+ stop_byte - from_byte, charsets, table,
+ multibyte);
if (stop < to)
{
from = stop, from_byte = stop_byte;
val = Qnil;
for (i = charset_table_used - 1; i >= 0; i--)
- if (!NILP (XCDR (AREF (charsets, i))))
+ if (!NILP (AREF (charsets, i)))
val = Fcons (CHARSET_NAME (charset_table + i), val);
return val;
}
doc: /* Return a list of charsets in STR.
Optional arg TABLE if non-nil is a translation table to look up.
-If the string contains invalid multibyte characters,
-`unknown' is included in the returned list.
-
If STR is unibyte, the returned list may contain
only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
(str, table)
CHECK_STRING (str);
charsets = Fmake_vector (make_number (charset_table_used), Qnil);
- find_charsets_in_text (XSTRING (str)->data, XSTRING (str)->size,
- STRING_BYTES (XSTRING (str)), charsets, table);
-
+ find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str),
+ charsets, table,
+ STRING_MULTIBYTE (str));
val = Qnil;
for (i = charset_table_used - 1; i >= 0; i--)
- if (!NILP (XCDR (AREF (charsets, i))))
+ if (!NILP (AREF (charsets, i)))
val = Fcons (CHARSET_NAME (charset_table + i), val);
return val;
}
method = CHARSET_METHOD (charset);
}
- if (method == CHARSET_METHOD_INHERIT)
+ if (method == CHARSET_METHOD_SUBSET)
+ {
+ Lisp_Object subset_info;
+
+ subset_info = CHARSET_SUBSET (charset);
+ charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
+ code -= XINT (AREF (subset_info, 3));
+ if (code < XFASTINT (AREF (subset_info, 1))
+ || code > XFASTINT (AREF (subset_info, 2)))
+ c = -1;
+ else
+ c = DECODE_CHAR (charset, code);
+ }
+ else if (method == CHARSET_METHOD_SUPERSET)
{
Lisp_Object parents;
- parents = CHARSET_PARENTS (charset);
+ parents = CHARSET_SUPERSET (charset);
c = -1;
for (; CONSP (parents); parents = XCDR (parents))
{
int id = XINT (XCAR (XCAR (parents)));
int code_offset = XINT (XCDR (XCAR (parents)));
- unsigned this_code = code + code_offset;
+ unsigned this_code = code - code_offset;
charset = CHARSET_FROM_ID (id);
if ((c = DECODE_CHAR (charset, this_code)) >= 0)
else
{
char_index = CODE_POINT_TO_INDEX (charset, code);
+ if (char_index < 0)
+ return -1;
if (method == CHARSET_METHOD_MAP)
{
return c;
}
+/* Variable used temporarily by the macro ENCODE_CHAR. */
+Lisp_Object charset_work;
/* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
- CHARSET, return CHARSET_INVALID_CODE (CHARSET). */
+ CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
+ use CHARSET's strict_max_char instead of max_char. */
unsigned
encode_char (charset, c)
if (CHARSET_UNIFIED_P (charset))
{
- Lisp_Object deunifier;
- int deunified;
+ Lisp_Object deunifier, deunified;
deunifier = CHARSET_DEUNIFIER (charset);
if (! CHAR_TABLE_P (deunifier))
{
- Funify_charset (CHARSET_NAME (charset), Qnil);
+ Funify_charset (CHARSET_NAME (charset), Qnil, Qnil);
deunifier = CHARSET_DEUNIFIER (charset);
}
- deunified = XINT (CHAR_TABLE_REF (deunifier, c));
- if (deunified > 0)
- c = deunified;
+ deunified = CHAR_TABLE_REF (deunifier, c);
+ if (! NILP (deunified))
+ c = XINT (deunified);
}
- if (! CHARSET_FAST_MAP_REF ((c), charset->fast_map)
- || c < CHARSET_MIN_CHAR (charset) || c > CHARSET_MAX_CHAR (charset))
- return CHARSET_INVALID_CODE (charset);
+ if (method == CHARSET_METHOD_SUBSET)
+ {
+ Lisp_Object subset_info;
+ struct charset *this_charset;
+
+ subset_info = CHARSET_SUBSET (charset);
+ this_charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
+ code = ENCODE_CHAR (this_charset, c);
+ if (code == CHARSET_INVALID_CODE (this_charset)
+ || code < XFASTINT (AREF (subset_info, 1))
+ || code > XFASTINT (AREF (subset_info, 2)))
+ return CHARSET_INVALID_CODE (charset);
+ code += XINT (AREF (subset_info, 3));
+ return code;
+ }
- if (method == CHARSET_METHOD_INHERIT)
+ if (method == CHARSET_METHOD_SUPERSET)
{
Lisp_Object parents;
- parents = CHARSET_PARENTS (charset);
+ parents = CHARSET_SUPERSET (charset);
for (; CONSP (parents); parents = XCDR (parents))
{
int id = XINT (XCAR (XCAR (parents)));
struct charset *this_charset = CHARSET_FROM_ID (id);
code = ENCODE_CHAR (this_charset, c);
- if (code != CHARSET_INVALID_CODE (this_charset)
- && (code_offset < 0 || code >= code_offset))
- {
- code -= code_offset;
- if (CODE_POINT_TO_INDEX (charset, code) >= 0)
- return code;
- }
+ if (code != CHARSET_INVALID_CODE (this_charset))
+ return code + code_offset;
}
return CHARSET_INVALID_CODE (charset);
}
+ if (! CHARSET_FAST_MAP_REF ((c), charset->fast_map)
+ || c < CHARSET_MIN_CHAR (charset) || c > CHARSET_MAX_CHAR (charset))
+ return CHARSET_INVALID_CODE (charset);
+
if (method == CHARSET_METHOD_MAP_DEFERRED)
{
load_charset (charset);
if (! CHAR_TABLE_P (CHARSET_ENCODER (charset)))
return CHARSET_INVALID_CODE (charset);
val = CHAR_TABLE_REF (encoder, c);
- if (CONSP (val))
- code = (XINT (XCAR (val)) << 16) | XINT (XCDR (val));
- else
- code = XINT (val);
+ if (NILP (val))
+ return CHARSET_INVALID_CODE (charset);
+ code = XINT (val);
+ if (! CHARSET_COMPACT_CODES_P (charset))
+ code = INDEX_TO_CODE_POINT (charset, code);
}
- else
+ else /* method == CHARSET_METHOD_OFFSET */
{
code = c - CHARSET_CODE_OFFSET (charset);
code = INDEX_TO_CODE_POINT (charset, code);
CHECK_CHARSET_GET_ID (charset, id);
if (CONSP (code_point))
{
- CHECK_NATNUM (XCAR (code_point));
- CHECK_NATNUM (XCDR (code_point));
- code = (XINT (XCAR (code_point)) << 16) | (XINT (XCAR (code_point)));
+ CHECK_NATNUM_CAR (code_point);
+ CHECK_NATNUM_CDR (code_point);
+ code = (XINT (XCAR (code_point)) << 16) | (XINT (XCDR (code_point)));
}
else
{
(ch, charset, restriction)
Lisp_Object ch, charset, restriction;
{
- int c, id;
+ int id;
unsigned code;
struct charset *charsetp;
CHECK_CHARSET_GET_ID (charset, id);
CHECK_NATNUM (ch);
- c = XINT (ch);
charsetp = CHARSET_FROM_ID (id);
- code = ENCODE_CHAR (charsetp, ch);
+ code = ENCODE_CHAR (charsetp, XINT (ch));
if (code == CHARSET_INVALID_CODE (charsetp))
return Qnil;
if (code > 0x7FFFFFF)
}
-DEFUN ("make-char", Fmake_char, Smake_char, 1, 4, 0,
- doc: /* Return a character of CHARSET whose position code is CODE.
-
-If dimension of CHARSET is two, and the third optional arg CODE2 is
-non-nil, CODE actually specifies the first byte of the position code,
-and CODE2 specifies the second byte.
+DEFUN ("make-char", Fmake_char, Smake_char, 1, 5, 0,
+ doc:
+ /* Return a character of CHARSET whose position codes are CODEn.
-If dimension of CHARSET is three, and the third optional arg CODE2 and
-the fourth optional arg CODE3 are both non-nil, CODE actually
-specifies the first byte of the position code, CODE2 the second byte,
-and CODE3 the third byte. */)
- (charset, code, code2, code3)
- Lisp_Object charset, code, code2, code3;
+CODE1 through CODE4 are optional, but if you don't supply sufficient
+position codes, it is assumed that the minimum code in each dimension
+is specified. */)
+ (charset, code1, code2, code3, code4)
+ Lisp_Object charset, code1, code2, code3, code4;
{
int id, dimension;
struct charset *charsetp;
- unsigned c;
+ unsigned code;
+ int c;
CHECK_CHARSET_GET_ID (charset, id);
charsetp = CHARSET_FROM_ID (id);
- if (NILP (code))
- code = make_number (CHARSET_MIN_CODE (charsetp));
+ dimension = CHARSET_DIMENSION (charsetp);
+ if (NILP (code1))
+ code = (CHARSET_ASCII_COMPATIBLE_P (charsetp)
+ ? 0 : CHARSET_MIN_CODE (charsetp));
else
{
- CHECK_NATNUM (code);
- dimension = CHARSET_DIMENSION (charsetp);
+ CHECK_NATNUM (code1);
+ if (XFASTINT (code1) >= 0x100)
+ args_out_of_range (make_number (0xFF), code1);
+ code = XFASTINT (code1);
- if (!NILP (code2))
+ if (dimension > 1)
{
- CHECK_NATNUM (code2);
- if (dimension == 3)
- CHECK_NATNUM (code3);
+ code <<= 8;
+ if (NILP (code2))
+ code |= charsetp->code_space[(dimension - 2) * 4];
+ else
+ {
+ CHECK_NATNUM (code2);
+ if (XFASTINT (code2) >= 0x100)
+ args_out_of_range (make_number (0xFF), code2);
+ code |= XFASTINT (code2);
+ }
+
+ if (dimension > 2)
+ {
+ code <<= 8;
+ if (NILP (code3))
+ code |= charsetp->code_space[(dimension - 3) * 4];
+ else
+ {
+ CHECK_NATNUM (code3);
+ if (XFASTINT (code3) >= 0x100)
+ args_out_of_range (make_number (0xFF), code3);
+ code |= XFASTINT (code3);
+ }
+
+ if (dimension > 3)
+ {
+ code <<= 8;
+ if (NILP (code4))
+ code |= charsetp->code_space[0];
+ else
+ {
+ CHECK_NATNUM (code4);
+ if (XFASTINT (code4) >= 0x100)
+ args_out_of_range (make_number (0xFF), code4);
+ code |= XFASTINT (code4);
+ }
+ }
+ }
}
}
- if (dimension == 1 || NILP (code2))
- c = XFASTINT (code);
- else if (dimension == 2)
- c = (XFASTINT (code) << 8) | XFASTINT (code2);
- else if (dimension == 3)
- c = (XFASTINT (code) << 16) | (XFASTINT (code2) << 8) | XFASTINT (code3);
-
- c = DECODE_CHAR (charsetp, c);
+ if (CHARSET_ISO_FINAL (charsetp) >= 0)
+ code &= 0x7F7F7F7F;
+ c = DECODE_CHAR (charsetp, code);
+ if (c < 0)
+ error ("Invalid code(s)");
return make_number (c);
}
DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
- doc: /*Return list of charset and one or two position-codes of CHAR.
-If CHAR is invalid as a character code,
-return a list of symbol `unknown' and CHAR. */)
+ doc:
+ /*Return list of charset and one to four position-codes of CHAR.
+The charset is decided by the current priority order of charsets.
+A position-code is a byte value of each dimension of the code-point of
+CHAR in the charset. */)
(ch)
Lisp_Object ch;
{
c = XFASTINT (ch);
charset = CHAR_CHARSET (c);
if (! charset)
- return Fcons (intern ("unknown"), Fcons (ch, Qnil));
-
+ abort ();
code = ENCODE_CHAR (charset, c);
if (code == CHARSET_INVALID_CODE (charset))
abort ();
dimension = CHARSET_DIMENSION (charset);
- val = (dimension == 1 ? Fcons (make_number (code), Qnil)
- : dimension == 2 ? Fcons (make_number (code >> 8),
- Fcons (make_number (code & 0xFF), Qnil))
- : Fcons (make_number (code >> 16),
- Fcons (make_number ((code >> 8) & 0xFF),
- Fcons (make_number (code & 0xFF), Qnil))));
+ for (val = Qnil; dimension > 0; dimension--)
+ {
+ val = Fcons (make_number (code & 0xFF), val);
+ code >>= 8;
+ }
return Fcons (CHARSET_NAME (charset), val);
}
return Qnil;
}
+DEFUN ("charset-priority-list", Fcharset_priority_list,
+ Scharset_priority_list, 0, 1, 0,
+ doc: /* Return the list of charsets ordered by priority.
+HIGHESTP non-nil means just return the highest priority one. */)
+ (highestp)
+ Lisp_Object highestp;
+{
+ Lisp_Object val = Qnil, list = Vcharset_ordered_list;
+
+ if (!NILP (highestp))
+ return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list))));
+
+ while (!NILP (list))
+ {
+ val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list)))), val);
+ list = XCDR (list);
+ }
+ return Fnreverse (val);
+}
+
+DEFUN ("set-charset-priority", Fset_charset_priority, Sset_charset_priority,
+ 1, MANY, 0,
+ doc: /* Assign higher priority to the charsets given as arguments.
+usage: (set-charset-priority &rest charsets) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object new_head, old_list, arglist[2];
+ Lisp_Object list_2022, list_emacs_mule;
+ int i, id;
+
+ old_list = Fcopy_sequence (Vcharset_ordered_list);
+ new_head = Qnil;
+ for (i = 0; i < nargs; i++)
+ {
+ CHECK_CHARSET_GET_ID (args[i], id);
+ if (! NILP (Fmemq (make_number (id), old_list)))
+ {
+ old_list = Fdelq (make_number (id), old_list);
+ new_head = Fcons (make_number (id), new_head);
+ }
+ }
+ arglist[0] = Fnreverse (new_head);
+ arglist[1] = old_list;
+ Vcharset_ordered_list = Fnconc (2, arglist);
+ charset_ordered_list_tick++;
+
+ for (old_list = Vcharset_ordered_list, list_2022 = list_emacs_mule = Qnil;
+ CONSP (old_list); old_list = XCDR (old_list))
+ {
+ if (! NILP (Fmemq (XCAR (old_list), Viso_2022_charset_list)))
+ list_2022 = Fcons (XCAR (old_list), list_2022);
+ if (! NILP (Fmemq (XCAR (old_list), Vemacs_mule_charset_list)))
+ list_emacs_mule = Fcons (XCAR (old_list), list_emacs_mule);
+ }
+ Viso_2022_charset_list = Fnreverse (list_2022);
+ Vemacs_mule_charset_list = Fnreverse (list_emacs_mule);
+
+ return Qnil;
+}
+
+DEFUN ("charset-id-internal", Fcharset_id_internal, Scharset_id_internal,
+ 0, 1, 0,
+ doc: /* Internal use only.
+Return charset identification number of CHARSET. */)
+ (charset)
+ Lisp_Object charset;
+{
+ int id;
+
+ CHECK_CHARSET_GET_ID (charset, id);
+ return make_number (id);
+}
+
\f
void
init_charset ()
{
-
+ Vcharset_map_path
+ = Fcons (Fexpand_file_name (build_string ("charsets"), Vdata_directory),
+ Qnil);
}
for (k = 0; k < ISO_MAX_FINAL; k++)
iso_charset_table[i][j][k] = -1;
- for (i = 0; i < 255; i++)
+ for (i = 0; i < 256; i++)
emacs_mule_charset[i] = NULL;
-#if 0
- Vchar_charset_set = Fmake_char_table (Qnil, Qnil);
- CHAR_TABLE_SET (Vchar_charset_set, make_number (97), Qnil);
+ charset_jisx0201_roman = -1;
+ charset_jisx0208_1978 = -1;
+ charset_jisx0208 = -1;
- DEFSYM (Qcharset_encode_table, "charset-encode-table");
-
- /* Intern this now in case it isn't already done.
- Setting this variable twice is harmless.
- But don't staticpro it here--that is done in alloc.c. */
- Qchar_table_extra_slots = intern ("char-table-extra-slots");
-
- /* Now we are ready to set up this property, so we can create syntax
- tables. */
- Fput (Qcharset_encode_table, Qchar_table_extra_slots, make_number (0));
-#endif
+ for (i = 0; i < 128; i++)
+ unibyte_to_multibyte_table[i] = i;
+ for (; i < 256; i++)
+ unibyte_to_multibyte_table[i] = BYTE8_TO_CHAR (i);
}
#ifdef emacs
void
syms_of_charset ()
{
- char *p;
-
DEFSYM (Qcharsetp, "charsetp");
DEFSYM (Qascii, "ascii");
DEFSYM (Qunicode, "unicode");
- DEFSYM (Qeight_bit_control, "eight-bit-control");
- DEFSYM (Qeight_bit_graphic, "eight-bit-graphic");
+ DEFSYM (Qeight_bit, "eight-bit");
DEFSYM (Qiso_8859_1, "iso-8859-1");
DEFSYM (Qgl, "gl");
DEFSYM (Qgr, "gr");
- p = (char *) xmalloc (30000);
-
staticpro (&Vcharset_ordered_list);
Vcharset_ordered_list = Qnil;
Vemacs_mule_charset_list = Qnil;
staticpro (&Vcharset_hash_table);
- Vcharset_hash_table = Fmakehash (Qeq);
+ {
+ Lisp_Object args[2];
+ args[0] = QCtest;
+ args[1] = Qeq;
+ Vcharset_hash_table = Fmake_hash_table (2, args);
+ }
charset_table_size = 128;
charset_table = ((struct charset *)
defsubr (&Smap_charset_chars);
defsubr (&Sdefine_charset_internal);
defsubr (&Sdefine_charset_alias);
- defsubr (&Sprimary_charset);
- defsubr (&Sset_primary_charset);
+ defsubr (&Sunibyte_charset);
+ defsubr (&Sset_unibyte_charset);
defsubr (&Scharset_plist);
defsubr (&Sset_charset_plist);
defsubr (&Sunify_charset);
defsubr (&Scharset_after);
defsubr (&Siso_charset);
defsubr (&Sclear_charset_maps);
+ defsubr (&Scharset_priority_list);
+ defsubr (&Sset_charset_priority);
+ defsubr (&Scharset_id_internal);
- DEFVAR_LISP ("charset-map-directory", &Vcharset_map_directory,
- doc: /* Directory of charset map files that come with GNU Emacs.
-The default value is \"\\[data-directory]/charsets\". */);
- Vcharset_map_directory = Fexpand_file_name (build_string ("charsets"),
- Vdata_directory);
+ DEFVAR_LISP ("charset-map-path", &Vcharset_map_path,
+ doc: /* *Lisp of directories to search for charset map files. */);
+ Vcharset_map_path = Qnil;
DEFVAR_LISP ("charset-list", &Vcharset_list,
- doc: /* List of charsets ever defined. */);
+ doc: /* List of all charsets ever defined. */);
Vcharset_list = Qnil;
- /* Make the prerequisite charset `ascii' and `unicode'. */
- {
- Lisp_Object args[charset_arg_max];
- Lisp_Object plist[14];
- Lisp_Object val;
-
- plist[0] = intern (":name");
- plist[1] = args[charset_arg_name] = Qascii;
- plist[2] = intern (":dimension");
- plist[3] = args[charset_arg_dimension] = make_number (1);
- val = Fmake_vector (make_number (8), make_number (0));
- ASET (val, 1, make_number (127));
- plist[4] = intern (":code-space");
- plist[5] = args[charset_arg_code_space] = val;
- plist[6] = intern (":iso-final-char");
- plist[7] = args[charset_arg_iso_final] = make_number ('B');
- args[charset_arg_iso_revision] = Qnil;
- plist[8] = intern (":emacs-mule-id");
- plist[9] = args[charset_arg_emacs_mule_id] = make_number (0);
- plist[10] = intern (":ascii-compatible-p");
- plist[11] = args[charset_arg_ascii_compatible_p] = Qt;
- args[charset_arg_supplementary_p] = Qnil;
- args[charset_arg_invalid_code] = Qnil;
- plist[12] = intern (":code-offset");
- plist[13] = args[charset_arg_code_offset] = make_number (0);
- args[charset_arg_map] = Qnil;
- args[charset_arg_parents] = Qnil;
- args[charset_arg_unify_map] = Qnil;
- /* The actual plist is set by mule-conf.el. */
- args[charset_arg_plist] = Flist (14, plist);
- Fdefine_charset_internal (charset_arg_max, args);
- charset_ascii = CHARSET_SYMBOL_ID (Qascii);
-
- plist[1] = args[charset_arg_name] = Qunicode;
- plist[3] = args[charset_arg_dimension] = make_number (3);
- val = Fmake_vector (make_number (8), make_number (0));
- ASET (val, 1, make_number (255));
- ASET (val, 3, make_number (255));
- ASET (val, 5, make_number (16));
- plist[5] = args[charset_arg_code_space] = val;
- plist[7] = args[charset_arg_iso_final] = Qnil;
- args[charset_arg_iso_revision] = Qnil;
- plist[9] = args[charset_arg_emacs_mule_id] = Qnil;
- plist[11] = args[charset_arg_ascii_compatible_p] = Qt;
- args[charset_arg_supplementary_p] = Qnil;
- args[charset_arg_invalid_code] = Qnil;
- plist[13] = args[charset_arg_code_offset] = make_number (0);
- args[charset_arg_map] = Qnil;
- args[charset_arg_parents] = Qnil;
- args[charset_arg_unify_map] = Qnil;
- /* The actual plist is set by mule-conf.el. */
- args[charset_arg_plist] = Flist (14, plist);
- Fdefine_charset_internal (charset_arg_max, args);
- charset_unicode = CHARSET_SYMBOL_ID (Qunicode);
- }
+ charset_ascii
+ = define_charset_internal (Qascii, 1, "\x00\x7F\x00\x00\x00\x00",
+ 0, 127, 'B', -1, 0, 1, 0, 0);
+ charset_iso_8859_1
+ = define_charset_internal (Qiso_8859_1, 1, "\x00\xFF\x00\x00\x00\x00",
+ 0, 255, -1, -1, -1, 1, 0, 0);
+ charset_unicode
+ = define_charset_internal (Qunicode, 3, "\x00\xFF\x00\xFF\x00\x10",
+ 0, MAX_UNICODE_CHAR, -1, 0, -1, 1, 0, 0);
+ charset_eight_bit
+ = define_charset_internal (Qeight_bit, 1, "\x80\xFF\x00\x00\x00\x00",
+ 128, 255, -1, 0, -1, 0, 0,
+ MAX_5_BYTE_CHAR + 1);
}
#endif /* emacs */
HCoop / bpt / emacs.git / blobdiff