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

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

This file is part of GNU Emacs.

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

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
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19

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

Andreas Schwab's avatar
Andreas Schwab committed
22
#include <unistd.h>
Andreas Schwab's avatar
Andreas Schwab committed
23
#include <time.h>
Andreas Schwab's avatar
Andreas Schwab committed
24

25 26
#include <intprops.h>

Jim Blandy's avatar
Jim Blandy committed
27 28
#include "lisp.h"
#include "commands.h"
29
#include "character.h"
30
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
31
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
32
#include "keyboard.h"
Stefan Monnier's avatar
Stefan Monnier committed
33
#include "keymap.h"
34
#include "intervals.h"
35 36
#include "frame.h"
#include "window.h"
Gerd Moellmann's avatar
Gerd Moellmann committed
37
#include "blockinput.h"
38 39
#ifdef HAVE_MENUS
#if defined (HAVE_X_WINDOWS)
Andreas Schwab's avatar
Andreas Schwab committed
40 41
#include "xterm.h"
#endif
42
#endif /* HAVE_MENUS */
Jim Blandy's avatar
Jim Blandy committed
43

44 45 46
Lisp_Object Qstring_lessp;
static Lisp_Object Qprovide, Qrequire;
static Lisp_Object Qyes_or_no_p_history;
47
Lisp_Object Qcursor_in_echo_area;
48 49
static Lisp_Object Qwidget_type;
static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
Jim Blandy's avatar
Jim Blandy committed
50

51 52
static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;

53
static bool internal_equal (Lisp_Object, Lisp_Object, int, bool);
54

Paul Eggert's avatar
Paul Eggert committed
55
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
Pavel Janík's avatar
Pavel Janík committed
56
       doc: /* Return the argument unchanged.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
57
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
58 59 60 61 62
{
  return arg;
}

DEFUN ("random", Frandom, Srandom, 0, 1, 0,
63
       doc: /* Return a pseudo-random number.
64 65 66
All integers representable in Lisp, i.e. between `most-negative-fixnum'
and `most-positive-fixnum', inclusive, are equally likely.

67 68
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.
Glenn Morris's avatar
Glenn Morris committed
69 70 71 72
With a string argument, set the seed based on the string's contents.
Other values of LIMIT are ignored.

See Info node `(elisp)Random Numbers' for more details.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
73
  (Lisp_Object limit)
Jim Blandy's avatar
Jim Blandy committed
74
{
75
  EMACS_INT val;
Jim Blandy's avatar
Jim Blandy committed
76

77
  if (EQ (limit, Qt))
78 79 80
    init_random ();
  else if (STRINGP (limit))
    seed_random (SSDATA (limit), SBYTES (limit));
81

82
  val = get_random ();
83
  if (NATNUMP (limit) && XFASTINT (limit) != 0)
84 85
    val %= XFASTINT (limit);
  return make_number (val);
Jim Blandy's avatar
Jim Blandy committed
86 87
}

88 89 90 91
/* Heuristic on how many iterations of a tight loop can be safely done
   before it's time to do a QUIT.  This must be a power of 2.  */
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };

92
/* Random data-structure functions.  */
Jim Blandy's avatar
Jim Blandy committed
93

Paul Eggert's avatar
Paul Eggert committed
94
DEFUN ("length", Flength, Slength, 1, 1, 0,
95
       doc: /* Return the length of vector, list or string SEQUENCE.
Gerd Moellmann's avatar
Gerd Moellmann committed
96
A byte-code function object is also allowed.
John Paul Wallington's avatar
John Paul Wallington committed
97
If the string contains multibyte characters, this is not necessarily
Gerd Moellmann's avatar
Gerd Moellmann committed
98
the number of bytes in the string; it is the number of characters.
99
To get the number of bytes, use `string-bytes'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
100
  (register Lisp_Object sequence)
Jim Blandy's avatar
Jim Blandy committed
101
{
102
  register Lisp_Object val;
Jim Blandy's avatar
Jim Blandy committed
103

104
  if (STRINGP (sequence))
105
    XSETFASTINT (val, SCHARS (sequence));
106
  else if (VECTORP (sequence))
Stefan Monnier's avatar
Stefan Monnier committed
107
    XSETFASTINT (val, ASIZE (sequence));
108
  else if (CHAR_TABLE_P (sequence))
109
    XSETFASTINT (val, MAX_CHAR);
110 111
  else if (BOOL_VECTOR_P (sequence))
    XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
Stefan Monnier's avatar
Stefan Monnier committed
112 113
  else if (COMPILEDP (sequence))
    XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
114
  else if (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
115
    {
116 117 118
      EMACS_INT i = 0;

      do
Jim Blandy's avatar
Jim Blandy committed
119
	{
120
	  ++i;
121
	  if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
122 123 124 125 126
	    {
	      if (MOST_POSITIVE_FIXNUM < i)
		error ("List too long");
	      QUIT;
	    }
127
	  sequence = XCDR (sequence);
Jim Blandy's avatar
Jim Blandy committed
128
	}
129
      while (CONSP (sequence));
Jim Blandy's avatar
Jim Blandy committed
130

131
      CHECK_LIST_END (sequence, sequence);
132 133

      val = make_number (i);
Jim Blandy's avatar
Jim Blandy committed
134
    }
135
  else if (NILP (sequence))
136
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
137
  else
138
    wrong_type_argument (Qsequencep, sequence);
139

140
  return val;
Jim Blandy's avatar
Jim Blandy committed
141 142
}

143
/* This does not check for quits.  That is safe since it must terminate.  */
144 145

DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
146
       doc: /* Return the length of a list, but avoid error or infinite loop.
Gerd Moellmann's avatar
Gerd Moellmann committed
147 148
This function never gets an error.  If LIST is not really a list,
it returns 0.  If LIST is circular, it returns a finite value
149
which is at least the number of distinct elements.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
150
  (Lisp_Object list)
151
{
152 153 154 155 156
  Lisp_Object tail, halftail;
  double hilen = 0;
  uintmax_t lolen = 1;

  if (! CONSP (list))
157
    return make_number (0);
158 159

  /* halftail is used to detect circular lists.  */
160
  for (tail = halftail = list; ; )
161
    {
162 163
      tail = XCDR (tail);
      if (! CONSP (tail))
164
	break;
165 166 167 168 169 170 171 172 173 174 175 176 177
      if (EQ (tail, halftail))
	break;
      lolen++;
      if ((lolen & 1) == 0)
	{
	  halftail = XCDR (halftail);
	  if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
	    {
	      QUIT;
	      if (lolen == 0)
		hilen += UINTMAX_MAX + 1.0;
	    }
	}
178 179
    }

180 181 182 183
  /* If the length does not fit into a fixnum, return a float.
     On all known practical machines this returns an upper bound on
     the true length.  */
  return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
184 185
}

186
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
187
       doc: /* Return the number of bytes in STRING.
Miles Bader's avatar
Miles Bader committed
188
If STRING is multibyte, this may be greater than the length of STRING.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
189
  (Lisp_Object string)
190
{
191
  CHECK_STRING (string);
192
  return make_number (SBYTES (string));
193 194
}

Paul Eggert's avatar
Paul Eggert committed
195
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
196
       doc: /* Return t if two strings have identical contents.
Gerd Moellmann's avatar
Gerd Moellmann committed
197
Case is significant, but text properties are ignored.
198
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
199
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
200
{
201
  if (SYMBOLP (s1))
202
    s1 = SYMBOL_NAME (s1);
203
  if (SYMBOLP (s2))
204
    s2 = SYMBOL_NAME (s2);
205 206
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
207

208 209
  if (SCHARS (s1) != SCHARS (s2)
      || SBYTES (s1) != SBYTES (s2)
210
      || memcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
Jim Blandy's avatar
Jim Blandy committed
211 212 213 214
    return Qnil;
  return Qt;
}

Paul Eggert's avatar
Paul Eggert committed
215
DEFUN ("compare-strings", Fcompare_strings, Scompare_strings, 6, 7, 0,
Juanma Barranquero's avatar
Juanma Barranquero committed
216
       doc: /* Compare the contents of two strings, converting to multibyte if needed.
217 218 219 220 221 222 223 224 225 226 227 228
The arguments START1, END1, START2, and END2, if non-nil, are
positions specifying which parts of STR1 or STR2 to compare.  In
string STR1, compare the part between START1 (inclusive) and END1
\(exclusive).  If START1 is nil, it defaults to 0, the beginning of
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.

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,
characters are converted to lower-case before comparing them.  Unibyte
strings are converted to multibyte for comparison.
Gerd Moellmann's avatar
Gerd Moellmann committed
229 230 231 232 233

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;
234
  N - 1 is the number of characters that match at the beginning.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
235
  (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
236
{
237 238
  register ptrdiff_t end1_char, end2_char;
  register ptrdiff_t i1, i1_byte, i2, i2_byte;
239

240 241
  CHECK_STRING (str1);
  CHECK_STRING (str2);
242 243 244 245
  if (NILP (start1))
    start1 = make_number (0);
  if (NILP (start2))
    start2 = make_number (0);
246 247
  CHECK_NATNUM (start1);
  CHECK_NATNUM (start2);
248
  if (! NILP (end1))
249
    CHECK_NATNUM (end1);
250
  if (! NILP (end2))
251
    CHECK_NATNUM (end2);
252

253
  end1_char = SCHARS (str1);
254 255
  if (! NILP (end1) && end1_char > XINT (end1))
    end1_char = XINT (end1);
256 257
  if (end1_char < XINT (start1))
    args_out_of_range (str1, start1);
258

259
  end2_char = SCHARS (str2);
260 261
  if (! NILP (end2) && end2_char > XINT (end2))
    end2_char = XINT (end2);
262 263 264 265 266 267 268 269
  if (end2_char < XINT (start2))
    args_out_of_range (str2, start2);

  i1 = XINT (start1);
  i2 = XINT (start2);

  i1_byte = string_char_to_byte (str1, i1);
  i2_byte = string_char_to_byte (str2, i2);
270 271 272 273 274 275 276 277

  while (i1 < end1_char && i2 < end2_char)
    {
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

      if (STRING_MULTIBYTE (str1))
278
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
279 280
      else
	{
281
	  c1 = SREF (str1, i1++);
282
	  MAKE_CHAR_MULTIBYTE (c1);
283 284 285
	}

      if (STRING_MULTIBYTE (str2))
286
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
287 288
      else
	{
289
	  c2 = SREF (str2, i2++);
290
	  MAKE_CHAR_MULTIBYTE (c2);
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
	}

      if (c1 == c2)
	continue;

      if (! NILP (ignore_case))
	{
	  Lisp_Object tem;

	  tem = Fupcase (make_number (c1));
	  c1 = XINT (tem);
	  tem = Fupcase (make_number (c2));
	  c2 = XINT (tem);
	}

      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)
313
	return make_number (- i1 + XINT (start1));
314
      else
315
	return make_number (i1 - XINT (start1));
316 317 318 319 320 321 322 323 324 325
    }

  if (i1 < end1_char)
    return make_number (i1 - XINT (start1) + 1);
  if (i2 < end2_char)
    return make_number (- i1 + XINT (start1) - 1);

  return Qt;
}

Paul Eggert's avatar
Paul Eggert committed
326
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
327
       doc: /* Return t if first arg string is less than second in lexicographic order.
Gerd Moellmann's avatar
Gerd Moellmann committed
328
Case is significant.
329
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
330
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
331
{
332 333
  register ptrdiff_t end;
  register ptrdiff_t i1, i1_byte, i2, i2_byte;
Jim Blandy's avatar
Jim Blandy committed
334

335
  if (SYMBOLP (s1))
336
    s1 = SYMBOL_NAME (s1);
337
  if (SYMBOLP (s2))
338
    s2 = SYMBOL_NAME (s2);
339 340
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
341

342 343
  i1 = i1_byte = i2 = i2_byte = 0;

344 345 346
  end = SCHARS (s1);
  if (end > SCHARS (s2))
    end = SCHARS (s2);
Jim Blandy's avatar
Jim Blandy committed
347

348
  while (i1 < end)
Jim Blandy's avatar
Jim Blandy committed
349
    {
350 351 352 353
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

354 355
      FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
      FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
356 357 358

      if (c1 != c2)
	return c1 < c2 ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
359
    }
360
  return i1 < SCHARS (s2) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
361 362
}

363
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
364
			   enum Lisp_Type target_type, bool last_special);
Jim Blandy's avatar
Jim Blandy committed
365 366 367

/* ARGSUSED */
Lisp_Object
368
concat2 (Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
369 370 371 372 373 374 375
{
  Lisp_Object args[2];
  args[0] = s1;
  args[1] = s2;
  return concat (2, args, Lisp_String, 0);
}

Richard M. Stallman's avatar
Richard M. Stallman committed
376 377
/* ARGSUSED */
Lisp_Object
378
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
Richard M. Stallman's avatar
Richard M. Stallman committed
379 380 381 382 383 384 385 386
{
  Lisp_Object args[3];
  args[0] = s1;
  args[1] = s2;
  args[2] = s3;
  return concat (3, args, Lisp_String, 0);
}

Paul Eggert's avatar
Paul Eggert committed
387
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
388
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
389 390
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
391 392
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES)  */)
393
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
394 395 396 397
{
  return concat (nargs, args, Lisp_Cons, 1);
}

Paul Eggert's avatar
Paul Eggert committed
398
DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
399
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
400
The result is a string whose elements are the elements of all the arguments.
401 402
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES)  */)
403
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
404 405 406 407
{
  return concat (nargs, args, Lisp_String, 0);
}

Paul Eggert's avatar
Paul Eggert committed
408
DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
409
       doc: /* Concatenate all the arguments and make the result a vector.
Gerd Moellmann's avatar
Gerd Moellmann committed
410
The result is a vector whose elements are the elements of all the arguments.
411 412
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES)   */)
413
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
414
{
415
  return concat (nargs, args, Lisp_Vectorlike, 0);
Jim Blandy's avatar
Jim Blandy committed
416 417
}

418

Paul Eggert's avatar
Paul Eggert committed
419
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
Dave Love's avatar
Dave Love committed
420
       doc: /* Return a copy of a list, vector, string or char-table.
Gerd Moellmann's avatar
Gerd Moellmann committed
421
The elements of a list or vector are not copied; they are shared
422
with the original.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
423
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
424
{
Jim Blandy's avatar
Jim Blandy committed
425
  if (NILP (arg)) return arg;
426 427 428

  if (CHAR_TABLE_P (arg))
    {
429
      return copy_char_table (arg);
430 431 432 433 434
    }

  if (BOOL_VECTOR_P (arg))
    {
      Lisp_Object val;
435
      ptrdiff_t size_in_chars
436 437
	= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
	   / BOOL_VECTOR_BITS_PER_CHAR);
438 439

      val = Fmake_bool_vector (Flength (arg), Qnil);
440 441
      memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data,
	      size_in_chars);
442 443 444
      return val;
    }

445
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
446 447
    wrong_type_argument (Qsequencep, arg);

Jim Blandy's avatar
Jim Blandy committed
448 449 450
  return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}

451 452
/* 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
453
struct textprop_rec
454
{
455
  ptrdiff_t argnum;		/* refer to ARGS (arguments of `concat') */
456 457
  ptrdiff_t from;		/* refer to ARGS[argnum] (argument string) */
  ptrdiff_t to;			/* refer to VAL (the target string) */
458 459
};

Jim Blandy's avatar
Jim Blandy committed
460
static Lisp_Object
461
concat (ptrdiff_t nargs, Lisp_Object *args,
462
	enum Lisp_Type target_type, bool last_special)
Jim Blandy's avatar
Jim Blandy committed
463 464
{
  Lisp_Object val;
465 466
  Lisp_Object tail;
  Lisp_Object this;
467 468
  ptrdiff_t toindex;
  ptrdiff_t toindex_byte = 0;
469 470
  EMACS_INT result_len;
  EMACS_INT result_len_byte;
471
  ptrdiff_t argnum;
Jim Blandy's avatar
Jim Blandy committed
472 473
  Lisp_Object last_tail;
  Lisp_Object prev;
474
  bool some_multibyte;
475
  /* When we make a multibyte string, we can't copy text properties
Paul Eggert's avatar
Paul Eggert committed
476 477
     while concatenating each string because the length of resulting
     string can't be decided until we finish the whole concatenation.
478
     So, we record strings that have text properties to be copied
Paul Eggert's avatar
Paul Eggert committed
479
     here, and copy the text properties after the concatenation.  */
480
  struct textprop_rec  *textprops = NULL;
Juanma Barranquero's avatar
Juanma Barranquero committed
481
  /* Number of elements in textprops.  */
482
  ptrdiff_t num_textprops = 0;
Kim F. Storm's avatar
Kim F. Storm committed
483
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
484

485 486
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
487 488 489 490 491 492 493 494 495
  /* 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;

496
  /* Check each argument.  */
Jim Blandy's avatar
Jim Blandy committed
497 498 499
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
500
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
Stefan Monnier's avatar
Stefan Monnier committed
501
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
502
	wrong_type_argument (Qsequencep, this);
Jim Blandy's avatar
Jim Blandy committed
503 504
    }

505 506 507 508 509 510 511 512
  /* 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
513
    {
514
      EMACS_INT len;
Jim Blandy's avatar
Jim Blandy committed
515
      this = args[argnum];
516 517
      len = XFASTINT (Flength (this));
      if (target_type == Lisp_String)
518
	{
519 520
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
521
	  ptrdiff_t i;
522
	  Lisp_Object ch;
523
	  int c;
524
	  ptrdiff_t this_len_byte;
525

Stefan Monnier's avatar
Stefan Monnier committed
526
	  if (VECTORP (this) || COMPILEDP (this))
527
	    for (i = 0; i < len; i++)
528
	      {
Stefan Monnier's avatar
Stefan Monnier committed
529
		ch = AREF (this, i);
Miles Bader's avatar
Miles Bader committed
530
		CHECK_CHARACTER (ch);
531 532
		c = XFASTINT (ch);
		this_len_byte = CHAR_BYTES (c);
533 534
		if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		  string_overflow ();
535
		result_len_byte += this_len_byte;
536
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
537
		  some_multibyte = 1;
538
	      }
539 540
	  else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
	    wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
541
	  else if (CONSP (this))
542
	    for (; CONSP (this); this = XCDR (this))
543
	      {
544
		ch = XCAR (this);
Miles Bader's avatar
Miles Bader committed
545
		CHECK_CHARACTER (ch);
546 547
		c = XFASTINT (ch);
		this_len_byte = CHAR_BYTES (c);
548 549
		if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
		  string_overflow ();
550
		result_len_byte += this_len_byte;
551
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
552
		  some_multibyte = 1;
553
	      }
554
	  else if (STRINGP (this))
555
	    {
556
	      if (STRING_MULTIBYTE (this))
557 558
		{
		  some_multibyte = 1;
559
		  this_len_byte = SBYTES (this);
560 561
		}
	      else
562 563 564 565 566
		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;
567
	    }
568
	}
569 570

      result_len += len;
571 572
      if (MOST_POSITIVE_FIXNUM < result_len)
	memory_full (SIZE_MAX);
Jim Blandy's avatar
Jim Blandy committed
573 574
    }

575 576
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
577

578
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
579
  if (target_type == Lisp_Cons)
580
    val = Fmake_list (make_number (result_len), Qnil);
581
  else if (target_type == Lisp_Vectorlike)
582
    val = Fmake_vector (make_number (result_len), Qnil);
583
  else if (some_multibyte)
584
    val = make_uninit_multibyte_string (result_len, result_len_byte);
585 586
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
587

588 589 590
  /* In `append', if all but last arg are nil, return last arg.  */
  if (target_type == Lisp_Cons && EQ (val, Qnil))
    return last_tail;
Jim Blandy's avatar
Jim Blandy committed
591

592
  /* Copy the contents of the args into the result.  */
Jim Blandy's avatar
Jim Blandy committed
593
  if (CONSP (val))
594
    tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
Jim Blandy's avatar
Jim Blandy committed
595
  else
596
    toindex = 0, toindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
597 598

  prev = Qnil;
599
  if (STRINGP (val))
600
    SAFE_NALLOCA (textprops, 1, nargs);
Jim Blandy's avatar
Jim Blandy committed
601 602 603 604

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
605 606 607
      ptrdiff_t thisleni = 0;
      register ptrdiff_t thisindex = 0;
      register ptrdiff_t thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
608 609 610 611 612

      this = args[argnum];
      if (!CONSP (this))
	thislen = Flength (this), thisleni = XINT (thislen);

613 614 615
      /* 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
616
	{
617
	  ptrdiff_t thislen_byte = SBYTES (this);
618

619
	  memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
620
	  if (string_intervals (this))
621
	    {
Kenichi Handa's avatar
Kenichi Handa committed
622
	      textprops[num_textprops].argnum = argnum;
623
	      textprops[num_textprops].from = 0;
Kenichi Handa's avatar
Kenichi Handa committed
624
	      textprops[num_textprops++].to = toindex;
625
	    }
626
	  toindex_byte += thislen_byte;
627
	  toindex += thisleni;
628
	}
629 630 631
      /* Copy a single-byte string to a multibyte string.  */
      else if (STRINGP (this) && STRINGP (val))
	{
632
	  if (string_intervals (this))
633
	    {
Kenichi Handa's avatar
Kenichi Handa committed
634 635 636
	      textprops[num_textprops].argnum = argnum;
	      textprops[num_textprops].from = 0;
	      textprops[num_textprops++].to = toindex;
637
	    }
638 639 640
	  toindex_byte += copy_text (SDATA (this),
				     SDATA (val) + toindex_byte,
				     SCHARS (this), 0, 1);
641 642
	  toindex += thisleni;
	}
643 644 645 646 647 648 649 650 651 652
      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))
653
	      elt = XCAR (this), this = XCDR (this);
654 655 656
	    else if (thisindex >= thisleni)
	      break;
	    else if (STRINGP (this))
657
	      {
658
		int c;
659
		if (STRING_MULTIBYTE (this))
660 661 662
		  FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
						      thisindex,
						      thisindex_byte);
663
		else
664
		  {
665 666 667
		    c = SREF (this, thisindex); thisindex++;
		    if (some_multibyte && !ASCII_CHAR_P (c))
		      c = BYTE8_TO_CHAR (c);
668
		  }
669
		XSETFASTINT (elt, c);
670 671 672 673
	      }
	    else if (BOOL_VECTOR_P (this))
	      {
		int byte;
674 675
		byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
		if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
676
		  elt = Qt;
677
		else
678 679
		  elt = Qnil;
		thisindex++;
680
	      }
681
	    else
682 683 684 685
	      {
		elt = AREF (this, thisindex);
		thisindex++;
	      }
Jim Blandy's avatar
Jim Blandy committed
686

687 688
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
689
	      {
690
		XSETCAR (tail, elt);
691
		prev = tail;
692
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
693
	      }
694
	    else if (VECTORP (val))
695 696 697 698
	      {
		ASET (val, toindex, elt);
		toindex++;
	      }
699 700
	    else
	      {
701 702 703
		int c;
		CHECK_CHARACTER (elt);
		c = XFASTINT (elt);
704
		if (some_multibyte)
705
		  toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
706
		else
707
		  SSET (val, toindex_byte++, c);
708
		toindex++;
709 710
	      }
	  }
Jim Blandy's avatar
Jim Blandy committed
711
    }
Jim Blandy's avatar
Jim Blandy committed
712
  if (!NILP (prev))
713
    XSETCDR (prev, last_tail);
Jim Blandy's avatar
Jim Blandy committed
714

Kenichi Handa's avatar
Kenichi Handa committed
715
  if (num_textprops > 0)
716
    {
717
      Lisp_Object props;
718
      ptrdiff_t last_to_end = -1;
719

Kenichi Handa's avatar
Kenichi Handa committed
720
      for (argnum = 0; argnum < num_textprops; argnum++)
721
	{
Kenichi Handa's avatar
Kenichi Handa committed
722
	  this = args[textprops[argnum].argnum];
723 724
	  props = text_property_list (this,
				      make_number (0),
725
				      make_number (SCHARS (this)),
726
				      Qnil);
Paul Eggert's avatar
Paul Eggert committed
727
	  /* If successive arguments have properties, be sure that the
728
	     value of `composition' property be the copy.  */
729
	  if (last_to_end == textprops[argnum].to)
730 731 732
	    make_composition_value_copy (props);
	  add_text_properties_from_list (val, props,
					 make_number (textprops[argnum].to));
733
	  last_to_end = textprops[argnum].to + SCHARS (this);
734 735
	}
    }
Kim F. Storm's avatar
Kim F. Storm committed
736 737

  SAFE_FREE ();
Karl Heuer's avatar
Karl Heuer committed
738
  return val;
Jim Blandy's avatar
Jim Blandy committed
739 740
}

741
static Lisp_Object string_char_byte_cache_string;
742 743
static ptrdiff_t string_char_byte_cache_charpos;
static ptrdiff_t string_char_byte_cache_bytepos;
744

745
void