fns.c 136 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Random utility Lisp functions.
2 3
   Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997,
                 1998, 1999, 2000, 2001, 2002, 2003, 2004,
Juanma Barranquero's avatar
Juanma Barranquero committed
4 5
                 2005, 2006, 2007, 2008, 2009, 2010
		 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
6 7 8

This file is part of GNU Emacs.

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

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

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

Andreas Schwab's avatar
Andreas Schwab committed
24 25 26
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
Andreas Schwab's avatar
Andreas Schwab committed
27
#include <time.h>
28
#include <setjmp.h>
Andreas Schwab's avatar
Andreas Schwab committed
29

Jim Blandy's avatar
Jim Blandy committed
30 31 32 33
/* Note on some machines this defines `vector' as a typedef,
   so make sure we don't use that name in this file.  */
#undef vector
#define vector *****
34

Jim Blandy's avatar
Jim Blandy committed
35 36
#include "lisp.h"
#include "commands.h"
37
#include "character.h"
38
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
39
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
40
#include "keyboard.h"
Stefan Monnier's avatar
Stefan Monnier committed
41
#include "keymap.h"
42
#include "intervals.h"
43 44
#include "frame.h"
#include "window.h"
Gerd Moellmann's avatar
Gerd Moellmann committed
45
#include "blockinput.h"
46 47
#ifdef HAVE_MENUS
#if defined (HAVE_X_WINDOWS)
Andreas Schwab's avatar
Andreas Schwab committed
48 49
#include "xterm.h"
#endif
50
#endif /* HAVE_MENUS */
Jim Blandy's avatar
Jim Blandy committed
51

Karl Heuer's avatar
Karl Heuer committed
52
#ifndef NULL
53
#define NULL ((POINTER_TYPE *)0)
Karl Heuer's avatar
Karl Heuer committed
54 55
#endif

56 57 58 59
/* Nonzero enables use of dialog boxes for questions
   asked by mouse commands.  */
int use_dialog_box;

Kenichi Handa's avatar
Kenichi Handa committed
60 61 62 63
/* Nonzero enables use of a file dialog for file name
   questions asked by mouse commands.  */
int use_file_dialog;

64 65
extern int minibuffer_auto_raise;
extern Lisp_Object minibuf_window;
66
extern Lisp_Object Vlocale_coding_system;
67
extern int load_in_progress;
68

69
Lisp_Object Qstring_lessp, Qprovide, Qrequire;
70
Lisp_Object Qyes_or_no_p_history;
71
Lisp_Object Qcursor_in_echo_area;
Karl Heuer's avatar
Karl Heuer committed
72
Lisp_Object Qwidget_type;
73
Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
Jim Blandy's avatar
Jim Blandy committed
74

75 76
extern Lisp_Object Qinput_method_function;

77
static int internal_equal (Lisp_Object , Lisp_Object, int, int);
78

79
extern long get_random (void);
80
extern void seed_random (long);
81 82 83 84

#ifndef HAVE_UNISTD_H
extern long time ();
#endif
85

Jim Blandy's avatar
Jim Blandy committed
86
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
Pavel Janík's avatar
Pavel Janík committed
87
       doc: /* Return the argument unchanged.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
88
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
89 90 91 92 93
{
  return arg;
}

DEFUN ("random", Frandom, Srandom, 0, 1, 0,
94
       doc: /* Return a pseudo-random number.
Gerd Moellmann's avatar
Gerd Moellmann committed
95
All integers representable in Lisp are equally likely.
Kenichi Handa's avatar
Kenichi Handa committed
96
  On most systems, this is 29 bits' worth.
97 98 99
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.
Other values of LIMIT are ignored.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
100
  (Lisp_Object limit)
Jim Blandy's avatar
Jim Blandy committed
101
{
102 103
  EMACS_INT val;
  Lisp_Object lispy_val;
104
  unsigned long denominator;
Jim Blandy's avatar
Jim Blandy committed
105

106
  if (EQ (limit, Qt))
107
    seed_random (getpid () + time (NULL));
108
  if (NATNUMP (limit) && XFASTINT (limit) != 0)
Jim Blandy's avatar
Jim Blandy committed
109
    {
110 111 112 113
      /* Try to take our random number from the higher bits of VAL,
	 not the lower, since (says Gentzel) the low bits of `random'
	 are less random than the higher ones.  We do this by using the
	 quotient rather than the remainder.  At the high end of the RNG
114
	 it's possible to get a quotient larger than n; discarding
115
	 these values eliminates the bias that would otherwise appear
116
	 when using a large n.  */
117
      denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit);
118
      do
119
	val = get_random () / denominator;
120
      while (val >= XFASTINT (limit));
Jim Blandy's avatar
Jim Blandy committed
121
    }
122
  else
123
    val = get_random ();
124 125
  XSETINT (lispy_val, val);
  return lispy_val;
Jim Blandy's avatar
Jim Blandy committed
126 127 128 129 130
}

/* Random data-structure functions */

DEFUN ("length", Flength, Slength, 1, 1, 0,
131
       doc: /* Return the length of vector, list or string SEQUENCE.
Gerd Moellmann's avatar
Gerd Moellmann committed
132
A byte-code function object is also allowed.
John Paul Wallington's avatar
John Paul Wallington committed
133
If the string contains multibyte characters, this is not necessarily
Gerd Moellmann's avatar
Gerd Moellmann committed
134
the number of bytes in the string; it is the number of characters.
135
To get the number of bytes, use `string-bytes'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
136
  (register Lisp_Object sequence)
Jim Blandy's avatar
Jim Blandy committed
137
{
138
  register Lisp_Object val;
Jim Blandy's avatar
Jim Blandy committed
139 140
  register int i;

141
  if (STRINGP (sequence))
142
    XSETFASTINT (val, SCHARS (sequence));
143
  else if (VECTORP (sequence))
Stefan Monnier's avatar
Stefan Monnier committed
144
    XSETFASTINT (val, ASIZE (sequence));
145
  else if (CHAR_TABLE_P (sequence))
146
    XSETFASTINT (val, MAX_CHAR);
147 148 149
  else if (BOOL_VECTOR_P (sequence))
    XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
  else if (COMPILEDP (sequence))
Stefan Monnier's avatar
Stefan Monnier committed
150
    XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
151
  else if (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
152
    {
153 154
      i = 0;
      while (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
155
	{
156
	  sequence = XCDR (sequence);
157 158 159 160 161 162 163 164
	  ++i;

	  if (!CONSP (sequence))
	    break;

	  sequence = XCDR (sequence);
	  ++i;
	  QUIT;
Jim Blandy's avatar
Jim Blandy committed
165 166
	}

167
      CHECK_LIST_END (sequence, sequence);
168 169

      val = make_number (i);
Jim Blandy's avatar
Jim Blandy committed
170
    }
171
  else if (NILP (sequence))
172
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
173
  else
174
    wrong_type_argument (Qsequencep, sequence);
175

176
  return val;
Jim Blandy's avatar
Jim Blandy committed
177 178
}

179
/* This does not check for quits.  That is safe since it must terminate.  */
180 181

DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
182
       doc: /* Return the length of a list, but avoid error or infinite loop.
Gerd Moellmann's avatar
Gerd Moellmann committed
183 184
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
185
which is at least the number of distinct elements.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
186
  (Lisp_Object list)
187 188 189 190 191 192
{
  Lisp_Object tail, halftail, length;
  int len = 0;

  /* halftail is used to detect circular lists.  */
  halftail = list;
193
  for (tail = list; CONSP (tail); tail = XCDR (tail))
194 195
    {
      if (EQ (tail, halftail) && len != 0)
196
	break;
197
      len++;
198
      if ((len & 1) == 0)
199
	halftail = XCDR (halftail);
200 201 202 203 204 205
    }

  XSETINT (length, len);
  return length;
}

206
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
207
       doc: /* Return the number of bytes in STRING.
Miles Bader's avatar
Miles Bader committed
208
If STRING is multibyte, this may be greater than the length of STRING.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
209
  (Lisp_Object string)
210
{
211
  CHECK_STRING (string);
212
  return make_number (SBYTES (string));
213 214
}

Jim Blandy's avatar
Jim Blandy committed
215
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
216
       doc: /* Return t if two strings have identical contents.
Gerd Moellmann's avatar
Gerd Moellmann committed
217
Case is significant, but text properties are ignored.
218
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
219
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
220
{
221
  if (SYMBOLP (s1))
222
    s1 = SYMBOL_NAME (s1);
223
  if (SYMBOLP (s2))
224
    s2 = SYMBOL_NAME (s2);
225 226
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
227

228 229
  if (SCHARS (s1) != SCHARS (s2)
      || SBYTES (s1) != SBYTES (s2)
230
      || memcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
Jim Blandy's avatar
Jim Blandy committed
231 232 233 234
    return Qnil;
  return Qt;
}

235
DEFUN ("compare-strings", Fcompare_strings,
236
       Scompare_strings, 6, 7, 0,
237
doc: /* Compare the contents of two strings, converting to multibyte if needed.
Gerd Moellmann's avatar
Gerd Moellmann committed
238 239 240 241 242 243 244 245 246 247 248
In string STR1, skip the first START1 characters and stop at END1.
In string STR2, skip the first START2 characters and stop at END2.
END1 and END2 default to the full lengths of the respective strings.

Case is significant in this comparison if IGNORE-CASE is nil.
Unibyte strings are converted to multibyte for comparison.

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;
249
  N - 1 is the number of characters that match at the beginning.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
250
  (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
251 252 253 254
{
  register int end1_char, end2_char;
  register int i1, i1_byte, i2, i2_byte;

255 256
  CHECK_STRING (str1);
  CHECK_STRING (str2);
257 258 259 260
  if (NILP (start1))
    start1 = make_number (0);
  if (NILP (start2))
    start2 = make_number (0);
261 262
  CHECK_NATNUM (start1);
  CHECK_NATNUM (start2);
263
  if (! NILP (end1))
264
    CHECK_NATNUM (end1);
265
  if (! NILP (end2))
266
    CHECK_NATNUM (end2);
267 268 269 270 271 272 273

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

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

274
  end1_char = SCHARS (str1);
275 276 277
  if (! NILP (end1) && end1_char > XINT (end1))
    end1_char = XINT (end1);

278
  end2_char = SCHARS (str2);
279 280 281 282 283 284 285 286 287 288
  if (! NILP (end2) && end2_char > XINT (end2))
    end2_char = XINT (end2);

  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))
289
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
290 291
      else
	{
292
	  c1 = SREF (str1, i1++);
293
	  MAKE_CHAR_MULTIBYTE (c1);
294 295 296
	}

      if (STRING_MULTIBYTE (str2))
297
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
298 299
      else
	{
300
	  c2 = SREF (str2, i2++);
301
	  MAKE_CHAR_MULTIBYTE (c2);
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
	}

      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)
324
	return make_number (- i1 + XINT (start1));
325
      else
326
	return make_number (i1 - XINT (start1));
327 328 329 330 331 332 333 334 335 336
    }

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

  return Qt;
}

Jim Blandy's avatar
Jim Blandy committed
337
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
338
       doc: /* Return t if first arg string is less than second in lexicographic order.
Gerd Moellmann's avatar
Gerd Moellmann committed
339
Case is significant.
340
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
341
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
342 343
{
  register int end;
344
  register int i1, i1_byte, i2, i2_byte;
Jim Blandy's avatar
Jim Blandy committed
345

346
  if (SYMBOLP (s1))
347
    s1 = SYMBOL_NAME (s1);
348
  if (SYMBOLP (s2))
349
    s2 = SYMBOL_NAME (s2);
350 351
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
352

353 354
  i1 = i1_byte = i2 = i2_byte = 0;

355 356 357
  end = SCHARS (s1);
  if (end > SCHARS (s2))
    end = SCHARS (s2);
Jim Blandy's avatar
Jim Blandy committed
358

359
  while (i1 < end)
Jim Blandy's avatar
Jim Blandy committed
360
    {
361 362 363 364
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

365 366
      FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
      FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
367 368 369

      if (c1 != c2)
	return c1 < c2 ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
370
    }
371
  return i1 < SCHARS (s2) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
372 373
}

374 375 376 377
#if __GNUC__
/* "gcc -O3" enables automatic function inlining, which optimizes out
   the arguments for the invocations of this function, whereas it
   expects these values on the stack.  */
378
static Lisp_Object concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special) __attribute__((noinline));
379
#else  /* !__GNUC__ */
380
static Lisp_Object concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special);
381
#endif
Jim Blandy's avatar
Jim Blandy committed
382 383 384

/* ARGSUSED */
Lisp_Object
385
concat2 (Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
386 387 388 389 390 391 392
{
  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
393 394
/* ARGSUSED */
Lisp_Object
395
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
Richard M. Stallman's avatar
Richard M. Stallman committed
396 397 398 399 400 401 402 403
{
  Lisp_Object args[3];
  args[0] = s1;
  args[1] = s2;
  args[2] = s3;
  return concat (3, args, Lisp_String, 0);
}

Jim Blandy's avatar
Jim Blandy committed
404
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
405
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
406 407
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
408 409
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES)  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
410
  (int nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
411 412 413 414 415
{
  return concat (nargs, args, Lisp_Cons, 1);
}

DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
416
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
417
The result is a string whose elements are the elements of all the arguments.
418 419
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES)  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
420
  (int nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
421 422 423 424 425
{
  return concat (nargs, args, Lisp_String, 0);
}

DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
426
       doc: /* Concatenate all the arguments and make the result a vector.
Gerd Moellmann's avatar
Gerd Moellmann committed
427
The result is a vector whose elements are the elements of all the arguments.
428 429
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES)   */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
430
  (int nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
431
{
432
  return concat (nargs, args, Lisp_Vectorlike, 0);
Jim Blandy's avatar
Jim Blandy committed
433 434
}

435

Jim Blandy's avatar
Jim Blandy committed
436
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
Dave Love's avatar
Dave Love committed
437
       doc: /* Return a copy of a list, vector, string or char-table.
Gerd Moellmann's avatar
Gerd Moellmann committed
438
The elements of a list or vector are not copied; they are shared
439
with the original.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
440
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
441
{
Jim Blandy's avatar
Jim Blandy committed
442
  if (NILP (arg)) return arg;
443 444 445

  if (CHAR_TABLE_P (arg))
    {
446
      return copy_char_table (arg);
447 448 449 450 451 452
    }

  if (BOOL_VECTOR_P (arg))
    {
      Lisp_Object val;
      int size_in_chars
453 454
	= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
	   / BOOL_VECTOR_BITS_PER_CHAR);
455 456

      val = Fmake_bool_vector (Flength (arg), Qnil);
457 458
      memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data,
	      size_in_chars);
459 460 461
      return val;
    }

462
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
463 464
    wrong_type_argument (Qsequencep, arg);

Jim Blandy's avatar
Jim Blandy committed
465 466 467
  return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}

468 469
/* 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
470
struct textprop_rec
471 472 473 474 475 476
{
  int argnum;			/* refer to ARGS (arguments of `concat') */
  int from;			/* refer to ARGS[argnum] (argument string) */
  int to;			/* refer to VAL (the target string) */
};

Jim Blandy's avatar
Jim Blandy committed
477
static Lisp_Object
478
concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)
Jim Blandy's avatar
Jim Blandy committed
479 480 481 482 483
{
  Lisp_Object val;
  register Lisp_Object tail;
  register Lisp_Object this;
  int toindex;
484
  int toindex_byte = 0;
485 486
  register int result_len;
  register int result_len_byte;
Jim Blandy's avatar
Jim Blandy committed
487 488 489
  register int argnum;
  Lisp_Object last_tail;
  Lisp_Object prev;
490
  int some_multibyte;
491 492 493 494 495
  /* When we make a multibyte string, we can't copy text properties
     while concatinating each string because the length of resulting
     string can't be decided until we finish the whole concatination.
     So, we record strings that have text properties to be copied
     here, and copy the text properties after the concatination.  */
496
  struct textprop_rec  *textprops = NULL;
Juanma Barranquero's avatar
Juanma Barranquero committed
497
  /* Number of elements in textprops.  */
Kenichi Handa's avatar
Kenichi Handa committed
498
  int num_textprops = 0;
Kim F. Storm's avatar
Kim F. Storm committed
499
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
500

501 502
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
503 504 505 506 507 508 509 510 511
  /* 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;

512
  /* Check each argument.  */
Jim Blandy's avatar
Jim Blandy committed
513 514 515
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
516
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
517
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
518
	wrong_type_argument (Qsequencep, this);
Jim Blandy's avatar
Jim Blandy committed
519 520
    }

521 522 523 524 525 526 527 528
  /* 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
529
    {
530
      int len;
Jim Blandy's avatar
Jim Blandy committed
531
      this = args[argnum];
532 533
      len = XFASTINT (Flength (this));
      if (target_type == Lisp_String)
534
	{
535 536
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
537 538
	  int i;
	  Lisp_Object ch;
539
	  int this_len_byte;
540

541
	  if (VECTORP (this))
542
	    for (i = 0; i < len; i++)
543
	      {
Stefan Monnier's avatar
Stefan Monnier committed
544
		ch = AREF (this, i);
Miles Bader's avatar
Miles Bader committed
545
		CHECK_CHARACTER (ch);
546
		this_len_byte = CHAR_BYTES (XINT (ch));
547
		result_len_byte += this_len_byte;
548
		if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
549
		  some_multibyte = 1;
550
	      }
551 552
	  else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
	    wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
553
	  else if (CONSP (this))
554
	    for (; CONSP (this); this = XCDR (this))
555
	      {
556
		ch = XCAR (this);
Miles Bader's avatar
Miles Bader committed
557
		CHECK_CHARACTER (ch);
558
		this_len_byte = CHAR_BYTES (XINT (ch));
559
		result_len_byte += this_len_byte;
560
		if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
561
		  some_multibyte = 1;
562
	      }
563
	  else if (STRINGP (this))
564
	    {
565
	      if (STRING_MULTIBYTE (this))
566 567
		{
		  some_multibyte = 1;
568
		  result_len_byte += SBYTES (this);
569 570
		}
	      else
571 572
		result_len_byte += count_size_as_multibyte (SDATA (this),
							    SCHARS (this));
573
	    }
574
	}
575 576

      result_len += len;
577 578
      if (result_len < 0)
	error ("String overflow");
Jim Blandy's avatar
Jim Blandy committed
579 580
    }

581 582
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
583

584
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
585
  if (target_type == Lisp_Cons)
586
    val = Fmake_list (make_number (result_len), Qnil);
587
  else if (target_type == Lisp_Vectorlike)
588
    val = Fmake_vector (make_number (result_len), Qnil);
589
  else if (some_multibyte)
590
    val = make_uninit_multibyte_string (result_len, result_len_byte);
591 592
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
593

594 595 596
  /* 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
597

598
  /* Copy the contents of the args into the result.  */
Jim Blandy's avatar
Jim Blandy committed
599
  if (CONSP (val))
600
    tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
Jim Blandy's avatar
Jim Blandy committed
601
  else
602
    toindex = 0, toindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
603 604

  prev = Qnil;
605
  if (STRINGP (val))
Kim F. Storm's avatar
Kim F. Storm committed
606
    SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
Jim Blandy's avatar
Jim Blandy committed
607 608 609 610

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
611
      int thisleni = 0;
612
      register unsigned int thisindex = 0;
613
      register unsigned int thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
614 615 616 617 618

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

619 620 621
      /* 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
622
	{
623
	  int thislen_byte = SBYTES (this);
624

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

700 701
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
702
	      {
703
		XSETCAR (tail, elt);
704
		prev = tail;
705
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
706
	      }
707
	    else if (VECTORP (val))
708 709 710 711
	      {
		ASET (val, toindex, elt);
		toindex++;
	      }
712 713
	    else
	      {
714
		CHECK_NUMBER (elt);
715
		if (some_multibyte)
Kenichi Handa's avatar
Kenichi Handa committed
716 717
		  toindex_byte += CHAR_STRING (XINT (elt),
					       SDATA (val) + toindex_byte);
718
		else
Kenichi Handa's avatar
Kenichi Handa committed
719
		  SSET (val, toindex_byte++, XINT (elt));
720
		toindex++;
721 722
	      }
	  }
Jim Blandy's avatar
Jim Blandy committed
723
    }
Jim Blandy's avatar
Jim Blandy committed
724
  if (!NILP (prev))
725
    XSETCDR (prev, last_tail);
Jim Blandy's avatar
Jim Blandy committed
726

Kenichi Handa's avatar
Kenichi Handa committed
727
  if (num_textprops > 0)
728
    {
729
      Lisp_Object props;
730
      int last_to_end = -1;
731

Kenichi Handa's avatar
Kenichi Handa committed
732
      for (argnum = 0; argnum < num_textprops; argnum++)
733
	{
Kenichi Handa's avatar
Kenichi Handa committed
734
	  this = args[textprops[argnum].argnum];
735 736
	  props = text_property_list (this,
				      make_number (0),
737
				      make_number (SCHARS (this)),
738 739 740
				      Qnil);
	  /* If successive arguments have properites, be sure that the
	     value of `composition' property be the copy.  */
741
	  if (last_to_end == textprops[argnum].to)
742 743 744
	    make_composition_value_copy (props);
	  add_text_properties_from_list (val, props,
					 make_number (textprops[argnum].to));
745
	  last_to_end = textprops[argnum].to + SCHARS (this);
746 747
	}
    }
Kim F. Storm's avatar
Kim F. Storm committed
748 749

  SAFE_FREE ();
Karl Heuer's avatar
Karl Heuer committed
750
  return val;
Jim Blandy's avatar
Jim Blandy committed