data.c 89 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-1995, 1997-2012
Glenn Morris's avatar
Glenn Morris committed
3
                 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

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

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19 20


21
#include <config.h>
22
#include <signal.h>
23
#include <stdio.h>
24
#include <setjmp.h>
25 26 27

#include <intprops.h>

Jim Blandy's avatar
Jim Blandy committed
28
#include "lisp.h"
Jim Blandy's avatar
Jim Blandy committed
29
#include "puresize.h"
30
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
31
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
32
#include "keyboard.h"
33
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
34
#include "syssignal.h"
35
#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p.  */
36
#include "font.h"
Jim Blandy's avatar
Jim Blandy committed
37

38
#include <float.h>
39
/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*.  */
40 41 42 43 44 45 46 47 48
#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
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
static Lisp_Object Qsubr;
Jim Blandy's avatar
Jim Blandy committed
53
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
54
Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
55 56 57 58 59 60 61
static Lisp_Object Qwrong_type_argument;
Lisp_Object Qvoid_variable, Qvoid_function;
static Lisp_Object Qcyclic_function_indirection;
static Lisp_Object Qcyclic_variable_indirection;
Lisp_Object Qcircular_list;
static Lisp_Object Qsetting_constant;
Lisp_Object Qinvalid_read_syntax;
Jim Blandy's avatar
Jim Blandy committed
62
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 68
Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
static Lisp_Object Qnatnump;
Jim Blandy's avatar
Jim Blandy committed
69 70
Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
71 72 73
Lisp_Object Qbuffer_or_string_p;
static Lisp_Object Qkeywordp, Qboundp;
Lisp_Object Qfboundp;
74
Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
75

Jim Blandy's avatar
Jim Blandy committed
76
Lisp_Object Qcdr;
77
static Lisp_Object Qad_advice_info, Qad_activate_internal;
Jim Blandy's avatar
Jim Blandy committed
78

79 80 81
Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
Lisp_Object Qoverflow_error, Qunderflow_error;

82
Lisp_Object Qfloatp;
Jim Blandy's avatar
Jim Blandy committed
83 84
Lisp_Object Qnumberp, Qnumber_or_marker_p;

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

96 97
Lisp_Object Qinteractive_form;

98
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
99

100

Jim Blandy's avatar
Jim Blandy committed
101
Lisp_Object
102
wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
Jim Blandy's avatar
Jim Blandy committed
103
{
104 105 106 107 108 109
  /* 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 (); */
110

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

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

void
121
args_out_of_range (Lisp_Object a1, Lisp_Object a2)
Jim Blandy's avatar
Jim Blandy committed
122
{
123
  xsignal2 (Qargs_out_of_range, a1, a2);
Jim Blandy's avatar
Jim Blandy committed
124 125 126
}

void
127
args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
Jim Blandy's avatar
Jim Blandy committed
128
{
129
  xsignal3 (Qargs_out_of_range, a1, a2, a3);
Jim Blandy's avatar
Jim Blandy committed
130 131 132 133 134 135
}


/* Data type predicates */

DEFUN ("eq", Feq, Seq, 2, 2, 0,
136
       doc: /* Return t if the two args are the same Lisp object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
137
  (Lisp_Object obj1, Lisp_Object obj2)
Jim Blandy's avatar
Jim Blandy committed
138 139 140 141 142 143
{
  if (EQ (obj1, obj2))
    return Qt;
  return Qnil;
}

144 145
DEFUN ("null", Fnull, Snull, 1, 1, 0,
       doc: /* Return t if OBJECT is nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
146
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
147
{
148
  if (NILP (object))
Jim Blandy's avatar
Jim Blandy committed
149 150 151 152
    return Qt;
  return Qnil;
}

153
DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
154 155 156
       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'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
157
  (Lisp_Object object)
158
{
159
  switch (XTYPE (object))
160
    {
161
    case_Lisp_Int:
162 163 164 165 166 167 168 169 170 171 172 173
      return Qinteger;

    case Lisp_Symbol:
      return Qsymbol;

    case Lisp_String:
      return Qstring;

    case Lisp_Cons:
      return Qcons;

    case Lisp_Misc:
174
      switch (XMISCTYPE (object))
175 176 177 178 179 180 181 182 183 184 185
	{
	case Lisp_Misc_Marker:
	  return Qmarker;
	case Lisp_Misc_Overlay:
	  return Qoverlay;
	case Lisp_Misc_Float:
	  return Qfloat;
	}
      abort ();

    case Lisp_Vectorlike:
186
      if (WINDOW_CONFIGURATIONP (object))
187
	return Qwindow_configuration;
188
      if (PROCESSP (object))
189
	return Qprocess;
190
      if (WINDOWP (object))
191
	return Qwindow;
192
      if (SUBRP (object))
193
	return Qsubr;
Stefan Monnier's avatar
Stefan Monnier committed
194 195
      if (COMPILEDP (object))
	return Qcompiled_function;
196
      if (BUFFERP (object))
197
	return Qbuffer;
198
      if (CHAR_TABLE_P (object))
199
	return Qchar_table;
200
      if (BOOL_VECTOR_P (object))
201
	return Qbool_vector;
202
      if (FRAMEP (object))
203
	return Qframe;
204
      if (HASH_TABLE_P (object))
Gerd Moellmann's avatar
Gerd Moellmann committed
205
	return Qhash_table;
206 207 208 209 210 211
      if (FONT_SPEC_P (object))
	return Qfont_spec;
      if (FONT_ENTITY_P (object))
	return Qfont_entity;
      if (FONT_OBJECT_P (object))
	return Qfont_object;
212 213 214 215 216 217 218 219 220 221
      return Qvector;

    case Lisp_Float:
      return Qfloat;

    default:
      abort ();
    }
}

222 223
DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
       doc: /* Return t if OBJECT is a cons cell.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
224
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
225
{
226
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
227 228 229 230
    return Qt;
  return Qnil;
}

231
DEFUN ("atom", Fatom, Satom, 1, 1, 0,
232
       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
233
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
234
{
235
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
236 237 238 239
    return Qnil;
  return Qt;
}

240
DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
Luc Teirlinck's avatar
Luc Teirlinck committed
241 242
       doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
Otherwise, return nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
243
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
244
{
245
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
246 247 248 249
    return Qt;
  return Qnil;
}

250
DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
251
       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
252
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
253
{
254
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
255 256 257 258
    return Qnil;
  return Qt;
}

259
DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
260
       doc: /* Return t if OBJECT is a symbol.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
261
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
262
{
263
  if (SYMBOLP (object))
Jim Blandy's avatar
Jim Blandy committed
264 265 266 267
    return Qt;
  return Qnil;
}

Dave Love's avatar
Dave Love committed
268 269 270
/* Define this in C to avoid unnecessarily consing up the symbol
   name.  */
DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
271 272 273
       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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
274
  (Lisp_Object object)
Dave Love's avatar
Dave Love committed
275 276
{
  if (SYMBOLP (object)
277
      && SREF (SYMBOL_NAME (object), 0) == ':'
278
      && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
Dave Love's avatar
Dave Love committed
279 280 281 282
    return Qt;
  return Qnil;
}

283
DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
284
       doc: /* Return t if OBJECT is a vector.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
285
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
286
{
287
  if (VECTORP (object))
Jim Blandy's avatar
Jim Blandy committed
288 289 290 291
    return Qt;
  return Qnil;
}

292
DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
293
       doc: /* Return t if OBJECT is a string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
294
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
295
{
296
  if (STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
297 298 299 300
    return Qt;
  return Qnil;
}

301
DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
302 303
       1, 1, 0,
       doc: /* Return t if OBJECT is a multibyte string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
304
  (Lisp_Object object)
305 306 307 308 309 310 311
{
  if (STRINGP (object) && STRING_MULTIBYTE (object))
    return Qt;
  return Qnil;
}

DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0,
312
       doc: /* Return t if OBJECT is a char-table.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
313
  (Lisp_Object object)
314 315 316 317 318 319
{
  if (CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

320 321
DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
       Svector_or_char_table_p, 1, 1, 0,
322
       doc: /* Return t if OBJECT is a char-table or vector.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
323
  (Lisp_Object object)
324 325 326 327 328 329
{
  if (VECTORP (object) || CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

330 331
DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0,
       doc: /* Return t if OBJECT is a bool-vector.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
332
  (Lisp_Object object)
333 334 335 336 337 338
{
  if (BOOL_VECTOR_P (object))
    return Qt;
  return Qnil;
}

339 340
DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0,
       doc: /* Return t if OBJECT is an array (string or vector).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
341
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
342
{
343
  if (ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
344 345 346 347 348
    return Qt;
  return Qnil;
}

DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
349
       doc: /* Return t if OBJECT is a sequence (list or array).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
350
  (register Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
351
{
352
  if (CONSP (object) || NILP (object) || ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
353 354 355 356
    return Qt;
  return Qnil;
}

357 358
DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0,
       doc: /* Return t if OBJECT is an editor buffer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
359
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
360
{
361
  if (BUFFERP (object))
Jim Blandy's avatar
Jim Blandy committed
362 363 364 365
    return Qt;
  return Qnil;
}

366 367
DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
       doc: /* Return t if OBJECT is a marker (editor pointer).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
368
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
369
{
370
  if (MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
371 372 373 374
    return Qt;
  return Qnil;
}

375 376
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
       doc: /* Return t if OBJECT is a built-in function.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
377
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
378
{
379
  if (SUBRP (object))
Jim Blandy's avatar
Jim Blandy committed
380 381 382 383
    return Qt;
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
384
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
385 386
       1, 1, 0,
       doc: /* Return t if OBJECT is a byte-compiled function object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
387
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
388
{
389
  if (COMPILEDP (object))
Jim Blandy's avatar
Jim Blandy committed
390 391 392 393
    return Qt;
  return Qnil;
}

394
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
395
       doc: /* Return t if OBJECT is a character or a string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
396
  (register Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
397
{
398
  if (CHARACTERP (object) || STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
399 400 401 402
    return Qt;
  return Qnil;
}

403 404
DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
       doc: /* Return t if OBJECT is an integer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
405
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
406
{
407
  if (INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
408 409 410 411
    return Qt;
  return Qnil;
}

412
DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
413
       doc: /* Return t if OBJECT is an integer or a marker (editor pointer).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
414
  (register Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
415
{
416
  if (MARKERP (object) || INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
417 418 419 420
    return Qt;
  return Qnil;
}

421
DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
422
       doc: /* Return t if OBJECT is a nonnegative integer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
423
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
424
{
425
  if (NATNUMP (object))
Jim Blandy's avatar
Jim Blandy committed
426 427 428 429 430
    return Qt;
  return Qnil;
}

DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
431
       doc: /* Return t if OBJECT is a number (floating point or integer).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
432
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
433
{
434
  if (NUMBERP (object))
Jim Blandy's avatar
Jim Blandy committed
435
    return Qt;
Jim Blandy's avatar
Jim Blandy committed
436 437
  else
    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
438 439 440 441
}

DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
       Snumber_or_marker_p, 1, 1, 0,
442
       doc: /* Return t if OBJECT is a number or a marker.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
443
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
444
{
445
  if (NUMBERP (object) || MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
446 447 448
    return Qt;
  return Qnil;
}
449 450

DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
451
       doc: /* Return t if OBJECT is a floating point number.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
452
  (Lisp_Object object)
453
{
454
  if (FLOATP (object))
455 456 457
    return Qt;
  return Qnil;
}
458

Jim Blandy's avatar
Jim Blandy committed
459 460 461

/* Extract and set components of lists */

Paul Eggert's avatar
Paul Eggert committed
462
DEFUN ("car", Fcar, Scar, 1, 1, 0,
463
       doc: /* Return the car of LIST.  If arg is nil, return nil.
464 465
Error if arg is not nil and not a cons cell.  See also `car-safe'.

Luc Teirlinck's avatar
Luc Teirlinck committed
466 467
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as car, cdr, cons cell and list.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
468
  (register Lisp_Object list)
Jim Blandy's avatar
Jim Blandy committed
469
{
470
  return CAR (list);
Jim Blandy's avatar
Jim Blandy committed
471 472
}

Paul Eggert's avatar
Paul Eggert committed
473
DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
474
       doc: /* Return the car of OBJECT if it is a cons cell, or else nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
475
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
476
{
477
  return CAR_SAFE (object);
Jim Blandy's avatar
Jim Blandy committed
478 479
}

Paul Eggert's avatar
Paul Eggert committed
480
DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
481
       doc: /* Return the cdr of LIST.  If arg is nil, return nil.
482 483
Error if arg is not nil and not a cons cell.  See also `cdr-safe'.

Luc Teirlinck's avatar
Luc Teirlinck committed
484 485
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as cdr, car, cons cell and list.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
486
  (register Lisp_Object list)
Jim Blandy's avatar
Jim Blandy committed
487
{
488
  return CDR (list);
Jim Blandy's avatar
Jim Blandy committed
489 490
}

Paul Eggert's avatar
Paul Eggert committed
491
DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
492
       doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
493
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
494
{
495
  return CDR_SAFE (object);
Jim Blandy's avatar
Jim Blandy committed
496 497
}

Paul Eggert's avatar
Paul Eggert committed
498
DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
499
       doc: /* Set the car of CELL to be NEWCAR.  Returns NEWCAR.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
500
  (register Lisp_Object cell, Lisp_Object newcar)
Jim Blandy's avatar
Jim Blandy committed
501
{
502
  CHECK_CONS (cell);
Jim Blandy's avatar
Jim Blandy committed
503
  CHECK_IMPURE (cell);
504
  XSETCAR (cell, newcar);
Jim Blandy's avatar
Jim Blandy committed
505 506 507
  return newcar;
}

Paul Eggert's avatar
Paul Eggert committed
508
DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
509
       doc: /* Set the cdr of CELL to be NEWCDR.  Returns NEWCDR.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
510
  (register Lisp_Object cell, Lisp_Object newcdr)
Jim Blandy's avatar
Jim Blandy committed
511
{
512
  CHECK_CONS (cell);
Jim Blandy's avatar
Jim Blandy committed
513
  CHECK_IMPURE (cell);
514
  XSETCDR (cell, newcdr);
Jim Blandy's avatar
Jim Blandy committed
515 516 517 518 519
  return newcdr;
}

/* Extract and set components of symbols */

Paul Eggert's avatar
Paul Eggert committed
520
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
521
       doc: /* Return t if SYMBOL's value is not void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
522
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
523 524
{
  Lisp_Object valcontents;
525
  struct Lisp_Symbol *sym;
526
  CHECK_SYMBOL (symbol);
527
  sym = XSYMBOL (symbol);
Jim Blandy's avatar
Jim Blandy committed
528

529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553
 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
554

555
  return (EQ (valcontents, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
556 557
}

Paul Eggert's avatar
Paul Eggert committed
558
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
559
       doc: /* Return t if SYMBOL's function definition is not void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
560
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
561
{
562
  CHECK_SYMBOL (symbol);
563
  return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
564 565
}

566
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
567 568
       doc: /* Make SYMBOL's value be void.
Return SYMBOL.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
569
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
570
{
571
  CHECK_SYMBOL (symbol);
572
  if (SYMBOL_CONSTANT_P (symbol))
573
    xsignal1 (Qsetting_constant, symbol);
574 575
  Fset (symbol, Qunbound);
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
576 577
}

578
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
579 580
       doc: /* Make SYMBOL's function definition be void.
Return SYMBOL.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
581
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
582
{
583
  CHECK_SYMBOL (symbol);
584
  if (NILP (symbol) || EQ (symbol, Qt))
585
    xsignal1 (Qsetting_constant, symbol);
586 587
  XSYMBOL (symbol)->function = Qunbound;
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
588 589
}

Paul Eggert's avatar
Paul Eggert committed
590
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
591
       doc: /* Return SYMBOL's function definition.  Error if that is void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
592
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
593
{
594
  CHECK_SYMBOL (symbol);
595 596 597
  if (!EQ (XSYMBOL (symbol)->function, Qunbound))
    return XSYMBOL (symbol)->function;
  xsignal1 (Qvoid_function, symbol);
Jim Blandy's avatar
Jim Blandy committed
598 599
}

600 601
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
       doc: /* Return SYMBOL's property list.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
602
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
603
{
604
  CHECK_SYMBOL (symbol);
605
  return XSYMBOL (symbol)->plist;
Jim Blandy's avatar
Jim Blandy committed
606 607
}

Paul Eggert's avatar
Paul Eggert committed
608
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
609
       doc: /* Return SYMBOL's name, a string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
610
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
611 612 613
{
  register Lisp_Object name;

614
  CHECK_SYMBOL (symbol);
615
  name = SYMBOL_NAME (symbol);
Jim Blandy's avatar
Jim Blandy committed
616 617 618
  return name;
}

Paul Eggert's avatar
Paul Eggert committed
619
DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
620
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
621
  (register Lisp_Object symbol, Lisp_Object definition)
622
{
623 624
  register Lisp_Object function;

625
  CHECK_SYMBOL (symbol);
626
  if (NILP (symbol) || EQ (symbol, Qt))
627
    xsignal1 (Qsetting_constant, symbol);
628 629 630 631 632 633 634 635 636

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

637
  XSYMBOL (symbol)->function = definition;
638
  /* Handle automatic advice activation */
639
  if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
640
    {
641
      call2 (Qad_activate_internal, symbol, Qnil);
642
      definition = XSYMBOL (symbol)->function;
643
    }
644
  return definition;
Jim Blandy's avatar
Jim Blandy committed
645 646
}

647
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
648
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
Richard M. Stallman's avatar
Richard M. Stallman committed
649 650 651 652
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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
653
  (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
654
{
655
  CHECK_SYMBOL (symbol);
656 657 658
  if (CONSP (XSYMBOL (symbol)->function)
      && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, symbol));
659
  definition = Ffset (symbol, definition);
660
  LOADHIST_ATTACH (Fcons (Qdefun, symbol));
661 662
  if (!NILP (docstring))
    Fput (symbol, Qfunction_documentation, docstring);
663
  return definition;
664 665
}

Jim Blandy's avatar
Jim Blandy committed
666
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
Kenichi Handa's avatar
Kenichi Handa committed
667
       doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
668
  (register Lisp_Object symbol, Lisp_Object newplist)
Jim Blandy's avatar
Jim Blandy committed
669
{
670
  CHECK_SYMBOL (symbol);
671
  XSYMBOL (symbol)->plist = newplist;
Jim Blandy's avatar
Jim Blandy committed
672 673
  return newplist;
}
Jim Blandy's avatar
Jim Blandy committed
674

675
DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
676 677 678 679 680
       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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
681
  (Lisp_Object subr)
682 683
{
  short minargs, maxargs;
684
  CHECK_SUBR (subr);
685 686 687 688 689 690 691 692 693 694
  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
695 696 697
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
       doc: /* Return name of subroutine SUBR.
SUBR must be a built-in function.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
698
  (Lisp_Object subr)
Stefan Monnier's avatar
Stefan Monnier committed
699 700
{
  const char *name;
701
  CHECK_SUBR (subr);
Stefan Monnier's avatar
Stefan Monnier committed
702
  name = XSUBR (subr)->symbol_name;
703
  return build_string (name);
Stefan Monnier's avatar
Stefan Monnier committed
704 705
}

Paul Eggert's avatar
Paul Eggert committed
706
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
Kenichi Handa's avatar
Kenichi Handa committed
707
       doc: /* Return the interactive form of CMD or nil if none.
Luc Teirlinck's avatar
Luc Teirlinck committed
708 709
If CMD is not a command, the return value is nil.
Value, if non-nil, is a list \(interactive SPEC).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
710
  (Lisp_Object cmd)
711
{
712
  Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
713

714 715 716 717 718 719 720 721
  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))
    {
722
      Lisp_Object tmp = Fget (fun, Qinteractive_form);
723 724 725 726 727
      if (!NILP (tmp))
	return tmp;
      else
	fun = Fsymbol_function (fun);
    }
Kenichi Handa's avatar
Kenichi Handa committed
728 729 730

  if (SUBRP (fun))
    {
731
      const char *spec = XSUBR (fun)->intspec;
732 733 734 735
      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
736 737 738 739 740 741 742 743 744
    }
  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);
745
      if (EQ (funcar, Qclosure))
746 747
	return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
      else if (EQ (funcar, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
748 749 750 751 752 753 754 755 756 757
	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);
	}
    }
758 759 760
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
761

762 763 764 765 766 767 768 769
/***********************************************************************
		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
770
struct Lisp_Symbol *
771
indirect_variable (struct Lisp_Symbol *symbol)
772
{
Stefan Monnier's avatar
Stefan Monnier committed
773
  struct Lisp_Symbol *tortoise, *hare;
774 775 776

  hare = tortoise = symbol;

777
  while (hare->redirect == SYMBOL_VARALIAS)
778
    {