data.c 88.2 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2 3
   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 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 <stdio.h>
23 24 25

#include <intprops.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"
35
#include "keymap.h"
Jim Blandy's avatar
Jim Blandy committed
36

37 38
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
static Lisp_Object Qsubr;
Jim Blandy's avatar
Jim Blandy committed
39
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
40
Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
41 42 43 44 45 46 47
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
48
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
Roland McGrath's avatar
Roland McGrath committed
49
Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
Jim Blandy's avatar
Jim Blandy committed
50
Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
51
Lisp_Object Qtext_read_only;
Kenichi Handa's avatar
Kenichi Handa committed
52

53 54
Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
static Lisp_Object Qnatnump;
Jim Blandy's avatar
Jim Blandy committed
55 56
Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
57 58 59
Lisp_Object Qbuffer_or_string_p;
static Lisp_Object Qkeywordp, Qboundp;
Lisp_Object Qfboundp;
60
Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
61

Jim Blandy's avatar
Jim Blandy committed
62
Lisp_Object Qcdr;
63
static Lisp_Object Qad_advice_info, Qad_activate_internal;
Jim Blandy's avatar
Jim Blandy committed
64

65 66
static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
Lisp_Object Qrange_error, Qoverflow_error;
67

68
Lisp_Object Qfloatp;
Jim Blandy's avatar
Jim Blandy committed
69 70
Lisp_Object Qnumberp, Qnumber_or_marker_p;

Paul Eggert's avatar
Paul Eggert committed
71 72
Lisp_Object Qinteger, Qsymbol;
static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
73
Lisp_Object Qwindow;
74 75 76
static Lisp_Object Qoverlay, Qwindow_configuration;
static Lisp_Object Qprocess, Qmarker;
static Lisp_Object Qcompiled_function, Qframe;
77
Lisp_Object Qbuffer;
Gerd Moellmann's avatar
Gerd Moellmann committed
78
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
79
static Lisp_Object Qsubrp, Qmany, Qunevalled;
80
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
81
static Lisp_Object Qdefun;
82

83 84
Lisp_Object Qinteractive_form;
static Lisp_Object Qdefalias_fset_function;
85

86
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
87

88

Jim Blandy's avatar
Jim Blandy committed
89
Lisp_Object
90
wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
Jim Blandy's avatar
Jim Blandy committed
91
{
92 93 94 95 96
  /* 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)
97
   *   emacs_abort (); */
98

99
  xsignal2 (Qwrong_type_argument, predicate, value);
Jim Blandy's avatar
Jim Blandy committed
100 101
}

Andreas Schwab's avatar
Andreas Schwab committed
102
void
103
pure_write_error (void)
Jim Blandy's avatar
Jim Blandy committed
104 105 106 107 108
{
  error ("Attempt to modify read-only object");
}

void
109
args_out_of_range (Lisp_Object a1, Lisp_Object a2)
Jim Blandy's avatar
Jim Blandy committed
110
{
111
  xsignal2 (Qargs_out_of_range, a1, a2);
Jim Blandy's avatar
Jim Blandy committed
112 113 114
}

void
115
args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
Jim Blandy's avatar
Jim Blandy committed
116
{
117
  xsignal3 (Qargs_out_of_range, a1, a2, a3);
Jim Blandy's avatar
Jim Blandy committed
118 119 120
}


121
/* Data type predicates.  */
Jim Blandy's avatar
Jim Blandy committed
122 123

DEFUN ("eq", Feq, Seq, 2, 2, 0,
124
       doc: /* Return t if the two args are the same Lisp object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
125
  (Lisp_Object obj1, Lisp_Object obj2)
Jim Blandy's avatar
Jim Blandy committed
126 127 128 129 130 131
{
  if (EQ (obj1, obj2))
    return Qt;
  return Qnil;
}

132 133
DEFUN ("null", Fnull, Snull, 1, 1, 0,
       doc: /* Return t if OBJECT is nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
134
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
135
{
136
  if (NILP (object))
Jim Blandy's avatar
Jim Blandy committed
137 138 139 140
    return Qt;
  return Qnil;
}

141
DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
142 143 144
       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
145
  (Lisp_Object object)
146
{
147
  switch (XTYPE (object))
148
    {
149
    case_Lisp_Int:
150 151 152 153 154 155 156 157 158 159 160 161
      return Qinteger;

    case Lisp_Symbol:
      return Qsymbol;

    case Lisp_String:
      return Qstring;

    case Lisp_Cons:
      return Qcons;

    case Lisp_Misc:
162
      switch (XMISCTYPE (object))
163 164 165 166 167 168 169 170
	{
	case Lisp_Misc_Marker:
	  return Qmarker;
	case Lisp_Misc_Overlay:
	  return Qoverlay;
	case Lisp_Misc_Float:
	  return Qfloat;
	}
171
      emacs_abort ();
172 173

    case Lisp_Vectorlike:
174
      if (WINDOW_CONFIGURATIONP (object))
175
	return Qwindow_configuration;
176
      if (PROCESSP (object))
177
	return Qprocess;
178
      if (WINDOWP (object))
179
	return Qwindow;
180
      if (SUBRP (object))
181
	return Qsubr;
Stefan Monnier's avatar
Stefan Monnier committed
182 183
      if (COMPILEDP (object))
	return Qcompiled_function;
184
      if (BUFFERP (object))
185
	return Qbuffer;
186
      if (CHAR_TABLE_P (object))
187
	return Qchar_table;
188
      if (BOOL_VECTOR_P (object))
189
	return Qbool_vector;
190
      if (FRAMEP (object))
191
	return Qframe;
192
      if (HASH_TABLE_P (object))
Gerd Moellmann's avatar
Gerd Moellmann committed
193
	return Qhash_table;
194 195 196 197 198 199
      if (FONT_SPEC_P (object))
	return Qfont_spec;
      if (FONT_ENTITY_P (object))
	return Qfont_entity;
      if (FONT_OBJECT_P (object))
	return Qfont_object;
200 201 202 203 204 205
      return Qvector;

    case Lisp_Float:
      return Qfloat;

    default:
206
      emacs_abort ();
207 208 209
    }
}

210 211
DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
       doc: /* Return t if OBJECT is a cons cell.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
212
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
213
{
214
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
215 216 217 218
    return Qt;
  return Qnil;
}

219
DEFUN ("atom", Fatom, Satom, 1, 1, 0,
220
       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
221
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
222
{
223
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
224 225 226 227
    return Qnil;
  return Qt;
}

228
DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
Luc Teirlinck's avatar
Luc Teirlinck committed
229 230
       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
231
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
232
{
233
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
234 235 236 237
    return Qt;
  return Qnil;
}

238
DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
239
       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
240
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
241
{
242
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
243 244 245 246
    return Qnil;
  return Qt;
}

247
DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
248
       doc: /* Return t if OBJECT is a symbol.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
249
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
250
{
251
  if (SYMBOLP (object))
Jim Blandy's avatar
Jim Blandy committed
252 253 254 255
    return Qt;
  return Qnil;
}

Dave Love's avatar
Dave Love committed
256 257 258
/* Define this in C to avoid unnecessarily consing up the symbol
   name.  */
DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
259 260 261
       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
262
  (Lisp_Object object)
Dave Love's avatar
Dave Love committed
263 264
{
  if (SYMBOLP (object)
265
      && SREF (SYMBOL_NAME (object), 0) == ':'
266
      && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
Dave Love's avatar
Dave Love committed
267 268 269 270
    return Qt;
  return Qnil;
}

271
DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
272
       doc: /* Return t if OBJECT is a vector.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
273
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
274
{
275
  if (VECTORP (object))
Jim Blandy's avatar
Jim Blandy committed
276 277 278 279
    return Qt;
  return Qnil;
}

280
DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
281
       doc: /* Return t if OBJECT is a string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
282
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
283
{
284
  if (STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
285 286 287 288
    return Qt;
  return Qnil;
}

289
DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
290 291
       1, 1, 0,
       doc: /* Return t if OBJECT is a multibyte string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
292
  (Lisp_Object object)
293 294 295 296 297 298 299
{
  if (STRINGP (object) && STRING_MULTIBYTE (object))
    return Qt;
  return Qnil;
}

DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0,
300
       doc: /* Return t if OBJECT is a char-table.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
301
  (Lisp_Object object)
302 303 304 305 306 307
{
  if (CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

308 309
DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
       Svector_or_char_table_p, 1, 1, 0,
310
       doc: /* Return t if OBJECT is a char-table or vector.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
311
  (Lisp_Object object)
312 313 314 315 316 317
{
  if (VECTORP (object) || CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

318 319
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
320
  (Lisp_Object object)
321 322 323 324 325 326
{
  if (BOOL_VECTOR_P (object))
    return Qt;
  return Qnil;
}

327 328
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
329
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
330
{
331
  if (ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
332 333 334 335 336
    return Qt;
  return Qnil;
}

DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
337
       doc: /* Return t if OBJECT is a sequence (list or array).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
338
  (register Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
339
{
340
  if (CONSP (object) || NILP (object) || ARRAYP (object))
Jim Blandy's avatar
Jim Blandy committed
341 342 343 344
    return Qt;
  return Qnil;
}

345 346
DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0,
       doc: /* Return t if OBJECT is an editor buffer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
347
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
348
{
349
  if (BUFFERP (object))
Jim Blandy's avatar
Jim Blandy committed
350 351 352 353
    return Qt;
  return Qnil;
}

354 355
DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
       doc: /* Return t if OBJECT is a marker (editor pointer).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
356
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
357
{
358
  if (MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
359 360 361 362
    return Qt;
  return Qnil;
}

363 364
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
       doc: /* Return t if OBJECT is a built-in function.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
365
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
366
{
367
  if (SUBRP (object))
Jim Blandy's avatar
Jim Blandy committed
368 369 370 371
    return Qt;
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
372
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
373 374
       1, 1, 0,
       doc: /* Return t if OBJECT is a byte-compiled function object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
375
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
376
{
377
  if (COMPILEDP (object))
Jim Blandy's avatar
Jim Blandy committed
378 379 380 381
    return Qt;
  return Qnil;
}

382
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
383
       doc: /* Return t if OBJECT is a character or a string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
384
  (register Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
385
{
386
  if (CHARACTERP (object) || STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
387 388 389 390
    return Qt;
  return Qnil;
}

391 392
DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
       doc: /* Return t if OBJECT is an integer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
393
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
394
{
395
  if (INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
396 397 398 399
    return Qt;
  return Qnil;
}

400
DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
401
       doc: /* Return t if OBJECT is an integer or a marker (editor pointer).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
402
  (register Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
403
{
404
  if (MARKERP (object) || INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
405 406 407 408
    return Qt;
  return Qnil;
}

409
DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
410
       doc: /* Return t if OBJECT is a nonnegative integer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
411
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
412
{
413
  if (NATNUMP (object))
Jim Blandy's avatar
Jim Blandy committed
414 415 416 417 418
    return Qt;
  return Qnil;
}

DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
419
       doc: /* Return t if OBJECT is a number (floating point or integer).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
420
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
421
{
422
  if (NUMBERP (object))
Jim Blandy's avatar
Jim Blandy committed
423
    return Qt;
Jim Blandy's avatar
Jim Blandy committed
424 425
  else
    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
426 427 428 429
}

DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
       Snumber_or_marker_p, 1, 1, 0,
430
       doc: /* Return t if OBJECT is a number or a marker.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
431
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
432
{
433
  if (NUMBERP (object) || MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
434 435 436
    return Qt;
  return Qnil;
}
437 438

DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
439
       doc: /* Return t if OBJECT is a floating point number.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
440
  (Lisp_Object object)
441
{
442
  if (FLOATP (object))
443 444 445
    return Qt;
  return Qnil;
}
446

Jim Blandy's avatar
Jim Blandy committed
447

448
/* Extract and set components of lists.  */
Jim Blandy's avatar
Jim Blandy committed
449

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

Luc Teirlinck's avatar
Luc Teirlinck committed
454 455
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
456
  (register Lisp_Object list)
Jim Blandy's avatar
Jim Blandy committed
457
{
458
  return CAR (list);
Jim Blandy's avatar
Jim Blandy committed
459 460
}

Paul Eggert's avatar
Paul Eggert committed
461
DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
462
       doc: /* Return the car of OBJECT if it is a cons cell, or else nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
463
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
464
{
465
  return CAR_SAFE (object);
Jim Blandy's avatar
Jim Blandy committed
466 467
}

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

Luc Teirlinck's avatar
Luc Teirlinck committed
472 473
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
474
  (register Lisp_Object list)
Jim Blandy's avatar
Jim Blandy committed
475
{
476
  return CDR (list);
Jim Blandy's avatar
Jim Blandy committed
477 478
}

Paul Eggert's avatar
Paul Eggert committed
479
DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
480
       doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
481
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
482
{
483
  return CDR_SAFE (object);
Jim Blandy's avatar
Jim Blandy committed
484 485
}

Paul Eggert's avatar
Paul Eggert committed
486
DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
487
       doc: /* Set the car of CELL to be NEWCAR.  Returns NEWCAR.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
488
  (register Lisp_Object cell, Lisp_Object newcar)
Jim Blandy's avatar
Jim Blandy committed
489
{
490
  CHECK_CONS (cell);
Jim Blandy's avatar
Jim Blandy committed
491
  CHECK_IMPURE (cell);
492
  XSETCAR (cell, newcar);
Jim Blandy's avatar
Jim Blandy committed
493 494 495
  return newcar;
}

Paul Eggert's avatar
Paul Eggert committed
496
DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
497
       doc: /* Set the cdr of CELL to be NEWCDR.  Returns NEWCDR.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
498
  (register Lisp_Object cell, Lisp_Object newcdr)
Jim Blandy's avatar
Jim Blandy committed
499
{
500
  CHECK_CONS (cell);
Jim Blandy's avatar
Jim Blandy committed
501
  CHECK_IMPURE (cell);
502
  XSETCDR (cell, newcdr);
Jim Blandy's avatar
Jim Blandy committed
503 504 505
  return newcdr;
}

506
/* Extract and set components of symbols.  */
Jim Blandy's avatar
Jim Blandy committed
507

Paul Eggert's avatar
Paul Eggert committed
508
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
509 510 511
       doc: /* Return t if SYMBOL's value is not void.
Note that if `lexical-binding' is in effect, this refers to the
global value outside of any lexical scope.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
512
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
513 514
{
  Lisp_Object valcontents;
515
  struct Lisp_Symbol *sym;
516
  CHECK_SYMBOL (symbol);
517
  sym = XSYMBOL (symbol);
Jim Blandy's avatar
Jim Blandy committed
518

519 520 521 522 523 524 525 526 527 528 529 530 531 532 533
 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);
534
	    valcontents = blv_value (blv);
535 536 537 538 539 540 541
	  }
	break;
      }
    case SYMBOL_FORWARDED:
      /* In set_internal, we un-forward vars when their value is
	 set to Qunbound. */
      return Qt;
542
    default: emacs_abort ();
543
    }
Jim Blandy's avatar
Jim Blandy committed
544

545
  return (EQ (valcontents, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
546 547
}

548
/* FIXME: Make it an alias for function-symbol!  */
Paul Eggert's avatar
Paul Eggert committed
549
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
550
       doc: /* Return t if SYMBOL's function definition is not void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
551
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
552
{
553
  CHECK_SYMBOL (symbol);
554
  return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
Jim Blandy's avatar
Jim Blandy committed
555 556
}

557
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
558 559
       doc: /* Make SYMBOL's value be void.
Return SYMBOL.  */)
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
  if (SYMBOL_CONSTANT_P (symbol))
564
    xsignal1 (Qsetting_constant, symbol);
565 566
  Fset (symbol, Qunbound);
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
567 568
}

569
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
570
       doc: /* Make SYMBOL's function definition be nil.
571
Return SYMBOL.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
572
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
573
{
574
  CHECK_SYMBOL (symbol);
575
  if (NILP (symbol) || EQ (symbol, Qt))
576
    xsignal1 (Qsetting_constant, symbol);
577
  set_symbol_function (symbol, Qnil);
578
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
579 580
}

Paul Eggert's avatar
Paul Eggert committed
581
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
582
       doc: /* Return SYMBOL's function definition.  Error if that is void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
583
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
584
{
585
  CHECK_SYMBOL (symbol);
Andreas Schwab's avatar
Indent  
Andreas Schwab committed
586
  return XSYMBOL (symbol)->function;
Jim Blandy's avatar
Jim Blandy committed
587 588
}

589 590
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
       doc: /* Return SYMBOL's property list.  */)
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
  return XSYMBOL (symbol)->plist;
Jim Blandy's avatar
Jim Blandy committed
595 596
}

Paul Eggert's avatar
Paul Eggert committed
597
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
598
       doc: /* Return SYMBOL's name, a string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
599
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
600 601 602
{
  register Lisp_Object name;

603
  CHECK_SYMBOL (symbol);
604
  name = SYMBOL_NAME (symbol);
Jim Blandy's avatar
Jim Blandy committed
605 606 607
  return name;
}

Paul Eggert's avatar
Paul Eggert committed
608
DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
609
       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
610
  (register Lisp_Object symbol, Lisp_Object definition)
611
{
612
  register Lisp_Object function;
613
  CHECK_SYMBOL (symbol);
614

615
  function = XSYMBOL (symbol)->function;
616

617
  if (!NILP (Vautoload_queue) && !NILP (function))
618 619
    Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);

620
  if (AUTOLOADP (function))
621 622
    Fput (symbol, Qautoload, XCDR (function));

623
  set_symbol_function (symbol, definition);
624

625
  return definition;
Jim Blandy's avatar
Jim Blandy committed
626 627
}

628
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
629
       doc: /* Set SYMBOL's function definition to DEFINITION.
Richard M. Stallman's avatar
Richard M. Stallman committed
630 631 632
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
633 634
determined by DEFINITION.
The return value is undefined.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
635
  (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
636
{
637
  CHECK_SYMBOL (symbol);
638 639 640 641
  if (!NILP (Vpurify_flag)
      /* If `definition' is a keymap, immutable (and copying) is wrong.  */
      && !KEYMAPP (definition))
    definition = Fpurecopy (definition);
642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663

  {
    bool autoload = AUTOLOADP (definition);
    if (NILP (Vpurify_flag) || !autoload)
      { /* Only add autoload entries after dumping, because the ones before are
	   not useful and else we get loads of them from the loaddefs.el.  */

	if (AUTOLOADP (XSYMBOL (symbol)->function))
	  /* Remember that the function was already an autoload.  */
	  LOADHIST_ATTACH (Fcons (Qt, symbol));
	LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
      }
  }

  { /* Handle automatic advice activation.  */
    Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
    if (!NILP (hook))
      call2 (hook, symbol, definition);
    else
      Ffset (symbol, definition);
  }

664 665
  if (!NILP (docstring))
    Fput (symbol, Qfunction_documentation, docstring);
666 667 668 669
  /* We used to return `definition', but now that `defun' and `defmacro' expand
     to a call to `defalias', we return `symbol' for backward compatibility
     (bug#11686).  */
  return symbol;
670 671
}

Jim Blandy's avatar
Jim Blandy committed
672
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
Kenichi Handa's avatar
Kenichi Handa committed
673
       doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
674
  (register Lisp_Object symbol, Lisp_Object newplist)
Jim Blandy's avatar
Jim Blandy committed
675
{
676
  CHECK_SYMBOL (symbol);
677
  set_symbol_plist (symbol, newplist);
Jim Blandy's avatar
Jim Blandy committed
678 679
  return newplist;
}
Jim Blandy's avatar
Jim Blandy committed
680

681
DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
682 683 684 685 686
       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
687
  (Lisp_Object subr)
688 689
{
  short minargs, maxargs;
690
  CHECK_SUBR (subr);
691 692
  minargs = XSUBR (subr)->min_args;
  maxargs = XSUBR (subr)->max_args;
693 694 695 696
  return Fcons (make_number (minargs),
		maxargs == MANY ?        Qmany
		: maxargs == UNEVALLED ? Qunevalled
		:                        make_number (maxargs));
697 698
}

Stefan Monnier's avatar
Stefan Monnier committed
699 700 701
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
702
  (Lisp_Object subr)
Stefan Monnier's avatar
Stefan Monnier committed
703 704
{
  const char *name;
705
  CHECK_SUBR (subr);
Stefan Monnier's avatar
Stefan Monnier committed
706
  name = XSUBR (subr)->symbol_name;
707
  return build_string (name);
Stefan Monnier's avatar
Stefan Monnier committed
708 709
}

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

718
  if (NILP (fun))
719 720 721
    return Qnil;

  /* Use an `interactive-form' property if present, analogous to the
722
     function-documentation property.  */
723 724 725
  fun = cmd;
  while (SYMBOLP (fun))
    {
726
      Lisp_Object tmp = Fget (fun, Qinteractive_form);
727 728 729 730 731
      if (!NILP (tmp))
	return tmp;
      else
	fun = Fsymbol_function (fun);
    }
Kenichi Handa's avatar
Kenichi Handa committed
732 733 734

  if (SUBRP (fun))
    {
735
      const char *spec = XSUBR (fun)->intspec;
736 737 738 739
      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
740 741 742 743 744 745
    }
  else if (COMPILEDP (fun))
    {
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
	return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
    }
746 747
  else if (AUTOLOADP (fun))
    return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
Kenichi Handa's avatar
Kenichi Handa committed
748 749 750
  else if (CONSP (fun))
    {
      Lisp_Object funcar = XCAR (fun);
751
      if (EQ (funcar, Qclosure))