/* chartab.c -- char-table support
- Copyright (C) 2003
+ Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <setjmp.h>
#include "lisp.h"
#include "character.h"
#include "charset.h"
size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
vector = Fmake_vector (make_number (size), init);
+ XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
XCHAR_TABLE (vector)->parent = Qnil;
XCHAR_TABLE (vector)->purpose = purpose;
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth];
table = Fmake_vector (make_number (size), defalt);
+ XSETPVECTYPE (XVECTOR (table), PVEC_SUB_CHAR_TABLE);
XSUB_CHAR_TABLE (table)->depth = make_number (depth);
XSUB_CHAR_TABLE (table)->min_char = make_number (min_char);
- XSETSUB_CHAR_TABLE (table, XSUB_CHAR_TABLE (table));
return table;
}
int i;
copy = Fmake_vector (make_number (size), Qnil);
+ XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE);
XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
- XCHAR_TABLE (copy)->ascii = XCHAR_TABLE (table)->ascii;
for (i = 0; i < chartab_size[0]; i++)
XCHAR_TABLE (copy)->contents[i]
= (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
: XCHAR_TABLE (table)->contents[i]);
- if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy)->ascii))
- XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
+ XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
size -= VECSIZE (struct Lisp_Char_Table) - 1;
for (i = 0; i < size; i++)
XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
int depth = XINT (tbl->depth);
int min_char = XINT (tbl->min_char);
int max_char = min_char + chartab_chars[depth - 1] - 1;
- int index = CHARTAB_IDX (c, depth, min_char);
+ int index = CHARTAB_IDX (c, depth, min_char), idx;
Lisp_Object val;
val = tbl->contents[index];
- *from = min_char + index * chartab_chars[depth];
- *to = *from + chartab_chars[depth] - 1;
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, defalt);
else if (NILP (val))
val = defalt;
- while (*from > min_char
- && *from == min_char + index * chartab_chars[depth])
+ idx = index;
+ while (idx > 0 && *from < min_char + idx * chartab_chars[depth])
{
Lisp_Object this_val;
- int this_from = *from - chartab_chars[depth];
- int this_to = *from - 1;
- index--;
- this_val = tbl->contents[index];
+ c = min_char + idx * chartab_chars[depth] - 1;
+ idx--;
+ this_val = tbl->contents[idx];
if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, this_to,
- &this_from, &this_to,
- defalt);
+ this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
else if (NILP (this_val))
this_val = defalt;
if (! EQ (this_val, val))
- break;
- *from = this_from;
+ {
+ *from = c + 1;
+ break;
+ }
}
- index = CHARTAB_IDX (c, depth, min_char);
- while (*to < max_char
- && *to == min_char + (index + 1) * chartab_chars[depth] - 1)
+ while ((c = min_char + (index + 1) * chartab_chars[depth]) <= max_char
+ && *to >= c)
{
Lisp_Object this_val;
- int this_from = *to + 1;
- int this_to = this_from + chartab_chars[depth] - 1;
index++;
this_val = tbl->contents[index];
if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, this_from,
- &this_from, &this_to,
- defalt);
+ this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
else if (NILP (this_val))
this_val = defalt;
if (! EQ (this_val, val))
- break;
- *to = this_to;
+ {
+ *to = c - 1;
+ break;
+ }
}
return val;
}
-/* Return the value for C in char-table TABLE. Set *FROM and *TO to
- the range of characters (containing C) that have the same value as
- C. It is not assured that the value of (*FROM - 1) and (*TO + 1)
- is different from that of C. */
+/* Return the value for C in char-table TABLE. Shrink the range *FROM
+ and *TO to cover characters (containing C) that have the same value
+ as C. It is not assured that the values of (*FROM - 1) and (*TO +
+ 1) are different from that of C. */
Lisp_Object
char_table_ref_and_range (table, c, from, to)
int *from, *to;
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
- int index = CHARTAB_IDX (c, 0, 0);
+ int index = CHARTAB_IDX (c, 0, 0), idx;
Lisp_Object val;
val = tbl->contents[index];
- *from = index * chartab_chars[0];
- *to = *from + chartab_chars[0] - 1;
+ if (*from < 0)
+ *from = 0;
+ if (*to < 0)
+ *to = MAX_CHAR;
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt);
else if (NILP (val))
val = tbl->defalt;
- while (*from > 0 && *from == index * chartab_chars[0])
+ idx = index;
+ while (*from < idx * chartab_chars[0])
{
Lisp_Object this_val;
- int this_from = *from - chartab_chars[0];
- int this_to = *from - 1;
- index--;
- this_val = tbl->contents[index];
+ c = idx * chartab_chars[0] - 1;
+ idx--;
+ this_val = tbl->contents[idx];
if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, this_to,
- &this_from, &this_to,
+ this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt);
else if (NILP (this_val))
this_val = tbl->defalt;
if (! EQ (this_val, val))
- break;
- *from = this_from;
+ {
+ *from = c + 1;
+ break;
+ }
}
- while (*to < MAX_CHAR && *to == (index + 1) * chartab_chars[0] - 1)
+ while (*to >= (index + 1) * chartab_chars[0])
{
Lisp_Object this_val;
- int this_from = *to + 1;
- int this_to = this_from + chartab_chars[0] - 1;
index++;
+ c = index * chartab_chars[0];
this_val = tbl->contents[index];
if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, this_from,
- &this_from, &this_to,
+ this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt);
else if (NILP (this_val))
this_val = tbl->defalt;
if (! EQ (this_val, val))
- break;
- *to = this_to;
+ {
+ *to = c - 1;
+ break;
+ }
}
return val;
{
int i;
- XCHAR_TABLE (char_table)->ascii = Qnil;
+ XCHAR_TABLE (char_table)->ascii = value;
for (i = 0; i < chartab_size[0]; i++)
- XCHAR_TABLE (char_table)->contents[i] = Qnil;
- XCHAR_TABLE (char_table)->defalt = value;
+ XCHAR_TABLE (char_table)->contents[i] = value;
}
else if (EQ (range, Qnil))
XCHAR_TABLE (char_table)->defalt = value;
}
static Lisp_Object
-optimize_sub_char_table (table)
- Lisp_Object table;
+optimize_sub_char_table (table, test)
+ Lisp_Object table, test;
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
Lisp_Object elt, this;
- int i;
+ int i, optimizable;
elt = XSUB_CHAR_TABLE (table)->contents[0];
if (SUB_CHAR_TABLE_P (elt))
- elt = XSUB_CHAR_TABLE (table)->contents[0] = optimize_sub_char_table (elt);
- if (SUB_CHAR_TABLE_P (elt))
- return table;
+ elt = XSUB_CHAR_TABLE (table)->contents[0]
+ = optimize_sub_char_table (elt, test);
+ optimizable = SUB_CHAR_TABLE_P (elt) ? 0 : 1;
for (i = 1; i < chartab_size[depth]; i++)
{
this = XSUB_CHAR_TABLE (table)->contents[i];
if (SUB_CHAR_TABLE_P (this))
this = XSUB_CHAR_TABLE (table)->contents[i]
- = optimize_sub_char_table (this);
- if (SUB_CHAR_TABLE_P (this)
- || NILP (Fequal (this, elt)))
- break;
+ = optimize_sub_char_table (this, test);
+ if (optimizable
+ && (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. */
+ : EQ (test, Qeq) ? !EQ (this, elt) /* Optimize `eq' case. */
+ : NILP (call2 (test, this, elt))))
+ optimizable = 0;
}
- return (i < chartab_size[depth] ? table : elt);
+ return (optimizable ? elt : table);
}
DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
- 1, 1, 0,
- doc: /* Optimize CHAR-TABLE. */)
- (char_table)
- Lisp_Object char_table;
+ 1, 2, 0,
+ doc: /* Optimize CHAR-TABLE.
+TEST is the comparison function used to decide whether two entries are
+equivalent and can be merged. It defaults to `equal'. */)
+ (char_table, test)
+ Lisp_Object char_table, test;
{
Lisp_Object elt;
int i;
{
elt = XCHAR_TABLE (char_table)->contents[i];
if (SUB_CHAR_TABLE_P (elt))
- XCHAR_TABLE (char_table)->contents[i] = optimize_sub_char_table (elt);
+ XCHAR_TABLE (char_table)->contents[i]
+ = optimize_sub_char_table (elt, test);
}
+ /* Reset the `ascii' cache, in case it got optimized away. */
+ XCHAR_TABLE (char_table)->ascii = char_table_ascii (char_table);
+
return Qnil;
}
\f
+/* Map C_FUNCTION or FUNCTION over TABLE (top or sub char-table),
+ calling it for each character or group of characters that share a
+ value. RANGE is a cons (FROM . TO) specifying the range of target
+ characters, VAL is a value of FROM in TABLE, DEFAULT_VAL is the
+ default value of the char-table, PARENT is the parent of the
+ char-table.
+
+ ARG is passed to C_FUNCTION when that is called.
+
+ It returns the value of last character covered by TABLE (not the
+ value inheritted from the parent), and by side-effect, the car part
+ of RANGE is updated to the minimum character C where C and all the
+ following characters in TABLE have the same value. */
+
static Lisp_Object
map_sub_char_table (c_function, function, table, arg, val, range,
default_val, parent)
void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
Lisp_Object function, table, arg, val, range, default_val, parent;
{
- struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
- int depth = XINT (tbl->depth);
+ /* Pointer to the elements of TABLE. */
+ Lisp_Object *contents;
+ /* Depth of TABLE. */
+ int depth;
+ /* Minimum and maxinum characters covered by TABLE. */
+ int min_char, max_char;
+ /* Number of characters covered by one element of TABLE. */
+ int chars_in_block;
+ int from = XINT (XCAR (range)), to = XINT (XCDR (range));
int i, c;
- for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth];
- i++, c += chartab_chars[depth])
+ if (SUB_CHAR_TABLE_P (table))
{
- Lisp_Object this;
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+
+ depth = XINT (tbl->depth);
+ contents = tbl->contents;
+ min_char = XINT (tbl->min_char);
+ max_char = min_char + chartab_chars[depth - 1] - 1;
+ }
+ else
+ {
+ depth = 0;
+ contents = XCHAR_TABLE (table)->contents;
+ min_char = 0;
+ max_char = MAX_CHAR;
+ }
+ chars_in_block = chartab_chars[depth];
+
+ if (to < max_char)
+ max_char = to;
+ /* Set I to the index of the first element to check. */
+ if (from <= min_char)
+ i = 0;
+ else
+ i = (from - min_char) / chars_in_block;
+ for (c = min_char + chars_in_block * i; c <= max_char;
+ i++, c += chars_in_block)
+ {
+ Lisp_Object this = contents[i];
+ int nextc = c + chars_in_block;
- this = tbl->contents[i];
if (SUB_CHAR_TABLE_P (this))
- val = map_sub_char_table (c_function, function, this, arg, val, range,
- default_val, parent);
+ {
+ if (to >= nextc)
+ XSETCDR (range, make_number (nextc - 1));
+ val = map_sub_char_table (c_function, function, this, arg,
+ val, range, default_val, parent);
+ }
else
{
if (NILP (this))
this = default_val;
- if (NILP (this) && ! NILP (parent))
- this = CHAR_TABLE_REF (parent, c);
- if (NILP (Fequal (val, this)))
+ if (!EQ (val, this))
{
- if (! NILP (val))
+ int different_value = 1;
+
+ if (NILP (val))
+ {
+ if (! NILP (parent))
+ {
+ Lisp_Object temp = XCHAR_TABLE (parent)->parent;
+
+ /* This is to get a value of FROM in PARENT
+ without checking the parent of PARENT. */
+ XCHAR_TABLE (parent)->parent = Qnil;
+ val = CHAR_TABLE_REF (parent, from);
+ XCHAR_TABLE (parent)->parent = temp;
+ XSETCDR (range, make_number (c - 1));
+ val = map_sub_char_table (c_function, function,
+ parent, arg, val, range,
+ XCHAR_TABLE (parent)->defalt,
+ XCHAR_TABLE (parent)->parent);
+ if (EQ (val, this))
+ different_value = 0;
+ }
+ }
+ if (! NILP (val) && different_value)
{
XSETCDR (range, make_number (c - 1));
- if (depth == 3
- && EQ (XCAR (range), XCDR (range)))
+ if (EQ (XCAR (range), XCDR (range)))
{
if (c_function)
(*c_function) (arg, XCAR (range), val);
}
}
val = this;
+ from = c;
XSETCAR (range, make_number (c));
}
}
+ XSETCDR (range, make_number (to));
}
return val;
}
Lisp_Object function, table, arg;
{
Lisp_Object range, val;
- int c, i;
struct gcpro gcpro1, gcpro2, gcpro3;
- range = Fcons (make_number (0), Qnil);
+ range = Fcons (make_number (0), make_number (MAX_CHAR));
GCPRO3 (table, arg, range);
val = XCHAR_TABLE (table)->ascii;
if (SUB_CHAR_TABLE_P (val))
val = XSUB_CHAR_TABLE (val)->contents[0];
-
- for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
+ val = map_sub_char_table (c_function, function, table, arg, val, range,
+ XCHAR_TABLE (table)->defalt,
+ XCHAR_TABLE (table)->parent);
+ /* If VAL is nil and TABLE has a parent, we must consult the parent
+ recursively. */
+ while (NILP (val) && ! NILP (XCHAR_TABLE (table)->parent))
{
- Lisp_Object this;
-
- this = XCHAR_TABLE (table)->contents[i];
- if (SUB_CHAR_TABLE_P (this))
- val = map_sub_char_table (c_function, function, this, arg, val, range,
- XCHAR_TABLE (table)->defalt,
- XCHAR_TABLE (table)->parent);
- else
- {
- if (NILP (this))
- this = XCHAR_TABLE (table)->defalt;
- if (NILP (this) && ! NILP (XCHAR_TABLE (table)->parent))
- this = CHAR_TABLE_REF (XCHAR_TABLE (table)->parent, c);
- if (NILP (Fequal (val, this)))
- {
- if (! NILP (val))
- {
- XSETCDR (range, make_number (c - 1));
- if (c_function)
- (*c_function) (arg, range, val);
- else
- call2 (function, range, val);
- }
- val = this;
- XSETCAR (range, make_number (c));
- }
- }
+ Lisp_Object parent = XCHAR_TABLE (table)->parent;
+ Lisp_Object temp = XCHAR_TABLE (parent)->parent;
+ int from = XINT (XCAR (range));
+
+ /* This is to get a value of FROM in PARENT without checking the
+ parent of PARENT. */
+ XCHAR_TABLE (parent)->parent = Qnil;
+ val = CHAR_TABLE_REF (parent, from);
+ XCHAR_TABLE (parent)->parent = temp;
+ val = map_sub_char_table (c_function, function, parent, arg, val, range,
+ XCHAR_TABLE (parent)->defalt,
+ XCHAR_TABLE (parent)->parent);
+ table = parent;
}
if (! NILP (val))
{
- XSETCDR (range, make_number (c - 1));
- if (c_function)
- (*c_function) (arg, range, val);
+ if (EQ (XCAR (range), XCDR (range)))
+ {
+ if (c_function)
+ (*c_function) (arg, XCAR (range), val);
+ else
+ call2 (function, XCAR (range), val);
+ }
else
- call2 (function, range, val);
+ {
+ if (c_function)
+ (*c_function) (arg, range, val);
+ else
+ call2 (function, range, val);
+ }
}
UNGCPRO;
}
+/* Support function for `map-charset-chars'. Map C_FUNCTION or
+ FUNCTION over TABLE, calling it for each character or a group of
+ succeeding characters that have non-nil value in TABLE. TABLE is a
+ "mapping table" or a "deunifier table" of a certain charset.
+
+ If CHARSET is not NULL (this is the case that `map-charset-chars'
+ is called with non-nil FROM-CODE and TO-CODE), it is a charset who
+ owns TABLE, and the function is called only on a character in the
+ range FROM and TO. FROM and TO are not character codes, but code
+ points of a character in CHARSET.
+
+ This function is called in these two cases:
+
+ (1) A charset has a mapping file name in :map property.
+
+ (2) A charset has an upper code space in :offset property and a
+ mapping file name in :unify-map property. In this case, this
+ function is called only for characters in the Unicode code space.
+ Characters in upper code space are handled directly in
+ map_charset_chars. */
+
void
map_char_table_for_charset (c_function, function, table, arg,
charset, from, to)
HCoop / bpt / emacs.git / blobdiff