#include <config.h>
#include <unistd.h>
-#include <time.h>
-
#include <intprops.h>
#include <vla.h>
#include "lisp.h"
-#include "commands.h"
#include "character.h"
#include "coding.h"
+#include "composite.h"
#include "buffer.h"
-#include "keyboard.h"
-#include "keymap.h"
#include "intervals.h"
-#include "frame.h"
#include "window.h"
-#include "blockinput.h"
-#if defined (HAVE_X_WINDOWS)
-#include "xterm.h"
-#endif
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
Lisp_Object [restrict], Lisp_Object [restrict]);
The arguments START1, END1, START2, and END2, if non-nil, are
positions specifying which parts of STR1 or STR2 to compare. In
string STR1, compare the part between START1 (inclusive) and END1
-\(exclusive). If START1 is nil, it defaults to 0, the beginning of
+(exclusive). If START1 is nil, it defaults to 0, the beginning of
the string; if END1 is nil, it defaults to the length of the string.
Likewise, in string STR2, compare the part between START2 and END2.
Like in `substring', negative values are counted from the end.
}
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
- doc: /* Return t if first arg string is less than second in lexicographic order.
+ doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead. */)
- (register Lisp_Object s1, Lisp_Object s2)
+ (register Lisp_Object string1, Lisp_Object string2)
{
register ptrdiff_t end;
register ptrdiff_t i1, i1_byte, i2, i2_byte;
- if (SYMBOLP (s1))
- s1 = SYMBOL_NAME (s1);
- if (SYMBOLP (s2))
- s2 = SYMBOL_NAME (s2);
- CHECK_STRING (s1);
- CHECK_STRING (s2);
+ if (SYMBOLP (string1))
+ string1 = SYMBOL_NAME (string1);
+ if (SYMBOLP (string2))
+ string2 = SYMBOL_NAME (string2);
+ CHECK_STRING (string1);
+ CHECK_STRING (string2);
i1 = i1_byte = i2 = i2_byte = 0;
- end = SCHARS (s1);
- if (end > SCHARS (s2))
- end = SCHARS (s2);
+ end = SCHARS (string1);
+ if (end > SCHARS (string2))
+ end = SCHARS (string2);
while (i1 < end)
{
characters, not just the bytes. */
int c1, c2;
- FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
- FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
+ FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
+ FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
if (c1 != c2)
return c1 < c2 ? Qt : Qnil;
}
- return i1 < SCHARS (s2) ? Qt : Qnil;
+ return i1 < SCHARS (string2) ? Qt : Qnil;
}
DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
locale settings. For example, punctuation and whitespace characters
might be considered less significant for sorting:
-\(sort '\("11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp)
- => \("11" "1 1" "1.1" "12" "1 2" "1.2")
+(sort \\='("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp)
+ => ("11" "1 1" "1.1" "12" "1 2" "1.2")
The optional argument LOCALE, a string, overrides the setting of your
current locale identifier for collation. The value is system
the same meaning might be considered as equal, like different grave
accent Unicode characters:
-\(string-collate-equalp \(string ?\\uFF40) \(string ?\\u1FEF))
+(string-collate-equalp (string ?\\uFF40) (string ?\\u1FEF))
=> t
The optional argument LOCALE, a string, overrides the setting of your
Lisp_Object
concat2 (Lisp_Object s1, Lisp_Object s2)
{
- Lisp_Object args[2];
- args[0] = s1;
- args[1] = s2;
- return concat (2, args, Lisp_String, 0);
+ return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0);
}
/* ARGSUSED */
Lisp_Object
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
{
- Lisp_Object args[3];
- args[0] = s1;
- args[1] = s2;
- args[2] = s3;
- return concat (3, args, Lisp_String, 0);
+ return concat (3, ((Lisp_Object []) {s1, s2, s3}), Lisp_String, 0);
}
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
newly created string with no text properties. If STRING is multibyte
or entirely ASCII, it is returned unchanged. In particular, when
STRING is unibyte and entirely ASCII, the returned string is unibyte.
-\(When the characters are all ASCII, Emacs primitives will treat the
+(When the characters are all ASCII, Emacs primitives will treat the
string the same way whether it is unibyte or multibyte.) */)
(Lisp_Object string)
{
See also `string-to-multibyte'.
Beware, this often doesn't really do what you think it does.
-It is similar to (decode-coding-string STRING 'utf-8-emacs).
+It is similar to (decode-coding-string STRING \\='utf-8-emacs).
If you're not sure, whether to use `string-as-multibyte' or
`string-to-multibyte', use `string-to-multibyte'. */)
(Lisp_Object string)
DEFUN ("substring", Fsubstring, Ssubstring, 1, 3, 0,
doc: /* Return a new string whose contents are a substring of STRING.
The returned string consists of the characters between index FROM
-\(inclusive) and index TO (exclusive) of STRING. FROM and TO are
+(inclusive) and index TO (exclusive) of STRING. FROM and TO are
zero-indexed: 0 means the first character of STRING. Negative values
are counted from the end of STRING. If TO is nil, the substring runs
to the end of STRING.
The STRING argument may also be a vector. In that case, the return
value is a new vector that contains the elements between index FROM
-\(inclusive) and index TO (exclusive) of that vector argument.
+(inclusive) and index TO (exclusive) of that vector argument.
With one argument, just copy STRING (with properties, if any). */)
(Lisp_Object string, Lisp_Object from, Lisp_Object to)
list.
Write `(setq foo (delq element foo))' to be sure of correctly changing
-the value of a list `foo'. */)
+the value of a list `foo'. See also `remq', which does not modify the
+argument. */)
(register Lisp_Object elt, Lisp_Object list)
{
Lisp_Object tail, tortoise, prev = Qnil;
sort_list (Lisp_Object list, Lisp_Object predicate)
{
Lisp_Object front, back;
- register Lisp_Object len, tem;
- struct gcpro gcpro1, gcpro2;
+ Lisp_Object len, tem;
EMACS_INT length;
front = list;
back = Fcdr (tem);
Fsetcdr (tem, Qnil);
- GCPRO2 (front, back);
front = Fsort (front, predicate);
back = Fsort (back, predicate);
- UNGCPRO;
return merge (front, back, predicate);
}
return;
ptrdiff_t halflen = len >> 1;
Lisp_Object *tmp;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (vector, predicate);
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (tmp, halflen);
for (ptrdiff_t i = 0; i < halflen; i++)
tmp[i] = make_number (0);
sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp);
SAFE_FREE ();
- UNGCPRO;
}
DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
Lisp_Object
merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
{
- Lisp_Object value;
- register Lisp_Object tail;
- Lisp_Object tem;
- register Lisp_Object l1, l2;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- l1 = org_l1;
- l2 = org_l2;
- tail = Qnil;
- value = Qnil;
-
- /* It is sufficient to protect org_l1 and org_l2.
- When l1 and l2 are updated, we copy the new values
- back into the org_ vars. */
- GCPRO4 (org_l1, org_l2, pred, value);
+ Lisp_Object l1 = org_l1;
+ Lisp_Object l2 = org_l2;
+ Lisp_Object tail = Qnil;
+ Lisp_Object value = Qnil;
while (1)
{
if (NILP (l1))
{
- UNGCPRO;
if (NILP (tail))
return l2;
Fsetcdr (tail, l2);
}
if (NILP (l2))
{
- UNGCPRO;
if (NILP (tail))
return l1;
Fsetcdr (tail, l1);
return value;
}
+
+ Lisp_Object tem;
if (inorder (pred, Fcar (l1), Fcar (l2)))
{
tem = l1;
DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
doc: /* 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
+(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
corresponding to the given PROP, or nil if PROP is not one of the
properties on the list. This function never signals an error. */)
(Lisp_Object plist, Lisp_Object prop)
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
doc: /* 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 a symbol and VAL is any object.
+(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is 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.
DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
doc: /* Extract a value from a property list, comparing with `equal'.
PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
+(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
corresponding to the given PROP, or nil if PROP is not
one of the properties on the list. */)
(Lisp_Object plist, Lisp_Object prop)
DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
+(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
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.
if (depth > 200)
error ("Stack overflow in equal");
if (NILP (ht))
- {
- Lisp_Object args[2];
- args[0] = QCtest;
- args[1] = Qeq;
- ht = Fmake_hash_table (2, args);
- }
+ ht = CALLN (Fmake_hash_table, QCtest, Qeq);
switch (XTYPE (o1))
{
case Lisp_Cons: case Lisp_Misc: case Lisp_Vectorlike:
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
ptrdiff_t size_byte = SBYTES (array);
+ ptrdiff_t product;
- if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
- || SCHARS (array) * len != size_byte)
+ if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte)
error ("Attempt to change byte length of a string");
for (idx = 0; idx < size_byte; idx++)
*p++ = str[idx % len];
Lisp_Object
nconc2 (Lisp_Object s1, Lisp_Object s2)
{
- Lisp_Object args[2];
- args[0] = s1;
- args[1] = s2;
- return Fnconc (2, args);
+ return CALLN (Fnconc, s1, s2);
}
DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
{
Lisp_Object tail, dummy;
EMACS_INT i;
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- if (vals)
- {
- /* Don't let vals contain any garbage when GC happens. */
- memclear (vals, leni * word_size);
-
- GCPRO3 (dummy, fn, seq);
- gcpro1.var = vals;
- gcpro1.nvars = leni;
- }
- else
- GCPRO2 (fn, seq);
- /* 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 (VECTORP (seq) || COMPILEDP (seq))
{
tail = XCDR (tail);
}
}
-
- UNGCPRO;
}
DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
(Lisp_Object function, Lisp_Object sequence, Lisp_Object separator)
{
Lisp_Object len;
- register EMACS_INT leni;
+ EMACS_INT leni;
EMACS_INT nargs;
ptrdiff_t i;
- register Lisp_Object *args;
- struct gcpro gcpro1;
+ Lisp_Object *args;
Lisp_Object ret;
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (args, nargs);
- GCPRO1 (separator);
mapcar1 (leni, args, function, sequence);
- UNGCPRO;
for (i = leni - 1; i > 0; i--)
args[i + i] = args[i];
}
\f
/* This is how C code calls `yes-or-no-p' and allows the user
- to redefined it.
-
- Anything that calls this function must protect from GC! */
+ to redefine it. */
Lisp_Object
do_yes_or_no_p (Lisp_Object prompt)
return call1 (intern ("yes-or-no-p"), prompt);
}
-/* Anything that calls this function must protect from GC! */
-
DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
doc: /* Ask user a yes-or-no question.
Return t if answer is yes, and nil if the answer is no.
(Lisp_Object prompt)
{
Lisp_Object ans;
- struct gcpro gcpro1;
CHECK_STRING (prompt);
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
- && use_dialog_box)
+ && use_dialog_box && ! NILP (last_input_event))
{
Lisp_Object pane, menu, obj;
redisplay_preserve_echo_area (4);
pane = list2 (Fcons (build_string ("Yes"), Qt),
Fcons (build_string ("No"), Qnil));
- GCPRO1 (pane);
menu = Fcons (prompt, pane);
obj = Fx_popup_dialog (Qt, menu, Qnil);
- UNGCPRO;
return obj;
}
AUTO_STRING (yes_or_no, "(yes or no) ");
- prompt = Fconcat (2, (Lisp_Object []) {prompt, yes_or_no});
- GCPRO1 (prompt);
+ prompt = CALLN (Fconcat, prompt, yes_or_no);
while (1)
{
Qyes_or_no_p_history, Qnil,
Qnil));
if (SCHARS (ans) == 3 && !strcmp (SSDATA (ans), "yes"))
- {
- UNGCPRO;
- return Qt;
- }
+ return Qt;
if (SCHARS (ans) == 2 && !strcmp (SSDATA (ans), "no"))
- {
- UNGCPRO;
- return Qnil;
- }
+ return Qnil;
Fding (Qnil);
Fdiscard_input ();
If FEATURE is not a member of the list `features', then the feature
is not loaded; so load the file FILENAME.
If FILENAME is omitted, the printname of FEATURE is used as the file name,
-and `load' will try to load this name appended with the suffix `.elc' or
-`.el', in that order. The name without appended suffix will not be used.
+and `load' will try to load this name appended with the suffix `.elc',
+`.el', or the system-dependent suffix for dynamic module files, in that
+order. The name without appended suffix will not be used.
See `get-load-suffixes' for the complete list of suffixes.
If the optional third argument NOERROR is non-nil,
then return nil if the file is not found instead of signaling an error.
(Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
{
Lisp_Object tem;
- struct gcpro gcpro1, gcpro2;
bool from_file = load_in_progress;
CHECK_SYMBOL (feature);
Vautoload_queue = Qt;
/* Load the file. */
- GCPRO2 (feature, filename);
tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
- UNGCPRO;
/* If load failed entirely, return nil. */
if (NILP (tem))
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
doc: /* Return non-nil if PLIST has the property PROP.
PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.
+(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol.
Unlike `plist-get', this allows you to distinguish between a missing
property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
{
while (CONSP (plist) && !EQ (XCAR (plist), prop))
{
- QUIT;
plist = XCDR (plist);
plist = CDR (plist);
+ QUIT;
}
return plist;
}
usage: (widget-apply WIDGET PROPERTY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- /* This function can GC. */
- Lisp_Object newargs[3];
- struct gcpro gcpro1, gcpro2;
- Lisp_Object result;
-
- newargs[0] = Fwidget_get (args[0], args[1]);
- newargs[1] = args[0];
- newargs[2] = Flist (nargs - 2, args + 2);
- GCPRO2 (newargs[0], newargs[2]);
- result = Fapply (3, newargs);
- UNGCPRO;
+ Lisp_Object widget = args[0];
+ Lisp_Object property = args[1];
+ Lisp_Object propval = Fwidget_get (widget, property);
+ Lisp_Object trailing_args = Flist (nargs - 2, args + 2);
+ Lisp_Object result = CALLN (Fapply, propval, widget, trailing_args);
return result;
}
Lisp_Object v = Fmake_vector (make_number (7), Qnil);
const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
int i;
- struct gcpro gcpro1;
- GCPRO1 (v);
synchronize_system_time_locale ();
for (i = 0; i < 7; i++)
{
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
- UNGCPRO;
return v;
}
#endif /* DAY_1 */
const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
MON_8, MON_9, MON_10, MON_11, MON_12};
int i;
- struct gcpro gcpro1;
- GCPRO1 (v);
synchronize_system_time_locale ();
for (i = 0; i < 12; i++)
{
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
- UNGCPRO;
return v;
}
#endif /* MON_1 */
Low-level Functions
***********************************************************************/
-static struct hash_table_test hashtest_eq;
-struct hash_table_test hashtest_eql, hashtest_equal;
+struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
HASH2 in hash table H using `eql'. Value is true if KEY1 and
Lisp_Object key1,
Lisp_Object key2)
{
- Lisp_Object args[3];
-
- args[0] = ht->user_cmp_function;
- args[1] = key1;
- args[2] = key2;
- return !NILP (Ffuncall (3, args));
+ return !NILP (call2 (ht->user_cmp_function, key1, key2));
}
static EMACS_UINT
hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
{
- Lisp_Object args[2], hash;
-
- args[0] = ht->user_hash_function;
- args[1] = key;
- hash = Ffuncall (2, args);
+ Lisp_Object hash = call1 (ht->user_hash_function, key);
return hashfn_eq (ht, hash);
}
#ifdef ENABLE_CHECKING
if (HASH_TABLE_P (Vpurify_flag)
&& XHASH_TABLE (Vpurify_flag) == h)
- Fmessage (2, ((Lisp_Object [])
- { build_string ("Growing hash table to: %d"),
- make_number (new_size) }));
+ message ("Growing hash table to: %"pI"d", new_size);
#endif
set_hash_key_and_value (h, larger_vector (h->key_and_value,
start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
- /* We need not gcpro idx since it's either an integer or nil. */
while (!NILP (idx))
{
ptrdiff_t i = XFASTINT (idx);
/* Remove the entry matching KEY from hash table H, if there is one. */
-static void
+void
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash_code;
idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil;
- /* We need not gcpro idx, prev since they're either integers or nil. */
while (!NILP (idx))
{
ptrdiff_t i = XFASTINT (idx);
static bool
sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
- ptrdiff_t bucket, n;
- bool marked;
+ ptrdiff_t n = gc_asize (h->index);
+ bool marked = false;
- n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
- marked = 0;
-
- for (bucket = 0; bucket < n; ++bucket)
+ for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
{
Lisp_Object idx, next, prev;
(Lisp_Object function, Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- Lisp_Object args[3];
- ptrdiff_t i;
- for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)))
- {
- args[0] = function;
- args[1] = HASH_KEY (h, i);
- args[2] = HASH_VALUE (h, i);
- Ffuncall (3, args);
- }
+ call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i));
return Qnil;
}
if (NILP (coding_system) && !NILP (Fbuffer_file_name (object)))
{
/* Check file-coding-system-alist. */
- Lisp_Object args[4], val;
-
- args[0] = Qwrite_region; args[1] = start; args[2] = end;
- args[3] = Fbuffer_file_name (object);
- val = Ffind_operation_coding_system (4, args);
+ Lisp_Object val = CALLN (Ffind_operation_coding_system,
+ Qwrite_region, start, end,
+ Fbuffer_file_name (object));
if (CONSP (val) && !NILP (XCDR (val)))
coding_system = XCDR (val);
}
defsubr (&Sdefine_hash_table_test);
DEFSYM (Qstring_lessp, "string-lessp");
- DEFSYM (Qstring_collate_lessp, "string-collate-lessp");
- DEFSYM (Qstring_collate_equalp, "string-collate-equalp");
DEFSYM (Qprovide, "provide");
DEFSYM (Qrequire, "require");
DEFSYM (Qyes_or_no_p_history, "yes-or-no-p-history");
DEFVAR_LISP ("features", Vfeatures,
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
- Vfeatures = list1 (intern_c_string ("emacs"));
+ Vfeatures = list1 (Qemacs);
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");