fns.c 132 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,
4
                 2005, 2006, 2007, 2008, 2009, 2010, 2011
Juanma Barranquero's avatar
Juanma Barranquero committed
5
		 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
#include <unistd.h>
Andreas Schwab's avatar
Andreas Schwab committed
25
#include <time.h>
26
#include <setjmp.h>
Andreas Schwab's avatar
Andreas Schwab committed
27

Jim Blandy's avatar
Jim Blandy committed
28 29 30 31
/* 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 *****
32

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

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

54
Lisp_Object Qstring_lessp, Qprovide, Qrequire;
55
Lisp_Object Qyes_or_no_p_history;
56
Lisp_Object Qcursor_in_echo_area;
Karl Heuer's avatar
Karl Heuer committed
57
Lisp_Object Qwidget_type;
58
Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
Jim Blandy's avatar
Jim Blandy committed
59

60
static int internal_equal (Lisp_Object , Lisp_Object, int, int);
61

62
extern long get_random (void);
63
extern void seed_random (long);
64 65 66 67

#ifndef HAVE_UNISTD_H
extern long time ();
#endif
68

Jim Blandy's avatar
Jim Blandy committed
69
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
Pavel Janík's avatar
Pavel Janík committed
70
       doc: /* Return the argument unchanged.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
71
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
72 73 74 75 76
{
  return arg;
}

DEFUN ("random", Frandom, Srandom, 0, 1, 0,
77
       doc: /* Return a pseudo-random number.
Gerd Moellmann's avatar
Gerd Moellmann committed
78
All integers representable in Lisp are equally likely.
Kenichi Handa's avatar
Kenichi Handa committed
79
  On most systems, this is 29 bits' worth.
80 81 82
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
83
  (Lisp_Object limit)
Jim Blandy's avatar
Jim Blandy committed
84
{
85 86
  EMACS_INT val;
  Lisp_Object lispy_val;
87
  unsigned long denominator;
Jim Blandy's avatar
Jim Blandy committed
88

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

DEFUN ("length", Flength, Slength, 1, 1, 0,
114
       doc: /* Return the length of vector, list or string SEQUENCE.
Gerd Moellmann's avatar
Gerd Moellmann committed
115
A byte-code function object is also allowed.
John Paul Wallington's avatar
John Paul Wallington committed
116
If the string contains multibyte characters, this is not necessarily
Gerd Moellmann's avatar
Gerd Moellmann committed
117
the number of bytes in the string; it is the number of characters.
118
To get the number of bytes, use `string-bytes'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
119
  (register Lisp_Object sequence)
Jim Blandy's avatar
Jim Blandy committed
120
{
121
  register Lisp_Object val;
Jim Blandy's avatar
Jim Blandy committed
122 123
  register int i;

124
  if (STRINGP (sequence))
125
    XSETFASTINT (val, SCHARS (sequence));
126
  else if (VECTORP (sequence))
Stefan Monnier's avatar
Stefan Monnier committed
127
    XSETFASTINT (val, ASIZE (sequence));
128
  else if (CHAR_TABLE_P (sequence))
129
    XSETFASTINT (val, MAX_CHAR);
130 131 132
  else if (BOOL_VECTOR_P (sequence))
    XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
  else if (COMPILEDP (sequence))
Stefan Monnier's avatar
Stefan Monnier committed
133
    XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
134
  else if (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
135
    {
136 137
      i = 0;
      while (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
138
	{
139
	  sequence = XCDR (sequence);
140 141 142 143 144 145 146 147
	  ++i;

	  if (!CONSP (sequence))
	    break;

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

150
      CHECK_LIST_END (sequence, sequence);
151 152

      val = make_number (i);
Jim Blandy's avatar
Jim Blandy committed
153
    }
154
  else if (NILP (sequence))
155
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
156
  else
157
    wrong_type_argument (Qsequencep, sequence);
158

159
  return val;
Jim Blandy's avatar
Jim Blandy committed
160 161
}

162
/* This does not check for quits.  That is safe since it must terminate.  */
163 164

DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
165
       doc: /* Return the length of a list, but avoid error or infinite loop.
Gerd Moellmann's avatar
Gerd Moellmann committed
166 167
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
168
which is at least the number of distinct elements.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
169
  (Lisp_Object list)
170 171 172 173 174 175
{
  Lisp_Object tail, halftail, length;
  int len = 0;

  /* halftail is used to detect circular lists.  */
  halftail = list;
176
  for (tail = list; CONSP (tail); tail = XCDR (tail))
177 178
    {
      if (EQ (tail, halftail) && len != 0)
179
	break;
180
      len++;
181
      if ((len & 1) == 0)
182
	halftail = XCDR (halftail);
183 184 185 186 187 188
    }

  XSETINT (length, len);
  return length;
}

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

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

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

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

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

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

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

256
  end1_char = SCHARS (str1);
257 258 259
  if (! NILP (end1) && end1_char > XINT (end1))
    end1_char = XINT (end1);

260
  end2_char = SCHARS (str2);
261 262 263 264 265 266 267 268 269 270
  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))
271
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
272 273
      else
	{
274
	  c1 = SREF (str1, i1++);
275
	  MAKE_CHAR_MULTIBYTE (c1);
276 277 278
	}

      if (STRING_MULTIBYTE (str2))
279
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
280 281
      else
	{
282
	  c2 = SREF (str2, i2++);
283
	  MAKE_CHAR_MULTIBYTE (c2);
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
	}

      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)
306
	return make_number (- i1 + XINT (start1));
307
      else
308
	return make_number (i1 - XINT (start1));
309 310 311 312 313 314 315 316 317 318
    }

  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
319
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
320
       doc: /* Return t if first arg string is less than second in lexicographic order.
Gerd Moellmann's avatar
Gerd Moellmann committed
321
Case is significant.
322
Symbols are also allowed; their print names are used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
323
  (register Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
324
{
325 326
  register EMACS_INT end;
  register EMACS_INT i1, i1_byte, i2, i2_byte;
Jim Blandy's avatar
Jim Blandy committed
327

328
  if (SYMBOLP (s1))
329
    s1 = SYMBOL_NAME (s1);
330
  if (SYMBOLP (s2))
331
    s2 = SYMBOL_NAME (s2);
332 333
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
334

335 336
  i1 = i1_byte = i2 = i2_byte = 0;

337 338 339
  end = SCHARS (s1);
  if (end > SCHARS (s2))
    end = SCHARS (s2);
Jim Blandy's avatar
Jim Blandy committed
340

341
  while (i1 < end)
Jim Blandy's avatar
Jim Blandy committed
342
    {
343 344 345 346
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

347 348
      FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
      FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
349 350 351

      if (c1 != c2)
	return c1 < c2 ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
352
    }
353
  return i1 < SCHARS (s2) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
354 355
}

356 357
static Lisp_Object concat (int nargs, Lisp_Object *args,
			   enum Lisp_Type target_type, int last_special);
Jim Blandy's avatar
Jim Blandy committed
358 359 360

/* ARGSUSED */
Lisp_Object
361
concat2 (Lisp_Object s1, Lisp_Object s2)
Jim Blandy's avatar
Jim Blandy committed
362 363 364 365 366 367 368
{
  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
369 370
/* ARGSUSED */
Lisp_Object
371
concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
Richard M. Stallman's avatar
Richard M. Stallman committed
372 373 374 375 376 377 378 379
{
  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
380
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
381
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
382 383
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
384 385
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
386
  (int nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
387 388 389 390 391
{
  return concat (nargs, args, Lisp_Cons, 1);
}

DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
392
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
393
The result is a string whose elements are the elements of all the arguments.
394 395
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
396
  (int nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
397 398 399 400 401
{
  return concat (nargs, args, Lisp_String, 0);
}

DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
402
       doc: /* Concatenate all the arguments and make the result a vector.
Gerd Moellmann's avatar
Gerd Moellmann committed
403
The result is a vector whose elements are the elements of all the arguments.
404 405
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES)   */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
406
  (int nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
407
{
408
  return concat (nargs, args, Lisp_Vectorlike, 0);
Jim Blandy's avatar
Jim Blandy committed
409 410
}

411

Jim Blandy's avatar
Jim Blandy committed
412
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
Dave Love's avatar
Dave Love committed
413
       doc: /* Return a copy of a list, vector, string or char-table.
Gerd Moellmann's avatar
Gerd Moellmann committed
414
The elements of a list or vector are not copied; they are shared
415
with the original.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
416
  (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
417
{
Jim Blandy's avatar
Jim Blandy committed
418
  if (NILP (arg)) return arg;
419 420 421

  if (CHAR_TABLE_P (arg))
    {
422
      return copy_char_table (arg);
423 424 425 426 427 428
    }

  if (BOOL_VECTOR_P (arg))
    {
      Lisp_Object val;
      int size_in_chars
429 430
	= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
	   / BOOL_VECTOR_BITS_PER_CHAR);
431 432

      val = Fmake_bool_vector (Flength (arg), Qnil);
433 434
      memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data,
	      size_in_chars);
435 436 437
      return val;
    }

438
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
439 440
    wrong_type_argument (Qsequencep, arg);

Jim Blandy's avatar
Jim Blandy committed
441 442 443
  return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}

444 445
/* 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
446
struct textprop_rec
447 448
{
  int argnum;			/* refer to ARGS (arguments of `concat') */
449 450
  EMACS_INT from;		/* refer to ARGS[argnum] (argument string) */
  EMACS_INT to;			/* refer to VAL (the target string) */
451 452
};

Jim Blandy's avatar
Jim Blandy committed
453
static Lisp_Object
454
concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)
Jim Blandy's avatar
Jim Blandy committed
455 456 457 458
{
  Lisp_Object val;
  register Lisp_Object tail;
  register Lisp_Object this;
459 460 461 462
  EMACS_INT toindex;
  EMACS_INT toindex_byte = 0;
  register EMACS_INT result_len;
  register EMACS_INT result_len_byte;
Jim Blandy's avatar
Jim Blandy committed
463 464 465
  register int argnum;
  Lisp_Object last_tail;
  Lisp_Object prev;
466
  int some_multibyte;
467 468 469 470 471
  /* 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.  */
472
  struct textprop_rec  *textprops = NULL;
Juanma Barranquero's avatar
Juanma Barranquero committed
473
  /* Number of elements in textprops.  */
Kenichi Handa's avatar
Kenichi Handa committed
474
  int num_textprops = 0;
Kim F. Storm's avatar
Kim F. Storm committed
475
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
476

477 478
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
479 480 481 482 483 484 485 486 487
  /* 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;

488
  /* Check each argument.  */
Jim Blandy's avatar
Jim Blandy committed
489 490 491
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
492
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
493
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
494
	wrong_type_argument (Qsequencep, this);
Jim Blandy's avatar
Jim Blandy committed
495 496
    }

497 498 499 500 501 502 503 504
  /* 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
505
    {
506
      EMACS_INT len;
Jim Blandy's avatar
Jim Blandy committed
507
      this = args[argnum];
508 509
      len = XFASTINT (Flength (this));
      if (target_type == Lisp_String)
510
	{
511 512
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
513
	  EMACS_INT i;
514
	  Lisp_Object ch;
515
	  EMACS_INT this_len_byte;
516

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

      result_len += len;
553 554
      if (result_len < 0)
	error ("String overflow");
Jim Blandy's avatar
Jim Blandy committed
555 556
    }

557 558
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
559

560
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
561
  if (target_type == Lisp_Cons)
562
    val = Fmake_list (make_number (result_len), Qnil);
563
  else if (target_type == Lisp_Vectorlike)
564
    val = Fmake_vector (make_number (result_len), Qnil);
565
  else if (some_multibyte)
566
    val = make_uninit_multibyte_string (result_len, result_len_byte);
567 568
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
569

570 571 572
  /* 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
573

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

  prev = Qnil;
581
  if (STRINGP (val))
Kim F. Storm's avatar
Kim F. Storm committed
582
    SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
Jim Blandy's avatar
Jim Blandy committed
583 584 585 586

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
587 588 589
      EMACS_INT thisleni = 0;
      register EMACS_INT thisindex = 0;
      register EMACS_INT thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
590 591 592 593 594

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

595 596 597
      /* 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
598
	{
599
	  EMACS_INT thislen_byte = SBYTES (this);
600

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

676 677
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
678
	      {
679
		XSETCAR (tail, elt);
680
		prev = tail;
681
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
682
	      }
683
	    else if (VECTORP (val))
684 685 686 687
	      {
		ASET (val, toindex, elt);
		toindex++;
	      }
688 689
	    else
	      {
690
		CHECK_NUMBER (elt);
691
		if (some_multibyte)
Kenichi Handa's avatar
Kenichi Handa committed
692 693
		  toindex_byte += CHAR_STRING (XINT (elt),
					       SDATA (val) + toindex_byte);
694
		else
Kenichi Handa's avatar
Kenichi Handa committed
695
		  SSET (val, toindex_byte++, XINT (elt));
696
		toindex++;
697 698
	      }
	  }
Jim Blandy's avatar
Jim Blandy committed
699
    }
Jim Blandy's avatar
Jim Blandy committed
700
  if (!NILP (prev))
701
    XSETCDR (prev, last_tail);
Jim Blandy's avatar
Jim Blandy committed
702

Kenichi Handa's avatar
Kenichi Handa committed
703
  if (num_textprops > 0)
704
    {
705
      Lisp_Object props;
706
      EMACS_INT last_to_end = -1;
707

Kenichi Handa's avatar
Kenichi Handa committed
708
      for (argnum = 0; argnum < num_textprops; argnum++)
709
	{
Kenichi Handa's avatar
Kenichi Handa committed
710
	  this = args[textprops[argnum].argnum];
711 712
	  props = text_property_list (this,
				      make_number (0),
713
				      make_number (SCHARS (this)),
714 715 716
				      Qnil);
	  /* If successive arguments have properites, be sure that the
	     value of `composition' property be the copy.  */
717
	  if (last_to_end == textprops[argnum].to)
718 719 720
	    make_composition_value_copy (props);
	  add_text_properties_from_list (val, props,
					 make_number (textprops[argnum].to));
721
	  last_to_end = textprops[argnum].to + SCHARS (this);
722 723
	}
    }
Kim F. Storm's avatar
Kim F. Storm committed
724 725

  SAFE_FREE ();
Karl Heuer's avatar
Karl Heuer committed
726
  return val;
Jim Blandy's avatar
Jim Blandy committed
727 728
}

729
static Lisp_Object string_char_byte_cache_string;
730 731
static EMACS_INT string_char_byte_cache_charpos;
static EMACS_INT string_char_byte_cache_bytepos;
732

733
void
734
clear_string_char_byte_cache (void)
735 736 737 738
{
  string_char_byte_cache_string = Qnil;
}

739
/* Return the byte index corresponding to CHAR_INDEX in STRING.  */
740

741
EMACS_INT
742
string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
743
{
744