/* 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.
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,
doc: /* Return t if first arg string is less than second in collation order.
Symbols are also allowed; their print names are used instead.
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);
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];
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.
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;
}
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
/* 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;
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 (&Sstring_equal);
defsubr (&Scompare_strings);
defsubr (&Sstring_lessp);
+ defsubr (&Sstring_version_lessp);
defsubr (&Sstring_collate_lessp);
defsubr (&Sstring_collate_equalp);
defsubr (&Sappend);