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-1995, 1997-2011
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>
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
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 55 56 57 58 59 60 61
Lisp_Object Qerror, Qquit, Qargs_out_of_range;
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;
Stefan Monnier's avatar
Stefan Monnier committed
90
static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
Gerd Moellmann's avatar
Gerd Moellmann committed
91
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
92
static Lisp_Object Qsubrp, Qmany, Qunevalled;
93
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
94

95 96
Lisp_Object Qinteractive_form;

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

99

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

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

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

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

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


/* Data type predicates */

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

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

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

    case Lisp_Symbol:
      return Qsymbol;

    case Lisp_String:
      return Qstring;

    case Lisp_Cons:
      return Qcons;

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

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

    case Lisp_Float:
      return Qfloat;

    default:
      abort ();
    }
}

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

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

239
DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
Luc Teirlinck's avatar
Luc Teirlinck committed
240 241
       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
242
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
243
{
244
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
245 246 247 248
    return Qt;
  return Qnil;
}

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

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

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

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

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

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

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

329 330
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
331
  (Lisp_Object object)
332 333 334 335 336 337
{
  if (BOOL_VECTOR_P (object))
    return Qt;
  return Qnil;
}

338 339
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
340
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
341
{
342
  if (ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
343 344 345 346 347
    return Qt;
  return Qnil;
}

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

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

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

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

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

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

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

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

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

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

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

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

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

Luc Teirlinck's avatar
Luc Teirlinck committed
465 466
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
467
  (register Lisp_Object list)
Jim Blandy's avatar
Jim Blandy committed
468
{
469
  return CAR (list);
Jim Blandy's avatar
Jim Blandy committed
470 471
}

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

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

Luc Teirlinck's avatar
Luc Teirlinck committed
483 484
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
485
  (register Lisp_Object list)
Jim Blandy's avatar
Jim Blandy committed
486
{
487
  return CDR (list);
Jim Blandy's avatar
Jim Blandy committed
488 489
}

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

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

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

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

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
 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
553

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

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

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

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

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

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

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

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

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

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

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

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

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

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

674
DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
675 676 677 678 679
       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
680
  (Lisp_Object subr)
681 682
{
  short minargs, maxargs;
683
  CHECK_SUBR (subr);
684 685 686 687 688 689 690 691 692 693
  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
694 695 696
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
697
  (Lisp_Object subr)
Stefan Monnier's avatar
Stefan Monnier committed
698 699
{
  const char *name;
700
  CHECK_SUBR (subr);
Stefan Monnier's avatar
Stefan Monnier committed
701 702 703 704
  name = XSUBR (subr)->symbol_name;
  return make_string (name, strlen (name));
}

Paul Eggert's avatar
Paul Eggert committed
705
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
Kenichi Handa's avatar
Kenichi Handa committed
706
       doc: /* Return the interactive form of CMD or nil if none.
Luc Teirlinck's avatar
Luc Teirlinck committed
707 708
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
709
  (Lisp_Object cmd)
710
{
711
  Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
712

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

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

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

  hare = tortoise = symbol;

776
  while (hare->redirect == SYMBOL_VARALIAS)
777
    {
778 779
      hare = SYMBOL_ALIAS (hare);
      if (hare->redirect != SYMBOL_VARALIAS)