data.c 94.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, 2010
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>
25
#include <setjmp.h>
Jim Blandy's avatar
Jim Blandy committed
26
#include "lisp.h"
Jim Blandy's avatar
Jim Blandy committed
27
#include "puresize.h"
28
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
29
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
30
#include "keyboard.h"
31
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
32
#include "syssignal.h"
33
#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p. */
34
#include "font.h"
Jim Blandy's avatar
Jim Blandy committed
35

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

40 41 42 43 44 45 46 47 48 49
/* 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
50 51
#include <math.h>

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

Jim Blandy's avatar
Jim Blandy committed
56 57 58
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
59
Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
60
Lisp_Object Qcyclic_variable_indirection, Qcircular_list;
Jim Blandy's avatar
Jim Blandy committed
61 62
Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
Roland McGrath's avatar
Roland McGrath committed
63
Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
Jim Blandy's avatar
Jim Blandy committed
64
Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
65
Lisp_Object Qtext_read_only;
Kenichi Handa's avatar
Kenichi Handa committed
66

67
Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
Jim Blandy's avatar
Jim Blandy committed
68 69
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
70
Lisp_Object Qbuffer_or_string_p, Qkeywordp;
Jim Blandy's avatar
Jim Blandy committed
71
Lisp_Object Qboundp, Qfboundp;
72
Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
73

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

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

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

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

92 93
Lisp_Object Qinteractive_form;

94
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
95

96
Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
97

98 99

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


Jim Blandy's avatar
Jim Blandy committed
106
Lisp_Object
107
wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
Jim Blandy's avatar
Jim Blandy committed
108
{
109 110 111 112 113 114
  /* If VALUE is not even a valid Lisp object, we'd want to abort here
     where we can get a backtrace showing where it came from.  We used
     to try and do that by checking the tagbits, but nowadays all
     tagbits are potentially valid.  */
  /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
   *   abort (); */
115

116
  xsignal2 (Qwrong_type_argument, predicate, value);
Jim Blandy's avatar
Jim Blandy committed
117 118
}

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

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

void
132
args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
Jim Blandy's avatar
Jim Blandy committed
133
{
134
  xsignal3 (Qargs_out_of_range, a1, a2, a3);
Jim Blandy's avatar
Jim Blandy committed
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
145
sign_extend_lisp_int (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
    case_Lisp_Int:
185 186 187 188 189 190 191 192 193 194 195 196
      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
  struct Lisp_Symbol *sym;
581
  CHECK_SYMBOL (symbol);
582
  sym = XSYMBOL (symbol);
Jim Blandy's avatar
Jim Blandy committed
583

584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608
 start:
  switch (sym->redirect)
    {
    case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
    case SYMBOL_LOCALIZED:
      {
	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
	if (blv->fwd)
	  /* In set_internal, we un-forward vars when their value is
    	     set to Qunbound. */
    	  return Qt;
	else
	  {
	    swap_in_symval_forwarding (sym, blv);
	    valcontents = BLV_VALUE (blv);
	  }
	break;
      }
    case SYMBOL_FORWARDED:
      /* In set_internal, we un-forward vars when their value is
	 set to Qunbound. */
      return Qt;
    default: abort ();
    }
Jim Blandy's avatar
Jim Blandy committed
609

610
  return (EQ (valcontents, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
611 612
}

613 614 615
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
       doc: /* Return t if SYMBOL's function definition is not void.  */)
     (symbol)
616
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
617
{
618
  CHECK_SYMBOL (symbol);
619
  return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
620 621
}

622
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
623 624
       doc: /* Make SYMBOL's value be void.
Return SYMBOL.  */)
625
     (symbol)
626
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
627
{
628
  CHECK_SYMBOL (symbol);
629
  if (SYMBOL_CONSTANT_P (symbol))
630
    xsignal1 (Qsetting_constant, symbol);
631 632
  Fset (symbol, Qunbound);
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
633 634
}

635
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
636 637
       doc: /* Make SYMBOL's function definition be void.
Return SYMBOL.  */)
638
     (symbol)
639
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
640
{
641
  CHECK_SYMBOL (symbol);
642
  if (NILP (symbol) || EQ (symbol, Qt))
643
    xsignal1 (Qsetting_constant, symbol);
644 645
  XSYMBOL (symbol)->function = Qunbound;
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
646 647 648
}

DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
649 650
       doc: /* Return SYMBOL's function definition.  Error if that is void.  */)
     (symbol)
Jim Blandy's avatar
Jim Blandy committed
651
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
652
{
653
  CHECK_SYMBOL (symbol);
654 655 656
  if (!EQ (XSYMBOL (symbol)->function, Qunbound))
    return XSYMBOL (symbol)->function;
  xsignal1 (Qvoid_function, symbol);
Jim Blandy's avatar
Jim Blandy committed
657 658
}

659 660 661
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
       doc: /* Return SYMBOL's property list.  */)
     (symbol)
662
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
663
{
664
  CHECK_SYMBOL (symbol);
665
  return XSYMBOL (symbol)->plist;
Jim Blandy's avatar
Jim Blandy committed
666 667
}

668 669 670
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
       doc: /* Return SYMBOL's name, a string.  */)
     (symbol)
671
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
672 673 674
{
  register Lisp_Object name;

675
  CHECK_SYMBOL (symbol);
676
  name = SYMBOL_NAME (symbol);
Jim Blandy's avatar
Jim Blandy committed
677 678 679 680
  return name;
}

DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
681 682
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.  */)
     (symbol, definition)
683
     register Lisp_Object symbol, definition;
684
{
685 686
  register Lisp_Object function;

687
  CHECK_SYMBOL (symbol);
688
  if (NILP (symbol) || EQ (symbol, Qt))
689
    xsignal1 (Qsetting_constant, symbol);
690 691 692 693 694 695 696 697 698

  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));

699
  XSYMBOL (symbol)->function = definition;
700
  /* Handle automatic advice activation */
701
  if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
702
    {
703
      call2 (Qad_activate_internal, symbol, Qnil);
704
      definition = XSYMBOL (symbol)->function;
705
    }
706
  return definition;
Jim Blandy's avatar
Jim Blandy committed
707 708
}

709 710 711
extern Lisp_Object Qfunction_documentation;

DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
712
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
Richard M. Stallman's avatar
Richard M. Stallman committed
713 714 715 716
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.  */)
717 718
     (symbol, definition, docstring)
     register Lisp_Object symbol, definition, docstring;
719
{
720
  CHECK_SYMBOL (symbol);
721 722 723
  if (CONSP (XSYMBOL (symbol)->function)
      && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, symbol));
724
  definition = Ffset (symbol, definition);
725
  LOADHIST_ATTACH (Fcons (Qdefun, symbol));
726 727
  if (!NILP (docstring))
    Fput (symbol, Qfunction_documentation, docstring);
728
  return definition;
729 730
}

Jim Blandy's avatar
Jim Blandy committed
731
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
Kenichi Handa's avatar
Kenichi Handa committed
732
       doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.  */)
733
     (symbol, newplist)
734
     register Lisp_Object symbol, newplist;
Jim Blandy's avatar
Jim Blandy committed
735
{
736
  CHECK_SYMBOL (symbol);
737
  XSYMBOL (symbol)->plist = newplist;
Jim Blandy's avatar
Jim Blandy committed
738 739
  return newplist;
}
Jim Blandy's avatar
Jim Blandy committed
740

741
DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
742 743 744 745 746 747
       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)
748 749 750
     Lisp_Object subr;
{
  short minargs, maxargs;
751
  CHECK_SUBR (subr);
752 753 754 755 756 757 758 759 760 761
  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
762 763 764 765 766 767 768
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;
769
  CHECK_SUBR (subr);
Stefan Monnier's avatar
Stefan Monnier committed
770 771 772 773
  name = XSUBR (subr)->symbol_name;
  return make_string (name, strlen (name));
}

Kenichi Handa's avatar
Kenichi Handa committed
774 775
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
776 777
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
778 779
     (cmd)
     Lisp_Object cmd;
780
{
781
  Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
782

783 784 785 786 787 788 789 790
  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))
    {
791
      Lisp_Object tmp = Fget (fun, Qinteractive_form);
792 793 794 795 796
      if (!NILP (tmp))
	return tmp;
      else
	fun = Fsymbol_function (fun);
    }
Kenichi Handa's avatar
Kenichi Handa committed
797 798 799

  if (SUBRP (fun))
    {
800 801 802 803 804
      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
805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824
    }
  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);
	}
    }
825 826 827
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
828

829 830 831 832 833 834 835 836
/***********************************************************************
		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.  */