/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
#include "font.h"
#include "keymap.h"
-Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
-static Lisp_Object Qsubr;
-Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
-static Lisp_Object Qwrong_length_argument;
-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;
-Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
-Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
-Lisp_Object Qtext_read_only;
-
-Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
-static Lisp_Object Qnatnump;
-Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
-Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
-Lisp_Object Qbool_vector_p;
-Lisp_Object Qbuffer_or_string_p;
-static Lisp_Object Qkeywordp, Qboundp;
-Lisp_Object Qfboundp;
-Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
-
-Lisp_Object Qcdr;
-static Lisp_Object Qad_advice_info, Qad_activate_internal;
-
-static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
-Lisp_Object Qrange_error, Qoverflow_error;
-
-Lisp_Object Qfloatp;
-Lisp_Object Qnumberp, Qnumber_or_marker_p;
-
-Lisp_Object Qinteger, Qsymbol;
-static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
-Lisp_Object Qwindow;
-static Lisp_Object Qoverlay, Qwindow_configuration;
-static Lisp_Object Qprocess, Qmarker;
-static Lisp_Object Qcompiled_function, Qframe;
-Lisp_Object Qbuffer;
-static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
-static Lisp_Object Qsubrp;
-static Lisp_Object Qmany, Qunevalled;
-Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-static Lisp_Object Qdefun;
-
-Lisp_Object Qinteractive_form;
-static Lisp_Object Qdefalias_fset_function;
-
static void swap_in_symval_forwarding (struct Lisp_Symbol *,
struct Lisp_Buffer_Local_Value *);
/* Data type predicates. */
DEFUN ("eq", Feq, Seq, 2, 2, 0,
- doc: /* Return t if the two args are the same Lisp object. */)
+ doc: /* Return t if the two args are the same Lisp object. */
+ attributes: const)
(Lisp_Object obj1, Lisp_Object obj2)
{
if (EQ (obj1, obj2))
}
DEFUN ("null", Fnull, Snull, 1, 1, 0,
- doc: /* Return t if OBJECT is nil. */)
+ doc: /* Return t if OBJECT is nil, and return nil otherwise. */
+ attributes: const)
(Lisp_Object object)
{
if (NILP (object))
case Lisp_Misc_Overlay:
return Qoverlay;
case Lisp_Misc_Float:
- return Qfloat;
+ return Qfloat;
+ case Lisp_Misc_Finalizer:
+ return Qfinalizer;
+ default:
+ emacs_abort ();
}
- emacs_abort ();
case Lisp_Vectorlike:
if (WINDOW_CONFIGURATIONP (object))
}
DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
- doc: /* Return t if OBJECT is a cons cell. */)
+ doc: /* Return t if OBJECT is a cons cell. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object))
}
DEFUN ("atom", Fatom, Satom, 1, 1, 0,
- doc: /* Return t if OBJECT is not a cons cell. This includes nil. */)
+ doc: /* Return t if OBJECT is not a cons cell. This includes nil. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object))
DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
-Otherwise, return nil. */)
+Otherwise, return nil. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object) || NILP (object))
}
DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
- doc: /* Return t if OBJECT is not a list. Lists include nil. */)
+ doc: /* Return t if OBJECT is not a list. Lists include nil. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object) || NILP (object))
}
\f
DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
- doc: /* Return t if OBJECT is a symbol. */)
+ doc: /* Return t if OBJECT is a symbol. */
+ attributes: const)
(Lisp_Object object)
{
if (SYMBOLP (object))
}
DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
- doc: /* Return t if OBJECT is a string. */)
+ doc: /* Return t if OBJECT is a string. */
+ attributes: const)
(Lisp_Object object)
{
if (STRINGP (object))
}
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a character or a string. */)
+ doc: /* Return t if OBJECT is a character or a string. */
+ attributes: const)
(register Lisp_Object object)
{
if (CHARACTERP (object) || STRINGP (object))
}
\f
DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
- doc: /* Return t if OBJECT is an integer. */)
+ doc: /* Return t if OBJECT is an integer. */
+ attributes: const)
(Lisp_Object object)
{
if (INTEGERP (object))
}
DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
- doc: /* Return t if OBJECT is a nonnegative integer. */)
+ doc: /* Return t if OBJECT is a nonnegative integer. */
+ attributes: const)
(Lisp_Object object)
{
if (NATNUMP (object))
}
DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
- doc: /* Return t if OBJECT is a number (floating point or integer). */)
+ doc: /* Return t if OBJECT is a number (floating point or integer). */
+ attributes: const)
(Lisp_Object object)
{
if (NUMBERP (object))
}
DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
- doc: /* Return t if OBJECT is a floating point number. */)
+ doc: /* Return t if OBJECT is a floating point number. */
+ attributes: const)
(Lisp_Object object)
{
if (FLOATP (object))
(register Lisp_Object cell, Lisp_Object newcar)
{
CHECK_CONS (cell);
- CHECK_IMPURE (cell);
+ CHECK_IMPURE (cell, XCONS (cell));
XSETCAR (cell, newcar);
return newcar;
}
(register Lisp_Object cell, Lisp_Object newcdr)
{
CHECK_CONS (cell);
- CHECK_IMPURE (cell);
+ CHECK_IMPURE (cell, XCONS (cell));
XSETCDR (cell, newcdr);
return newcdr;
}
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
doc: /* Return the interactive form of CMD or nil if none.
If CMD is not a command, the return value is nil.
-Value, if non-nil, is a list \(interactive SPEC). */)
+Value, if non-nil, is a list (interactive SPEC). */)
(Lisp_Object cmd)
{
Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
AUTO_STRING (value_should_be_from, "Value should be from ");
AUTO_STRING (to, " to ");
xsignal2 (Qerror,
- Fconcat (4, ((Lisp_Object [])
- {value_should_be_from, Fnumber_to_string (min),
- to, Fnumber_to_string (max)})),
+ CALLN (Fconcat, value_should_be_from, Fnumber_to_string (min),
+ to, Fnumber_to_string (max)),
wrong);
}
(Lisp_Object args)
{
Lisp_Object args_left, symbol, val;
- struct gcpro gcpro1;
args_left = val = args;
- GCPRO1 (args);
while (CONSP (args_left))
{
args_left = Fcdr (XCDR (args_left));
}
- UNGCPRO;
return val;
}
\f
Lisp_Object symbol;
XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
if (let_shadows_global_binding_p (symbol))
- message ("Making %s buffer-local while let-bound!",
- SDATA (SYMBOL_NAME (variable)));
+ {
+ AUTO_STRING (format, "Making %s buffer-local while let-bound!");
+ CALLN (Fmessage, format, SYMBOL_NAME (variable));
+ }
}
}
1, 1, "vMake Local Variable: ",
doc: /* Make VARIABLE have a separate value in the current buffer.
Other buffers will continue to share a common default value.
-\(The buffer-local value of VARIABLE starts out as the same value
-VARIABLE previously had. If VARIABLE was void, it remains void.\)
+(The buffer-local value of VARIABLE starts out as the same value
+VARIABLE previously had. If VARIABLE was void, it remains void.)
Return VARIABLE.
If the variable is already arranged to become local when set,
just as setting the variable would do.
This function returns VARIABLE, and therefore
- (set (make-local-variable 'VARIABLE) VALUE-EXP)
+ (set (make-local-variable \\='VARIABLE) VALUE-EXP)
works.
See also `make-variable-buffer-local'.
Lisp_Object symbol;
XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
if (let_shadows_global_binding_p (symbol))
- message ("Making %s local to %s while let-bound!",
- SDATA (SYMBOL_NAME (variable)),
- SDATA (BVAR (current_buffer, name)));
+ {
+ AUTO_STRING (format, "Making %s local to %s while let-bound!");
+ CALLN (Fmessage, format, SYMBOL_NAME (variable),
+ BVAR (current_buffer, name));
+ }
}
}
if (NILP (tem))
{
if (let_shadows_buffer_binding_p (sym))
- message ("Making %s buffer-local while locally let-bound!",
- SDATA (SYMBOL_NAME (variable)));
+ {
+ AUTO_STRING (format,
+ "Making %s buffer-local while locally let-bound!");
+ CALLN (Fmessage, format, SYMBOL_NAME (variable));
+ }
/* Swap out any local binding for some other buffer, and make
sure the current value is permanently recorded, if it's the
Lisp_Object symbol;
XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
if (let_shadows_global_binding_p (symbol))
- message ("Making %s frame-local while let-bound!",
- SDATA (SYMBOL_NAME (variable)));
+ {
+ AUTO_STRING (format, "Making %s frame-local while let-bound!");
+ CALLN (Fmessage, format, SYMBOL_NAME (variable));
+ }
}
return variable;
}
doc: /* Return the function at the end of OBJECT's function chain.
If OBJECT is not a symbol, just return it. Otherwise, follow all
function indirections to find the final function binding and return it.
-If the final symbol in the chain is unbound, signal a void-function error.
-Optional arg NOERROR non-nil means to return nil instead of signaling.
Signal a cyclic-function-indirection error if there is a loop in the
function chain of symbols. */)
(register Lisp_Object object, Lisp_Object noerror)
if (!NILP (result))
return result;
- if (NILP (noerror))
- xsignal1 (Qvoid_function, object);
-
return Qnil;
}
\f
CHECK_NUMBER (idx);
idxval = XINT (idx);
CHECK_ARRAY (array, Qarrayp);
- CHECK_IMPURE (array);
if (VECTORP (array))
{
+ CHECK_IMPURE (array, XVECTOR (array));
if (idxval < 0 || idxval >= ASIZE (array))
args_out_of_range (array, idx);
ASET (array, idxval, newelt);
{
int c;
+ CHECK_IMPURE (array, XSTRING (array));
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_CHARACTER (newelt);
DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
doc: /* Return the byteorder for the machine.
Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
-lowercase l) for small endian machines. */)
+lowercase l) for small endian machines. */
+ attributes: const)
(void)
{
unsigned i = 0x04030201;
DEFSYM (Qlistp, "listp");
DEFSYM (Qconsp, "consp");
DEFSYM (Qsymbolp, "symbolp");
- DEFSYM (Qkeywordp, "keywordp");
DEFSYM (Qintegerp, "integerp");
DEFSYM (Qnatnump, "natnump");
DEFSYM (Qwholenump, "wholenump");
DEFSYM (Qmarkerp, "markerp");
DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
- DEFSYM (Qboundp, "boundp");
DEFSYM (Qfboundp, "fboundp");
DEFSYM (Qfloatp, "floatp");
DEFSYM (Qcdr, "cdr");
- /* Handle automatic advice activation. */
- DEFSYM (Qad_advice_info, "ad-advice-info");
- DEFSYM (Qad_activate_internal, "ad-activate-internal");
-
error_tail = pure_cons (Qerror, Qnil);
/* ERROR is used as a signaler for random errors for which nothing else is
PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
"Arithmetic underflow error");
- staticpro (&Qnil);
- staticpro (&Qt);
- staticpro (&Qunbound);
-
/* Types that type-of returns. */
DEFSYM (Qinteger, "integer");
DEFSYM (Qsymbol, "symbol");
DEFSYM (Qcons, "cons");
DEFSYM (Qmarker, "marker");
DEFSYM (Qoverlay, "overlay");
+ DEFSYM (Qfinalizer, "finalizer");
DEFSYM (Qfloat, "float");
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
DEFSYM (Qchar_table, "char-table");
DEFSYM (Qbool_vector, "bool-vector");
DEFSYM (Qhash_table, "hash-table");
- DEFSYM (Qmisc, "misc");
DEFSYM (Qdefun, "defun");