fns.c 158 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Random utility Lisp functions.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1987, 1993-1995, 1997-2019 Free Software Foundation,
4
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20

21
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
22

Paul Eggert's avatar
Paul Eggert committed
23
#include <stdlib.h>
Andreas Schwab's avatar
Andreas Schwab committed
24
#include <unistd.h>
25
#include <filevercmp.h>
26
#include <intprops.h>
Paul Eggert's avatar
Paul Eggert committed
27
#include <vla.h>
28
#include <errno.h>
29

Jim Blandy's avatar
Jim Blandy committed
30
#include "lisp.h"
Paul Eggert's avatar
Paul Eggert committed
31
#include "bignum.h"
32
#include "character.h"
33
#include "coding.h"
34
#include "composite.h"
Jim Blandy's avatar
Jim Blandy committed
35
#include "buffer.h"
36
#include "intervals.h"
37
#include "window.h"
38
#include "puresize.h"
39
#include "gnutls.h"
Jim Blandy's avatar
Jim Blandy committed
40

41
#if defined WINDOWSNT && defined HAVE_GNUTLS3
42 43 44
# define gnutls_rnd w32_gnutls_rnd
#endif

Paul Eggert's avatar
Paul Eggert committed
45
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
46
			      Lisp_Object *restrict, Lisp_Object *restrict);
47 48 49
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
			    enum equal_kind, int, Lisp_Object);
50

Paul Eggert's avatar
Paul Eggert committed
51
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
52 53
       doc: /* Return the argument unchanged.  */
       attributes: const)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
54
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
55 56 57 58 59
{
  return arg;
}

DEFUN ("random", Frandom, Srandom, 0, 1, 0,
60 61 62
       doc: /* Return a pseudo-random integer.
By default, return a fixnum; all fixnums are equally likely.
With positive fixnum LIMIT, return random integer in interval [0,LIMIT).
63
With argument t, set the random number seed from the system's entropy
64
pool if available, otherwise from less-random volatile data such as the time.
Glenn Morris's avatar
Glenn Morris committed
65 66 67
With a string argument, set the seed based on the string's contents.

See Info node `(elisp)Random Numbers' for more details.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
68
  (Lisp_Object limit)
Jim Blandy's avatar
Jim Blandy committed
69
{
70
  EMACS_INT val;
Jim Blandy's avatar
Jim Blandy committed
71

72
  if (EQ (limit, Qt))
73 74 75
    init_random ();
  else if (STRINGP (limit))
    seed_random (SSDATA (limit), SBYTES (limit));
76

77
  val = get_random ();
Tom Tromey's avatar
Tom Tromey committed
78
  if (FIXNUMP (limit) && 0 < XFIXNUM (limit))
79 80 81 82 83
    while (true)
      {
	/* Return the remainder, except reject the rare case where
	   get_random returns a number so close to INTMASK that the
	   remainder isn't random.  */
Tom Tromey's avatar
Tom Tromey committed
84 85
	EMACS_INT remainder = val % XFIXNUM (limit);
	if (val - remainder <= INTMASK - XFIXNUM (limit) + 1)
86
	  return make_fixnum (remainder);
87 88
	val = get_random ();
      }
89
  return make_fixnum (val);
Jim Blandy's avatar
Jim Blandy committed
90 91
}

92
/* Random data-structure functions.  */
Jim Blandy's avatar
Jim Blandy committed
93

Paul Eggert's avatar
Paul Eggert committed
94
/* Return LIST's length.  Signal an error if LIST is not a proper list.  */
Paul Eggert's avatar
Paul Eggert committed
95 96 97 98 99 100 101 102

ptrdiff_t
list_length (Lisp_Object list)
{
  intptr_t i = 0;
  FOR_EACH_TAIL (list)
    i++;
  CHECK_LIST_END (list, list);
103
  return i;
Paul Eggert's avatar
Paul Eggert committed
104 105 106
}


Paul Eggert's avatar
Paul Eggert committed
107
DEFUN ("length", Flength, Slength, 1, 1, 0,
108
       doc: /* Return the length of vector, list or string SEQUENCE.
Gerd Moellmann's avatar
Gerd Moellmann committed
109
A byte-code function object is also allowed.
John Paul Wallington's avatar
John Paul Wallington committed
110
If the string contains multibyte characters, this is not necessarily
Gerd Moellmann's avatar
Gerd Moellmann committed
111
the number of bytes in the string; it is the number of characters.
112
To get the number of bytes, use `string-bytes'.  */)
Paul Eggert's avatar
Paul Eggert committed
113
  (Lisp_Object sequence)
Jim Blandy's avatar
Jim Blandy committed
114
{
Paul Eggert's avatar
Paul Eggert committed
115
  EMACS_INT val;
Jim Blandy's avatar
Jim Blandy committed
116

117
  if (STRINGP (sequence))
Paul Eggert's avatar
Paul Eggert committed
118
    val = SCHARS (sequence);
119
  else if (VECTORP (sequence))
Paul Eggert's avatar
Paul Eggert committed
120
    val = ASIZE (sequence);
121
  else if (CHAR_TABLE_P (sequence))
Paul Eggert's avatar
Paul Eggert committed
122
    val = MAX_CHAR;
123
  else if (BOOL_VECTOR_P (sequence))
Paul Eggert's avatar
Paul Eggert committed
124
    val = bool_vector_size (sequence);
125
  else if (COMPILEDP (sequence) || RECORDP (sequence))
Paul Eggert's avatar
Paul Eggert committed
126
    val = PVSIZE (sequence);
127
  else if (CONSP (sequence))
Paul Eggert's avatar
Paul Eggert committed
128
    val = list_length (sequence);
129
  else if (NILP (sequence))
Paul Eggert's avatar
Paul Eggert committed
130
    val = 0;
Jim Blandy's avatar
Jim Blandy committed
131
  else
132
    wrong_type_argument (Qsequencep, sequence);
133

Paul Eggert's avatar
Paul Eggert committed
134
  return make_fixnum (val);
Jim Blandy's avatar
Jim Blandy committed
135 136
}

137
DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
138
       doc: /* Return the length of a list, but avoid error or infinite loop.
Gerd Moellmann's avatar
Gerd Moellmann committed
139
This function never gets an error.  If LIST is not really a list,
140
it returns 0.  If LIST is circular, it returns an integer that is at
141
least the number of distinct elements.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
142
  (Lisp_Object list)
143
{
144 145 146
  intptr_t len = 0;
  FOR_EACH_TAIL_SAFE (list)
    len++;
147
  return make_fixnum (len);
148 149
}

Paul Eggert's avatar
Paul Eggert committed
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0,
       doc: /* Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr is nil).  */
       attributes: const)
  (Lisp_Object object)
{
  intptr_t len = 0;
  Lisp_Object last_tail = object;
  Lisp_Object tail = object;
  FOR_EACH_TAIL_SAFE (tail)
    {
      len++;
      rarely_quit (len);
      last_tail = XCDR (tail);
    }
  if (!NILP (last_tail))
    return Qnil;
167
  return make_fixnum (len);
Paul Eggert's avatar
Paul Eggert committed
168 169
}

170
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
171
       doc: /* Return the number of bytes in STRING.
Miles Bader's avatar
Miles Bader committed
172
If STRING is multibyte, this may be greater than the length of STRING.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
173
  (Lisp_Object string)
174
{
175
  CHECK_STRING (string);
176
  return make_fixnum (SBYTES (string));
177 178
}

Chen Bin's avatar
Chen Bin committed
179 180
DEFUN ("string-distance", Fstring_distance, Sstring_distance, 2, 3, 0,
       doc: /* Return Levenshtein distance between STRING1 and STRING2.
181 182 183 184 185
The distance is the number of deletions, insertions, and substitutions
required to transform STRING1 into STRING2.
If BYTECOMPARE is nil or omitted, compute distance in terms of characters.
If BYTECOMPARE is non-nil, compute distance in terms of bytes.
Letter-case is significant, but text properties are ignored. */)
Chen Bin's avatar
Chen Bin committed
186 187 188 189 190 191
  (Lisp_Object string1, Lisp_Object string2, Lisp_Object bytecompare)

{
  CHECK_STRING (string1);
  CHECK_STRING (string2);

192 193
  bool use_byte_compare =
    !NILP (bytecompare)
Chen Bin's avatar
Chen Bin committed
194
    || (!STRING_MULTIBYTE (string1) && !STRING_MULTIBYTE (string2));
195 196
  ptrdiff_t len1 = use_byte_compare ? SBYTES (string1) : SCHARS (string1);
  ptrdiff_t len2 = use_byte_compare ? SBYTES (string2) : SCHARS (string2);
Chen Bin's avatar
Chen Bin committed
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
  ptrdiff_t x, y, lastdiag, olddiag;

  USE_SAFE_ALLOCA;
  ptrdiff_t *column = SAFE_ALLOCA ((len1 + 1) * sizeof (ptrdiff_t));
  for (y = 1; y <= len1; y++)
    column[y] = y;

  if (use_byte_compare)
    {
      char *s1 = SSDATA (string1);
      char *s2 = SSDATA (string2);

      for (x = 1; x <= len2; x++)
        {
          column[0] = x;
          for (y = 1, lastdiag = x - 1; y <= len1; y++)
            {
              olddiag = column[y];
215 216
              column[y] = min (min (column[y] + 1, column[y-1] + 1),
			       lastdiag + (s1[y-1] == s2[x-1] ? 0 : 1));
Chen Bin's avatar
Chen Bin committed
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233
              lastdiag = olddiag;
            }
        }
    }
  else
    {
      int c1, c2;
      ptrdiff_t i1, i1_byte, i2 = 0, i2_byte = 0;
      for (x = 1; x <= len2; x++)
        {
          column[0] = x;
          FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
          i1 = i1_byte = 0;
          for (y = 1, lastdiag = x - 1; y <= len1; y++)
            {
              olddiag = column[y];
              FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
234 235
              column[y] = min (min (column[y] + 1, column[y-1] + 1),
			       lastdiag + (c1 == c2 ? 0 : 1));
Chen Bin's avatar
Chen Bin committed
236 237 238 239 240 241
              lastdiag = olddiag;
            }
        }
    }

  SAFE_FREE ();
242
  return make_fixnum (column[len1]);
Chen Bin's avatar
Chen Bin committed
243 244
}

Paul Eggert's avatar
Paul Eggert committed
245
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
246
       doc: /* Return t if two strings have identical contents.
Gerd Moellmann's avatar
Gerd Moellmann committed
247
Case is significant, but text properties are ignored.
248
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
249
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
250
{
251
  if (SYMBOLP (s1))
252
    s1 = SYMBOL_NAME (s1);
253
  if (SYMBOLP (s2))
254
    s2 = SYMBOL_NAME (s2);
255 256
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
257

258 259
  if (SCHARS (s1) != SCHARS (s2)
      || SBYTES (s1) != SBYTES (s2)
260
      || memcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
Jim Blandy's avatar
Jim Blandy committed
261 262 263 264
    return Qnil;
  return Qt;
}

Paul Eggert's avatar
Paul Eggert committed
265
DEFUN ("compare-strings", Fcompare_strings, Scompare_strings, 6, 7, 0,
Juanma Barranquero's avatar
Juanma Barranquero committed
266
       doc: /* Compare the contents of two strings, converting to multibyte if needed.
267 268 269
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
270
\(exclusive).  If START1 is nil, it defaults to 0, the beginning of
271 272
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.
273
Like in `substring', negative values are counted from the end.
274 275 276 277

The strings are compared by the numeric values of their characters.
For instance, STR1 is "less than" STR2 if its first differing
character has a smaller numeric value.  If IGNORE-CASE is non-nil,
278
characters are converted to upper-case before comparing them.  Unibyte
279
strings are converted to multibyte for comparison.
Gerd Moellmann's avatar
Gerd Moellmann committed
280 281 282 283 284

The value is t if the strings (or specified portions) match.
If string STR1 is less, the value is a negative number N;
  - 1 - N is the number of characters that match at the beginning.
If string STR1 is greater, the value is a positive number N;
285
  N - 1 is the number of characters that match at the beginning.  */)
286 287
  (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2,
   Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
288
{
289
  ptrdiff_t from1, to1, from2, to2, i1, i1_byte, i2, i2_byte;
290

291 292
  CHECK_STRING (str1);
  CHECK_STRING (str2);
293

294 295
  /* For backward compatibility, silently bring too-large positive end
     values into range.  */
Tom Tromey's avatar
Tom Tromey committed
296
  if (FIXNUMP (end1) && SCHARS (str1) < XFIXNUM (end1))
297
    end1 = make_fixnum (SCHARS (str1));
Tom Tromey's avatar
Tom Tromey committed
298
  if (FIXNUMP (end2) && SCHARS (str2) < XFIXNUM (end2))
299
    end2 = make_fixnum (SCHARS (str2));
300

301 302 303 304 305
  validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1);
  validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2);

  i1 = from1;
  i2 = from2;
306 307 308

  i1_byte = string_char_to_byte (str1, i1);
  i2_byte = string_char_to_byte (str2, i2);
309

310
  while (i1 < to1 && i2 < to2)
311 312 313 314 315
    {
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

316 317
      FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte);
      FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte);
318 319 320 321 322 323

      if (c1 == c2)
	continue;

      if (! NILP (ignore_case))
	{
Tom Tromey's avatar
Tom Tromey committed
324 325
	  c1 = XFIXNUM (Fupcase (make_fixnum (c1)));
	  c2 = XFIXNUM (Fupcase (make_fixnum (c2)));
326 327 328 329 330 331 332 333 334
	}

      if (c1 == c2)
	continue;

      /* Note that I1 has already been incremented
	 past the character that we are comparing;
	 hence we don't add or subtract 1 here.  */
      if (c1 < c2)
335
	return make_fixnum (- i1 + from1);
336
      else
337
	return make_fixnum (i1 - from1);
338 339
    }

340
  if (i1 < to1)
341
    return make_fixnum (i1 - from1 + 1);
342
  if (i2 < to2)
343
    return make_fixnum (- i1 + from1 - 1);
344 345 346 347

  return Qt;
}

Paul Eggert's avatar
Paul Eggert committed
348
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
349
       doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order.
Gerd Moellmann's avatar
Gerd Moellmann committed
350
Case is significant.
351
Symbols are also allowed; their print names are used instead.  */)
352
  (register Lisp_Object string1, Lisp_Object string2)
Jim Blandy's avatar
Jim Blandy committed
353
{
354 355
  register ptrdiff_t end;
  register ptrdiff_t i1, i1_byte, i2, i2_byte;
Jim Blandy's avatar
Jim Blandy committed
356

357 358 359 360 361 362
  if (SYMBOLP (string1))
    string1 = SYMBOL_NAME (string1);
  if (SYMBOLP (string2))
    string2 = SYMBOL_NAME (string2);
  CHECK_STRING (string1);
  CHECK_STRING (string2);
Jim Blandy's avatar
Jim Blandy committed
363

364 365
  i1 = i1_byte = i2 = i2_byte = 0;

366 367 368
  end = SCHARS (string1);
  if (end > SCHARS (string2))
    end = SCHARS (string2);
Jim Blandy's avatar
Jim Blandy committed
369

370
  while (i1 < end)
Jim Blandy's avatar
Jim Blandy committed
371
    {
372 373 374 375
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

376 377
      FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
      FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
378 379 380

      if (c1 != c2)
	return c1 < c2 ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
381
    }
382
  return i1 < SCHARS (string2) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
383
}
Michael Albinus's avatar
Michael Albinus committed
384

385 386 387 388 389 390 391 392 393
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.
394

395
For example, \"foo2.png\" compares less than \"foo12.png\".
396 397
Case is significant.
Symbols are also allowed; their print names are used instead.  */)
398
  (Lisp_Object string1, Lisp_Object string2)
399 400 401 402 403 404 405
{
  if (SYMBOLP (string1))
    string1 = SYMBOL_NAME (string1);
  if (SYMBOLP (string2))
    string2 = SYMBOL_NAME (string2);
  CHECK_STRING (string1);
  CHECK_STRING (string2);
406 407
  return string_version_cmp (string1, string2) < 0 ? Qt : Qnil;
}
408

409 410 411 412 413
/* Return negative, 0, positive if STRING1 is <, =, > STRING2 as per
   string-version-lessp.  */
int
string_version_cmp (Lisp_Object string1, Lisp_Object string2)
{
414 415 416 417 418
  char *p1 = SSDATA (string1);
  char *p2 = SSDATA (string2);
  char *lim1 = p1 + SBYTES (string1);
  char *lim2 = p2 + SBYTES (string2);
  int cmp;
419

420
  while ((cmp = filevercmp (p1, p2)) == 0)
421
    {
422
      /* If the strings are identical through their first NUL bytes,
423 424
	 skip past identical prefixes and try again.  */
      ptrdiff_t size = strlen (p1) + 1;
425
      eassert (size == strlen (p2) + 1);
426 427
      p1 += size;
      p2 += size;
428 429 430 431 432 433
      bool more1 = p1 <= lim1;
      bool more2 = p2 <= lim2;
      if (!more1)
	return more2;
      if (!more2)
	return -1;
434
    }
435

436
  return cmp;
437 438
}

439
DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
Michael Albinus's avatar
Michael Albinus committed
440
       doc: /* Return t if first arg string is less than second in collation order.
441
Symbols are also allowed; their print names are used instead.
Michael Albinus's avatar
Michael Albinus committed
442 443 444

This function obeys the conventions for collation order in your
locale settings.  For example, punctuation and whitespace characters
445
might be considered less significant for sorting:
Michael Albinus's avatar
Michael Albinus committed
446

447
\(sort \\='("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp)
448
  => ("11" "1 1" "1.1" "12" "1 2" "1.2")
Michael Albinus's avatar
Michael Albinus committed
449

450 451 452
The optional argument LOCALE, a string, overrides the setting of your
current locale identifier for collation.  The value is system
dependent; a LOCALE \"en_US.UTF-8\" is applicable on POSIX systems,
453
while it would be, e.g., \"enu_USA.1252\" on MS-Windows systems.
Michael Albinus's avatar
Michael Albinus committed
454

455 456 457
If IGNORE-CASE is non-nil, characters are converted to lower-case
before comparing them.

458 459 460 461
To emulate Unicode-compliant collation on MS-Windows systems,
bind `w32-collate-ignore-punctuation' to a non-nil value, since
the codeset part of the locale cannot be \"UTF-8\" on MS-Windows.

462 463 464
If your system does not support a locale environment, this function
behaves like `string-lessp'.  */)
  (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
Michael Albinus's avatar
Michael Albinus committed
465
{
466
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
Michael Albinus's avatar
Michael Albinus committed
467 468 469 470 471 472 473
  /* Check parameters.  */
  if (SYMBOLP (s1))
    s1 = SYMBOL_NAME (s1);
  if (SYMBOLP (s2))
    s2 = SYMBOL_NAME (s2);
  CHECK_STRING (s1);
  CHECK_STRING (s2);
474 475
  if (!NILP (locale))
    CHECK_STRING (locale);
Michael Albinus's avatar
Michael Albinus committed
476

477
  return (str_collate (s1, s2, locale, ignore_case) < 0) ? Qt : Qnil;
Michael Albinus's avatar
Michael Albinus committed
478

479
#else  /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
480
  return Fstring_lessp (s1, s2);
481
#endif /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
482 483
}

484
DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 4, 0,
Michael Albinus's avatar
Michael Albinus committed
485
       doc: /* Return t if two strings have identical contents.
486
Symbols are also allowed; their print names are used instead.
Michael Albinus's avatar
Michael Albinus committed
487 488 489

This function obeys the conventions for collation order in your locale
settings.  For example, characters with different coding points but
490 491
the same meaning might be considered as equal, like different grave
accent Unicode characters:
Michael Albinus's avatar
Michael Albinus committed
492

493
\(string-collate-equalp (string ?\\uFF40) (string ?\\u1FEF))
Michael Albinus's avatar
Michael Albinus committed
494 495
  => t

496 497 498
The optional argument LOCALE, a string, overrides the setting of your
current locale identifier for collation.  The value is system
dependent; a LOCALE \"en_US.UTF-8\" is applicable on POSIX systems,
499
while it would be \"enu_USA.1252\" on MS Windows systems.
Michael Albinus's avatar
Michael Albinus committed
500

501 502 503
If IGNORE-CASE is non-nil, characters are converted to lower-case
before comparing them.

504 505 506 507
To emulate Unicode-compliant collation on MS-Windows systems,
bind `w32-collate-ignore-punctuation' to a non-nil value, since
the codeset part of the locale cannot be \"UTF-8\" on MS-Windows.

508
If your system does not support a locale environment, this function
509 510
behaves like `string-equal'.

511
Do NOT use this function to compare file names for equality.  */)
512
  (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
Michael Albinus's avatar
Michael Albinus committed
513
{
514
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
Michael Albinus's avatar
Michael Albinus committed
515 516 517 518 519 520 521
  /* Check parameters.  */
  if (SYMBOLP (s1))
    s1 = SYMBOL_NAME (s1);
  if (SYMBOLP (s2))
    s2 = SYMBOL_NAME (s2);
  CHECK_STRING (s1);
  CHECK_STRING (s2);
522 523
  if (!NILP (locale))
    CHECK_STRING (locale);
Michael Albinus's avatar
Michael Albinus committed
524

525
  return (str_collate (s1, s2, locale, ignore_case) == 0) ? Qt : Qnil;
Michael Albinus's avatar
Michael Albinus committed
526

527
#else  /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
528
  return Fstring_equal (s1, s2);
529
#endif /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
530
}
Jim Blandy's avatar
Jim Blandy committed
531

532
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
533
			   enum Lisp_Type target_type, bool last_special);
Jim Blandy's avatar
Jim Blandy committed
534 535 536

/* ARGSUSED */
Lisp_Object
537
concat2 (Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
538
{
539
  return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0);
Jim Blandy's avatar
Jim Blandy committed
540 541
}

Richard M. Stallman's avatar
Richard M. Stallman committed
542 543
/* ARGSUSED */
Lisp_Object
544
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
Richard M. Stallman's avatar
Richard M. Stallman committed
545
{
546
  return concat (3, ((Lisp_Object []) {s1, s2, s3}), Lisp_String, 0);
Richard M. Stallman's avatar
Richard M. Stallman committed
547 548
}

Paul Eggert's avatar
Paul Eggert committed
549
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
550
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
551 552
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
553 554
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES)  */)
555
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
556 557 558 559
{
  return concat (nargs, args, Lisp_Cons, 1);
}

Paul Eggert's avatar
Paul Eggert committed
560
DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
561
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
562
The result is a string whose elements are the elements of all the arguments.
563 564
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES)  */)
565
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
566 567 568 569
{
  return concat (nargs, args, Lisp_String, 0);
}

Paul Eggert's avatar
Paul Eggert committed
570
DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
571
       doc: /* Concatenate all the arguments and make the result a vector.
Gerd Moellmann's avatar
Gerd Moellmann committed
572
The result is a vector whose elements are the elements of all the arguments.
573 574
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES)   */)
575
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
576
{
577
  return concat (nargs, args, Lisp_Vectorlike, 0);
Jim Blandy's avatar
Jim Blandy committed
578 579
}

580

Paul Eggert's avatar
Paul Eggert committed
581
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
582 583
       doc: /* Return a copy of a list, vector, string, char-table or record.
The elements of a list, vector or record are not copied; they are
584 585 586
shared with the original.
If the original sequence is empty, this function may return
the same empty object instead of its copy.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
587
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
588
{
Jim Blandy's avatar
Jim Blandy committed
589
  if (NILP (arg)) return arg;
590

591 592
  if (RECORDP (arg))
    {
593
      return Frecord (PVSIZE (arg), XVECTOR (arg)->contents);
594 595
    }

596 597
  if (CHAR_TABLE_P (arg))
    {
598
      return copy_char_table (arg);
599 600 601 602
    }

  if (BOOL_VECTOR_P (arg))
    {
603 604 605 606
      EMACS_INT nbits = bool_vector_size (arg);
      ptrdiff_t nbytes = bool_vector_bytes (nbits);
      Lisp_Object val = make_uninit_bool_vector (nbits);
      memcpy (bool_vector_data (val), bool_vector_data (arg), nbytes);
607 608 609
      return val;
    }

610
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
611 612
    wrong_type_argument (Qsequencep, arg);

613
  return concat (1, &arg, XTYPE (arg), 0);
Jim Blandy's avatar
Jim Blandy committed
614 615
}

616 617
/* This structure holds information of an argument of `concat' that is
   a string and has text properties to be copied.  */
Kenichi Handa's avatar
Kenichi Handa committed
618
struct textprop_rec
619
{
620
  ptrdiff_t argnum;		/* refer to ARGS (arguments of `concat') */
621 622
  ptrdiff_t from;		/* refer to ARGS[argnum] (argument string) */
  ptrdiff_t to;			/* refer to VAL (the target string) */
623 624
};

Jim Blandy's avatar
Jim Blandy committed
625
static Lisp_Object
626
concat (ptrdiff_t nargs, Lisp_Object *args,
627
	enum Lisp_Type target_type, bool last_special)
Jim Blandy's avatar
Jim Blandy committed
628 629
{
  Lisp_Object val;
630 631
  Lisp_Object tail;
  Lisp_Object this;
632 633
  ptrdiff_t toindex;
  ptrdiff_t toindex_byte = 0;
634 635
  EMACS_INT result_len;
  EMACS_INT result_len_byte;
636
  ptrdiff_t argnum;
Jim Blandy's avatar
Jim Blandy committed
637 638
  Lisp_Object last_tail;
  Lisp_Object prev;
639
  bool some_multibyte;
640
  /* When we make a multibyte string, we can't copy text properties
Paul Eggert's avatar
Paul Eggert committed
641 642
     while concatenating each string because the length of resulting
     string can't be decided until we finish the whole concatenation.
643
     So, we record strings that have text properties to be copied
Paul Eggert's avatar
Paul Eggert committed
644
     here, and copy the text properties after the concatenation.  */
645
  struct textprop_rec  *textprops = NULL;
Juanma Barranquero's avatar
Juanma Barranquero committed
646
  /* Number of elements in textprops.  */
647
  ptrdiff_t num_textprops = 0;
Kim F. Storm's avatar
Kim F. Storm committed
648
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
649

650 651
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
652 653 654 655 656 657 658 659 660
  /* In append, the last arg isn't treated like the others */
  if (last_special && nargs > 0)
    {
      nargs--;
      last_tail = args[nargs];
    }
  else
    last_tail = Qnil;

661
  /* Check each argument.  */
Jim Blandy's avatar
Jim Blandy committed
662 663 664
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
665
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
Stefan Monnier's avatar
Stefan Monnier committed
666
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
667
	wrong_type_argument (Qsequencep, this);
Jim Blandy's avatar
Jim Blandy committed
668 669
    }

670 671 672 673 674 675 676 677
  /* Compute total length in chars of arguments in RESULT_LEN.
     If desired output is a string, also compute length in bytes
     in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE
     whether the result should be a multibyte string.  */
  result_len_byte = 0;
  result_len = 0;
  some_multibyte = 0;
  for (argnum = 0; argnum < nargs; argnum++)
Jim Blandy's avatar
Jim Blandy committed
678
    {
679
      EMACS_INT len;
Jim Blandy's avatar
Jim Blandy committed
680
      this = args[argnum];
Tom Tromey's avatar
Tom Tromey committed
681
      len = XFIXNAT (Flength (this));
682
      if (target_type == Lisp_String)
683
	{
684 685
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
686
	  ptrdiff_t i;
687
	  Lisp_Object ch;
688
	  int c;
689
	  ptrdiff_t this_len_byte;
690

Stefan Monnier's avatar
Stefan Monnier committed
691
	  if (VECTORP (this) || COMPILEDP (this))
692
	    for (i = 0; i < len; i++)
693
	      {
Stefan Monnier's avatar
Stefan Monnier committed
694
		ch = AREF (this, i);
Miles Bader's avatar
Miles Bader committed
695
		CHECK_CHARACTER (ch);
Tom Tromey's avatar
Tom Tromey committed
696
		c = XFIXNAT (ch);
697
		this_len_byte = CHAR_BYTES (c);
698 699
		if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		  string_overflow ();
700
		result_len_byte += this_len_byte;
701
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
702
		  some_multibyte = 1;
703
	      }
704
	  else if (BOOL_VECTOR_P (this) && bool_vector_size (this) > 0)
705
	    wrong_type_argument (Qintegerp, Faref (this, make_fixnum (0)));
706
	  else if (CONSP (this))
707
	    for (; CONSP (this); this = XCDR (this))
708
	      {
709
		ch = XCAR (this);
Miles Bader's avatar
Miles Bader committed
710
		CHECK_CHARACTER (ch);
Tom Tromey's avatar
Tom Tromey committed
711
		c = XFIXNAT (ch);
712
		this_len_byte = CHAR_BYTES (c);
713 714
		if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		  string_overflow ();
715
		result_len_byte += this_len_byte;
716
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
717
		  some_multibyte = 1;
718
	      }
719
	  else if (STRINGP (this))
720
	    {
721
	      if (STRING_MULTIBYTE (this))
722 723
		{
		  some_multibyte = 1;
724
		  this_len_byte = SBYTES (this);
725 726
		}
	      else
727 728 729 730 731
		this_len_byte = count_size_as_multibyte (SDATA (this),
							 SCHARS (this));
	      if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		string_overflow ();
	      result_len_byte += this_len_byte;
732
	    }
733
	}
734 735

      result_len += len;
736 737
      if (MOST_POSITIVE_FIXNUM < result_len)
	memory_full (SIZE_MAX);
Jim Blandy's avatar
Jim Blandy committed
738 739
    }

740 741
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
742

743
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
744
  if (target_type == Lisp_Cons)
745
    val = Fmake_list (make_fixnum (result_len), Qnil);
746
  else if (target_type == Lisp_Vectorlike)
747
    val = make_nil_vector (result_len);
748
  else if (some_multibyte)
749
    val = make_uninit_multibyte_string (result_len, result_len_byte);
750 751
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
752

753
  /* In `append', if all but last arg are nil, return last arg.  */
Paul Eggert's avatar
Paul Eggert committed
754
  if (target_type == Lisp_Cons && NILP (val))
755
    return last_tail;
Jim Blandy's avatar
Jim Blandy committed
756

757
  /* Copy the contents of the args into the result.  */
Jim Blandy's avatar
Jim Blandy committed
758
  if (CONSP (val))
759
    tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
Jim Blandy's avatar
Jim Blandy committed
760
  else
761
    toindex = 0, toindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
762 763

  prev = Qnil;
764
  if (STRINGP (val))
765
    SAFE_NALLOCA (textprops, 1, nargs);
Jim Blandy's avatar
Jim Blandy committed
766 767 768 769

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
770 771 772
      ptrdiff_t thisleni = 0;
      register ptrdiff_t thisindex = 0;
      register ptrdiff_t thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
773 774 775

      this = args[argnum];
      if (!CONSP (this))
Tom Tromey's avatar
Tom Tromey committed
776
	thislen = Flength (this), thisleni = XFIXNUM (thislen);
Jim Blandy's avatar
Jim Blandy committed
777

778 779 780
      /* Between strings of the same kind, copy fast.  */
      if (STRINGP (this) && STRINGP (val)
	  && STRING_MULTIBYTE (this) == some_multibyte)
Jim Blandy's avatar
Jim Blandy committed
781
	{
782
	  ptrdiff_t thislen_byte = SBYTES (this);
783

784
	  memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
785
	  if (string_intervals (this))
786
	    {
Kenichi Handa's avatar
Kenichi Handa committed
787
	      textprops[num_textprops].argnum = argnum;
788
	      textprops[num_textprops].from = 0;
Kenichi Handa's avatar
Kenichi Handa committed
789
	      textprops[num_textprops++].to = toindex;
790
	    }
791
	  toindex_byte += thislen_byte;
792
	  toindex += thisleni;
793
	}
794 795 796
      /* Copy a single-byte string to a multibyte string.  */
      else if (STRINGP (this) && STRINGP (val))
	{
797
	  if (string_intervals (this))
798
	    {
Kenichi Handa's avatar
Kenichi Handa committed
799 800 801
	      textprops[num_textprops].argnum = argnum;
	      textprops[num_textprops].from = 0;
	      textprops[num_textprops++].to = toindex;
802
	    }
803 804 805
	  toindex_byte += copy_text (SDATA (this),
				     SDATA (val) + toindex_byte,
				     SCHARS (this), 0, 1);
806 807
	  toindex += thisleni;
	}
808 809 810 811 812 813 814 815 816 817
      else
	/* Copy element by element.  */
	while (1)
	  {
	    register Lisp_Object elt;

	    /* Fetch next element of `this' arg into `elt', or break if
	       `this' is exhausted. */
	    if (NILP (this)) break;
	    if (CONSP (this))
818
	      elt = XCAR (this), this = XCDR (this);
819 820 821
	    else if (thisindex >= thisleni)
	      break;
	    else if (STRINGP (this))
822
	      {
823
		int c;
824
		if (STRING_MULTIBYTE (this))
825 826 827
		  FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
						      thisindex,
						      thisindex_byte);
828
		else
829
		  {
830 831 832
		    c = SREF (this, thisindex); thisindex++;
		    if (some_multibyte && !ASCII_CHAR_P (c))
		      c = BYTE8_TO_CHAR (c);
833
		  }
834
		XSETFASTINT (elt, c);
835 836 837
	      }
	    else if (BOOL_VECTOR_P (this))
	      {
838
		elt = bool_vector_ref (this, thisindex);
839
		thisindex++;
840
	      }
841
	    else
842 843 844 845
	      {
		elt = AREF (this, thisindex);
		thisindex++;
	      }
Jim Blandy's avatar
Jim Blandy committed
846

847 848
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
849
	      {
850
		XSETCAR (tail, elt);
851
		prev = tail;
852
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
853
	      }
854
	    else if (VECTORP (val))
855 856 857 858
	      {
		ASET (val, toindex, elt);
		toindex++;
	      }
859 860
	    else
	      {
861 862
		int c;
		CHECK_CHARACTER (elt);
Tom Tromey's avatar
Tom Tromey committed
863
		c = XFIXNAT (elt);
864
		if (some_multibyte)
865
		  toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
866
		else
867
		  SSET (val, toindex_byte++, c);
868
		toindex++;
869