/* Random utility Lisp functions.
- Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
+#include <config.h>
/* Note on some machines this defines `vector' as a typedef,
so make sure we don't use that name in this file. */
#include "buffer.h"
#include "keyboard.h"
+#include "intervals.h"
+
+extern Lisp_Object Flookup_key ();
Lisp_Object Qstring_lessp, Qprovide, Qrequire;
+Lisp_Object Qyes_or_no_p_history;
-static Lisp_Object internal_equal ();
+static int internal_equal ();
\f
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
"Return the argument unchanged.")
return arg;
}
+extern long get_random ();
+extern void seed_random ();
+extern long time ();
+
DEFUN ("random", Frandom, Srandom, 0, 1, 0,
"Return a pseudo-random number.\n\
-On most systems all integers representable in Lisp are equally likely.\n\
- This is 24 bits' worth.\n\
-With argument N, return random number in interval [0,N).\n\
+All integers representable in Lisp are equally likely.\n\
+ On most systems, this is 28 bits' worth.\n\
+With positive integer argument N, return random number in interval [0,N).\n\
With argument t, set the random number seed from the current time and pid.")
(limit)
Lisp_Object limit;
{
int val;
- extern long random ();
- extern srandom ();
- extern long time ();
+ unsigned long denominator;
if (EQ (limit, Qt))
- srandom (getpid () + time (0));
- val = random ();
- if (XTYPE (limit) == Lisp_Int && XINT (limit) != 0)
+ seed_random (getpid () + time (0));
+ if (NATNUMP (limit) && XFASTINT (limit) != 0)
{
/* Try to take our random number from the higher bits of VAL,
not the lower, since (says Gentzel) the low bits of `random'
- are less random than the higher ones. */
- val &= 0xfffffff; /* Ensure positive. */
- val >>= 5;
- if (XINT (limit) < 10000)
- val >>= 6;
- val %= XINT (limit);
+ are less random than the higher ones. We do this by using the
+ quotient rather than the remainder. At the high end of the RNG
+ it's possible to get a quotient larger than limit; discarding
+ these values eliminates the bias that would otherwise appear
+ when using a large limit. */
+ denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit);
+ do
+ val = get_random () / denominator;
+ while (val >= XFASTINT (limit));
}
+ else
+ val = get_random ();
return make_number (val);
}
\f
register int i;
retry:
- if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String
- || XTYPE (obj) == Lisp_Compiled)
- return Farray_length (obj);
+ if (STRINGP (obj))
+ XSETFASTINT (val, XSTRING (obj)->size);
+ else if (VECTORP (obj))
+ XSETFASTINT (val, XVECTOR (obj)->size);
+ else if (COMPILEDP (obj))
+ XSETFASTINT (val, XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (obj))
{
- for (i = 0, tail = obj; !NILP(tail); i++)
+ for (i = 0, tail = obj; !NILP (tail); i++)
{
QUIT;
tail = Fcdr (tail);
}
- XFASTINT (val) = i;
- return val;
- }
- else if (NILP(obj))
- {
- XFASTINT (val) = 0;
- return val;
+ XSETFASTINT (val, i);
}
+ else if (NILP (obj))
+ XSETFASTINT (val, 0);
else
{
obj = wrong_type_argument (Qsequencep, obj);
goto retry;
}
+ return val;
}
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
"T if two strings have identical contents.\n\
-Case is significant.\n\
+Case is significant, but text properties are ignored.\n\
Symbols are also allowed; their print names are used instead.")
(s1, s2)
register Lisp_Object s1, s2;
{
- if (XTYPE (s1) == Lisp_Symbol)
- XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
- if (XTYPE (s2) == Lisp_Symbol)
- XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
+ if (SYMBOLP (s1))
+ XSETSTRING (s1, XSYMBOL (s1)->name);
+ if (SYMBOLP (s2))
+ XSETSTRING (s2, XSYMBOL (s2)->name);
CHECK_STRING (s1, 0);
CHECK_STRING (s2, 1);
register unsigned char *p1, *p2;
register int end;
- if (XTYPE (s1) == Lisp_Symbol)
- XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
- if (XTYPE (s2) == Lisp_Symbol)
- XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
+ if (SYMBOLP (s1))
+ XSETSTRING (s1, XSYMBOL (s1)->name);
+ if (SYMBOLP (s2))
+ XSETSTRING (s2, XSYMBOL (s2)->name);
CHECK_STRING (s1, 0);
CHECK_STRING (s2, 1);
#endif /* NO_ARG_ARRAY */
}
+/* ARGSUSED */
+Lisp_Object
+concat3 (s1, s2, s3)
+ Lisp_Object s1, s2, s3;
+{
+#ifdef NO_ARG_ARRAY
+ Lisp_Object args[3];
+ args[0] = s1;
+ args[1] = s2;
+ args[2] = s3;
+ return concat (3, args, Lisp_String, 0);
+#else
+ return concat (3, &s1, Lisp_String, 0);
+#endif /* NO_ARG_ARRAY */
+}
+
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
"Concatenate all the arguments and make the result a list.\n\
The result is a list whose elements are the elements of all the arguments.\n\
DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
"Concatenate all the arguments and make the result a string.\n\
The result is a string whose elements are the elements of all the arguments.\n\
-Each argument may be a string, a list of numbers, or a vector of numbers.")
+Each argument may be a string or a list or vector of characters (integers).\n\
+\n\
+Do not use individual integers as arguments!\n\
+The behavior of `concat' in that case will be changed later!\n\
+If your program passes an integer as an argument to `concat',\n\
+you should change it right away not to do so.")
(nargs, args)
int nargs;
Lisp_Object *args;
int nargs;
Lisp_Object *args;
{
- return concat (nargs, args, Lisp_Vector, 0);
+ return concat (nargs, args, Lisp_Vectorlike, 0);
}
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
Lisp_Object arg;
{
if (NILP (arg)) return arg;
- if (!CONSP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String)
+ if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
arg = wrong_type_argument (Qsequencep, arg);
return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}
for (argnum = 0; argnum < nargs; argnum++)
{
this = args[argnum];
- if (!(CONSP (this) || NILP (this)
- || XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String
- || XTYPE (this) == Lisp_Compiled))
+ if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
+ || COMPILEDP (this)))
{
- if (XTYPE (this) == Lisp_Int)
+ if (INTEGERP (this))
args[argnum] = Fnumber_to_string (this);
else
args[argnum] = wrong_type_argument (Qsequencep, this);
leni += XFASTINT (len);
}
- XFASTINT (len) = leni;
+ XSETFASTINT (len, leni);
if (target_type == Lisp_Cons)
val = Fmake_list (len, Qnil);
- else if (target_type == Lisp_Vector)
+ else if (target_type == Lisp_Vectorlike)
val = Fmake_vector (len, Qnil);
else
val = Fmake_string (len, len);
if (!CONSP (this))
thislen = Flength (this), thisleni = XINT (thislen);
+ if (STRINGP (this) && STRINGP (val)
+ && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
+ {
+ copy_text_properties (make_number (0), thislen, this,
+ make_number (toindex), val, Qnil);
+ }
+
while (1)
{
register Lisp_Object elt;
- /* Fetch next element of `this' arg into `elt', or break if `this' is exhausted. */
+ /* Fetch next element of `this' arg into `elt', or break if
+ `this' is exhausted. */
if (NILP (this)) break;
if (CONSP (this))
elt = Fcar (this), this = Fcdr (this);
else
{
if (thisindex >= thisleni) break;
- if (XTYPE (this) == Lisp_String)
- XFASTINT (elt) = XSTRING (this)->data[thisindex++];
+ if (STRINGP (this))
+ XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
else
elt = XVECTOR (this)->contents[thisindex++];
}
prev = tail;
tail = XCONS (tail)->cdr;
}
- else if (XTYPE (val) == Lisp_Vector)
+ else if (VECTORP (val))
XVECTOR (val)->contents[toindex++] = elt;
else
{
- while (XTYPE (elt) != Lisp_Int)
+ while (!INTEGERP (elt))
elt = wrong_type_argument (Qintegerp, elt);
{
#ifdef MASSC_REGISTER_BUG
Lisp_Object string;
register Lisp_Object from, to;
{
+ Lisp_Object res;
+
CHECK_STRING (string, 0);
CHECK_NUMBER (from, 1);
if (NILP (to))
&& XINT (to) <= XSTRING (string)->size))
args_out_of_range_3 (string, from, to);
- return make_string (XSTRING (string)->data + XINT (from),
- XINT (to) - XINT (from));
+ res = make_string (XSTRING (string)->data + XINT (from),
+ XINT (to) - XINT (from));
+ copy_text_properties (from, to, string, make_number (0), res, Qnil);
+ return res;
}
\f
DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
CHECK_NUMBER (n, 0);
while (1)
{
- if (XTYPE (seq) == Lisp_Cons || NILP (seq))
+ if (CONSP (seq) || NILP (seq))
return Fcar (Fnthcdr (n, seq));
- else if (XTYPE (seq) == Lisp_String
- || XTYPE (seq) == Lisp_Vector)
+ else if (STRINGP (seq) || VECTORP (seq))
return Faref (seq, n);
else
seq = wrong_type_argument (Qsequencep, seq);
}
DEFUN ("member", Fmember, Smember, 2, 2, 0,
- "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL.\n\
+ "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
The value is actually the tail of LIST whose car is ELT.")
(elt, list)
register Lisp_Object elt;
}
DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
- "Return non-nil if ELT is `eq' to the car of an element of LIST.\n\
-The value is actually the element of LIST whose car is ELT.\n\
+ "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
+The value is actually the element of LIST whose car is KEY.\n\
Elements of LIST that are not conses are ignored.")
(key, list)
register Lisp_Object key;
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
- "Return non-nil if ELT is `equal' to the car of an element of LIST.\n\
-The value is actually the element of LIST whose car is ELT.")
+ "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
+The value is actually the element of LIST whose car equals KEY.")
(key, list)
register Lisp_Object key;
Lisp_Object list;
}
return Qnil;
}
+
+DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
+ "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
+The value is actually the element of LIST whose cdr equals KEY.")
+ (key, list)
+ register Lisp_Object key;
+ Lisp_Object list;
+{
+ register Lisp_Object tail;
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ {
+ register Lisp_Object elt, tem;
+ elt = Fcar (tail);
+ if (!CONSP (elt)) continue;
+ tem = Fequal (Fcdr (elt), key);
+ if (!NILP (tem)) return elt;
+ QUIT;
+ }
+ return Qnil;
+}
\f
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
"Delete by side effect any occurrences of ELT as a member of LIST.\n\
DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
"Delete by side effect any occurrences of ELT as a member of LIST.\n\
The modified LIST is returned. Comparison is done with `equal'.\n\
-If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
-therefore, write `(setq foo (delete element foo))'\n\
+If the first member of LIST is ELT, deleting it is not a side effect;\n\
+it is simply using a different list.\n\
+Therefore, write `(setq foo (delete element foo))'\n\
to be sure of changing the value of `foo'.")
(elt, list)
register Lisp_Object elt;
}
}
\f
-DEFUN ("get", Fget, Sget, 2, 2, 0,
- "Return the value of SYMBOL's PROPNAME property.\n\
-This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
- (sym, prop)
- Lisp_Object sym;
+
+DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
+ "Extract a value from a property list.\n\
+PLIST is a property list, which is a list of the form\n\
+\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
+corresponding to the given PROP, or nil if PROP is not\n\
+one of the properties on the list.")
+ (val, prop)
+ Lisp_Object val;
register Lisp_Object prop;
{
register Lisp_Object tail;
- for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
+ for (tail = val; !NILP (tail); tail = Fcdr (Fcdr (tail)))
{
register Lisp_Object tem;
tem = Fcar (tail);
return Qnil;
}
-DEFUN ("put", Fput, Sput, 3, 3, 0,
- "Store SYMBOL's PROPNAME property with value VALUE.\n\
-It can be retrieved with `(get SYMBOL PROPNAME)'.")
- (sym, prop, val)
- Lisp_Object sym;
- register Lisp_Object prop;
- Lisp_Object val;
+DEFUN ("get", Fget, Sget, 2, 2, 0,
+ "Return the value of SYMBOL's PROPNAME property.\n\
+This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
+ (symbol, propname)
+ Lisp_Object symbol, propname;
+{
+ CHECK_SYMBOL (symbol, 0);
+ return Fplist_get (XSYMBOL (symbol)->plist, propname);
+}
+
+DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
+ "Change value in PLIST of PROP to VAL.\n\
+PLIST is a property list, which is a list of the form\n\
+\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
+If PROP is already a property on the list, its value is set to VAL,\n\
+otherwise the new PROP VAL pair is added. The new plist is returned;\n\
+use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
+The PLIST is modified by side effects.")
+ (plist, prop, val)
+ Lisp_Object plist;
+ register Lisp_Object prop;
+ Lisp_Object val;
{
register Lisp_Object tail, prev;
Lisp_Object newcell;
prev = Qnil;
- for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
+ for (tail = plist; CONSP (tail) && CONSP (XCONS (tail)->cdr);
+ tail = XCONS (XCONS (tail)->cdr)->cdr)
{
- register Lisp_Object tem;
- tem = Fcar (tail);
- if (EQ (prop, tem))
- return Fsetcar (Fcdr (tail), val);
+ if (EQ (prop, XCONS (tail)->car))
+ {
+ Fsetcar (XCONS (tail)->cdr, val);
+ return plist;
+ }
prev = tail;
}
newcell = Fcons (prop, Fcons (val, Qnil));
if (NILP (prev))
- Fsetplist (sym, newcell);
+ return newcell;
else
- Fsetcdr (Fcdr (prev), newcell);
- return val;
+ Fsetcdr (XCONS (prev)->cdr, newcell);
+ return plist;
+}
+
+DEFUN ("put", Fput, Sput, 3, 3, 0,
+ "Store SYMBOL's PROPNAME property with value VALUE.\n\
+It can be retrieved with `(get SYMBOL PROPNAME)'.")
+ (symbol, propname, value)
+ Lisp_Object symbol, propname, value;
+{
+ CHECK_SYMBOL (symbol, 0);
+ XSYMBOL (symbol)->plist
+ = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
+ return value;
}
DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
They must have the same data type.\n\
Conses are compared by comparing the cars and the cdrs.\n\
Vectors and strings are compared element by element.\n\
-Numbers are compared by value. Symbols must match exactly.")
+Numbers are compared by value, but integers cannot equal floats.\n\
+ (Use `=' if you want integers and floats to be able to be equal.)\n\
+Symbols must match exactly.")
(o1, o2)
register Lisp_Object o1, o2;
{
- return internal_equal (o1, o2, 0);
+ return internal_equal (o1, o2, 0) ? Qt : Qnil;
}
-static Lisp_Object
+static int
internal_equal (o1, o2, depth)
register Lisp_Object o1, o2;
int depth;
{
if (depth > 200)
error ("Stack overflow in equal");
-do_cdr:
+
+ tail_recurse:
QUIT;
- if (EQ (o1, o2)) return Qt;
-#ifdef LISP_FLOAT_TYPE
- if (NUMBERP (o1) && NUMBERP (o2))
+ if (EQ (o1, o2))
+ return 1;
+ if (XTYPE (o1) != XTYPE (o2))
+ return 0;
+
+ switch (XTYPE (o1))
{
- return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
- }
+#ifdef LISP_FLOAT_TYPE
+ case Lisp_Float:
+ return (extract_float (o1) == extract_float (o2));
#endif
- if (XTYPE (o1) != XTYPE (o2)) return Qnil;
- if (XTYPE (o1) == Lisp_Cons
- || XTYPE (o1) == Lisp_Overlay)
- {
- Lisp_Object v1;
- v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
- if (NILP (v1))
- return v1;
- o1 = Fcdr (o1), o2 = Fcdr (o2);
- goto do_cdr;
- }
- if (XTYPE (o1) == Lisp_Marker)
- {
- return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
- && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
- ? Qt : Qnil;
- }
- if (XTYPE (o1) == Lisp_Vector
- || XTYPE (o1) == Lisp_Compiled)
- {
- register int index;
- if (XVECTOR (o1)->size != XVECTOR (o2)->size)
- return Qnil;
- for (index = 0; index < XVECTOR (o1)->size; index++)
+
+ case Lisp_Cons:
+ if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1))
+ return 0;
+ o1 = XCONS (o1)->cdr;
+ o2 = XCONS (o2)->cdr;
+ goto tail_recurse;
+
+ case Lisp_Misc:
+ if (XMISCTYPE (o1) != XMISCTYPE (o2))
+ return 0;
+ if (OVERLAYP (o1))
{
- Lisp_Object v, v1, v2;
- v1 = XVECTOR (o1)->contents [index];
- v2 = XVECTOR (o2)->contents [index];
- v = internal_equal (v1, v2, depth + 1);
- if (NILP (v)) return v;
+ if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1),
+ depth + 1)
+ || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o1),
+ depth + 1))
+ return 0;
+ o1 = XOVERLAY (o1)->plist;
+ o2 = XOVERLAY (o2)->plist;
+ goto tail_recurse;
}
- return Qt;
- }
- if (XTYPE (o1) == Lisp_String)
- {
+ if (MARKERP (o1))
+ {
+ return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
+ && (XMARKER (o1)->buffer == 0
+ || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos));
+ }
+ break;
+
+ case Lisp_Vectorlike:
+ {
+ register int i, size;
+ size = XVECTOR (o1)->size;
+ /* Pseudovectors have the type encoded in the size field, so this test
+ actually checks that the objects have the same type as well as the
+ same size. */
+ if (XVECTOR (o2)->size != size)
+ return 0;
+ /* But only true vectors and compiled functions are actually sensible
+ to compare, so eliminate the others now. */
+ if (size & PSEUDOVECTOR_FLAG)
+ {
+ if (!(size & PVEC_COMPILED))
+ return 0;
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ }
+ for (i = 0; i < size; i++)
+ {
+ Lisp_Object v1, v2;
+ v1 = XVECTOR (o1)->contents [i];
+ v2 = XVECTOR (o2)->contents [i];
+ if (!internal_equal (v1, v2, depth + 1))
+ return 0;
+ }
+ return 1;
+ }
+ break;
+
+ case Lisp_String:
if (XSTRING (o1)->size != XSTRING (o2)->size)
- return Qnil;
- if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
- return Qnil;
- return Qt;
+ return 0;
+ 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 Qnil;
+ return 0;
}
\f
DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
{
register int size, index, charval;
retry:
- if (XTYPE (array) == Lisp_Vector)
+ if (VECTORP (array))
{
register Lisp_Object *p = XVECTOR (array)->contents;
size = XVECTOR (array)->size;
for (index = 0; index < size; index++)
p[index] = item;
}
- else if (XTYPE (array) == Lisp_String)
+ else if (STRINGP (array))
{
register unsigned char *p = XSTRING (array)->data;
CHECK_NUMBER (item, 1);
/* We need not explicitly protect `tail' because it is used only on lists, and
1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
- if (XTYPE (seq) == Lisp_Vector)
+ if (VECTORP (seq))
{
for (i = 0; i < leni; i++)
{
vals[i] = call1 (fn, dummy);
}
}
- else if (XTYPE (seq) == Lisp_String)
+ else if (STRINGP (seq))
{
for (i = 0; i < leni; i++)
{
- XFASTINT (dummy) = XSTRING (seq)->data[i];
+ XSETFASTINT (dummy, XSTRING (seq)->data[i]);
vals[i] = call1 (fn, dummy);
}
}
DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
"Apply FN to each element of SEQ, and concat the results as strings.\n\
In between each pair of results, stick in SEP.\n\
-Thus, \" \" as SEP results in spaces between the values return by FN.")
+Thus, \" \" as SEP results in spaces between the values returned by FN.")
(fn, seq, sep)
Lisp_Object fn, seq, sep;
{
while (1)
{
+#ifdef HAVE_X_MENU
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && using_x_p ())
+ {
+ Lisp_Object pane, menu;
+ redisplay_preserve_echo_area ();
+ pane = Fcons (Fcons (build_string ("Yes"), Qt),
+ Fcons (Fcons (build_string ("No"), Qnil),
+ Qnil));
+ menu = Fcons (prompt, pane);
+ obj = Fx_popup_dialog (Qt, menu);
+ answer = !NILP (obj);
+ break;
+ }
+#endif
cursor_in_echo_area = 1;
- message ("%s(y or n) ", XSTRING (xprompt)->data);
+ message_nolog ("%s(y or n) ", XSTRING (xprompt)->data);
obj = read_filtered_event (1, 0, 0);
cursor_in_echo_area = 0;
}
else if (EQ (def, intern ("quit")))
Vquit_flag = Qt;
+ /* We want to exit this command for exit-prefix,
+ and this is the only way to do it. */
+ else if (EQ (def, intern ("exit-prefix")))
+ Vquit_flag = Qt;
QUIT;
if (! noninteractive)
{
cursor_in_echo_area = -1;
- message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
+ message_nolog ("%s(y or n) %c",
+ XSTRING (xprompt)->data, answer ? 'y' : 'n');
cursor_in_echo_area = ocech;
}
Takes one argument, which is the string to display to ask the question.\n\
It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
The user must confirm the answer with RET,\n\
-and can edit it until it as been confirmed.")
+and can edit it until it has been confirmed.")
(prompt)
Lisp_Object prompt;
{
register Lisp_Object ans;
Lisp_Object args[2];
struct gcpro gcpro1;
+ Lisp_Object menu;
CHECK_STRING (prompt, 0);
+#ifdef HAVE_X_MENU
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && using_x_p ())
+ {
+ Lisp_Object pane, menu, obj;
+ redisplay_preserve_echo_area ();
+ pane = Fcons (Fcons (build_string ("Yes"), Qt),
+ Fcons (Fcons (build_string ("No"), Qnil),
+ Qnil));
+ GCPRO1 (pane);
+ menu = Fcons (prompt, pane);
+ obj = Fx_popup_dialog (Qt, menu);
+ UNGCPRO;
+ return obj;
+ }
+#endif
+
args[0] = prompt;
args[1] = build_string ("(yes or no) ");
prompt = Fconcat (2, args);
GCPRO1 (prompt);
+
while (1)
{
- ans = Fdowncase (Fread_string (prompt, Qnil));
+ ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
+ Qyes_or_no_p_history));
if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
{
UNGCPRO;
message ("Please answer yes or no.");
Fsleep_for (make_number (2), Qnil);
}
- UNGCPRO;
}
\f
DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
staticpro (&Qprovide);
Qrequire = intern ("require");
staticpro (&Qrequire);
+ Qyes_or_no_p_history = intern ("yes-or-no-p-history");
+ staticpro (&Qyes_or_no_p_history);
DEFVAR_LISP ("features", &Vfeatures,
"A list of symbols which are the features of the executing emacs.\n\
defsubr (&Sassq);
defsubr (&Sassoc);
defsubr (&Srassq);
+ defsubr (&Srassoc);
defsubr (&Sdelq);
defsubr (&Sdelete);
defsubr (&Snreverse);
defsubr (&Sreverse);
defsubr (&Ssort);
+ defsubr (&Splist_get);
defsubr (&Sget);
+ defsubr (&Splist_put);
defsubr (&Sput);
defsubr (&Sequal);
defsubr (&Sfillarray);
HCoop / bpt / emacs.git / blobdiff