return concat (nargs, args, Lisp_Vectorlike, 0);
}
+/* Retrun a copy of a sub char table ARG. The elements except for a
+ nested sub char table are not copied. */
+static Lisp_Object
+copy_sub_char_table (arg)
+{
+ Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);
+ int i;
+
+ /* Copy all the contents. */
+ bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
+ SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
+ /* Recursively copy any sub char-tables in the ordinary slots. */
+ for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
+ if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
+ XCHAR_TABLE (copy)->contents[i]
+ = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
+
+ return copy;
+}
+
+
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
"Return a copy of a list, vector or string.\n\
The elements of a list or vector are not copied; they are shared\n\
if (CHAR_TABLE_P (arg))
{
- int i, size;
+ int i;
Lisp_Object copy;
- /* Calculate the number of extra slots. */
- size = CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (arg));
copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
/* Copy all the slots, including the extra ones. */
bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
- (XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) * sizeof (Lisp_Object));
-
- /* Recursively copy any char-tables in the ordinary slots. */
- for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- if (CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
+ ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
+ * sizeof (Lisp_Object)));
+
+ /* Recursively copy any sub char tables in the ordinary slots
+ for multibyte characters. */
+ for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
+ i < CHAR_TABLE_ORDINARY_SLOTS; i++)
+ if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
XCHAR_TABLE (copy)->contents[i]
- = Fcopy_sequence (XCHAR_TABLE (copy)->contents[i]);
+ = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
return copy;
}
DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
2, 2, 0,
- "Return the value in extra-slot number N of char-table CHAR-TABLE.")
+ "Return the value of CHAR-TABLE's extra-slot number N.")
(char_table, n)
Lisp_Object char_table, n;
{
DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
Sset_char_table_extra_slot,
3, 3, 0,
- "Set extra-slot number N of CHAR-TABLE to VALUE.")
+ "Set CHAR-TABLE's extra-slot number N to VALUE.")
(char_table, n, value)
Lisp_Object char_table, n, value;
{
return Faref (char_table, range);
else if (VECTORP (range))
{
- for (i = 0; i < XVECTOR (range)->size - 1; i++)
- char_table = Faref (char_table, XVECTOR (range)->contents[i]);
-
- if (EQ (XVECTOR (range)->contents[i], Qnil))
- return XCHAR_TABLE (char_table)->defalt;
- else
- return Faref (char_table, XVECTOR (range)->contents[i]);
+ int size = XVECTOR (range)->size;
+ Lisp_Object *val = XVECTOR (range)->contents;
+ Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
+ size <= 1 ? Qnil : val[1],
+ size <= 2 ? Qnil : val[2]);
+ return Faref (char_table, ch);
}
else
error ("Invalid RANGE argument to `char-table-range'");
Faset (char_table, range, value);
else if (VECTORP (range))
{
- for (i = 0; i < XVECTOR (range)->size - 1; i++)
- {
- Lisp_Object tmp = Faref (char_table, XVECTOR (range)->contents[i]);
- if (NILP (tmp))
- {
- /* Make this char-table deeper. */
- XVECTOR (char_table)->contents[XVECTOR (range)->contents[i]]
- = tmp = Fmake_char_table (Qnil, Qnil);
- }
- char_table = tmp;
- }
-
- if (EQ (XVECTOR (range)->contents[i], Qnil))
- XCHAR_TABLE (char_table)->defalt = value;
- else
- Faset (char_table, XVECTOR (range)->contents[i], value);
+ int size = XVECTOR (range)->size;
+ Lisp_Object *val = XVECTOR (range)->contents;
+ Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
+ size <= 1 ? Qnil : val[1],
+ size <= 2 ? Qnil : val[2]);
+ return Faset (char_table, ch, value);
}
else
error ("Invalid RANGE argument to `set-char-table-range'");
return value;
}
\f
-/* Map C_FUNCTION or FUNCTION over CHARTABLE, calling it for each
+/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
character or group of characters that share a value.
DEPTH is the current depth in the originally specified
chartable, and INDICES contains the vector indices
- for the levels our callers have descended. */
+ for the levels our callers have descended.
+
+ ARG is passed to C_FUNCTION when that is called. */
void
-map_char_table (c_function, function, chartable, depth, indices)
- Lisp_Object (*c_function) (), function, chartable, *indices;
+map_char_table (c_function, function, subtable, arg, depth, indices)
+ Lisp_Object (*c_function) (), function, subtable, arg, *indices;
int depth;
{
- int i;
- int from, to;
+ int i, to;
if (depth == 0)
- from = 0, to = CHAR_TABLE_ORDINARY_SLOTS;
+ {
+ /* At first, handle ASCII and 8-bit European characters. */
+ for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
+ {
+ Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
+ if (c_function)
+ (*c_function) (arg, make_number (i), elt);
+ else
+ call2 (function, make_number (i), elt);
+ }
+ to = CHAR_TABLE_ORDINARY_SLOTS;
+ }
else
- from = 32, to = 128;
- /* Make INDICES longer if we are about to fill it up. */
- if ((depth % 10) == 9)
{
- Lisp_Object *new_indices
- = (Lisp_Object *) alloca ((depth += 10) * sizeof (Lisp_Object));
- bcopy (indices, new_indices, depth * sizeof (Lisp_Object));
- indices = new_indices;
+ i = 32;
+ to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
}
- for (i = from; i < to; i++)
+ for (i; i < to; i++)
{
- Lisp_Object elt;
+ Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
+
indices[depth] = i;
- elt = XCHAR_TABLE (chartable)->contents[i];
- if (CHAR_TABLE_P (elt))
- map_char_table (c_function, function, elt, depth + 1, indices);
- else if (c_function)
- (*c_function) (depth + 1, indices, elt);
- else if (depth == 0 && i < 256)
- /* This is an ASCII or 8-bit European character. */
- call2 (function, make_number (i), elt);
+
+ if (SUB_CHAR_TABLE_P (elt))
+ {
+ if (depth >= 3)
+ error ("Too deep char table");
+ map_char_table (c_function, function, elt, arg,
+ depth + 1, indices);
+ }
else
{
- /* This is an entry for multibyte characters. */
- unsigned int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
+ int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
+
if (CHARSET_DEFINED_P (charset))
{
- c1 = depth < 1 ? 0 : XFASTINT (indices[1]);
- c2 = depth < 2 ? 0 : XFASTINT (indices[2]);
+ c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
+ c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
- call2 (function, make_number (c), elt);
+ if (c_function)
+ (*c_function) (arg, make_number (c), elt);
+ else
+ call2 (function, make_number (c), elt);
}
- }
+ }
}
}
Lisp_Object function, char_table;
{
Lisp_Object keyvec;
- Lisp_Object *indices = (Lisp_Object *) alloca (10 * sizeof (Lisp_Object));
+ /* The depth of char table is at most 3. */
+ Lisp_Object *indices = (Lisp_Object *) alloca (3 * sizeof (Lisp_Object));
- map_char_table (NULL, function, char_table, 0, indices);
+ map_char_table (NULL, function, char_table, char_table, 0, indices);
return Qnil;
}
\f
while (1)
{
ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
- Qyes_or_no_p_history));
+ Qyes_or_no_p_history, Qnil));
if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
{
UNGCPRO;