data.c 91.8 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2
   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
Glenn Morris's avatar
Glenn Morris committed
3
                 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Glenn Morris's avatar
Glenn Morris committed
4
                 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

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

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


22
#include <config.h>
23
#include <signal.h>
24
#include <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
25
#include "lisp.h"
Jim Blandy's avatar
Jim Blandy committed
26
#include "puresize.h"
27
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
28
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
29
#include "keyboard.h"
30
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
31
#include "syssignal.h"
32
#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p. */
33
#include "font.h"
Jim Blandy's avatar
Jim Blandy committed
34

35
#ifdef STDC_HEADERS
36
#include <float.h>
37
#endif
38

39 40 41 42 43 44 45 46 47 48
/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
#ifndef IEEE_FLOATING_POINT
#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
#define IEEE_FLOATING_POINT 1
#else
#define IEEE_FLOATING_POINT 0
#endif
#endif

Jim Blandy's avatar
Jim Blandy committed
49 50
#include <math.h>

51 52 53 54
#if !defined (atof)
extern double atof ();
#endif /* !atof */

Jim Blandy's avatar
Jim Blandy committed
55 56 57
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
Jim Blandy's avatar
Jim Blandy committed
58
Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
59
Lisp_Object Qcyclic_variable_indirection, Qcircular_list;
Jim Blandy's avatar
Jim Blandy committed
60 61
Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
Roland McGrath's avatar
Roland McGrath committed
62
Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
Jim Blandy's avatar
Jim Blandy committed
63
Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
64
Lisp_Object Qtext_read_only;
Kenichi Handa's avatar
Kenichi Handa committed
65

66
Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
Jim Blandy's avatar
Jim Blandy committed
67 68
Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
Dave Love's avatar
Dave Love committed
69
Lisp_Object Qbuffer_or_string_p, Qkeywordp;
Jim Blandy's avatar
Jim Blandy committed
70
Lisp_Object Qboundp, Qfboundp;
71
Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
72

Jim Blandy's avatar
Jim Blandy committed
73
Lisp_Object Qcdr;
74
Lisp_Object Qad_advice_info, Qad_activate_internal;
Jim Blandy's avatar
Jim Blandy committed
75

76 77 78
Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
Lisp_Object Qoverflow_error, Qunderflow_error;

79
Lisp_Object Qfloatp;
Jim Blandy's avatar
Jim Blandy committed
80 81
Lisp_Object Qnumberp, Qnumber_or_marker_p;

Kenichi Handa's avatar
Kenichi Handa committed
82 83
Lisp_Object Qinteger;
static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
Karl Heuer's avatar
Karl Heuer committed
84 85
static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
Lisp_Object Qprocess;
86
static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
Gerd Moellmann's avatar
Gerd Moellmann committed
87
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
88
static Lisp_Object Qsubrp, Qmany, Qunevalled;
89
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
90

91
static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
92

93
Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
94

95 96 97 98 99

void
circular_list_error (list)
     Lisp_Object list;
{
100
  xsignal (Qcircular_list, list);
101 102 103
}


Jim Blandy's avatar
Jim Blandy committed
104 105 106 107
Lisp_Object
wrong_type_argument (predicate, value)
     register Lisp_Object predicate, value;
{
108 109
  /* If VALUE is not even a valid Lisp object, abort here
     where we can get a backtrace showing where it came from.  */
110
  if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
111
    abort ();
112

113
  xsignal2 (Qwrong_type_argument, predicate, value);
Jim Blandy's avatar
Jim Blandy committed
114 115
}

Andreas Schwab's avatar
Andreas Schwab committed
116
void
Jim Blandy's avatar
Jim Blandy committed
117 118 119 120 121 122 123 124 125
pure_write_error ()
{
  error ("Attempt to modify read-only object");
}

void
args_out_of_range (a1, a2)
     Lisp_Object a1, a2;
{
126
  xsignal2 (Qargs_out_of_range, a1, a2);
Jim Blandy's avatar
Jim Blandy committed
127 128 129 130 131 132
}

void
args_out_of_range_3 (a1, a2, a3)
     Lisp_Object a1, a2, a3;
{
133
  xsignal3 (Qargs_out_of_range, a1, a2, a3);
Jim Blandy's avatar
Jim Blandy committed
134 135 136 137 138 139 140 141 142 143 144
}

/* On some machines, XINT needs a temporary location.
   Here it is, in case it is needed.  */

int sign_extend_temp;

/* On a few machines, XINT can only be done by calling this.  */

int
sign_extend_lisp_int (num)
145
     EMACS_INT num;
Jim Blandy's avatar
Jim Blandy committed
146
{
147 148
  if (num & (((EMACS_INT) 1) << (VALBITS - 1)))
    return num | (((EMACS_INT) (-1)) << VALBITS);
Jim Blandy's avatar
Jim Blandy committed
149
  else
150
    return num & ((((EMACS_INT) 1) << VALBITS) - 1);
Jim Blandy's avatar
Jim Blandy committed
151 152 153 154 155
}

/* Data type predicates */

DEFUN ("eq", Feq, Seq, 2, 2, 0,
156 157
       doc: /* Return t if the two args are the same Lisp object.  */)
     (obj1, obj2)
Jim Blandy's avatar
Jim Blandy committed
158 159 160 161 162 163 164
     Lisp_Object obj1, obj2;
{
  if (EQ (obj1, obj2))
    return Qt;
  return Qnil;
}

165 166 167
DEFUN ("null", Fnull, Snull, 1, 1, 0,
       doc: /* Return t if OBJECT is nil.  */)
     (object)
168
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
169
{
170
  if (NILP (object))
Jim Blandy's avatar
Jim Blandy committed
171 172 173 174
    return Qt;
  return Qnil;
}

175
DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
176 177 178 179
       doc: /* Return a symbol representing the type of OBJECT.
The symbol returned names the object's basic type;
for example, (type-of 1) returns `integer'.  */)
     (object)
180 181
     Lisp_Object object;
{
182
  switch (XTYPE (object))
183 184 185 186 187 188 189 190 191 192 193 194 195 196
    {
    case Lisp_Int:
      return Qinteger;

    case Lisp_Symbol:
      return Qsymbol;

    case Lisp_String:
      return Qstring;

    case Lisp_Cons:
      return Qcons;

    case Lisp_Misc:
197
      switch (XMISCTYPE (object))
198 199 200 201 202 203 204 205 206 207 208
	{
	case Lisp_Misc_Marker:
	  return Qmarker;
	case Lisp_Misc_Overlay:
	  return Qoverlay;
	case Lisp_Misc_Float:
	  return Qfloat;
	}
      abort ();

    case Lisp_Vectorlike:
209
      if (WINDOW_CONFIGURATIONP (object))
210
	return Qwindow_configuration;
211
      if (PROCESSP (object))
212
	return Qprocess;
213
      if (WINDOWP (object))
214
	return Qwindow;
215
      if (SUBRP (object))
216
	return Qsubr;
217
      if (COMPILEDP (object))
218
	return Qcompiled_function;
219
      if (BUFFERP (object))
220
	return Qbuffer;
221
      if (CHAR_TABLE_P (object))
222
	return Qchar_table;
223
      if (BOOL_VECTOR_P (object))
224
	return Qbool_vector;
225
      if (FRAMEP (object))
226
	return Qframe;
227
      if (HASH_TABLE_P (object))
Gerd Moellmann's avatar
Gerd Moellmann committed
228
	return Qhash_table;
229 230 231 232 233 234
      if (FONT_SPEC_P (object))
	return Qfont_spec;
      if (FONT_ENTITY_P (object))
	return Qfont_entity;
      if (FONT_OBJECT_P (object))
	return Qfont_object;
235 236 237 238 239 240 241 242 243 244
      return Qvector;

    case Lisp_Float:
      return Qfloat;

    default:
      abort ();
    }
}

245 246 247
DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
       doc: /* Return t if OBJECT is a cons cell.  */)
     (object)
248
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
249
{
250
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
251 252 253 254
    return Qt;
  return Qnil;
}

255
DEFUN ("atom", Fatom, Satom, 1, 1, 0,
256 257
       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */)
     (object)
258
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
259
{
260
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
261 262 263 264
    return Qnil;
  return Qt;
}

265
DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
Luc Teirlinck's avatar
Luc Teirlinck committed
266 267
       doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
Otherwise, return nil.  */)
268
     (object)
269
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
270
{
271
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
272 273 274 275
    return Qt;
  return Qnil;
}

276
DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
277 278
       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */)
     (object)
279
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
280
{
281
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
282 283 284 285
    return Qnil;
  return Qt;
}

286
DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
287 288
       doc: /* Return t if OBJECT is a symbol.  */)
     (object)
289
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
290
{
291
  if (SYMBOLP (object))
Jim Blandy's avatar
Jim Blandy committed
292 293 294 295
    return Qt;
  return Qnil;
}

Dave Love's avatar
Dave Love committed
296 297 298
/* Define this in C to avoid unnecessarily consing up the symbol
   name.  */
DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
299 300 301 302
       doc: /* Return t if OBJECT is a keyword.
This means that it is a symbol with a print name beginning with `:'
interned in the initial obarray.  */)
     (object)
Dave Love's avatar
Dave Love committed
303 304 305
     Lisp_Object object;
{
  if (SYMBOLP (object)
306
      && SREF (SYMBOL_NAME (object), 0) == ':'
307
      && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
Dave Love's avatar
Dave Love committed
308 309 310 311
    return Qt;
  return Qnil;
}

312
DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
313 314
       doc: /* Return t if OBJECT is a vector.  */)
     (object)
315
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
316
{
317
  if (VECTORP (object))
Jim Blandy's avatar
Jim Blandy committed
318 319 320 321
    return Qt;
  return Qnil;
}

322
DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
323 324
       doc: /* Return t if OBJECT is a string.  */)
     (object)
325
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
326
{
327
  if (STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
328 329 330 331
    return Qt;
  return Qnil;
}

332
DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
333 334 335
       1, 1, 0,
       doc: /* Return t if OBJECT is a multibyte string.  */)
     (object)
336 337 338 339 340 341 342 343
     Lisp_Object object;
{
  if (STRINGP (object) && STRING_MULTIBYTE (object))
    return Qt;
  return Qnil;
}

DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0,
344 345
       doc: /* Return t if OBJECT is a char-table.  */)
     (object)
346 347 348 349 350 351 352
     Lisp_Object object;
{
  if (CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

353 354
DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
       Svector_or_char_table_p, 1, 1, 0,
355 356
       doc: /* Return t if OBJECT is a char-table or vector.  */)
     (object)
357 358 359 360 361 362 363
     Lisp_Object object;
{
  if (VECTORP (object) || CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

364 365 366
DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0,
       doc: /* Return t if OBJECT is a bool-vector.  */)
     (object)
367 368 369 370 371 372 373
     Lisp_Object object;
{
  if (BOOL_VECTOR_P (object))
    return Qt;
  return Qnil;
}

374 375 376
DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0,
       doc: /* Return t if OBJECT is an array (string or vector).  */)
     (object)
377
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
378
{
379
  if (ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
380 381 382 383 384
    return Qt;
  return Qnil;
}

DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
385 386
       doc: /* Return t if OBJECT is a sequence (list or array).  */)
     (object)
387
     register Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
388
{
389
  if (CONSP (object) || NILP (object) || ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
390 391 392 393
    return Qt;
  return Qnil;
}

394 395 396
DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0,
       doc: /* Return t if OBJECT is an editor buffer.  */)
     (object)
397
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
398
{
399
  if (BUFFERP (object))
Jim Blandy's avatar
Jim Blandy committed
400 401 402 403
    return Qt;
  return Qnil;
}

404 405 406
DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
       doc: /* Return t if OBJECT is a marker (editor pointer).  */)
     (object)
407
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
408
{
409
  if (MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
410 411 412 413
    return Qt;
  return Qnil;
}

414 415 416
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
       doc: /* Return t if OBJECT is a built-in function.  */)
     (object)
417
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
418
{
419
  if (SUBRP (object))
Jim Blandy's avatar
Jim Blandy committed
420 421 422 423
    return Qt;
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
424
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
425 426 427
       1, 1, 0,
       doc: /* Return t if OBJECT is a byte-compiled function object.  */)
     (object)
428
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
429
{
430
  if (COMPILEDP (object))
Jim Blandy's avatar
Jim Blandy committed
431 432 433 434
    return Qt;
  return Qnil;
}

435
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
436
       doc: /* Return t if OBJECT is a character or a string.  */)
437
     (object)
438
     register Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
439
{
440
  if (CHARACTERP (object) || STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
441 442 443 444
    return Qt;
  return Qnil;
}

445 446 447
DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
       doc: /* Return t if OBJECT is an integer.  */)
     (object)
448
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
449
{
450
  if (INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
451 452 453 454
    return Qt;
  return Qnil;
}

455
DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
456 457
       doc: /* Return t if OBJECT is an integer or a marker (editor pointer).  */)
     (object)
458
     register Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
459
{
460
  if (MARKERP (object) || INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
461 462 463 464
    return Qt;
  return Qnil;
}

465
DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
466 467
       doc: /* Return t if OBJECT is a nonnegative integer.  */)
     (object)
468
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
469
{
470
  if (NATNUMP (object))
Jim Blandy's avatar
Jim Blandy committed
471 472 473 474 475
    return Qt;
  return Qnil;
}

DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
476 477
       doc: /* Return t if OBJECT is a number (floating point or integer).  */)
     (object)
478
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
479
{
480
  if (NUMBERP (object))
Jim Blandy's avatar
Jim Blandy committed
481
    return Qt;
Jim Blandy's avatar
Jim Blandy committed
482 483
  else
    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
484 485 486 487
}

DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
       Snumber_or_marker_p, 1, 1, 0,
488 489
       doc: /* Return t if OBJECT is a number or a marker.  */)
     (object)
490
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
491
{
492
  if (NUMBERP (object) || MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
493 494 495
    return Qt;
  return Qnil;
}
496 497

DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
498 499
       doc: /* Return t if OBJECT is a floating point number.  */)
     (object)
500
     Lisp_Object object;
501
{
502
  if (FLOATP (object))
503 504 505
    return Qt;
  return Qnil;
}
506

Jim Blandy's avatar
Jim Blandy committed
507 508 509 510

/* Extract and set components of lists */

DEFUN ("car", Fcar, Scar, 1, 1, 0,
511
       doc: /* Return the car of LIST.  If arg is nil, return nil.
512 513
Error if arg is not nil and not a cons cell.  See also `car-safe'.

Luc Teirlinck's avatar
Luc Teirlinck committed
514 515
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as car, cdr, cons cell and list.  */)
516
     (list)
Jim Blandy's avatar
Jim Blandy committed
517 518
     register Lisp_Object list;
{
519
  return CAR (list);
Jim Blandy's avatar
Jim Blandy committed
520 521 522
}

DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
523 524
       doc: /* Return the car of OBJECT if it is a cons cell, or else nil.  */)
     (object)
Jim Blandy's avatar
Jim Blandy committed
525 526
     Lisp_Object object;
{
527
  return CAR_SAFE (object);
Jim Blandy's avatar
Jim Blandy committed
528 529 530
}

DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
531
       doc: /* Return the cdr of LIST.  If arg is nil, return nil.
532 533
Error if arg is not nil and not a cons cell.  See also `cdr-safe'.

Luc Teirlinck's avatar
Luc Teirlinck committed
534 535
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as cdr, car, cons cell and list.  */)
536
     (list)
Jim Blandy's avatar
Jim Blandy committed
537 538
     register Lisp_Object list;
{
539
  return CDR (list);
Jim Blandy's avatar
Jim Blandy committed
540 541 542
}

DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
543 544
       doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil.  */)
     (object)
Jim Blandy's avatar
Jim Blandy committed
545 546
     Lisp_Object object;
{
547
  return CDR_SAFE (object);
Jim Blandy's avatar
Jim Blandy committed
548 549 550
}

DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
551 552
       doc: /* Set the car of CELL to be NEWCAR.  Returns NEWCAR.  */)
     (cell, newcar)
Jim Blandy's avatar
Jim Blandy committed
553 554
     register Lisp_Object cell, newcar;
{
555
  CHECK_CONS (cell);
Jim Blandy's avatar
Jim Blandy committed
556
  CHECK_IMPURE (cell);
557
  XSETCAR (cell, newcar);
Jim Blandy's avatar
Jim Blandy committed
558 559 560 561
  return newcar;
}

DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
562 563
       doc: /* Set the cdr of CELL to be NEWCDR.  Returns NEWCDR.  */)
     (cell, newcdr)
Jim Blandy's avatar
Jim Blandy committed
564 565
     register Lisp_Object cell, newcdr;
{
566
  CHECK_CONS (cell);
Jim Blandy's avatar
Jim Blandy committed
567
  CHECK_IMPURE (cell);
568
  XSETCDR (cell, newcdr);
Jim Blandy's avatar
Jim Blandy committed
569 570 571 572 573
  return newcdr;
}

/* Extract and set components of symbols */

574 575 576
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
       doc: /* Return t if SYMBOL's value is not void.  */)
     (symbol)
577
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
578 579
{
  Lisp_Object valcontents;
580
  CHECK_SYMBOL (symbol);
Jim Blandy's avatar
Jim Blandy committed
581

582
  valcontents = SYMBOL_VALUE (symbol);
Jim Blandy's avatar
Jim Blandy committed
583

584
  if (BUFFER_LOCAL_VALUEP (valcontents))
585
    valcontents = swap_in_symval_forwarding (symbol, valcontents);
Jim Blandy's avatar
Jim Blandy committed
586

587
  return (EQ (valcontents, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
588 589
}

590 591 592
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
       doc: /* Return t if SYMBOL's function definition is not void.  */)
     (symbol)
593
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
594
{
595
  CHECK_SYMBOL (symbol);
596
  return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
597 598
}

599
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
600 601
       doc: /* Make SYMBOL's value be void.
Return SYMBOL.  */)
602
     (symbol)
603
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
604
{
605
  CHECK_SYMBOL (symbol);
606
  if (SYMBOL_CONSTANT_P (symbol))
607
    xsignal1 (Qsetting_constant, symbol);
608 609
  Fset (symbol, Qunbound);
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
610 611
}

612
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
613 614
       doc: /* Make SYMBOL's function definition be void.
Return SYMBOL.  */)
615
     (symbol)
616
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
617
{
618
  CHECK_SYMBOL (symbol);
619
  if (NILP (symbol) || EQ (symbol, Qt))
620
    xsignal1 (Qsetting_constant, symbol);
621 622
  XSYMBOL (symbol)->function = Qunbound;
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
623 624 625
}

DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
626 627
       doc: /* Return SYMBOL's function definition.  Error if that is void.  */)
     (symbol)
Jim Blandy's avatar
Jim Blandy committed
628
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
629
{
630
  CHECK_SYMBOL (symbol);
631 632 633
  if (!EQ (XSYMBOL (symbol)->function, Qunbound))
    return XSYMBOL (symbol)->function;
  xsignal1 (Qvoid_function, symbol);
Jim Blandy's avatar
Jim Blandy committed
634 635
}

636 637 638
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
       doc: /* Return SYMBOL's property list.  */)
     (symbol)
639
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
640
{
641
  CHECK_SYMBOL (symbol);
642
  return XSYMBOL (symbol)->plist;
Jim Blandy's avatar
Jim Blandy committed
643 644
}

645 646 647
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
       doc: /* Return SYMBOL's name, a string.  */)
     (symbol)
648
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
649 650 651
{
  register Lisp_Object name;

652
  CHECK_SYMBOL (symbol);
653
  name = SYMBOL_NAME (symbol);
Jim Blandy's avatar
Jim Blandy committed
654 655 656 657
  return name;
}

DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
658 659
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.  */)
     (symbol, definition)
660
     register Lisp_Object symbol, definition;
661
{
662 663
  register Lisp_Object function;

664
  CHECK_SYMBOL (symbol);
665
  if (NILP (symbol) || EQ (symbol, Qt))
666
    xsignal1 (Qsetting_constant, symbol);
667 668 669 670 671 672 673 674 675

  function = XSYMBOL (symbol)->function;

  if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
    Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);

  if (CONSP (function) && EQ (XCAR (function), Qautoload))
    Fput (symbol, Qautoload, XCDR (function));

676
  XSYMBOL (symbol)->function = definition;
677
  /* Handle automatic advice activation */
678
  if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
679
    {
680
      call2 (Qad_activate_internal, symbol, Qnil);
681
      definition = XSYMBOL (symbol)->function;
682
    }
683
  return definition;
Jim Blandy's avatar
Jim Blandy committed
684 685
}

686 687 688
extern Lisp_Object Qfunction_documentation;

DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
689
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
Richard M. Stallman's avatar
Richard M. Stallman committed
690 691 692 693
Associates the function with the current load file, if any.
The optional third argument DOCSTRING specifies the documentation string
for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
determined by DEFINITION.  */)
694 695
     (symbol, definition, docstring)
     register Lisp_Object symbol, definition, docstring;
696
{
697
  CHECK_SYMBOL (symbol);
698 699 700
  if (CONSP (XSYMBOL (symbol)->function)
      && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, symbol));
701
  definition = Ffset (symbol, definition);
702
  LOADHIST_ATTACH (Fcons (Qdefun, symbol));
703 704
  if (!NILP (docstring))
    Fput (symbol, Qfunction_documentation, docstring);
705
  return definition;
706 707
}

Jim Blandy's avatar
Jim Blandy committed
708
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
Kenichi Handa's avatar
Kenichi Handa committed
709
       doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.  */)
710
     (symbol, newplist)
711
     register Lisp_Object symbol, newplist;
Jim Blandy's avatar
Jim Blandy committed
712
{
713
  CHECK_SYMBOL (symbol);
714
  XSYMBOL (symbol)->plist = newplist;
Jim Blandy's avatar
Jim Blandy committed
715 716
  return newplist;
}
Jim Blandy's avatar
Jim Blandy committed
717

718
DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
719 720 721 722 723 724
       doc: /* Return minimum and maximum number of args allowed for SUBR.
SUBR must be a built-in function.
The returned value is a pair (MIN . MAX).  MIN is the minimum number
of args.  MAX is the maximum number or the symbol `many', for a
function with `&rest' args, or `unevalled' for a special form.  */)
     (subr)
725 726 727
     Lisp_Object subr;
{
  short minargs, maxargs;
728
  CHECK_SUBR (subr);
729 730 731 732 733 734 735 736 737 738
  minargs = XSUBR (subr)->min_args;
  maxargs = XSUBR (subr)->max_args;
  if (maxargs == MANY)
    return Fcons (make_number (minargs), Qmany);
  else if (maxargs == UNEVALLED)
    return Fcons (make_number (minargs), Qunevalled);
  else
    return Fcons (make_number (minargs), make_number (maxargs));
}

Stefan Monnier's avatar
Stefan Monnier committed
739 740 741 742 743 744 745
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
       doc: /* Return name of subroutine SUBR.
SUBR must be a built-in function.  */)
     (subr)
     Lisp_Object subr;
{
  const char *name;
746
  CHECK_SUBR (subr);
Stefan Monnier's avatar
Stefan Monnier committed
747 748 749 750
  name = XSUBR (subr)->symbol_name;
  return make_string (name, strlen (name));
}

Kenichi Handa's avatar
Kenichi Handa committed
751 752
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
       doc: /* Return the interactive form of CMD or nil if none.
Luc Teirlinck's avatar
Luc Teirlinck committed
753 754
If CMD is not a command, the return value is nil.
Value, if non-nil, is a list \(interactive SPEC).  */)
Kenichi Handa's avatar
Kenichi Handa committed
755 756
     (cmd)
     Lisp_Object cmd;
757
{
758
  Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
759

760 761 762 763 764 765 766 767 768 769 770 771 772 773
  if (NILP (fun) || EQ (fun, Qunbound))
    return Qnil;

  /* Use an `interactive-form' property if present, analogous to the
     function-documentation property. */
  fun = cmd;
  while (SYMBOLP (fun))
    {
      Lisp_Object tmp = Fget (fun, intern ("interactive-form"));
      if (!NILP (tmp))
	return tmp;
      else
	fun = Fsymbol_function (fun);
    }
Kenichi Handa's avatar
Kenichi Handa committed
774 775 776

  if (SUBRP (fun))
    {
777 778 779 780 781
      char *spec = XSUBR (fun)->intspec;
      if (spec)
	return list2 (Qinteractive,
		      (*spec != '(') ? build_string (spec) :
		      Fcar (Fread_from_string (build_string (spec), Qnil, Qnil)));
Kenichi Handa's avatar
Kenichi Handa committed
782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801
    }
  else if (COMPILEDP (fun))
    {
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
	return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
    }
  else if (CONSP (fun))
    {
      Lisp_Object funcar = XCAR (fun);
      if (EQ (funcar, Qlambda))
	return Fassq (Qinteractive, Fcdr (XCDR (fun)));
      else if (EQ (funcar, Qautoload))
	{
	  struct gcpro gcpro1;
	  GCPRO1 (cmd);
	  do_autoload (fun, cmd);
	  UNGCPRO;
	  return Finteractive_form (cmd);
	}
    }
802 803 804
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
805

806 807 808 809 810 811 812 813
/***********************************************************************
		Getting and Setting Values of Symbols
 ***********************************************************************/

/* Return the symbol holding SYMBOL's value.  Signal
   `cyclic-variable-indirection' if SYMBOL's chain of variable
   indirections contains a loop.  */

Stefan Monnier's avatar
Stefan Monnier committed
814
struct Lisp_Symbol *
815
indirect_variable (symbol)
Stefan Monnier's avatar
Stefan Monnier committed
816
     struct Lisp_Symbol *symbol;
817
{
Stefan Monnier's avatar
Stefan Monnier committed
818
  struct Lisp_Symbol *tortoise, *hare;
819 820 821

  hare = tortoise = symbol;

Stefan Monnier's avatar
Stefan Monnier committed
822
  while (hare->indirect_variable)
823
    {
Stefan Monnier's avatar
Stefan Monnier committed
824 825
      hare = XSYMBOL (hare->value);
      if (!hare->indirect_variable)
826
	break;
827

Stefan Monnier's avatar
Stefan Monnier committed
828 829
      hare = XSYMBOL (hare->value);
      tortoise = XSYMBOL (tortoise->value);
830

Stefan Monnier's avatar
Stefan Monnier committed
831 832 833 834 835 836
      if (hare == tortoise)
	{
	  Lisp_Object tem;
	  XSETSYMBOL (tem, symbol);
	  xsignal1 (Qcyclic_variable_indirection, tem);
	}