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

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

87

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

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

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

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

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

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

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

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

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

    case Lisp_Symbol:
      return Qsymbol;

    case Lisp_String:
      return Qstring;

    case Lisp_Cons:
      return Qcons;

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

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

    case Lisp_Float:
      return Qfloat;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Paul Eggert's avatar
Paul Eggert committed
507
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
508
       doc: /* Return t if SYMBOL's value is not void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
509
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
510 511
{
  Lisp_Object valcontents;
512
  struct Lisp_Symbol *sym;
513
  CHECK_SYMBOL (symbol);
514
  sym = XSYMBOL (symbol);
Jim Blandy's avatar
Jim Blandy committed
515

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

542
  return (EQ (valcontents, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
543 544
}

Paul Eggert's avatar
Paul Eggert committed
545
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
546
       doc: /* Return t if SYMBOL's function definition is not void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
547
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
548
{
549
  CHECK_SYMBOL (symbol);
550
  return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt;
Jim Blandy's avatar
Jim Blandy committed
551 552
}

553
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
554 555
       doc: /* Make SYMBOL's value be void.
Return SYMBOL.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
556
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
557
{
558
  CHECK_SYMBOL (symbol);
559
  if (SYMBOL_CONSTANT_P (symbol))
560
    xsignal1 (Qsetting_constant, symbol);
561 562
  Fset (symbol, Qunbound);
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
563 564
}

565
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
566 567
       doc: /* Make SYMBOL's function definition 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 (NILP (symbol) || EQ (symbol, Qt))
572
    xsignal1 (Qsetting_constant, symbol);
573
  set_symbol_function (symbol, Qunbound);
574
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
575 576
}

Paul Eggert's avatar
Paul Eggert committed
577
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
578
       doc: /* Return SYMBOL's function definition.  Error if that is void.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
579
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
580
{
581
  CHECK_SYMBOL (symbol);
582 583
  if (!EQ (XSYMBOL (symbol)->function, Qunbound))
    return XSYMBOL (symbol)->function;
584
  xsignal1 (Qvoid_function, symbol);
Jim Blandy's avatar
Jim Blandy committed
585 586
}

587 588
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
       doc: /* Return SYMBOL's property list.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
589
  (register Lisp_Object symbol)
Jim Blandy's avatar
Jim Blandy committed
590
{
591
  CHECK_SYMBOL (symbol);
592
  return XSYMBOL (symbol)->plist;
Jim Blandy's avatar
Jim Blandy committed
593 594
}

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

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

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

612
  CHECK_SYMBOL (symbol);
613
  if (NILP (symbol) || EQ (symbol, Qt))
614
    xsignal1 (Qsetting_constant, symbol);
615

616
  function = XSYMBOL (symbol)->function;
617 618 619 620 621 622 623

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

624
  set_symbol_function (symbol, definition);
625
  /* Handle automatic advice activation.  */
626
  if (CONSP (XSYMBOL (symbol)->plist)
627
      && !NILP (Fget (symbol, Qad_advice_info)))
628
    {
629
      call2 (Qad_activate_internal, symbol, Qnil);
630
      definition = XSYMBOL (symbol)->function;
631
    }
632
  return definition;
Jim Blandy's avatar
Jim Blandy committed
633 634
}

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

Jim Blandy's avatar
Jim Blandy committed
662
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
Kenichi Handa's avatar
Kenichi Handa committed
663
       doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
664
  (register Lisp_Object symbol, Lisp_Object newplist)
Jim Blandy's avatar
Jim Blandy committed
665
{
666
  CHECK_SYMBOL (symbol);
667
  set_symbol_plist (symbol, newplist);
Jim Blandy's avatar
Jim Blandy committed
668 669
  return newplist;
}
Jim Blandy's avatar
Jim Blandy committed
670

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

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

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

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

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

  hare = tortoise = symbol;

773
  while (hare->redirect == SYMBOL_VARALIAS)
774
    {
775 776
      hare = SYMBOL_ALIAS (hare);
      if (hare->redirect != SYMBOL_VARALIAS)
777
	break;
778

779 780
      hare = SYMBOL_ALIAS (hare);
      tortoise = SYMBOL_ALIAS (tortoise);
781

Stefan Monnier's avatar
Stefan Monnier committed
782 783 784 785 786 787
      if (hare == tortoise)
	{
	  Lisp_Object tem;
	  XSETSYMBOL (tem, symbol);
	  xsignal1 (Qcyclic_variable_indirection, tem);
	}
788 789 790 791 792 793 794
    }

  return hare;
}


DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
795
       doc: /* Return the variable at the end of OBJECT's variable chain.
Chong Yidong's avatar
Chong Yidong committed
796 797 798 799 800 801
If OBJECT is a symbol, follow its variable indirections (if any), and
return the variable at the end of the chain of aliases.  See Info node
`(elisp)Variable Aliases'.

If OBJECT is not a symbol, just return it.  If there is a loop in the
chain of aliases, signal a `cyclic-variable-indirection' error.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
802
  (Lisp_Object object)
803 804
{
  if (SYMBOLP (object))
805 806 807 808
    {
      struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object));
      XSETSYMBOL (object, sym);
    }
809 810 811
  return object;
}

Jim Blandy's avatar
Jim Blandy committed
812 813 814 815 816 817 818

/* Given the raw contents of a symbol value cell,
   return the Lisp value of the symbol.
   This does not handle buffer-local variables; use
   swap_in_symval_forwarding for that.  */

Lisp_Object
819
do_symval_forwarding (register union Lisp_Fwd *valcontents)
Jim Blandy's avatar
Jim Blandy committed
820 821
{
  register Lisp_Object val;
822 823 824 825 826 827