#include "lisp.h"
#include "commands.h"
+#include "charset.h"
#include "buffer.h"
#include "keyboard.h"
#include "intervals.h"
+#include "frame.h"
+#include "window.h"
#ifndef NULL
#define NULL (void *)0
extern Lisp_Object Flookup_key ();
+extern int minibuffer_auto_raise;
+extern Lisp_Object minibuf_window;
+
Lisp_Object Qstring_lessp, Qprovide, Qrequire;
Lisp_Object Qyes_or_no_p_history;
+Lisp_Object Qcursor_in_echo_area;
static int internal_equal ();
\f
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;
DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
"Return a substring of STRING, starting at index FROM and ending before TO.\n\
TO may be nil or omitted; then the substring runs to the end of STRING.\n\
-If FROM or TO is negative, it counts from the end.")
+If FROM or TO is negative, it counts from the end.\n\
+\n\
+This function allows vectors as well as strings.")
(string, from, to)
Lisp_Object string;
register Lisp_Object from, to;
{
Lisp_Object res;
+ int size;
+
+ if (! (STRINGP (string) || VECTORP (string)))
+ wrong_type_argument (Qarrayp, string);
- CHECK_STRING (string, 0);
CHECK_NUMBER (from, 1);
+
+ if (STRINGP (string))
+ size = XSTRING (string)->size;
+ else
+ size = XVECTOR (string)->size;
+
if (NILP (to))
- to = Flength (string);
+ to = size;
else
CHECK_NUMBER (to, 2);
if (XINT (from) < 0)
- XSETINT (from, XINT (from) + XSTRING (string)->size);
+ XSETINT (from, XINT (from) + size);
if (XINT (to) < 0)
- XSETINT (to, XINT (to) + XSTRING (string)->size);
+ XSETINT (to, XINT (to) + size);
if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
- && XINT (to) <= XSTRING (string)->size))
+ && XINT (to) <= size))
args_out_of_range_3 (string, from, to);
- res = make_string (XSTRING (string)->data + XINT (from),
- XINT (to) - XINT (from));
- copy_text_properties (from, to, string, make_number (0), res, Qnil);
+ if (STRINGP (string))
+ {
+ res = make_string (XSTRING (string)->data + XINT (from),
+ XINT (to) - XINT (from));
+ copy_text_properties (from, to, string, make_number (0), res, Qnil);
+ }
+ else
+ res = Fvector (XINT (to) - XINT (from),
+ XVECTOR (string)->contents + XINT (from));
+
return res;
}
\f
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, depth, *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 (chartable, c_function, function, 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
register int answer;
Lisp_Object xprompt;
Lisp_Object args[2];
- int ocech = cursor_in_echo_area;
struct gcpro gcpro1, gcpro2;
+ int count = specpdl_ptr - specpdl;
+
+ specbind (Qcursor_in_echo_area, Qt);
map = Fsymbol_value (intern ("query-replace-map"));
while (1)
{
+
+
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& have_menus_p ())
choose_minibuf_frame ();
message_nolog ("%s(y or n) ", XSTRING (xprompt)->data);
+ if (minibuffer_auto_raise)
+ {
+ Lisp_Object mini_frame;
+
+ mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
+
+ Fraise_frame (mini_frame);
+ }
+
obj = read_filtered_event (1, 0, 0);
cursor_in_echo_area = 0;
/* If we need to quit, quit with cursor_in_echo_area = 0. */
QUIT;
key = Fmake_vector (make_number (1), obj);
- def = Flookup_key (map, key);
+ def = Flookup_key (map, key, Qt);
answer_string = Fsingle_key_description (obj);
if (EQ (def, intern ("skip")))
cursor_in_echo_area = -1;
message_nolog ("%s(y or n) %c",
XSTRING (xprompt)->data, answer ? 'y' : 'n');
- cursor_in_echo_area = ocech;
}
+ unbind_to (count, Qnil);
return answer ? Qt : 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;
staticpro (&Qrequire);
Qyes_or_no_p_history = intern ("yes-or-no-p-history");
staticpro (&Qyes_or_no_p_history);
+ Qcursor_in_echo_area = intern ("cursor-in-echo-area");
+ staticpro (&Qcursor_in_echo_area);
+
+ Fset (Qyes_or_no_p_history, Qnil);
DEFVAR_LISP ("features", &Vfeatures,
"A list of symbols which are the features of the executing emacs.\n\