/* Random utility Lisp functions.
-Copyright (C) 1985-1987, 1993-1995, 1997-2015 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2016 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 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <config.h>
#include <unistd.h>
-#include <time.h>
-
+#include <filevercmp.h>
#include <intprops.h>
#include <vla.h>
+#include <errno.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]);
and `most-positive-fixnum', inclusive, are equally likely.
With positive integer LIMIT, return random number in interval [0,LIMIT).
-With argument t, set the random number seed from the current time and pid.
+With argument t, set the random number seed from the system's entropy
+pool if available, otherwise from less-random volatile data such as the time.
With a string argument, set the seed based on the string's contents.
Other values of LIMIT are ignored.
}
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-version-lessp", Fstring_version_lessp,
+ Sstring_version_lessp, 2, 2, 0,
+ doc: /* Return non-nil if S1 is less than S2, as version strings.
+
+This function compares version strings S1 and S2:
+ 1) By prefix lexicographically.
+ 2) Then by version (similarly to version comparison of Debian's dpkg).
+ Leading zeros in version numbers are ignored.
+ 3) If both prefix and version are equal, compare as ordinary strings.
+
+For example, \"foo2.png\" compares less than \"foo12.png\".
+Case is significant.
+Symbols are also allowed; their print names are used instead. */)
+ (Lisp_Object string1, Lisp_Object string2)
+{
+ if (SYMBOLP (string1))
+ string1 = SYMBOL_NAME (string1);
+ if (SYMBOLP (string2))
+ string2 = SYMBOL_NAME (string2);
+ CHECK_STRING (string1);
+ CHECK_STRING (string2);
+
+ char *p1 = SSDATA (string1);
+ char *p2 = SSDATA (string2);
+ char *lim1 = p1 + SBYTES (string1);
+ char *lim2 = p2 + SBYTES (string2);
+ int cmp;
+
+ while ((cmp = filevercmp (p1, p2)) == 0)
+ {
+ /* If the strings are identical through their first null bytes,
+ skip past identical prefixes and try again. */
+ ptrdiff_t size = strlen (p1) + 1;
+ p1 += size;
+ p2 += size;
+ if (lim1 < p1)
+ return lim2 < p2 ? Qnil : Qt;
+ if (lim2 < p2)
+ return Qnil;
+ }
+
+ return cmp < 0 ? 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
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)
(register Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
if (!FLOATP (elt))
return Fmemq (elt, list);
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
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;
{
Lisp_Object tail, prev;
- for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
+ for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
{
CHECK_LIST_CONS (tail, seq);
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;
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 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 = CALLN (Fconcat, prompt, yes_or_no);
- GCPRO1 (prompt);
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. */
- struct gcpro gcpro1, gcpro2;
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);
- GCPRO2 (propval, trailing_args);
Lisp_Object result = CALLN (Fapply, propval, widget, trailing_args);
- UNGCPRO;
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
#ifdef ENABLE_CHECKING
if (HASH_TABLE_P (Vpurify_flag)
&& XHASH_TABLE (Vpurify_flag) == h)
- CALLN (Fmessage, 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;
-
- n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
- marked = 0;
+ ptrdiff_t n = gc_asize (h->index);
+ bool marked = false;
- for (bucket = 0; bucket < n; ++bucket)
+ for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
{
Lisp_Object idx, next, prev;
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");
defsubr (&Sstring_equal);
defsubr (&Scompare_strings);
defsubr (&Sstring_lessp);
+ defsubr (&Sstring_version_lessp);
defsubr (&Sstring_collate_lessp);
defsubr (&Sstring_collate_equalp);
defsubr (&Sappend);