/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
- Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+ Foundation, Inc.
This file is part of GNU Emacs.
static Lisp_Object Qcompiled_function, Qframe;
Lisp_Object Qbuffer;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
-static Lisp_Object Qsubrp, Qmany, Qunevalled;
+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 *);
+static bool
+BOOLFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Bool;
+}
+static bool
+INTFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Int;
+}
+static bool
+KBOARD_OBJFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
+}
+static bool
+OBJFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Obj;
+}
+
+static struct Lisp_Boolfwd *
+XBOOLFWD (union Lisp_Fwd *a)
+{
+ eassert (BOOLFWDP (a));
+ return &a->u_boolfwd;
+}
+static struct Lisp_Kboard_Objfwd *
+XKBOARD_OBJFWD (union Lisp_Fwd *a)
+{
+ eassert (KBOARD_OBJFWDP (a));
+ return &a->u_kboard_objfwd;
+}
+static struct Lisp_Intfwd *
+XINTFWD (union Lisp_Fwd *a)
+{
+ eassert (INTFWDP (a));
+ return &a->u_intfwd;
+}
+static struct Lisp_Objfwd *
+XOBJFWD (union Lisp_Fwd *a)
+{
+ eassert (OBJFWDP (a));
+ return &a->u_objfwd;
+}
+
+static void
+CHECK_SUBR (Lisp_Object x)
+{
+ CHECK_TYPE (SUBRP (x), Qsubrp, x);
+}
+
+static void
+set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
+{
+ eassert (found == !EQ (blv->defcell, blv->valcell));
+ blv->found = found;
+}
+
+static Lisp_Object
+blv_value (struct Lisp_Buffer_Local_Value *blv)
+{
+ return XCDR (blv->valcell);
+}
+
+static void
+set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ XSETCDR (blv->valcell, val);
+}
+
+static void
+set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->where = val;
+}
+
+static void
+set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->defcell = val;
+}
+
+static void
+set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->valcell = val;
+}
Lisp_Object
wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
}
void
-pure_write_error (void)
+pure_write_error (Lisp_Object obj)
{
- error ("Attempt to modify read-only object");
+ xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
}
void
DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
1, 1, 0,
- doc: /* Return t if OBJECT is a multibyte string. */)
+ doc: /* Return t if OBJECT is a multibyte string.
+Return nil if OBJECT is either a unibyte string, or not a string. */)
(Lisp_Object object)
{
if (STRINGP (object) && STRING_MULTIBYTE (object))
}
\f
-/* Extract and set components of lists */
+/* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil.
/* Extract and set components of symbols. */
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
- doc: /* Return t if SYMBOL's value is not void. */)
+ 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. */)
(register Lisp_Object symbol)
{
Lisp_Object valcontents;
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
}
+/* FIXME: Make it an alias for function-symbol! */
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's function definition is not void. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt;
+ return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
}
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
- doc: /* Make SYMBOL's function definition be void.
+ doc: /* Make SYMBOL's function definition be nil.
Return SYMBOL. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
if (NILP (symbol) || EQ (symbol, Qt))
xsignal1 (Qsetting_constant, symbol);
- set_symbol_function (symbol, Qunbound);
+ set_symbol_function (symbol, Qnil);
return symbol;
}
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- if (!EQ (XSYMBOL (symbol)->function, Qunbound))
- return XSYMBOL (symbol)->function;
- xsignal1 (Qvoid_function, symbol);
+ return XSYMBOL (symbol)->function;
}
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
(register Lisp_Object symbol, Lisp_Object definition)
{
register Lisp_Object function;
-
CHECK_SYMBOL (symbol);
- if (NILP (symbol) || EQ (symbol, Qt))
- xsignal1 (Qsetting_constant, symbol);
function = XSYMBOL (symbol)->function;
- if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
+ if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
- if (CONSP (function) && EQ (XCAR (function), Qautoload))
+ if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
set_symbol_function (symbol, definition);
- /* Handle automatic advice activation. */
- if (CONSP (XSYMBOL (symbol)->plist)
- && !NILP (Fget (symbol, Qad_advice_info)))
- {
- call2 (Qad_activate_internal, symbol, Qnil);
- definition = XSYMBOL (symbol)->function;
- }
+
return definition;
}
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
CHECK_SYMBOL (symbol);
- if (CONSP (XSYMBOL (symbol)->function)
- && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, symbol));
if (!NILP (Vpurify_flag)
/* If `definition' is a keymap, immutable (and copying) is wrong. */
&& !KEYMAPP (definition))
definition = Fpurecopy (definition);
- definition = Ffset (symbol, definition);
- LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+
+ {
+ 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);
+ }
+
if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring);
/* We used to return `definition', but now that `defun' and `defmacro' expand
CHECK_SUBR (subr);
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));
+ return Fcons (make_number (minargs),
+ maxargs == MANY ? Qmany
+ : maxargs == UNEVALLED ? Qunevalled
+ : make_number (maxargs));
}
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
{
Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
- if (NILP (fun) || EQ (fun, Qunbound))
+ if (NILP (fun))
return Qnil;
/* Use an `interactive-form' property if present, analogous to the
- function-documentation property. */
+ function-documentation property. */
fun = cmd;
while (SYMBOLP (fun))
{
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
}
+ else if (AUTOLOADP (fun))
+ return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun)));
- else if (EQ (funcar, Qautoload))
- {
- struct gcpro gcpro1;
- GCPRO1 (cmd);
- Fautoload_do_load (fun, cmd, Qnil);
- UNGCPRO;
- return Finteractive_form (cmd);
- }
}
return Qnil;
}
case Lisp_Fwd_Buffer_Obj:
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
- Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
+ Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
- if (!(NILP (type) || NILP (newval)
- || (XINT (type) == Lisp_Int0
- ? INTEGERP (newval)
- : XTYPE (newval) == XINT (type))))
- buffer_slot_type_mismatch (newval, XINT (type));
+ if (!NILP (predicate) && !NILP (newval)
+ && NILP (call1 (predicate, newval)))
+ wrong_type_argument (predicate, newval);
if (buf == NULL)
buf = current_buffer;
}
DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
- doc: /* Return SYMBOL's value. Error if that is void. */)
+ doc: /* Return SYMBOL's value. Error if that is void.
+Note that if `lexical-binding' is in effect, this returns the
+global value outside of any lexical scope. */)
(Lisp_Object symbol)
{
Lisp_Object val;
return newval;
}
-/* Return true if SYMBOL currently has a let-binding
- which was made in the buffer that is now current. */
-
-static bool
-let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
-{
- struct specbinding *p;
-
- for (p = specpdl_ptr; p > specpdl; )
- if ((--p)->func == NULL
- && CONSP (p->symbol))
- {
- struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
- eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
- if (symbol == let_bound_symbol
- && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
- return 1;
- }
-
- return 0;
-}
-
-static bool
-let_shadows_global_binding_p (Lisp_Object symbol)
-{
- struct specbinding *p;
-
- for (p = specpdl_ptr; p > specpdl; )
- if ((--p)->func == NULL && EQ (p->symbol, symbol))
- return 1;
-
- return 0;
-}
-
/* Store the value NEWVAL into SYMBOL.
If buffer/frame-locality is an issue, WHERE specifies which context to use.
(nil stands for the current buffer/frame).
local bindings in certain buffers. */)
(Lisp_Object symbol)
{
- register Lisp_Object value;
-
- value = default_value (symbol);
+ Lisp_Object value = default_value (symbol);
if (!EQ (value, Qunbound))
return value;
usage: (setq-default [VAR VALUE]...) */)
(Lisp_Object args)
{
- register Lisp_Object args_left;
- register Lisp_Object val, symbol;
+ Lisp_Object args_left, symbol, val;
struct gcpro gcpro1;
- if (NILP (args))
- return Qnil;
-
- args_left = args;
+ args_left = val = args;
GCPRO1 (args);
- do
+ while (CONSP (args_left))
{
- val = eval_sub (Fcar (Fcdr (args_left)));
+ val = eval_sub (Fcar (XCDR (args_left)));
symbol = XCAR (args_left);
Fset_default (symbol, val);
args_left = Fcdr (XCDR (args_left));
}
- while (!NILP (args_left));
UNGCPRO;
return val;
XSETBUFFER (tmp, buf);
XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
- for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (EQ (variable, XCAR (elt)))
- {
- eassert (!blv->frame_local);
- eassert (blv_found (blv) || !EQ (blv->where, tmp));
- return Qt;
- }
- }
- eassert (!blv_found (blv) || !EQ (blv->where, tmp));
+ if (EQ (blv->where, tmp)) /* The binding is already loaded. */
+ return blv_found (blv) ? Qt : Qnil;
+ else
+ for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (EQ (variable, XCAR (elt)))
+ {
+ eassert (!blv->frame_local);
+ return Qt;
+ }
+ }
return Qnil;
}
case SYMBOL_FORWARDED:
for (;;)
{
- if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+ if (!SYMBOLP (hare) || NILP (hare))
break;
hare = XSYMBOL (hare)->function;
- if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+ if (!SYMBOLP (hare) || NILP (hare))
break;
hare = XSYMBOL (hare)->function;
/* Optimize for no indirection. */
result = object;
- if (SYMBOLP (result) && !EQ (result, Qunbound)
+ if (SYMBOLP (result) && !NILP (result)
&& (result = XSYMBOL (result)->function, SYMBOLP (result)))
result = indirect_function (result);
- if (!EQ (result, Qunbound))
+ if (!NILP (result))
return result;
if (NILP (noerror))
return arith_driver (Amult, nargs, args);
}
-DEFUN ("/", Fquo, Squo, 2, MANY, 0,
+DEFUN ("/", Fquo, Squo, 1, MANY, 0,
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
-usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
+usage: (/ DIVIDEND &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
DEFSYM (Qfont_object, "font-object");
DEFSYM (Qinteractive_form, "interactive-form");
+ DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
HCoop / bpt / emacs.git / blobdiff