fns.c 157 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 406
{
  if (SYMBOLP (string1))
    string1 = SYMBOL_NAME (string1);
  if (SYMBOLP (string2))
    string2 = SYMBOL_NAME (string2);
  CHECK_STRING (string1);
  CHECK_STRING (string2);

407 408 409 410 411
  char *p1 = SSDATA (string1);
  char *p2 = SSDATA (string2);
  char *lim1 = p1 + SBYTES (string1);
  char *lim2 = p2 + SBYTES (string2);
  int cmp;
412

413
  while ((cmp = filevercmp (p1, p2)) == 0)
414
    {
415
      /* If the strings are identical through their first NUL bytes,
416 417 418 419 420 421 422 423
	 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;
424
    }
425 426

  return cmp < 0 ? Qt : Qnil;
427 428
}

429
DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
Michael Albinus's avatar
Michael Albinus committed
430
       doc: /* Return t if first arg string is less than second in collation order.
431
Symbols are also allowed; their print names are used instead.
Michael Albinus's avatar
Michael Albinus committed
432 433 434

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

437
\(sort \\='("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp)
438
  => ("11" "1 1" "1.1" "12" "1 2" "1.2")
Michael Albinus's avatar
Michael Albinus committed
439

440 441 442
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,
443
while it would be, e.g., \"enu_USA.1252\" on MS-Windows systems.
Michael Albinus's avatar
Michael Albinus committed
444

445 446 447
If IGNORE-CASE is non-nil, characters are converted to lower-case
before comparing them.

448 449 450 451
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.

452 453 454
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
455
{
456
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
Michael Albinus's avatar
Michael Albinus committed
457 458 459 460 461 462 463
  /* Check parameters.  */
  if (SYMBOLP (s1))
    s1 = SYMBOL_NAME (s1);
  if (SYMBOLP (s2))
    s2 = SYMBOL_NAME (s2);
  CHECK_STRING (s1);
  CHECK_STRING (s2);
464 465
  if (!NILP (locale))
    CHECK_STRING (locale);
Michael Albinus's avatar
Michael Albinus committed
466

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

469
#else  /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
470
  return Fstring_lessp (s1, s2);
471
#endif /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
472 473
}

474
DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 4, 0,
Michael Albinus's avatar
Michael Albinus committed
475
       doc: /* Return t if two strings have identical contents.
476
Symbols are also allowed; their print names are used instead.
Michael Albinus's avatar
Michael Albinus committed
477 478 479

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

483
\(string-collate-equalp (string ?\\uFF40) (string ?\\u1FEF))
Michael Albinus's avatar
Michael Albinus committed
484 485
  => t

486 487 488
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,
489
while it would be \"enu_USA.1252\" on MS Windows systems.
Michael Albinus's avatar
Michael Albinus committed
490

491 492 493
If IGNORE-CASE is non-nil, characters are converted to lower-case
before comparing them.

494 495 496 497
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.

498
If your system does not support a locale environment, this function
499 500
behaves like `string-equal'.

501
Do NOT use this function to compare file names for equality.  */)
502
  (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
Michael Albinus's avatar
Michael Albinus committed
503
{
504
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
Michael Albinus's avatar
Michael Albinus committed
505 506 507 508 509 510 511
  /* Check parameters.  */
  if (SYMBOLP (s1))
    s1 = SYMBOL_NAME (s1);
  if (SYMBOLP (s2))
    s2 = SYMBOL_NAME (s2);
  CHECK_STRING (s1);
  CHECK_STRING (s2);
512 513
  if (!NILP (locale))
    CHECK_STRING (locale);
Michael Albinus's avatar
Michael Albinus committed
514

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

517
#else  /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
518
  return Fstring_equal (s1, s2);
519
#endif /* !__STDC_ISO_10646__, !WINDOWSNT */
Michael Albinus's avatar
Michael Albinus committed
520
}
Jim Blandy's avatar
Jim Blandy committed
521

522
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
523
			   enum Lisp_Type target_type, bool last_special);
Jim Blandy's avatar
Jim Blandy committed
524 525 526

/* ARGSUSED */
Lisp_Object
527
concat2 (Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
528
{
529
  return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0);
Jim Blandy's avatar
Jim Blandy committed
530 531
}

Richard M. Stallman's avatar
Richard M. Stallman committed
532 533
/* ARGSUSED */
Lisp_Object
534
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
Richard M. Stallman's avatar
Richard M. Stallman committed
535
{
536
  return concat (3, ((Lisp_Object []) {s1, s2, s3}), Lisp_String, 0);
Richard M. Stallman's avatar
Richard M. Stallman committed
537 538
}

Paul Eggert's avatar
Paul Eggert committed
539
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
540
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
541 542
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
543 544
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES)  */)
545
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
546 547 548 549
{
  return concat (nargs, args, Lisp_Cons, 1);
}

Paul Eggert's avatar
Paul Eggert committed
550
DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
551
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
552
The result is a string whose elements are the elements of all the arguments.
553 554
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &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_String, 0);
}

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

570

Paul Eggert's avatar
Paul Eggert committed
571
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
572 573
       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
574 575 576
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
577
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
578
{
Jim Blandy's avatar
Jim Blandy committed
579
  if (NILP (arg)) return arg;
580

581 582
  if (RECORDP (arg))
    {
583
      return Frecord (PVSIZE (arg), XVECTOR (arg)->contents);
584 585
    }

586 587
  if (CHAR_TABLE_P (arg))
    {
588
      return copy_char_table (arg);
589 590 591 592
    }

  if (BOOL_VECTOR_P (arg))
    {
593 594 595 596
      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);
597 598 599
      return val;
    }

600
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
601 602
    wrong_type_argument (Qsequencep, arg);

603
  return concat (1, &arg, XTYPE (arg), 0);
Jim Blandy's avatar
Jim Blandy committed
604 605
}

606 607
/* 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
608
struct textprop_rec
609
{
610
  ptrdiff_t argnum;		/* refer to ARGS (arguments of `concat') */
611 612
  ptrdiff_t from;		/* refer to ARGS[argnum] (argument string) */
  ptrdiff_t to;			/* refer to VAL (the target string) */
613 614
};

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

640 641
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
642 643 644 645 646 647 648 649 650
  /* 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;

651
  /* Check each argument.  */
Jim Blandy's avatar
Jim Blandy committed
652 653 654
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
655
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
Stefan Monnier's avatar
Stefan Monnier committed
656
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
657
	wrong_type_argument (Qsequencep, this);
Jim Blandy's avatar
Jim Blandy committed
658 659
    }

660 661 662 663 664 665 666 667
  /* 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
668
    {
669
      EMACS_INT len;
Jim Blandy's avatar
Jim Blandy committed
670
      this = args[argnum];
Tom Tromey's avatar
Tom Tromey committed
671
      len = XFIXNAT (Flength (this));
672
      if (target_type == Lisp_String)
673
	{
674 675
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
676
	  ptrdiff_t i;
677
	  Lisp_Object ch;
678
	  int c;
679
	  ptrdiff_t this_len_byte;
680

Stefan Monnier's avatar
Stefan Monnier committed
681
	  if (VECTORP (this) || COMPILEDP (this))
682
	    for (i = 0; i < len; i++)
683
	      {
Stefan Monnier's avatar
Stefan Monnier committed
684
		ch = AREF (this, i);
Miles Bader's avatar
Miles Bader committed
685
		CHECK_CHARACTER (ch);
Tom Tromey's avatar
Tom Tromey committed
686
		c = XFIXNAT (ch);
687
		this_len_byte = CHAR_BYTES (c);
688 689
		if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		  string_overflow ();
690
		result_len_byte += this_len_byte;
691
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
692
		  some_multibyte = 1;
693
	      }
694
	  else if (BOOL_VECTOR_P (this) && bool_vector_size (this) > 0)
695
	    wrong_type_argument (Qintegerp, Faref (this, make_fixnum (0)));
696
	  else if (CONSP (this))
697
	    for (; CONSP (this); this = XCDR (this))
698
	      {
699
		ch = XCAR (this);
Miles Bader's avatar
Miles Bader committed
700
		CHECK_CHARACTER (ch);
Tom Tromey's avatar
Tom Tromey committed
701
		c = XFIXNAT (ch);
702
		this_len_byte = CHAR_BYTES (c);
703 704
		if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		  string_overflow ();
705
		result_len_byte += this_len_byte;
706
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
707
		  some_multibyte = 1;
708
	      }
709
	  else if (STRINGP (this))
710
	    {
711
	      if (STRING_MULTIBYTE (this))
712 713
		{
		  some_multibyte = 1;
714
		  this_len_byte = SBYTES (this);
715 716
		}
	      else
717 718 719 720 721
		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;
722
	    }
723
	}
724 725

      result_len += len;
726 727
      if (MOST_POSITIVE_FIXNUM < result_len)
	memory_full (SIZE_MAX);
Jim Blandy's avatar
Jim Blandy committed
728 729
    }

730 731
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
732

733
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
734
  if (target_type == Lisp_Cons)
735
    val = Fmake_list (make_fixnum (result_len), Qnil);
736
  else if (target_type == Lisp_Vectorlike)
737
    val = make_nil_vector (result_len);
738
  else if (some_multibyte)
739
    val = make_uninit_multibyte_string (result_len, result_len_byte);
740 741
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
742

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

747
  /* Copy the contents of the args into the result.  */
Jim Blandy's avatar
Jim Blandy committed
748
  if (CONSP (val))
749
    tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
Jim Blandy's avatar
Jim Blandy committed
750
  else
751
    toindex = 0, toindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
752 753

  prev = Qnil;
754
  if (STRINGP (val))
755
    SAFE_NALLOCA (textprops, 1, nargs);
Jim Blandy's avatar
Jim Blandy committed
756 757 758 759

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
760 761 762
      ptrdiff_t thisleni = 0;
      register ptrdiff_t thisindex = 0;
      register ptrdiff_t thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
763 764 765

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

768 769 770
      /* 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
771
	{
772
	  ptrdiff_t thislen_byte = SBYTES (this);
773

774
	  memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
775
	  if (string_intervals (this))
776
	    {
Kenichi Handa's avatar
Kenichi Handa committed
777
	      textprops[num_textprops].argnum = argnum;
778
	      textprops[num_textprops].from = 0;
Kenichi Handa's avatar
Kenichi Handa committed
779
	      textprops[num_textprops++].to = toindex;
780
	    }
781
	  toindex_byte += thislen_byte;
782
	  toindex += thisleni;
783
	}
784 785 786
      /* Copy a single-byte string to a multibyte string.  */
      else if (STRINGP (this) && STRINGP (val))
	{
787
	  if (string_intervals (this))
788
	    {
Kenichi Handa's avatar
Kenichi Handa committed
789 790 791
	      textprops[num_textprops].argnum = argnum;
	      textprops[num_textprops].from = 0;
	      textprops[num_textprops++].to = toindex;
792
	    }
793 794 795
	  toindex_byte += copy_text (SDATA (this),
				     SDATA (val) + toindex_byte,
				     SCHARS (this), 0, 1);
796 797
	  toindex += thisleni;
	}
798 799 800 801 802 803 804 805 806 807
      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))
808
	      elt = XCAR (this), this = XCDR (this);
809 810 811
	    else if (thisindex >= thisleni)
	      break;
	    else if (STRINGP (this))
812
	      {
813
		int c;
814
		if (STRING_MULTIBYTE (this))
815 816 817
		  FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
						      thisindex,
						      thisindex_byte);
818
		else
819
		  {
820 821 822
		    c = SREF (this, thisindex); thisindex++;
		    if (some_multibyte && !ASCII_CHAR_P (c))
		      c = BYTE8_TO_CHAR (c);
823
		  }
824
		XSETFASTINT (elt, c);
825 826 827
	      }
	    else if (BOOL_VECTOR_P (this))
	      {
828
		elt = bool_vector_ref (this, thisindex);
829
		thisindex++;
830
	      }
831
	    else
832 833 834 835
	      {
		elt = AREF (this, thisindex);
		thisindex++;
	      }
Jim Blandy's avatar
Jim Blandy committed
836

837 838
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
839
	      {
840
		XSETCAR (tail, elt);
841
		prev = tail;
842
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
843
	      }
Richard M. Stallman's avatar