fns.c 138 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 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7 8 9

This file is part of GNU Emacs.

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

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
along with GNU Emacs; see the file COPYING.  If not, write to
Lute Kamstra's avatar
Lute Kamstra committed
20 21
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */
Jim Blandy's avatar
Jim Blandy committed
22

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

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

30 31
#ifndef MAC_OS
/* On Mac OS, defining this conflicts with precompiled headers.  */
32

Jim Blandy's avatar
Jim Blandy committed
33 34 35 36
/* 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 *****
37 38 39

#endif  /* ! MAC_OSX */

Jim Blandy's avatar
Jim Blandy committed
40 41
#include "lisp.h"
#include "commands.h"
42
#include "character.h"
43
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
44
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
45
#include "keyboard.h"
Stefan Monnier's avatar
Stefan Monnier committed
46
#include "keymap.h"
47
#include "intervals.h"
48 49
#include "frame.h"
#include "window.h"
Gerd Moellmann's avatar
Gerd Moellmann committed
50
#include "blockinput.h"
51 52
#ifdef HAVE_MENUS
#if defined (HAVE_X_WINDOWS)
Andreas Schwab's avatar
Andreas Schwab committed
53
#include "xterm.h"
54 55 56
#elif defined (MAC_OS)
#include "macterm.h"
#endif
Andreas Schwab's avatar
Andreas Schwab committed
57
#endif
Jim Blandy's avatar
Jim Blandy committed
58

Karl Heuer's avatar
Karl Heuer committed
59
#ifndef NULL
60
#define NULL ((POINTER_TYPE *)0)
Karl Heuer's avatar
Karl Heuer committed
61 62
#endif

63 64 65 66
/* Nonzero enables use of dialog boxes for questions
   asked by mouse commands.  */
int use_dialog_box;

Kenichi Handa's avatar
Kenichi Handa committed
67 68 69 70
/* Nonzero enables use of a file dialog for file name
   questions asked by mouse commands.  */
int use_file_dialog;

71 72
extern int minibuffer_auto_raise;
extern Lisp_Object minibuf_window;
73
extern Lisp_Object Vlocale_coding_system;
74
extern int load_in_progress;
75

76
Lisp_Object Qstring_lessp, Qprovide, Qrequire;
77
Lisp_Object Qyes_or_no_p_history;
78
Lisp_Object Qcursor_in_echo_area;
Karl Heuer's avatar
Karl Heuer committed
79
Lisp_Object Qwidget_type;
80
Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
Jim Blandy's avatar
Jim Blandy committed
81

82 83
extern Lisp_Object Qinput_method_function;

84
static int internal_equal P_ ((Lisp_Object , Lisp_Object, int, int));
85 86

extern long get_random ();
87
extern void seed_random P_ ((long));
88 89 90 91

#ifndef HAVE_UNISTD_H
extern long time ();
#endif
92

Jim Blandy's avatar
Jim Blandy committed
93
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
Pavel Janík's avatar
Pavel Janík committed
94
       doc: /* Return the argument unchanged.  */)
95
     (arg)
Jim Blandy's avatar
Jim Blandy committed
96 97 98 99 100 101
     Lisp_Object arg;
{
  return arg;
}

DEFUN ("random", Frandom, Srandom, 0, 1, 0,
102
       doc: /* Return a pseudo-random number.
Gerd Moellmann's avatar
Gerd Moellmann committed
103
All integers representable in Lisp are equally likely.
Kenichi Handa's avatar
Kenichi Handa committed
104
  On most systems, this is 29 bits' worth.
Gerd Moellmann's avatar
Gerd Moellmann committed
105
With positive integer argument N, return random number in interval [0,N).
106 107
With argument t, set the random number seed from the current time and pid. */)
     (n)
108
     Lisp_Object n;
Jim Blandy's avatar
Jim Blandy committed
109
{
110 111
  EMACS_INT val;
  Lisp_Object lispy_val;
112
  unsigned long denominator;
Jim Blandy's avatar
Jim Blandy committed
113

114
  if (EQ (n, Qt))
115
    seed_random (getpid () + time (NULL));
116
  if (NATNUMP (n) && XFASTINT (n) != 0)
Jim Blandy's avatar
Jim Blandy committed
117
    {
118 119 120 121
      /* 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
122
	 it's possible to get a quotient larger than n; discarding
123
	 these values eliminates the bias that would otherwise appear
124 125
	 when using a large n.  */
      denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n);
126
      do
127
	val = get_random () / denominator;
128
      while (val >= XFASTINT (n));
Jim Blandy's avatar
Jim Blandy committed
129
    }
130
  else
131
    val = get_random ();
132 133
  XSETINT (lispy_val, val);
  return lispy_val;
Jim Blandy's avatar
Jim Blandy committed
134 135 136 137 138
}

/* Random data-structure functions */

DEFUN ("length", Flength, Slength, 1, 1, 0,
139
       doc: /* Return the length of vector, list or string SEQUENCE.
Gerd Moellmann's avatar
Gerd Moellmann committed
140
A byte-code function object is also allowed.
John Paul Wallington's avatar
John Paul Wallington committed
141
If the string contains multibyte characters, this is not necessarily
Gerd Moellmann's avatar
Gerd Moellmann committed
142
the number of bytes in the string; it is the number of characters.
143 144
To get the number of bytes, use `string-bytes'. */)
     (sequence)
145
     register Lisp_Object sequence;
Jim Blandy's avatar
Jim Blandy committed
146
{
147
  register Lisp_Object val;
Jim Blandy's avatar
Jim Blandy committed
148 149 150
  register int i;

 retry:
151
  if (STRINGP (sequence))
152
    XSETFASTINT (val, SCHARS (sequence));
153 154 155
  else if (VECTORP (sequence))
    XSETFASTINT (val, XVECTOR (sequence)->size);
  else if (CHAR_TABLE_P (sequence))
156
    XSETFASTINT (val, MAX_CHAR);
157 158 159 160 161
  else if (BOOL_VECTOR_P (sequence))
    XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
  else if (COMPILEDP (sequence))
    XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
  else if (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
162
    {
163 164
      i = 0;
      while (CONSP (sequence))
Jim Blandy's avatar
Jim Blandy committed
165
	{
166
	  sequence = XCDR (sequence);
167 168 169 170 171 172 173 174
	  ++i;

	  if (!CONSP (sequence))
	    break;

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

177 178 179 180
      if (!NILP (sequence))
	wrong_type_argument (Qlistp, sequence);

      val = make_number (i);
Jim Blandy's avatar
Jim Blandy committed
181
    }
182
  else if (NILP (sequence))
183
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
184 185
  else
    {
186
      sequence = wrong_type_argument (Qsequencep, sequence);
Jim Blandy's avatar
Jim Blandy committed
187 188
      goto retry;
    }
189
  return val;
Jim Blandy's avatar
Jim Blandy committed
190 191
}

192
/* This does not check for quits.  That is safe since it must terminate.  */
193 194

DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
195
       doc: /* Return the length of a list, but avoid error or infinite loop.
Gerd Moellmann's avatar
Gerd Moellmann committed
196 197
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
198 199
which is at least the number of distinct elements. */)
     (list)
200 201 202 203 204 205 206
     Lisp_Object list;
{
  Lisp_Object tail, halftail, length;
  int len = 0;

  /* halftail is used to detect circular lists.  */
  halftail = list;
207
  for (tail = list; CONSP (tail); tail = XCDR (tail))
208 209
    {
      if (EQ (tail, halftail) && len != 0)
210
	break;
211
      len++;
212
      if ((len & 1) == 0)
213
	halftail = XCDR (halftail);
214 215 216 217 218 219
    }

  XSETINT (length, len);
  return length;
}

220
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
221
       doc: /* Return the number of bytes in STRING.
222
If STRING is multibyte, this may be greater than the length of STRING. */)
223
     (string)
224
     Lisp_Object string;
225
{
226
  CHECK_STRING (string);
227
  return make_number (SBYTES (string));
228 229
}

Jim Blandy's avatar
Jim Blandy committed
230
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
231
       doc: /* Return t if two strings have identical contents.
Gerd Moellmann's avatar
Gerd Moellmann committed
232
Case is significant, but text properties are ignored.
233 234
Symbols are also allowed; their print names are used instead. */)
     (s1, s2)
Jim Blandy's avatar
Jim Blandy committed
235 236
     register Lisp_Object s1, s2;
{
237
  if (SYMBOLP (s1))
238
    s1 = SYMBOL_NAME (s1);
239
  if (SYMBOLP (s2))
240
    s2 = SYMBOL_NAME (s2);
241 242
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
243

244 245 246
  if (SCHARS (s1) != SCHARS (s2)
      || SBYTES (s1) != SBYTES (s2)
      || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
Jim Blandy's avatar
Jim Blandy committed
247 248 249 250
    return Qnil;
  return Qt;
}

251
DEFUN ("compare-strings", Fcompare_strings,
252
       Scompare_strings, 6, 7, 0,
253
doc: /* Compare the contents of two strings, converting to multibyte if needed.
Gerd Moellmann's avatar
Gerd Moellmann committed
254 255 256 257 258 259 260 261 262 263 264
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;
265 266
  N - 1 is the number of characters that match at the beginning. */)
     (str1, start1, end1, str2, start2, end2, ignore_case)
267 268 269 270 271
     Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case;
{
  register int end1_char, end2_char;
  register int i1, i1_byte, i2, i2_byte;

272 273
  CHECK_STRING (str1);
  CHECK_STRING (str2);
274 275 276 277
  if (NILP (start1))
    start1 = make_number (0);
  if (NILP (start2))
    start2 = make_number (0);
278 279
  CHECK_NATNUM (start1);
  CHECK_NATNUM (start2);
280
  if (! NILP (end1))
281
    CHECK_NATNUM (end1);
282
  if (! NILP (end2))
283
    CHECK_NATNUM (end2);
284 285 286 287 288 289 290

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

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

291
  end1_char = SCHARS (str1);
292 293 294
  if (! NILP (end1) && end1_char > XINT (end1))
    end1_char = XINT (end1);

295
  end2_char = SCHARS (str2);
296 297 298 299 300 301 302 303 304 305
  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))
306
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
307 308
      else
	{
309
	  c1 = SREF (str1, i1++);
310 311 312 313
	  c1 = unibyte_char_to_multibyte (c1);
	}

      if (STRING_MULTIBYTE (str2))
314
	FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
315 316
      else
	{
317
	  c2 = SREF (str2, i2++);
318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340
	  c2 = unibyte_char_to_multibyte (c2);
	}

      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)
341
	return make_number (- i1 + XINT (start1));
342
      else
343
	return make_number (i1 - XINT (start1));
344 345 346 347 348 349 350 351 352 353
    }

  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
354
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
355
       doc: /* Return t if first arg string is less than second in lexicographic order.
Gerd Moellmann's avatar
Gerd Moellmann committed
356
Case is significant.
357 358
Symbols are also allowed; their print names are used instead. */)
     (s1, s2)
Jim Blandy's avatar
Jim Blandy committed
359 360 361
     register Lisp_Object s1, s2;
{
  register int end;
362
  register int i1, i1_byte, i2, i2_byte;
Jim Blandy's avatar
Jim Blandy committed
363

364
  if (SYMBOLP (s1))
365
    s1 = SYMBOL_NAME (s1);
366
  if (SYMBOLP (s2))
367
    s2 = SYMBOL_NAME (s2);
368 369
  CHECK_STRING (s1);
  CHECK_STRING (s2);
Jim Blandy's avatar
Jim Blandy committed
370

371 372
  i1 = i1_byte = i2 = i2_byte = 0;

373 374 375
  end = SCHARS (s1);
  if (end > SCHARS (s2))
    end = SCHARS (s2);
Jim Blandy's avatar
Jim Blandy committed
376

377
  while (i1 < end)
Jim Blandy's avatar
Jim Blandy committed
378
    {
379 380 381 382
      /* When we find a mismatch, we must compare the
	 characters, not just the bytes.  */
      int c1, c2;

383 384
      FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
      FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
385 386 387

      if (c1 != c2)
	return c1 < c2 ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
388
    }
389
  return i1 < SCHARS (s2) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408
}

static Lisp_Object concat ();

/* ARGSUSED */
Lisp_Object
concat2 (s1, s2)
     Lisp_Object s1, s2;
{
#ifdef NO_ARG_ARRAY
  Lisp_Object args[2];
  args[0] = s1;
  args[1] = s2;
  return concat (2, args, Lisp_String, 0);
#else
  return concat (2, &s1, Lisp_String, 0);
#endif /* NO_ARG_ARRAY */
}

Richard M. Stallman's avatar
Richard M. Stallman committed
409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
/* ARGSUSED */
Lisp_Object
concat3 (s1, s2, s3)
     Lisp_Object s1, s2, s3;
{
#ifdef NO_ARG_ARRAY
  Lisp_Object args[3];
  args[0] = s1;
  args[1] = s2;
  args[2] = s3;
  return concat (3, args, Lisp_String, 0);
#else
  return concat (3, &s1, Lisp_String, 0);
#endif /* NO_ARG_ARRAY */
}

Jim Blandy's avatar
Jim Blandy committed
425
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
426
       doc: /* Concatenate all the arguments and make the result a list.
Gerd Moellmann's avatar
Gerd Moellmann committed
427 428
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
429 430
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES)  */)
431
     (nargs, args)
Jim Blandy's avatar
Jim Blandy committed
432 433 434 435 436 437 438
     int nargs;
     Lisp_Object *args;
{
  return concat (nargs, args, Lisp_Cons, 1);
}

DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
439
       doc: /* Concatenate all the arguments and make the result a string.
Gerd Moellmann's avatar
Gerd Moellmann committed
440
The result is a string whose elements are the elements of all the arguments.
441 442
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES)  */)
443
     (nargs, args)
Jim Blandy's avatar
Jim Blandy committed
444 445 446 447 448 449 450
     int nargs;
     Lisp_Object *args;
{
  return concat (nargs, args, Lisp_String, 0);
}

DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
451
       doc: /* Concatenate all the arguments and make the result a vector.
Gerd Moellmann's avatar
Gerd Moellmann committed
452
The result is a vector whose elements are the elements of all the arguments.
453 454
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES)   */)
455
     (nargs, args)
Jim Blandy's avatar
Jim Blandy committed
456 457 458
     int nargs;
     Lisp_Object *args;
{
459
  return concat (nargs, args, Lisp_Vectorlike, 0);
Jim Blandy's avatar
Jim Blandy committed
460 461
}

462

Jim Blandy's avatar
Jim Blandy committed
463
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
Dave Love's avatar
Dave Love committed
464
       doc: /* Return a copy of a list, vector, string or char-table.
Gerd Moellmann's avatar
Gerd Moellmann committed
465
The elements of a list or vector are not copied; they are shared
466 467
with the original. */)
     (arg)
Jim Blandy's avatar
Jim Blandy committed
468 469
     Lisp_Object arg;
{
Jim Blandy's avatar
Jim Blandy committed
470
  if (NILP (arg)) return arg;
471 472 473

  if (CHAR_TABLE_P (arg))
    {
474
      return copy_char_table (arg);
475 476 477 478 479 480
    }

  if (BOOL_VECTOR_P (arg))
    {
      Lisp_Object val;
      int size_in_chars
481 482
	= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
	   / BOOL_VECTOR_BITS_PER_CHAR);
483 484 485 486 487 488 489

      val = Fmake_bool_vector (Flength (arg), Qnil);
      bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
	     size_in_chars);
      return val;
    }

490
  if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
Jim Blandy's avatar
Jim Blandy committed
491 492 493 494
    arg = wrong_type_argument (Qsequencep, arg);
  return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}

495 496
/* 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
497
struct textprop_rec
498 499 500 501 502 503
{
  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
504 505 506 507 508 509 510 511 512 513 514
static Lisp_Object
concat (nargs, args, target_type, last_special)
     int nargs;
     Lisp_Object *args;
     enum Lisp_Type target_type;
     int last_special;
{
  Lisp_Object val;
  register Lisp_Object tail;
  register Lisp_Object this;
  int toindex;
515
  int toindex_byte = 0;
516 517
  register int result_len;
  register int result_len_byte;
Jim Blandy's avatar
Jim Blandy committed
518 519 520
  register int argnum;
  Lisp_Object last_tail;
  Lisp_Object prev;
521
  int some_multibyte;
522 523 524 525 526
  /* 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.  */
527
  struct textprop_rec  *textprops = NULL;
Kenichi Handa's avatar
Kenichi Handa committed
528 529
  /* Number of elments in textprops.  */
  int num_textprops = 0;
Kim F. Storm's avatar
Kim F. Storm committed
530
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
531

532 533
  tail = Qnil;

Jim Blandy's avatar
Jim Blandy committed
534 535 536 537 538 539 540 541 542
  /* 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;

543
  /* Canonicalize each argument.  */
Jim Blandy's avatar
Jim Blandy committed
544 545 546
  for (argnum = 0; argnum < nargs; argnum++)
    {
      this = args[argnum];
547
      if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
548
	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
Jim Blandy's avatar
Jim Blandy committed
549 550 551 552 553
	{
	    args[argnum] = wrong_type_argument (Qsequencep, this);
	}
    }

554 555 556 557 558 559 560 561
  /* 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
562
    {
563
      int len;
Jim Blandy's avatar
Jim Blandy committed
564
      this = args[argnum];
565 566
      len = XFASTINT (Flength (this));
      if (target_type == Lisp_String)
567
	{
568 569
	  /* We must count the number of bytes needed in the string
	     as well as the number of characters.  */
570 571
	  int i;
	  Lisp_Object ch;
572
	  int this_len_byte;
573

574
	  if (VECTORP (this))
575
	    for (i = 0; i < len; i++)
576 577
	      {
		ch = XVECTOR (this)->contents[i];
Dave Love's avatar
Dave Love committed
578 579
		if (! CHARACTERP (ch))
		  wrong_type_argument (Qcharacterp, ch);
580
		this_len_byte = CHAR_BYTES (XINT (ch));
581
		result_len_byte += this_len_byte;
582
		if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
583
		  some_multibyte = 1;
584
	      }
585 586
	  else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
	    wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
587
	  else if (CONSP (this))
588
	    for (; CONSP (this); this = XCDR (this))
589
	      {
590
		ch = XCAR (this);
Dave Love's avatar
Dave Love committed
591 592
		if (! CHARACTERP (ch))
		  wrong_type_argument (Qcharacterp, ch);
593
		this_len_byte = CHAR_BYTES (XINT (ch));
594
		result_len_byte += this_len_byte;
595
		if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
596
		  some_multibyte = 1;
597
	      }
598
	  else if (STRINGP (this))
599
	    {
600
	      if (STRING_MULTIBYTE (this))
601 602
		{
		  some_multibyte = 1;
603
		  result_len_byte += SBYTES (this);
604 605
		}
	      else
606 607
		result_len_byte += count_size_as_multibyte (SDATA (this),
							    SCHARS (this));
608
	    }
609
	}
610 611

      result_len += len;
Jim Blandy's avatar
Jim Blandy committed
612 613
    }

614 615
  if (! some_multibyte)
    result_len_byte = result_len;
Jim Blandy's avatar
Jim Blandy committed
616

617
  /* Create the output object.  */
Jim Blandy's avatar
Jim Blandy committed
618
  if (target_type == Lisp_Cons)
619
    val = Fmake_list (make_number (result_len), Qnil);
620
  else if (target_type == Lisp_Vectorlike)
621
    val = Fmake_vector (make_number (result_len), Qnil);
622
  else if (some_multibyte)
623
    val = make_uninit_multibyte_string (result_len, result_len_byte);
624 625
  else
    val = make_uninit_string (result_len);
Jim Blandy's avatar
Jim Blandy committed
626

627 628 629
  /* 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
630

631
  /* Copy the contents of the args into the result.  */
Jim Blandy's avatar
Jim Blandy committed
632
  if (CONSP (val))
633
    tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
Jim Blandy's avatar
Jim Blandy committed
634
  else
635
    toindex = 0, toindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
636 637

  prev = Qnil;
638
  if (STRINGP (val))
Kim F. Storm's avatar
Kim F. Storm committed
639
    SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
Jim Blandy's avatar
Jim Blandy committed
640 641 642 643

  for (argnum = 0; argnum < nargs; argnum++)
    {
      Lisp_Object thislen;
644
      int thisleni = 0;
645
      register unsigned int thisindex = 0;
646
      register unsigned int thisindex_byte = 0;
Jim Blandy's avatar
Jim Blandy committed
647 648 649 650 651

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

652 653 654
      /* 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
655
	{
656
	  int thislen_byte = SBYTES (this);
657

658 659 660
	  bcopy (SDATA (this), SDATA (val) + toindex_byte,
		 SBYTES (this));
	  if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
661
	    {
Kenichi Handa's avatar
Kenichi Handa committed
662
	      textprops[num_textprops].argnum = argnum;
663
	      textprops[num_textprops].from = 0;
Kenichi Handa's avatar
Kenichi Handa committed
664
	      textprops[num_textprops++].to = toindex;
665
	    }
666
	  toindex_byte += thislen_byte;
667
	  toindex += thisleni;
Kenichi Handa's avatar
Kenichi Handa committed
668
	  STRING_SET_CHARS (val, SCHARS (val));
669
	}
670 671 672
      /* Copy a single-byte string to a multibyte string.  */
      else if (STRINGP (this) && STRINGP (val))
	{
673
	  if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
674
	    {
Kenichi Handa's avatar
Kenichi Handa committed
675 676 677
	      textprops[num_textprops].argnum = argnum;
	      textprops[num_textprops].from = 0;
	      textprops[num_textprops++].to = toindex;
678
	    }
679 680 681
	  toindex_byte += copy_text (SDATA (this),
				     SDATA (val) + toindex_byte,
				     SCHARS (this), 0, 1);
682 683
	  toindex += thisleni;
	}
684 685 686 687 688 689 690 691 692 693
      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))
694
	      elt = XCAR (this), this = XCDR (this);
695 696 697
	    else if (thisindex >= thisleni)
	      break;
	    else if (STRINGP (this))
698
	      {
699
		int c;
700
		if (STRING_MULTIBYTE (this))
701
		  {
702 703 704
		    FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
							thisindex,
							thisindex_byte);
705
		    XSETFASTINT (elt, c);
706
		  }
707
		else
708
		  {
709
		    XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
710
		    if (some_multibyte
711
			&& XINT (elt) >= 0200
712 713
			&& XINT (elt) < 0400)
		      {
714
			c = unibyte_char_to_multibyte (XINT (elt));
715 716
			XSETINT (elt, c);
		      }
717
		  }
718 719 720 721
	      }
	    else if (BOOL_VECTOR_P (this))
	      {
		int byte;
722 723
		byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
		if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
724
		  elt = Qt;
725
		else
726 727
		  elt = Qnil;
		thisindex++;
728
	      }
729 730
	    else
	      elt = XVECTOR (this)->contents[thisindex++];
Jim Blandy's avatar
Jim Blandy committed
731

732 733
	    /* Store this element into the result.  */
	    if (toindex < 0)
Jim Blandy's avatar
Jim Blandy committed
734
	      {
735
		XSETCAR (tail, elt);
736
		prev = tail;
737
		tail = XCDR (tail);
Jim Blandy's avatar
Jim Blandy committed
738
	      }
739 740 741 742
	    else if (VECTORP (val))
	      XVECTOR (val)->contents[toindex++] = elt;
	    else
	      {
743
		CHECK_NUMBER (elt);
744
		if (some_multibyte)
Kenichi Handa's avatar
Kenichi Handa committed
745 746
		  toindex_byte += CHAR_STRING (XINT (elt),
					       SDATA (val) + toindex_byte);
747
		else
Kenichi Handa's avatar
Kenichi Handa committed
748
		  SSET (val, toindex_byte++, XINT (elt));
749
		toindex++;
750 751
	      }
	  }
Jim Blandy's avatar
Jim Blandy committed
752
    }
Jim Blandy's avatar
Jim Blandy committed
753
  if (!NILP (prev))
754
    XSETCDR (prev, last_tail);
Jim Blandy's avatar
Jim Blandy committed
755

Kenichi Handa's avatar
Kenichi Handa committed
756
  if (num_textprops > 0)
757
    {
758
      Lisp_Object props;
759
      int last_to_end = -1;
760

Kenichi Handa's avatar
Kenichi Handa committed
761
      for (argnum = 0; argnum < num_textprops; argnum++)
762
	{
Kenichi Handa's avatar
Kenichi Handa committed
763
	  this = args[textprops[argnum].argnum];
764 765
	  props = text_property_list (this,
				      make_number (0),
766
				      make_number (SCHARS (this)),
767 768 769
				      Qnil);
	  /* If successive arguments have properites, be sure that the
	     value of `composition' property be the copy.  */
770
	  if (last_to_end == textprops[argnum].to)
771 772 773
	    make_composition_value_copy (props);
	  add_text_properties_from_list (val, props,
					 make_number (textprops[argnum].to));
774
	  last_to_end = textprops[argnum].to + SCHARS (this);
775 776
	}
    }
Kim F. Storm's avatar
Kim F. Storm committed
777 778

  SAFE_FREE ();
Karl Heuer's avatar
Karl Heuer committed
779
  return val;
Jim Blandy's avatar
Jim Blandy committed
780 781
}

782 783 784 785
static Lisp_Object string_char_byte_cache_string;
static int string_char_byte_cache_charpos;
static int string_char_byte_cache_bytepos;

786 787 788 789 790 791
void
clear_string_char_byte_cache ()
{
  string_char_byte_cache_string = Qnil;
}

792 793 794 795 796 797 798
/* Return the character index corresponding to CHAR_INDEX in STRING.  */

int
string_char_to_byte (string, char_index)
     Lisp_Object string;
     int char_index;
{
Dave Love's avatar
Dave Love committed
799
  int i_byte;
800 801
  int best_below, best_below_byte;
  int best_above, best_above_byte;
802

803
  best_below = best_below_byte = 0;
804 805
  best_above = SCHARS (string);
  best_above_byte = SBYTES (string);
806 807
  if (best_above == best_above_byte)
    return char_index;
808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824

  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
825
      unsigned char *p = SDATA (string) + best_below_byte;
826

827 828
      while (best_below < char_index)
	{
829 830
	  p += BYTES_BY_CHAR_HEAD (*p);
	  best_below++;
831
	}
Kenichi Handa's avatar
Kenichi Handa committed
832
      i_byte = p - SDATA (string);
833 834
    }
  else
835
    {
Kenichi Handa's avatar
Kenichi Handa committed
836
      unsigned char *p = SDATA (string) + best_above_byte;
837

838 839
      while (best_above > char_index)
	{
840 841
	  p--;
	  while (!CHAR_HEAD_P (*p)) p--;
842 843
	  best_above--;
	}
Kenichi Handa's avatar
Kenichi Handa committed
844
      i_byte = p - SDATA (string);
845 846
    }

847
  string_char_byte_cache_bytepos = i_byte;
848
  string_char_byte_cache_charpos = char_index;
849 850
  string_char_byte_cache_string = string;

851 852
  return i_byte;
}
853

854 855 856 857 858 859 860
/* Return the character index corresponding to BYTE_INDEX in STRING.  */

int
string_byte_to_char (string, byte_index)
     Lisp_Object string;
     int byte_index;
{
861 862 863
  int i, i_byte;
  int best_below, best_below_byte;
  int best_above, best_above_byte;
864

865
  best_below = best_below_byte = 0;
866 867
  best_above = SCHARS (string);
  best_above_byte = SBYTES (string);
868 869
  if (best_above == best_above_byte)
    return byte_index;
870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886

  if (EQ (string, string_char_byte_cache_string))
    {
      if (string_char_byte_cache_bytepos < byte_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 (byte_index - best_below_byte < best_above_byte - byte_index)
    {
Kenichi Handa's avatar
Kenichi Handa committed
887 888
      unsigned char *p = SDATA (string) + best_below_byte;
      unsigned char *pend = SDATA (string) + byte_index;
889 890

      while (p < pend)
891
	{
892 893
	  p += BYTES_BY_CHAR_HEAD (*p);
	  best_below++;
894 895
	}
      i = best_below;
Kenichi Handa's avatar
Kenichi Handa committed
896
      i_byte = p - SDATA (string);
897 898
    }
  else
899
    {
Kenichi Handa's avatar
Kenichi Handa committed
900 901
      unsigned char *p = SDATA (string) + best_above_byte;
      unsigned char *pbeg = SDATA (string) + byte_index;
Kenichi Handa's avatar