#define NULL (void *)0
#endif
+/* Nonzero enables use of dialog boxes for questions
+ asked by mouse commands. */
+int use_dialog_box;
+
extern Lisp_Object Flookup_key ();
extern int minibuffer_auto_raise;
{
this = args[argnum];
len = Flength (this);
- leni += XFASTINT (len);
+ if (VECTORP (this) && target_type == Lisp_String)
+ {
+ /* We must pay attention to a multibyte character which
+ takes more than one byte in string. */
+ int i;
+ Lisp_Object ch;
+
+ for (i = 0; i < XFASTINT (len); i++)
+ {
+ ch = XVECTOR (this)->contents[i];
+ if (! INTEGERP (ch))
+ wrong_type_argument (Qintegerp, ch);
+ leni += Fchar_bytes (ch);
+ }
+ }
+ else
+ leni += XFASTINT (len);
}
XSETFASTINT (len, leni);
`this' is exhausted. */
if (NILP (this)) break;
if (CONSP (this))
- elt = Fcar (this), this = Fcdr (this);
+ elt = XCONS (this)->car, this = XCONS (this)->cdr;
else
{
if (thisindex >= thisleni) break;
while (!INTEGERP (elt))
elt = wrong_type_argument (Qintegerp, elt);
{
+ int c = XINT (elt);
+ unsigned char work[4], *str;
+ int i = CHAR_STRING (c, work, str);
+
#ifdef MASSC_REGISTER_BUG
/* Even removing all "register"s doesn't disable this bug!
Nothing simpler than this seems to work. */
- unsigned char *p = & XSTRING (val)->data[toindex++];
- *p = XINT (elt);
+ unsigned char *p = & XSTRING (val)->data[toindex];
+ bcopy (str, p, i);
#else
- XSTRING (val)->data[toindex++] = XINT (elt);
+ bcopy (str, & XSTRING (val)->data[toindex], i);
#endif
+ toindex += i;
}
}
}
size = XVECTOR (string)->size;
if (NILP (to))
- to = size;
+ XSETINT (to, size);
else
CHECK_NUMBER (to, 2);
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object tem;
tem = Fcar (tail);
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object tem;
tem = Fcar (tail);
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
if (!CONSP (elt)) continue;
- tem = Fcar (elt);
+ tem = XCONS (elt)->car;
if (EQ (key, tem)) return elt;
QUIT;
}
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = Fcdr (tail))
+ for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
if (!CONSP (elt)) continue;
- tem = Fcar (elt);
+ tem = XCONS (elt)->car;
if (EQ (key, tem)) return elt;
}
return Qnil;
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
if (!CONSP (elt)) continue;
- tem = Fequal (Fcar (elt), key);
+ tem = Fequal (XCONS (elt)->car, key);
if (!NILP (tem)) return elt;
QUIT;
}
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
if (!CONSP (elt)) continue;
- tem = Fcdr (elt);
+ tem = XCONS (elt)->cdr;
if (EQ (key, tem)) return elt;
QUIT;
}
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
if (!CONSP (elt)) continue;
- tem = Fequal (Fcdr (elt), key);
+ tem = Fequal (XCONS (elt)->cdr, key);
if (!NILP (tem)) return elt;
QUIT;
}
if (EQ (elt, tem))
{
if (NILP (prev))
- list = Fcdr (tail);
+ list = XCONS (tail)->cdr;
else
- Fsetcdr (prev, Fcdr (tail));
+ Fsetcdr (prev, XCONS (tail)->cdr);
}
else
prev = tail;
- tail = Fcdr (tail);
+ tail = XCONS (tail)->cdr;
QUIT;
}
return list;
if (! NILP (Fequal (elt, tem)))
{
if (NILP (prev))
- list = Fcdr (tail);
+ list = XCONS (tail)->cdr;
else
- Fsetcdr (prev, Fcdr (tail));
+ Fsetcdr (prev, XCONS (tail)->cdr);
}
else
prev = tail;
- tail = Fcdr (tail);
+ tail = XCONS (tail)->cdr;
QUIT;
}
return list;
(list)
Lisp_Object list;
{
- Lisp_Object length;
- register Lisp_Object *vec;
- register Lisp_Object tail;
- register int i;
-
- length = Flength (list);
- vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
- for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
- vec[i] = Fcar (tail);
+ Lisp_Object new;
- return Flist (XINT (length), vec);
+ for (new = Qnil; CONSP (list); list = XCONS (list)->cdr)
+ new = Fcons (XCONS (list)->car, new);
+ if (!NILP (list))
+ wrong_type_argument (Qconsp, list);
+ return new;
}
\f
Lisp_Object merge ();
register Lisp_Object prop;
{
register Lisp_Object tail;
- for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
+ for (tail = plist; !NILP (tail); tail = Fcdr (XCONS (tail)->cdr))
{
register Lisp_Object tem;
tem = Fcar (tail);
if (EQ (prop, tem))
- return Fcar (Fcdr (tail));
+ return Fcar (XCONS (tail)->cdr);
}
return Qnil;
}
if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,
XSTRING (o1)->size))
return 0;
-#ifdef USE_TEXT_PROPERTIES
- /* If the strings have intervals, verify they match;
- if not, they are unequal. */
- if ((XSTRING (o1)->intervals != 0 || XSTRING (o2)->intervals != 0)
- && ! compare_string_intervals (o1, o2))
- return 0;
-#endif
return 1;
}
return 0;
}
\f
+extern Lisp_Object Fmake_char_internal ();
+
DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
"Store each element of ARRAY with ITEM.\n\
ARRAY is a vector, string, char-table, or bool-vector.")
return Faref (char_table, range);
else if (VECTORP (range))
{
- 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);
+ if (XVECTOR (range)->size == 1)
+ return Faref (char_table, XVECTOR (range)->contents[0]);
+ else
+ {
+ 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))
{
- 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);
+ if (XVECTOR (range)->size == 1)
+ return Faset (char_table, XVECTOR (range)->contents[0], value);
+ else
+ {
+ 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'");
}
else
{
- i = 32;
+ i = 0;
to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
}
- for (i; i < to; i++)
+ for (; i < to; i++)
{
Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
- indices[depth] = i;
+ XSETFASTINT (indices[depth], i);
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);
+ map_char_table (c_function, function, elt, arg, depth + 1, indices);
}
else
{
DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
2, 2, 0,
- "Call FUNCTION for each range of like characters in CHAR-TABLE.\n\
+ "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
FUNCTION is called with two arguments--a key and a value.\n\
-The key is always a possible RANGE argument to `set-char-table-range'.")
+The key is always a possible IDX argument to `aref'.")
(function, char_table)
Lisp_Object function, char_table;
{
- Lisp_Object keyvec;
/* The depth of char table is at most 3. */
- Lisp_Object *indices = (Lisp_Object *) alloca (3 * sizeof (Lisp_Object));
+ Lisp_Object indices[3];
+
+ CHECK_CHAR_TABLE (char_table, 1);
map_char_table (NULL, function, char_table, char_table, 0, indices);
return Qnil;
for (i = 0; i < leni; i++)
{
vals[i] = call1 (fn, Fcar (tail));
- tail = Fcdr (tail);
+ tail = XCONS (tail)->cdr;
}
}
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && use_dialog_box
&& have_menus_p ())
{
Lisp_Object pane, menu;
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && use_dialog_box
&& have_menus_p ())
{
Lisp_Object pane, menu, obj;
Vautoload_queue = Qt;
Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
- Qnil, Qt, Qnil);
+ Qnil, Qt, Qnil, Qt);
tem = Fmemq (feature, Vfeatures);
if (NILP (tem))
Used by `featurep' and `require', and altered by `provide'.");
Vfeatures = Qnil;
+ DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
+ "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
+This applies to y-or-n and yes-or-no questions asked by commands\n\
+invoked by mouse clicks and mouse menu items.");
+ use_dialog_box = 1;
+
defsubr (&Sidentity);
defsubr (&Srandom);
defsubr (&Slength);