#include "lisp.h"
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#include <errno.h>
+#include "sysfile.h"
#include "buffer.h"
#include "bytecode.h"
Lisp_Object Qidentity;
static int internal_old_equal (Lisp_Object, Lisp_Object, int);
+Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
static Lisp_Object
mark_bit_vector (Lisp_Object obj)
size_bit_vector (const void *lheader)
{
Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader;
- return offsetof (Lisp_Bit_Vector,
- bits[BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))]);
+ return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits,
+ BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
}
static const struct lrecord_description bit_vector_description[] = {
`equal' is the same as in XEmacs, in that respect.)
Symbols are also allowed; their print names are used instead.
*/
- (s1, s2))
+ (string1, string2))
{
Bytecount len;
Lisp_String *p1, *p2;
- if (SYMBOLP (s1))
- p1 = XSYMBOL (s1)->name;
+ if (SYMBOLP (string1))
+ p1 = XSYMBOL (string1)->name;
else
{
- CHECK_STRING (s1);
- p1 = XSTRING (s1);
+ CHECK_STRING (string1);
+ p1 = XSTRING (string1);
}
- if (SYMBOLP (s2))
- p2 = XSYMBOL (s2)->name;
+ if (SYMBOLP (string2))
+ p2 = XSYMBOL (string2)->name;
else
{
- CHECK_STRING (s2);
- p2 = XSTRING (s2);
+ CHECK_STRING (string2);
+ p2 = XSTRING (string2);
}
return (((len = string_length (p1)) == string_length (p2)) &&
Unicode. When Unicode support is added to XEmacs/Mule, this problem
may be solved.
*/
- (s1, s2))
+ (string1, string2))
{
Lisp_String *p1, *p2;
Charcount end, len2;
int i;
- if (SYMBOLP (s1))
- p1 = XSYMBOL (s1)->name;
+ if (SYMBOLP (string1))
+ p1 = XSYMBOL (string1)->name;
else
{
- CHECK_STRING (s1);
- p1 = XSTRING (s1);
+ CHECK_STRING (string1);
+ p1 = XSTRING (string1);
}
- if (SYMBOLP (s2))
- p2 = XSYMBOL (s2)->name;
+ if (SYMBOLP (string2))
+ p2 = XSYMBOL (string2)->name;
else
{
- CHECK_STRING (s2);
- p2 = XSTRING (s2);
+ CHECK_STRING (string2);
+ p2 = XSTRING (string2);
}
end = string_char_length (p1);
int last_special);
Lisp_Object
-concat2 (Lisp_Object s1, Lisp_Object s2)
+concat2 (Lisp_Object string1, Lisp_Object string2)
{
Lisp_Object args[2];
- args[0] = s1;
- args[1] = s2;
+ args[0] = string1;
+ args[1] = string2;
return concat (2, args, c_string, 0);
}
Lisp_Object
-concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
+concat3 (Lisp_Object string1, Lisp_Object string2, Lisp_Object string3)
{
Lisp_Object args[3];
- args[0] = s1;
- args[1] = s2;
- args[2] = s3;
+ args[0] = string1;
+ args[1] = string2;
+ args[2] = string3;
return concat (3, args, c_string, 0);
}
Lisp_Object
-vconcat2 (Lisp_Object s1, Lisp_Object s2)
+vconcat2 (Lisp_Object vec1, Lisp_Object vec2)
{
Lisp_Object args[2];
- args[0] = s1;
- args[1] = s2;
+ args[0] = vec1;
+ args[1] = vec2;
return concat (2, args, c_vector, 0);
}
Lisp_Object
-vconcat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
+vconcat3 (Lisp_Object vec1, Lisp_Object vec2, Lisp_Object vec3)
{
Lisp_Object args[3];
- args[0] = s1;
- args[1] = s2;
- args[2] = s3;
+ args[0] = vec1;
+ args[1] = vec2;
+ args[2] = vec3;
return concat (3, args, c_vector, 0);
}
string_result_ptr = string_result;
break;
default:
+ val = Qnil;
abort ();
}
}
*/
(arg, vecp))
{
+ return safe_copy_tree (arg, vecp, 0);
+}
+
+Lisp_Object
+safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
+{
+ if (depth > 200)
+ signal_simple_error ("Stack overflow in copy-tree", arg);
+
if (CONSP (arg))
{
Lisp_Object rest;
Lisp_Object elt = XCAR (rest);
QUIT;
if (CONSP (elt) || VECTORP (elt))
- XCAR (rest) = Fcopy_tree (elt, vecp);
+ XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
- XCDR (rest) = Fcopy_tree (XCDR (rest), vecp);
+ XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
rest = XCDR (rest);
}
}
Lisp_Object elt = XVECTOR_DATA (arg) [j];
QUIT;
if (CONSP (elt) || VECTORP (elt))
- XVECTOR_DATA (arg) [j] = Fcopy_tree (elt, vecp);
+ XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
}
}
return arg;
}
DEFUN ("substring", Fsubstring, 2, 3, 0, /*
-Return a substring of STRING, starting at index FROM and ending before TO.
-TO may be nil or omitted; then the substring runs to the end of STRING.
-If FROM or TO is negative, it counts from the end.
-Relevant parts of the string-extent-data are copied in the new string.
+Return the substring of STRING starting at START and ending before END.
+END may be nil or omitted; then the substring runs to the end of STRING.
+If START or END is negative, it counts from the end.
+Relevant parts of the string-extent-data are copied to the new string.
*/
- (string, from, to))
+ (string, start, end))
{
- Charcount ccfr, ccto;
- Bytecount bfr, blen;
+ Charcount ccstart, ccend;
+ Bytecount bstart, blen;
Lisp_Object val;
CHECK_STRING (string);
- CHECK_INT (from);
- get_string_range_char (string, from, to, &ccfr, &ccto,
+ CHECK_INT (start);
+ get_string_range_char (string, start, end, &ccstart, &ccend,
GB_HISTORICAL_STRING_BEHAVIOR);
- bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr);
- blen = charcount_to_bytecount (XSTRING_DATA (string) + bfr, ccto - ccfr);
- val = make_string (XSTRING_DATA (string) + bfr, blen);
- /* Copy any applicable extent information into the new string: */
- copy_string_extents (val, string, 0, bfr, blen);
+ bstart = charcount_to_bytecount (XSTRING_DATA (string), ccstart);
+ blen = charcount_to_bytecount (XSTRING_DATA (string) + bstart, ccend - ccstart);
+ val = make_string (XSTRING_DATA (string) + bstart, blen);
+ /* Copy any applicable extent information into the new string. */
+ copy_string_extents (val, string, 0, bstart, blen);
return val;
}
return result;
}
else
- abort (); /* unreachable, since Flength (sequence) did not get an error */
+ {
+ abort (); /* unreachable, since Flength (sequence) did not get
+ an error */
+ return Qnil;
+ }
}
\f
*/
(list, n))
{
- int int_n;
+ EMACS_INT int_n;
CHECK_LIST (list);
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
{
if (internal_equal (elt, list_elt, 0))
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
{
if (internal_old_equal (elt, list_elt, 0))
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
{
if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
*/
(elt, list))
{
- Lisp_Object list_elt, tail;
EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
{
if (HACKEQ_UNSAFE (elt, list_elt))
Lisp_Object
memq_no_quit (Lisp_Object elt, Lisp_Object list)
{
- Lisp_Object list_elt, tail;
LIST_LOOP_3 (list_elt, list, tail)
{
if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
}
DEFUN ("assoc", Fassoc, 2, 2, 0, /*
-Return non-nil if KEY is `equal' to the car of an element of LIST.
-The value is actually the element of LIST whose car equals KEY.
+Return non-nil if KEY is `equal' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car equals KEY.
*/
- (key, list))
+ (key, alist))
{
/* This function can GC. */
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
if (internal_equal (key, elt_car, 0))
return elt;
}
DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
-Return non-nil if KEY is `old-equal' to the car of an element of LIST.
-The value is actually the element of LIST whose car equals KEY.
+Return non-nil if KEY is `old-equal' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car equals KEY.
*/
- (key, list))
+ (key, alist))
{
/* This function can GC. */
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
if (internal_old_equal (key, elt_car, 0))
return elt;
}
Lisp_Object
-assoc_no_quit (Lisp_Object key, Lisp_Object list)
+assoc_no_quit (Lisp_Object key, Lisp_Object alist)
{
int speccount = specpdl_depth ();
specbind (Qinhibit_quit, Qt);
- return unbind_to (speccount, Fassoc (key, list));
+ return unbind_to (speccount, Fassoc (key, alist));
}
DEFUN ("assq", Fassq, 2, 2, 0, /*
-Return non-nil if KEY is `eq' to the car of an element of LIST.
-The value is actually the element of LIST whose car is KEY.
-Elements of LIST that are not conses are ignored.
+Return non-nil if KEY is `eq' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car is KEY.
+Elements of ALIST that are not conses are ignored.
*/
- (key, list))
+ (key, alist))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
return elt;
}
DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
-Return non-nil if KEY is `old-eq' to the car of an element of LIST.
-The value is actually the element of LIST whose car is KEY.
-Elements of LIST that are not conses are ignored.
+Return non-nil if KEY is `old-eq' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car is KEY.
+Elements of ALIST that are not conses are ignored.
This function is provided only for byte-code compatibility with v19.
Do not use it.
*/
- (key, list))
+ (key, alist))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
if (HACKEQ_UNSAFE (key, elt_car))
return elt;
Use only on lists known never to be circular. */
Lisp_Object
-assq_no_quit (Lisp_Object key, Lisp_Object list)
+assq_no_quit (Lisp_Object key, Lisp_Object alist)
{
/* This cannot GC. */
- Lisp_Object elt;
- LIST_LOOP_2 (elt, list)
+ LIST_LOOP_2 (elt, alist)
{
Lisp_Object elt_car = XCAR (elt);
if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
}
DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
-Return non-nil if KEY is `equal' to the cdr of an element of LIST.
-The value is actually the element of LIST whose cdr equals KEY.
+Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
+The value is actually the element of ALIST whose cdr equals VALUE.
*/
- (key, list))
+ (value, alist))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
- if (internal_equal (key, elt_cdr, 0))
+ if (internal_equal (value, elt_cdr, 0))
return elt;
}
return Qnil;
}
DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
-Return non-nil if KEY is `old-equal' to the cdr of an element of LIST.
-The value is actually the element of LIST whose cdr equals KEY.
+Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST.
+The value is actually the element of ALIST whose cdr equals VALUE.
*/
- (key, list))
+ (value, alist))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
- if (internal_old_equal (key, elt_cdr, 0))
+ if (internal_old_equal (value, elt_cdr, 0))
return elt;
}
return Qnil;
}
DEFUN ("rassq", Frassq, 2, 2, 0, /*
-Return non-nil if KEY is `eq' to the cdr of an element of LIST.
-The value is actually the element of LIST whose cdr is KEY.
+Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
+The value is actually the element of ALIST whose cdr is VALUE.
*/
- (key, list))
+ (value, alist))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
- if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr))
+ if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
return elt;
}
return Qnil;
}
DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /*
-Return non-nil if KEY is `old-eq' to the cdr of an element of LIST.
-The value is actually the element of LIST whose cdr is KEY.
+Return non-nil if VALUE is `old-eq' to the cdr of an element of ALIST.
+The value is actually the element of ALIST whose cdr is VALUE.
*/
- (key, list))
+ (value, alist))
{
- Lisp_Object elt, elt_car, elt_cdr;
- EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
+ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
{
- if (HACKEQ_UNSAFE (key, elt_cdr))
+ if (HACKEQ_UNSAFE (value, elt_cdr))
return elt;
}
return Qnil;
}
-/* Like Frassq, but caller must ensure that LIST is properly
+/* Like Frassq, but caller must ensure that ALIST is properly
nil-terminated and ebola-free. */
Lisp_Object
-rassq_no_quit (Lisp_Object key, Lisp_Object list)
+rassq_no_quit (Lisp_Object value, Lisp_Object alist)
{
- Lisp_Object elt;
- LIST_LOOP_2 (elt, list)
+ LIST_LOOP_2 (elt, alist)
{
Lisp_Object elt_cdr = XCDR (elt);
- if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr))
+ if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
return elt;
}
return Qnil;
*/
(elt, list))
{
- Lisp_Object list_elt;
EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
(internal_equal (elt, list_elt, 0)));
return list;
*/
(elt, list))
{
- Lisp_Object list_elt;
EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
(internal_old_equal (elt, list_elt, 0)));
return list;
*/
(elt, list))
{
- Lisp_Object list_elt;
EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
(EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
return list;
*/
(elt, list))
{
- Lisp_Object list_elt;
EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
(HACKEQ_UNSAFE (elt, list_elt)));
return list;
Lisp_Object
delq_no_quit (Lisp_Object elt, Lisp_Object list)
{
- Lisp_Object list_elt;
LIST_LOOP_DELETE_IF (list_elt, list,
(EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
return list;
}
DEFUN ("remassoc", Fremassoc, 2, 2, 0, /*
-Delete by side effect any elements of LIST whose car is `equal' to KEY.
-The modified LIST is returned. If the first member of LIST has a car
+Delete by side effect any elements of ALIST whose car is `equal' to KEY.
+The modified ALIST is returned. If the first member of ALIST has a car
that is `equal' to KEY, there is no way to remove it by side effect;
therefore, write `(setq foo (remassoc key foo))' to be sure of changing
the value of `foo'.
*/
- (key, list))
+ (key, alist))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
+ EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
(CONSP (elt) &&
internal_equal (key, XCAR (elt), 0)));
- return list;
+ return alist;
}
Lisp_Object
-remassoc_no_quit (Lisp_Object key, Lisp_Object list)
+remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
{
int speccount = specpdl_depth ();
specbind (Qinhibit_quit, Qt);
- return unbind_to (speccount, Fremassoc (key, list));
+ return unbind_to (speccount, Fremassoc (key, alist));
}
DEFUN ("remassq", Fremassq, 2, 2, 0, /*
-Delete by side effect any elements of LIST whose car is `eq' to KEY.
-The modified LIST is returned. If the first member of LIST has a car
+Delete by side effect any elements of ALIST whose car is `eq' to KEY.
+The modified ALIST is returned. If the first member of ALIST has a car
that is `eq' to KEY, there is no way to remove it by side effect;
therefore, write `(setq foo (remassq key foo))' to be sure of changing
the value of `foo'.
*/
- (key, list))
+ (key, alist))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
+ EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
(CONSP (elt) &&
EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
- return list;
+ return alist;
}
/* no quit, no errors; be careful */
Lisp_Object
-remassq_no_quit (Lisp_Object key, Lisp_Object list)
+remassq_no_quit (Lisp_Object key, Lisp_Object alist)
{
- Lisp_Object elt;
- LIST_LOOP_DELETE_IF (elt, list,
+ LIST_LOOP_DELETE_IF (elt, alist,
(CONSP (elt) &&
EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
- return list;
+ return alist;
}
DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /*
-Delete by side effect any elements of LIST whose cdr is `equal' to VALUE.
-The modified LIST is returned. If the first member of LIST has a car
+Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE.
+The modified ALIST is returned. If the first member of ALIST has a car
that is `equal' to VALUE, there is no way to remove it by side effect;
therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
the value of `foo'.
*/
- (value, list))
+ (value, alist))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
+ EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
(CONSP (elt) &&
internal_equal (value, XCDR (elt), 0)));
- return list;
+ return alist;
}
DEFUN ("remrassq", Fremrassq, 2, 2, 0, /*
-Delete by side effect any elements of LIST whose cdr is `eq' to VALUE.
-The modified LIST is returned. If the first member of LIST has a car
+Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE.
+The modified ALIST is returned. If the first member of ALIST has a car
that is `eq' to VALUE, there is no way to remove it by side effect;
therefore, write `(setq foo (remrassq value foo))' to be sure of changing
the value of `foo'.
*/
- (value, list))
+ (value, alist))
{
- Lisp_Object elt;
- EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
+ EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
(CONSP (elt) &&
EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
- return list;
+ return alist;
}
/* Like Fremrassq, fast and unsafe; be careful */
Lisp_Object
-remrassq_no_quit (Lisp_Object value, Lisp_Object list)
+remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
{
- Lisp_Object elt;
- LIST_LOOP_DELETE_IF (elt, list,
+ LIST_LOOP_DELETE_IF (elt, alist,
(CONSP (elt) &&
EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
- return list;
+ return alist;
}
DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
(list))
{
Lisp_Object reversed_list = Qnil;
- Lisp_Object elt;
EXTERNAL_LIST_LOOP_2 (elt, list)
{
reversed_list = Fcons (elt, reversed_list);
Lisp_Object back, tem;
Lisp_Object front = list;
Lisp_Object len = Flength (list);
- int length = XINT (len);
- if (length < 2)
+ if (XINT (len) < 2)
return list;
- XSETINT (len, (length / 2) - 1);
+ len = make_int (XINT (len) / 2 - 1);
tem = Fnthcdr (len, list);
back = Fcdr (tem);
Fsetcdr (tem, Qnil);
PREDICATE is called with two elements of LIST, and should return T
if the first element is "less" than the second.
*/
- (list, pred))
+ (list, predicate))
{
- return list_sort (list, pred, merge_pred_function);
+ return list_sort (list, predicate, merge_pred_function);
}
Lisp_Object
bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb)
{
if (ERRB_EQ (errb, ERROR_ME))
- /* #### Eek, this will probably result in another error
- when PLIST is printed out */
return Fsignal (Qcircular_property_list, list1 (*plist));
else
{
DEFUN ("plist-get", Fplist_get, 2, 3, 0, /*
Extract a value from a property list.
PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
-corresponding to the given PROP, or DEFAULT if PROP is not
-one of the properties on the list.
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2...).
+PROPERTY is usually a symbol.
+This function returns the value corresponding to the PROPERTY,
+or DEFAULT if PROPERTY is not one of the properties on the list.
*/
- (plist, prop, default_))
+ (plist, property, default_))
{
- Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME);
- return UNBOUNDP (val) ? default_ : val;
+ Lisp_Object value = external_plist_get (&plist, property, 0, ERROR_ME);
+ return UNBOUNDP (value) ? default_ : value;
}
DEFUN ("plist-put", Fplist_put, 3, 3, 0, /*
-Change value in PLIST of PROP to VAL.
-PLIST is a property list, which is a list of the form \(PROP1 VALUE1
-PROP2 VALUE2 ...). PROP is usually a symbol and VAL is any object.
-If PROP is already a property on the list, its value is set to VAL,
-otherwise the new PROP VAL pair is added. The new plist is returned;
-use `(setq x (plist-put x prop val))' to be sure to use the new value.
-The PLIST is modified by side effects.
+Change value in PLIST of PROPERTY to VALUE.
+PLIST is a property list, which is a list of the form
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...).
+PROPERTY is usually a symbol and VALUE is any object.
+If PROPERTY is already a property on the list, its value is set to VALUE,
+otherwise the new PROPERTY VALUE pair is added.
+The new plist is returned; use `(setq x (plist-put x property value))'
+to be sure to use the new value. PLIST is modified by side effect.
*/
- (plist, prop, val))
+ (plist, property, value))
{
- external_plist_put (&plist, prop, val, 0, ERROR_ME);
+ external_plist_put (&plist, property, value, 0, ERROR_ME);
return plist;
}
DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /*
-Remove from PLIST the property PROP and its value.
-PLIST is a property list, which is a list of the form \(PROP1 VALUE1
-PROP2 VALUE2 ...). PROP is usually a symbol. The new plist is
-returned; use `(setq x (plist-remprop x prop val))' to be sure to use
-the new value. The PLIST is modified by side effects.
+Remove from PLIST the property PROPERTY and its value.
+PLIST is a property list, which is a list of the form
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...).
+PROPERTY is usually a symbol.
+The new plist is returned; use `(setq x (plist-remprop x property))'
+to be sure to use the new value. PLIST is modified by side effect.
*/
- (plist, prop))
+ (plist, property))
{
- external_remprop (&plist, prop, 0, ERROR_ME);
+ external_remprop (&plist, property, 0, ERROR_ME);
return plist;
}
DEFUN ("plist-member", Fplist_member, 2, 2, 0, /*
-Return t if PROP has a value specified in PLIST.
+Return t if PROPERTY has a value specified in PLIST.
*/
- (plist, prop))
+ (plist, property))
{
- Lisp_Object val = Fplist_get (plist, prop, Qunbound);
- return UNBOUNDP (val) ? Qnil : Qt;
+ Lisp_Object value = Fplist_get (plist, property, Qunbound);
+ return UNBOUNDP (value) ? Qnil : Qt;
}
DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /*
DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /*
Extract a value from a lax property list.
-
-LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
-using `equal' instead of `eq'. This function returns the value
-corresponding to the given PROP, or DEFAULT if PROP is not one of the
-properties on the list.
+LAX-PLIST is a lax property list, which is a list of the form
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
+properties is done using `equal' instead of `eq'.
+PROPERTY is usually a symbol.
+This function returns the value corresponding to PROPERTY,
+or DEFAULT if PROPERTY is not one of the properties on the list.
*/
- (lax_plist, prop, default_))
+ (lax_plist, property, default_))
{
- Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME);
- return UNBOUNDP (val) ? default_ : val;
+ Lisp_Object value = external_plist_get (&lax_plist, property, 1, ERROR_ME);
+ return UNBOUNDP (value) ? default_ : value;
}
DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
-Change value in LAX-PLIST of PROP to VAL.
-LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
-using `equal' instead of `eq'. PROP is usually a symbol and VAL is
-any object. If PROP is already a property on the list, its value is
-set to VAL, otherwise the new PROP VAL pair is added. The new plist
-is returned; use `(setq x (lax-plist-put x prop val))' to be sure to
-use the new value. The LAX-PLIST is modified by side effects.
-*/
- (lax_plist, prop, val))
-{
- external_plist_put (&lax_plist, prop, val, 1, ERROR_ME);
+Change value in LAX-PLIST of PROPERTY to VALUE.
+LAX-PLIST is a lax property list, which is a list of the form
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
+properties is done using `equal' instead of `eq'.
+PROPERTY is usually a symbol and VALUE is any object.
+If PROPERTY is already a property on the list, its value is set to
+VALUE, otherwise the new PROPERTY VALUE pair is added.
+The new plist is returned; use `(setq x (lax-plist-put x property value))'
+to be sure to use the new value. LAX-PLIST is modified by side effect.
+*/
+ (lax_plist, property, value))
+{
+ external_plist_put (&lax_plist, property, value, 1, ERROR_ME);
return lax_plist;
}
DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /*
-Remove from LAX-PLIST the property PROP and its value.
-LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
-using `equal' instead of `eq'. PROP is usually a symbol. The new
-plist is returned; use `(setq x (lax-plist-remprop x prop val))' to be
-sure to use the new value. The LAX-PLIST is modified by side effects.
+Remove from LAX-PLIST the property PROPERTY and its value.
+LAX-PLIST is a lax property list, which is a list of the form
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
+properties is done using `equal' instead of `eq'.
+PROPERTY is usually a symbol.
+The new plist is returned; use `(setq x (lax-plist-remprop x property))'
+to be sure to use the new value. LAX-PLIST is modified by side effect.
*/
- (lax_plist, prop))
+ (lax_plist, property))
{
- external_remprop (&lax_plist, prop, 1, ERROR_ME);
+ external_remprop (&lax_plist, property, 1, ERROR_ME);
return lax_plist;
}
DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /*
-Return t if PROP has a value specified in LAX-PLIST.
-LAX-PLIST is a lax property list, which is a list of the form \(PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties is done
-using `equal' instead of `eq'.
+Return t if PROPERTY has a value specified in LAX-PLIST.
+LAX-PLIST is a lax property list, which is a list of the form
+\(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
+properties is done using `equal' instead of `eq'.
*/
- (lax_plist, prop))
+ (lax_plist, property))
{
- return UNBOUNDP (Flax_plist_get (lax_plist, prop, Qunbound)) ? Qnil : Qt;
+ return UNBOUNDP (Flax_plist_get (lax_plist, property, Qunbound)) ? Qnil : Qt;
}
DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /*
Vectors and strings are compared element by element.
Numbers are compared by value. Symbols must match exactly.
*/
- (obj1, obj2))
+ (object1, object2))
{
- return internal_equal (obj1, obj2, 0) ? Qt : Qnil;
+ return internal_equal (object1, object2, 0) ? Qt : Qnil;
}
DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
This function is provided only for byte-code compatibility with v19.
Do not use it.
*/
- (obj1, obj2))
+ (object1, object2))
{
- return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil;
+ return internal_old_equal (object1, object2, 0) ? Qt : Qnil;
}
\f
else if (VECTORP (array))
{
Lisp_Object *p = XVECTOR_DATA (array);
- int len = XVECTOR_LENGTH (array);
+ size_t len = XVECTOR_LENGTH (array);
CHECK_LISP_WRITEABLE (array);
while (len--)
*p++ = item;
else if (BIT_VECTORP (array))
{
Lisp_Bit_Vector *v = XBIT_VECTOR (array);
- int len = bit_vector_length (v);
+ size_t len = bit_vector_length (v);
int bit;
CHECK_BIT (item);
- CHECK_LISP_WRITEABLE (array);
bit = XINT (item);
+ CHECK_LISP_WRITEABLE (array);
while (len--)
set_bit_vector_bit (v, len, bit);
}
{
/* (setcdr (last args[0]) args[1]) */
Lisp_Object tortoise, hare;
- int count;
+ size_t count;
for (hare = tortoise = args[0], count = 0;
CONSP (XCDR (hare));
if (CONSP (next) || argnum == nargs -1)
{
/* (setcdr (last val) next) */
- int count;
+ size_t count;
for (count = 0;
CONSP (XCDR (last_cons));
{
Lisp_Object result;
Lisp_Object args[2];
- int i;
struct gcpro gcpro1;
if (vals)
if (vals == 0) we don't have any free space available and
don't want to eat up any more stack with alloca().
- So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */
+ So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */
if (vals)
{
Lisp_Object *val = vals;
- Lisp_Object elt;
+ size_t i;
LIST_LOOP_2 (elt, sequence)
*val++ = elt;
else
{
Lisp_Object elt, tail;
+ EMACS_INT len_unused;
struct gcpro ngcpro1;
NGCPRO1 (tail);
{
- EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+ EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len_unused)
{
args[1] = elt;
Ffuncall (2, args);
else if (VECTORP (sequence))
{
Lisp_Object *objs = XVECTOR_DATA (sequence);
+ size_t i;
for (i = 0; i < leni; i++)
{
args[1] = *objs++;
else if (BIT_VECTORP (sequence))
{
Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
+ size_t i;
for (i = 0; i < leni; i++)
{
args[1] = make_int (bit_vector_bit (v, i));
*/
(function, sequence, separator))
{
- size_t len = XINT (Flength (sequence));
+ EMACS_INT len = XINT (Flength (sequence));
Lisp_Object *args;
- int i;
- int nargs = len + len - 1;
+ EMACS_INT i;
+ EMACS_INT nargs = len + len - 1;
if (len == 0) return build_string ("");
}
\f
+
+
+DEFUN ("replace-list", Freplace_list, 2, 2, 0, /*
+Destructively replace the list OLD with NEW.
+This is like (copy-sequence NEW) except that it reuses the
+conses in OLD as much as possible. If OLD and NEW are the same
+length, no consing will take place.
+*/
+ (old, new))
+{
+ Lisp_Object tail, oldtail = old, prevoldtail = Qnil;
+
+ EXTERNAL_LIST_LOOP (tail, new)
+ {
+ if (!NILP (oldtail))
+ {
+ CHECK_CONS (oldtail);
+ XCAR (oldtail) = XCAR (tail);
+ }
+ else if (!NILP (prevoldtail))
+ {
+ XCDR (prevoldtail) = Fcons (XCAR (tail), Qnil);
+ prevoldtail = XCDR (prevoldtail);
+ }
+ else
+ old = oldtail = Fcons (XCAR (tail), Qnil);
+
+ if (!NILP (oldtail))
+ {
+ prevoldtail = oldtail;
+ oldtail = XCDR (oldtail);
+ }
+ }
+
+ if (!NILP (prevoldtail))
+ XCDR (prevoldtail) = Qnil;
+ else
+ old = Qnil;
+
+ return old;
+}
+
+\f
/* #### this function doesn't belong in this file! */
+#ifdef HAVE_GETLOADAVG
+#ifdef HAVE_SYS_LOADAVG_H
+#include <sys/loadavg.h>
+#endif
+#else
+int getloadavg (double loadavg[], int nelem); /* Defined in getloadavg.c */
+#endif
+
DEFUN ("load-average", Fload_average, 0, 1, 0, /*
Return list of 1 minute, 5 minute and 15 minute load averages.
Each of the three load averages is multiplied by 100,
(featurep '(or (and xemacs 19.15) (and emacs 19.34)))
=> ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later.
+ (featurep '(and xemacs 21.02))
+ => ; Non-nil on XEmacs 21.2 and later.
+
NOTE: The advanced arguments of this function (anything other than a
symbol) are not yet supported by FSF Emacs. If you feel they are useful
for supporting multiple Emacs variants, lobby Richard Stallman at
-<bug-gnu-emacs@prep.ai.mit.edu>.
+<bug-gnu-emacs@gnu.org>.
*/
(fexp))
{
is not loaded; so load the file FILENAME.
If FILENAME is omitted, the printname of FEATURE is used as the file name.
*/
- (feature, file_name))
+ (feature, filename))
{
Lisp_Object tem;
CHECK_SYMBOL (feature);
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- call4 (Qload, NILP (file_name) ? Fsymbol_name (feature) : file_name,
+ call4 (Qload, NILP (filename) ? Fsymbol_name (feature) : filename,
Qnil, Qt, Qnil);
tem = Fmemq (feature, Vfeatures);
} while (0)
DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /*
-Base64-encode the region between BEG and END.
+Base64-encode the region between START and END.
Return the length of the encoded text.
Optional third argument NO-LINE-BREAK means do not break long lines
into shorter lines.
*/
- (beg, end, no_line_break))
+ (start, end, no_line_break))
{
Bufbyte *encoded;
Bytind encoded_length;
Lisp_Object input;
int speccount = specpdl_depth();
- get_buffer_range_char (buf, beg, end, &begv, &zv, 0);
+ get_buffer_range_char (buf, start, end, &begv, &zv, 0);
barf_if_buffer_read_only (buf, begv, zv);
/* We need to allocate enough room for encoding the text.
DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /*
Base64 encode STRING and return the result.
+Optional argument NO-LINE-BREAK means do not break long lines
+into shorter lines.
*/
(string, no_line_break))
{
}
DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /*
-Base64-decode the region between BEG and END.
+Base64-decode the region between START and END.
Return the length of the decoded text.
If the region can't be decoded, return nil and don't modify the buffer.
Characters out of the base64 alphabet are ignored.
*/
- (beg, end))
+ (start, end))
{
struct buffer *buf = current_buffer;
Bufpos begv, zv, old_pt = BUF_PT (buf);
Lisp_Object input;
int speccount = specpdl_depth();
- get_buffer_range_char (buf, beg, end, &begv, &zv, 0);
+ get_buffer_range_char (buf, start, end, &begv, &zv, 0);
barf_if_buffer_read_only (buf, begv, zv);
length = zv - begv;
void
syms_of_fns (void)
{
+ INIT_LRECORD_IMPLEMENTATION (bit_vector);
+
defsymbol (&Qstring_lessp, "string-lessp");
defsymbol (&Qidentity, "identity");
defsymbol (&Qyes_or_no_p, "yes-or-no-p");
DEFSUBR (Fmapvector);
DEFSUBR (Fmapc_internal);
DEFSUBR (Fmapconcat);
+ DEFSUBR (Freplace_list);
DEFSUBR (Fload_average);
DEFSUBR (Ffeaturep);
DEFSUBR (Frequire);
projects / chise / xemacs-chise.git.1 / blobdiff