#include "lisp.h"
#include "commands.h"
+#include "charset.h"
#include "buffer.h"
#include "keyboard.h"
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;
}
{
Lisp_Object val;
int size_in_chars
- = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR) / BITS_PER_CHAR;
+ = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
val = Fmake_bool_vector (Flength (arg), Qnil);
bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
{
Lisp_Object thislen;
int thisleni;
- register int thisindex = 0;
+ register unsigned int thisindex = 0;
this = args[argnum];
if (!CONSP (this))
else if (BOOL_VECTOR_P (this))
{
int size_in_chars
- = ((XBOOL_VECTOR (this)->size + BITS_PER_CHAR)
+ = ((XBOOL_VECTOR (this)->size + BITS_PER_CHAR - 1)
/ BITS_PER_CHAR);
int byte;
byte = XBOOL_VECTOR (val)->data[thisindex / BITS_PER_CHAR];
- if (byte & (1 << thisindex))
+ if (byte & (1 << (thisindex % BITS_PER_CHAR)))
elt = Qt;
else
elt = Qnil;
if (BOOL_VECTOR_P (o1))
{
int size_in_chars
- = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR) / BITS_PER_CHAR;
+ = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
return 0;
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
int size_in_chars
- = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR) / BITS_PER_CHAR;
+ = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
charval = (! NILP (item) ? -1 : 0);
for (index = 0; index < size_in_chars; index++)
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++)
- char_table = Faref (char_table, XVECTOR (range)->contents[i]);
-
- 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 size = CHAR_TABLE_ORDINARY_SLOTS;
+ int i, to;
- /* Make INDICES longer if we are about to fill it up. */
- if ((depth % 10) == 9)
+ if (depth == 0)
{
- Lisp_Object *new_indices
- = (Lisp_Object *) alloca ((depth += 10) * sizeof (Lisp_Object));
- bcopy (indices, new_indices, depth * sizeof (Lisp_Object));
- indices = new_indices;
+ /* 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
+ {
+ i = 32;
+ to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
}
- for (i = 0; i < size; 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, chartable, depth + 1, indices);
- else if (c_function)
- (*c_function) (depth + 1, indices, elt);
- /* Here we should handle all cases where the range is a single character
- by passing that character as a number. Currently, that is
- all the time, but with the MULE code this will have to be changed. */
- else if (depth == 0)
- 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
- call2 (function, Fvector (depth + 1, indices), elt);
+ {
+ int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
+
+ if (CHARSET_DEFINED_P (charset))
+ {
+ c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
+ c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
+ c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
+ 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;