fns.c 134 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Random utility Lisp functions.
2
   Copyright (C) 1985-1987, 1993-1995, 1997-2011
Juanma Barranquero's avatar
Juanma Barranquero committed
3
		 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>
24
#include <setjmp.h>
Andreas Schwab's avatar
Andreas Schwab committed
25

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

Karl Heuer's avatar
Karl Heuer committed
43
#ifndef NULL
44
#define NULL ((POINTER_TYPE *)0)
Karl Heuer's avatar
Karl Heuer committed
45 46
#endif

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

54
static int internal_equal (Lisp_Object , Lisp_Object, int, int);
55 56 57 58

#ifndef HAVE_UNISTD_H
extern long time ();
#endif
59

Paul Eggert's avatar
Paul Eggert committed
60
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
Pavel Janík's avatar
Pavel Janík committed
61
       doc: /* Return the argument unchanged.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
62
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
63 64 65 66 67
{
  return arg;
}

DEFUN ("random", Frandom, Srandom, 0, 1, 0,
68
       doc: /* Return a pseudo-random number.
Gerd Moellmann's avatar
Gerd Moellmann committed
69
All integers representable in Lisp are equally likely.
Kenichi Handa's avatar
Kenichi Handa committed
70
  On most systems, this is 29 bits' worth.
71 72 73
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
74
  (Lisp_Object limit)
Jim Blandy's avatar
Jim Blandy committed
75
{
76 77
  EMACS_INT val;
  Lisp_Object lispy_val;
78
  EMACS_UINT denominator;
Jim Blandy's avatar
Jim Blandy committed
79

80
  if (EQ (limit, Qt))
81
    seed_random (getpid () + time (NULL));
82
  if (NATNUMP (limit) && XFASTINT (limit) != 0)
Jim Blandy's avatar
Jim Blandy committed
83
    {
84 85 86 87
      /* 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
88
	 it's possible to get a quotient larger than n; discarding
89
	 these values eliminates the bias that would otherwise appear
90
	 when using a large n.  */
91
      denominator = ((EMACS_UINT) 1 << VALBITS) / XFASTINT (limit);
92
      do
93
	val = get_random () / denominator;
94
      while (val >= XFASTINT (limit));
Jim Blandy's avatar
Jim Blandy committed
95
    }
96
  else
97
    val = get_random ();
98 99
  XSETINT (lispy_val, val);
  return lispy_val;
Jim Blandy's avatar
Jim Blandy committed
100 101 102 103
}

/* Random data-structure functions */

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

114
  if (STRINGP (sequence))
115
    XSETFASTINT (val, SCHARS (sequence));
116
  else if (VECTORP (sequence))
Stefan Monnier's avatar
Stefan Monnier committed
117
    XSETFASTINT (val, ASIZE (sequence));
118
  else if (CHAR_TABLE_P (sequence))
119
    XSETFASTINT (val, MAX_CHAR);
120 121
  else if (BOOL_VECTOR_P (sequence))
    XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
Stefan Monnier's avatar
Stefan Monnier committed
122 123
  else if (COMPILEDP (sequence))
    XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
124
  else if (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
125
    {
126 127 128
      EMACS_INT i = 0;

      do
Jim Blandy's avatar
Jim Blandy committed
129
	{
130
	  ++i;
131 132 133 134 135 136
	  if ((i & ((1 << 10) - 1)) == 0)
	    {
	      if (MOST_POSITIVE_FIXNUM < i)
		error ("List too long");
	      QUIT;
	    }
137
	  sequence = XCDR (sequence);
Jim Blandy's avatar
Jim Blandy committed
138
	}
139
      while (CONSP (sequence));
Jim Blandy's avatar
Jim Blandy committed
140

141
      CHECK_LIST_END (sequence, sequence);
142 143

      val = make_number (i);
Jim Blandy's avatar
Jim Blandy committed
144
    }
145
  else if (NILP (sequence))
146
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
147
  else
148
    wrong_type_argument (Qsequencep, sequence);
149

150
  return val;
Jim Blandy's avatar
Jim Blandy committed
151 152
}

153
/* This does not check for quits.  That is safe since it must terminate.  */
154 155

DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
156
       doc: /* Return the length of a list, but avoid error or infinite loop.
Gerd Moellmann's avatar
Gerd Moellmann committed
157 158
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
159
which is at least the number of distinct elements.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
160
  (Lisp_Object list)
161 162 163 164 165 166
{
  Lisp_Object tail, halftail, length;
  int len = 0;

  /* halftail is used to detect circular lists.  */
  halftail = list;
167
  for (tail = list; CONSP (tail); tail = XCDR (tail))
168 169
    {
      if (EQ (tail, halftail) && len != 0)
170
	break;
171
      len++;
172
      if ((len & 1) == 0)
173
	halftail = XCDR (halftail);
174 175 176 177 178 179
    }

  XSETINT (length, len);
  return length;
}

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

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

202 203
  if (SCHARS (s1) != SCHARS (s2)
      || SBYTES (s1) != SBYTES (s2)
204
      || memcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
Jim Blandy's avatar
Jim Blandy committed
205 206 207 208
    return Qnil;
  return Qt;
}

Paul Eggert's avatar
Paul Eggert committed
209
DEFUN ("compare-strings", Fcompare_strings, Scompare_strings, 6, 7, 0,
Juanma Barranquero's avatar
Juanma Barranquero committed
210
       doc: /* Compare the contents of two strings, converting to multibyte if needed.
Gerd Moellmann's avatar
Gerd Moellmann committed
211 212 213 214 215 216 217 218 219 220 221
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;
222
  N - 1 is the number of characters that match at the beginning.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
223
  (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
224
{
225 226
  register EMACS_INT end1_char, end2_char;
  register EMACS_INT i1, i1_byte, i2, i2_byte;
227

228 229
  CHECK_STRING (str1);
  CHECK_STRING (str2);
230 231 232 233
  if (NILP (start1))
    start1 = make_number (0);
  if (NILP (start2))
    start2 = make_number (0);
234 235
  CHECK_NATNUM (start1);
  CHECK_NATNUM (start2);
236
  if (! NILP (end1))
237
    CHECK_NATNUM (end1);
238
  if (! NILP (end2))
239
    CHECK_NATNUM (end2);
240 241 242 243 244 245 246

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

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

247
  end1_char = SCHARS (str1);
248 249 250
  if (! NILP (end1) && end1_char > XINT (end1))
    end1_char = XINT (end1);

251
  end2_char = SCHARS (str2);
252 253 254 255 256 257 258 259 260 261
  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))
262
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
263 264
      else
	{
265
	  c1 = SREF (str1, i1++);
266
	  MAKE_CHAR_MULTIBYTE (c1);
267 268 269
	}

      if (STRING_MULTIBYTE (str2))
270
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
271 272
      else
	{
273
	  c2 = SREF (str2, i2++);
274
	  MAKE_CHAR_MULTIBYTE (c2);
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
	}

      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)
297
	return make_number (- i1 + XINT (start1));
298
      else
299
	return make_number (i1 - XINT (start1));
300 301 302 303 304 305 306 307 308 309
    }

  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
310
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
311
       doc: /* Return t if first arg string is less than second in lexicographic order.
Gerd Moellmann's avatar
Gerd Moellmann committed
312
Case is significant.
313
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
314
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
315
{
316 317
  register EMACS_INT end;
  register EMACS_INT i1, i1_byte, i2, i2_byte;
Jim Blandy's avatar
Jim Blandy committed
318

319
  if (SYMBOLP (s1))
320
    s1 = SYMBOL_NAME (s1);
321
  if (SYMBOLP (s2))
322
    s2 = SYMBOL_NAME (s2);
323 324
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
325

326 327
  i1 = i1_byte = i2 = i2_byte = 0;

328 329 330
  end = SCHARS (s1);
  if (end > SCHARS (s2))
    end = SCHARS (s2);
Jim Blandy's avatar
Jim Blandy committed
331

332
  while (i1 < end)
Jim Blandy's avatar
Jim Blandy committed
333
    {
334 335 336 337
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

338 339
      FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
      FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
340 341 342

      if (c1 != c2)
	return c1 < c2 ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
343
    }
344
  return i1 < SCHARS (s2) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
345 346
}

347
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
348
			   enum Lisp_Type target_type, int last_special);
Jim Blandy's avatar
Jim Blandy committed
349 350 351

/* ARGSUSED */
Lisp_Object
352
concat2 (Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
353 354 355 356 357 358 359
{
  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
360 361
/* ARGSUSED */
Lisp_Object
362
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
Richard M. Stallman's avatar
Richard M. Stallman committed
363 364 365 366 367 368 369 370
{
  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
371
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
372
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
373 374
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
375 376
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES)  */)
377
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
378 379 380 381
{
  return concat (nargs, args, Lisp_Cons, 1);
}

Paul Eggert's avatar
Paul Eggert committed
382
DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
383
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
384
The result is a string whose elements are the elements of all the arguments.
385 386
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES)  */)
387
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
388 389 390 391
{
  return concat (nargs, args, Lisp_String, 0);
}

Paul Eggert's avatar
Paul Eggert committed
392
DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
393
       doc: /* Concatenate all the arguments and make the result a vector.
Gerd Moellmann's avatar
Gerd Moellmann committed
394
The result is a vector whose elements are the elements of all the arguments.
395 396
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES)   */)
397
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
398
{
399
  return concat (nargs, args, Lisp_Vectorlike, 0);
Jim Blandy's avatar
Jim Blandy committed
400 401
}

402

Paul Eggert's avatar
Paul Eggert committed
403
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
Dave Love's avatar
Dave Love committed
404
       doc: /* Return a copy of a list, vector, string or char-table.
Gerd Moellmann's avatar
Gerd Moellmann committed
405
The elements of a list or vector are not copied; they are shared
406
with the original.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
407
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
408
{
Jim Blandy's avatar
Jim Blandy committed
409
  if (NILP (arg)) return arg;
410 411 412

  if (CHAR_TABLE_P (arg))
    {
413
      return copy_char_table (arg);
414 415 416 417 418 419
    }

  if (BOOL_VECTOR_P (arg))
    {
      Lisp_Object val;
      int size_in_chars
420 421
	= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
	   / BOOL_VECTOR_BITS_PER_CHAR);
422 423

      val = Fmake_bool_vector (Flength (arg), Qnil);
424 425
      memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data,
	      size_in_chars);
426 427 428
      return val;
    }

429
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
430 431
    wrong_type_argument (Qsequencep, arg);

Jim Blandy's avatar
Jim Blandy committed
432 433 434
  return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}

435 436
/* 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
437
struct textprop_rec
438
{
439
  ptrdiff_t argnum;		/* refer to ARGS (arguments of `concat') */
440 441
  EMACS_INT from;		/* refer to ARGS[argnum] (argument string) */
  EMACS_INT to;			/* refer to VAL (the target string) */
442 443
};

Jim Blandy's avatar
Jim Blandy committed
444
static Lisp_Object
445
concat (ptrdiff_t nargs, Lisp_Object *args,
446
	enum Lisp_Type target_type, int last_special)
Jim Blandy's avatar
Jim Blandy committed
447 448 449 450
{
  Lisp_Object val;
  register Lisp_Object tail;
  register Lisp_Object this;
451 452 453 454
  EMACS_INT toindex;
  EMACS_INT toindex_byte = 0;
  register EMACS_INT result_len;
  register EMACS_INT result_len_byte;
455
  ptrdiff_t argnum;
Jim Blandy's avatar
Jim Blandy committed
456 457
  Lisp_Object last_tail;
  Lisp_Object prev;
458
  int some_multibyte;
459
  /* When we make a multibyte string, we can't copy text properties
Paul Eggert's avatar
Paul Eggert committed
460 461
     while concatenating each string because the length of resulting
     string can't be decided until we finish the whole concatenation.
462
     So, we record strings that have text properties to be copied
Paul Eggert's avatar
Paul Eggert committed
463
     here, and copy the text properties after the concatenation.  */
464
  struct textprop_rec  *textprops = NULL;
Juanma Barranquero's avatar
Juanma Barranquero committed
465
  /* Number of elements in textprops.  */
466
  ptrdiff_t num_textprops = 0;
Kim F. Storm's avatar
Kim F. Storm committed
467
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
468

469 470
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
471 472 473 474 475 476 477 478 479
  /* 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;

480
  /* Check each argument.  */
Jim Blandy's avatar
Jim Blandy committed
481 482 483
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
484
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
Stefan Monnier's avatar
Stefan Monnier committed
485
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
486
	wrong_type_argument (Qsequencep, this);
Jim Blandy's avatar
Jim Blandy committed
487 488
    }

489 490 491 492 493 494 495 496
  /* 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
497
    {
498
      EMACS_INT len;
Jim Blandy's avatar
Jim Blandy committed
499
      this = args[argnum];
500 501
      len = XFASTINT (Flength (this));
      if (target_type == Lisp_String)
502
	{
503 504
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
505
	  EMACS_INT i;
506
	  Lisp_Object ch;
507
	  int c;
508
	  EMACS_INT this_len_byte;
509

Stefan Monnier's avatar
Stefan Monnier committed
510
	  if (VECTORP (this) || COMPILEDP (this))
511
	    for (i = 0; i < len; i++)
512
	      {
Stefan Monnier's avatar
Stefan Monnier committed
513
		ch = AREF (this, i);
Miles Bader's avatar
Miles Bader committed
514
		CHECK_CHARACTER (ch);
515 516
		c = XFASTINT (ch);
		this_len_byte = CHAR_BYTES (c);
517
		result_len_byte += this_len_byte;
518
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
519
		  some_multibyte = 1;
520
	      }
521 522
	  else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
	    wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
523
	  else if (CONSP (this))
524
	    for (; CONSP (this); this = XCDR (this))
525
	      {
526
		ch = XCAR (this);
Miles Bader's avatar
Miles Bader committed
527
		CHECK_CHARACTER (ch);
528 529
		c = XFASTINT (ch);
		this_len_byte = CHAR_BYTES (c);
530
		result_len_byte += this_len_byte;
531
		if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
532
		  some_multibyte = 1;
533
	      }
534
	  else if (STRINGP (this))
535
	    {
536
	      if (STRING_MULTIBYTE (this))
537 538
		{
		  some_multibyte = 1;
539
		  result_len_byte += SBYTES (this);
540 541
		}
	      else
542 543
		result_len_byte += count_size_as_multibyte (SDATA (this),
							    SCHARS (this));
544
	    }
545
	}
546 547

      result_len += len;
548 549
      if (result_len < 0)
	error ("String overflow");
Jim Blandy's avatar
Jim Blandy committed
550 551
    }

552 553
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
554

555
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
556
  if (target_type == Lisp_Cons)
557
    val = Fmake_list (make_number (result_len), Qnil);
558
  else if (target_type == Lisp_Vectorlike)
559
    val = Fmake_vector (make_number (result_len), Qnil);
560
  else if (some_multibyte)
561
    val = make_uninit_multibyte_string (result_len, result_len_byte);
562 563
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
564

565 566 567
  /* 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
568

569
  /* Copy the contents of the args into the result.  */
Jim Blandy's avatar
Jim Blandy committed
570
  if (CONSP (val))
571
    tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
Jim Blandy's avatar
Jim Blandy committed
572
  else
573
    toindex = 0, toindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
574 575

  prev = Qnil;
576
  if (STRINGP (val))
Kim F. Storm's avatar
Kim F. Storm committed
577
    SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
Jim Blandy's avatar
Jim Blandy committed
578 579 580 581

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
582 583 584
      EMACS_INT thisleni = 0;
      register EMACS_INT thisindex = 0;
      register EMACS_INT thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
585 586 587 588 589

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

590 591 592
      /* 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
593
	{
594
	  EMACS_INT thislen_byte = SBYTES (this);
595

596
	  memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
597
	  if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
598
	    {
Kenichi Handa's avatar
Kenichi Handa committed
599
	      textprops[num_textprops].argnum = argnum;
600
	      textprops[num_textprops].from = 0;
Kenichi Handa's avatar
Kenichi Handa committed
601
	      textprops[num_textprops++].to = toindex;
602
	    }
603
	  toindex_byte += thislen_byte;
604
	  toindex += thisleni;
605
	}
606 607 608
      /* Copy a single-byte string to a multibyte string.  */
      else if (STRINGP (this) && STRINGP (val))
	{
609
	  if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
610
	    {
Kenichi Handa's avatar
Kenichi Handa committed
611 612 613
	      textprops[num_textprops].argnum = argnum;
	      textprops[num_textprops].from = 0;
	      textprops[num_textprops++].to = toindex;
614
	    }
615 616 617
	  toindex_byte += copy_text (SDATA (this),
				     SDATA (val) + toindex_byte,
				     SCHARS (this), 0, 1);
618 619
	  toindex += thisleni;
	}
620 621 622 623 624 625 626 627 628 629
      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))
630
	      elt = XCAR (this), this = XCDR (this);
631 632 633
	    else if (thisindex >= thisleni)
	      break;
	    else if (STRINGP (this))
634
	      {
635
		int c;
636
		if (STRING_MULTIBYTE (this))
637 638 639
		  FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
						      thisindex,
						      thisindex_byte);
640
		else
641
		  {
642 643 644
		    c = SREF (this, thisindex); thisindex++;
		    if (some_multibyte && !ASCII_CHAR_P (c))
		      c = BYTE8_TO_CHAR (c);
645
		  }
646
		XSETFASTINT (elt, c);
647 648 649 650
	      }
	    else if (BOOL_VECTOR_P (this))
	      {
		int byte;
651 652
		byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
		if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
653
		  elt = Qt;
654
		else
655 656
		  elt = Qnil;
		thisindex++;
657
	      }
658
	    else
659 660 661 662
	      {
		elt = AREF (this, thisindex);
		thisindex++;
	      }
Jim Blandy's avatar
Jim Blandy committed
663

664 665
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
666
	      {
667
		XSETCAR (tail, elt);
668
		prev = tail;
669
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
670
	      }
671
	    else if (VECTORP (val))
672 673 674 675
	      {
		ASET (val, toindex, elt);
		toindex++;
	      }
676 677
	    else
	      {
678 679 680
		int c;
		CHECK_CHARACTER (elt);
		c = XFASTINT (elt);
681
		if (some_multibyte)
682
		  toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
683
		else
684
		  SSET (val, toindex_byte++, c);
685
		toindex++;
686 687
	      }
	  }
Jim Blandy's avatar
Jim Blandy committed
688
    }
Jim Blandy's avatar
Jim Blandy committed
689
  if (!NILP (prev))
690
    XSETCDR (prev, last_tail);
Jim Blandy's avatar
Jim Blandy committed
691

Kenichi Handa's avatar
Kenichi Handa committed
692
  if (num_textprops > 0)
693
    {
694
      Lisp_Object props;
695
      EMACS_INT last_to_end = -1;
696

Kenichi Handa's avatar
Kenichi Handa committed
697
      for (argnum = 0; argnum < num_textprops; argnum++)
698
	{
Kenichi Handa's avatar
Kenichi Handa committed
699
	  this = args[textprops[argnum].argnum];
700 701
	  props = text_property_list (this,
				      make_number (0),
702
				      make_number (SCHARS (this)),
703
				      Qnil);
Paul Eggert's avatar
Paul Eggert committed
704
	  /* If successive arguments have properties, be sure that the
705
	     value of `composition' property be the copy.  */
706
	  if (last_to_end == textprops[argnum].to)
707 708 709
	    make_composition_value_copy (props);
	  add_text_properties_from_list (val, props,
					 make_number (textprops[argnum].to));
710
	  last_to_end = textprops[argnum].to + SCHARS (this);
711 712
	}
    }
Kim F. Storm's avatar
Kim F. Storm committed
713 714

  SAFE_FREE ();
Karl Heuer's avatar
Karl Heuer committed
715
  return val;
Jim Blandy's avatar
Jim Blandy committed
716 717
}

718
static Lisp_Object string_char_byte_cache_string;
719 720
static EMACS_INT string_char_byte_cache_charpos;
static EMACS_INT string_char_byte_cache_bytepos;
721

722
void
723
clear_string_char_byte_cache (void)
724 725 726 727
{
  string_char_byte_cache_string = Qnil;
}

728
/* Return the byte index corresponding to CHAR_INDEX in STRING.  */
729

730
EMACS_INT
731
string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
732
{
733 734 735
  EMACS_INT i_byte;
  EMACS_INT best_below, best_below_byte;
  EMACS_INT best_above, best_above_byte;
736

737
  best_below = best_below_byte = 0;
738 739
  best_above = SCHARS (string);
  best_above_byte = SBYTES (string);
740 741
  if (best_above == best_above_byte)
    return char_index;
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758

  if (EQ (string, string_char_byte_cache_string))
    {
      if (string_char_byte_cache_charpos < char_index)
	{
	  best_below = string_char_byte_cache_charpos;
	  best_below_byte = string_char_byte_cache_bytepos;
	}
      else
	{
	  best_above = string_char_byte_cache_charpos;
	  best_above_byte = string_char_byte_cache_bytepos;
	}
    }

  if (char_index - best_below < best_above - char_index)
    {
Kenichi Handa's avatar
Kenichi Handa committed
759
      unsigned char *p = SDATA (string) + best_below_byte;
760

761 762
      while (best_below < char_index)
	{
763 764
	  p += BYTES_BY_CHAR_HEAD (*p);
	  best_below++;
765
	}
Kenichi Handa's avatar
Kenichi Handa committed
766
      i_byte = p - SDATA (string);
767 768
    }
  else
769
    {
Kenichi Handa's avatar
Kenichi Handa committed
770
      unsigned char *p = SDATA (string) + best_above_byte;
771

772 773
      while (best_above > char_index)
	{
774 775
	  p--;
	  while (!CHAR_HEAD_P (*p)) p--;
776 777
	  best_above--;
	}
Kenichi Handa's avatar
Kenichi Handa committed
778
      i_byte = p - SDATA (string);
779 780
    }

781
  string_char_byte_cache_bytepos = i_byte;
782
  string_char_byte_cache_charpos = char_index;
783 784
  string_char_byte_cache_string = string;

785 786
  return i_byte;
}
787

788 789
/* Return the character index corresponding to BYTE_INDEX in STRING.  */

790
EMACS_INT
791
string_byte_to_char (Lisp_Object string, EMACS_INT byte_index)
792
{
793 794 795
  EMACS_INT i, i_byte;
  EMACS_INT best_below, best_below_byte;
  EMACS_INT best_above, best_above_byte;
796