/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 2002
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 02, 2004
Free Software Foundation, Inc.
This file is part of GNU Emacs.
int gcpro_level;
#endif
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun, Qdefvar;
+Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
/* Pointer to first unused element in specpdl. */
-struct specbinding *specpdl_ptr;
+volatile struct specbinding *specpdl_ptr;
/* Maximum size allowed for specpdl allocation */
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
specpdl_ptr = specpdl;
- max_specpdl_size = 600;
+ max_specpdl_size = 1000;
max_lisp_eval_depth = 300;
Vrun_hooks = Qnil;
DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
- doc: /* Return t if function in which this appears was called interactively.
+ doc: /* Return t if the function was run directly by user input.
This means that the function was called with call-interactively (which
includes being called as the binding of a key)
-and input is currently coming from the keyboard (not in keyboard macro). */)
+and input is currently coming from the keyboard (not in keyboard macro),
+and Emacs is not running in batch mode (`noninteractive' is nil).
+
+The only known proper use of `interactive-p' is in deciding whether to
+display a helpful message, or how to display it. If you're thinking
+of using it for any other purpose, it is quite likely that you're
+making a mistake. Think: what do you want to do when the command is
+called from a keyboard macro?
+
+If you want to test whether your function was called with
+`call-interactively', the way to do that is by adding an extra
+optional argument, and making the `interactive' spec specify non-nil
+unconditionally for that argument. (`p' is a good way to do this.) */)
+ ()
+{
+ return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
+}
+
+
+DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0,
+ doc: /* Return t if the function using this was called with call-interactively.
+This is used for implementing advice and other function-modifying
+features of Emacs.
+
+The cleanest way to test whether your function was called with
+`call-interactively', the way to do that is by adding an extra
+optional argument, and making the `interactive' spec specify non-nil
+unconditionally for that argument. (`p' is a good way to do this.) */)
()
{
return interactive_p (1) ? Qt : Qnil;
}
-/* Return 1 if function in which this appears was called
- interactively. This means that the function was called with
- call-interactively (which includes being called as the binding of
- a key) and input is currently coming from the keyboard (not in
- keyboard macro).
+/* Return 1 if function in which this appears was called using
+ call-interactively.
EXCLUDE_SUBRS_P non-zero means always return 0 if the function
called is a built-in. */
struct backtrace *btp;
Lisp_Object fun;
- if (!INTERACTIVE)
- return 0;
-
btp = backtrace_list;
/* If this isn't a byte-compiled function, there may be a frame at
the top for Finteractive_p. If so, skip it. */
fun = Findirect_function (*btp->function);
- if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
+ if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
+ || XSUBR (fun) == &Scalled_interactively_p))
btp = btp->next;
/* If we're running an Emacs 18-style byte-compiled function, there
register Lisp_Object defn;
fn_name = Fcar (args);
+ CHECK_SYMBOL (fn_name);
defn = Fcons (Qlambda, Fcdr (args));
if (!NILP (Vpurify_flag))
defn = Fpurecopy (defn);
&& EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
LOADHIST_ATTACH (Fcons (Qt, fn_name));
Ffset (fn_name, defn);
- LOADHIST_ATTACH (fn_name);
+ LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
return fn_name;
}
Lisp_Object lambda_list, doc, tail;
fn_name = Fcar (args);
+ CHECK_SYMBOL (fn_name);
lambda_list = Fcar (Fcdr (args));
tail = Fcdr (Fcdr (args));
&& EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
LOADHIST_ATTACH (Fcons (Qt, fn_name));
Ffset (fn_name, defn);
- LOADHIST_ATTACH (fn_name);
+ LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
return fn_name;
}
doc: /* Make SYMBOL a variable alias for symbol ALIASED.
Setting the value of SYMBOL will subsequently set the value of ALIASED,
and getting the value of SYMBOL will return the value ALIASED has.
-ALIASED nil means remove the alias; SYMBOL is unbound after that.
-Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. */)
+Third arg DOCSTRING, if non-nil, is documentation for SYMBOL.
+The return value is ALIASED. */)
(symbol, aliased, docstring)
Lisp_Object symbol, aliased, docstring;
{
sym->indirect_variable = 1;
sym->value = aliased;
sym->constant = SYMBOL_CONSTANT_P (aliased);
- LOADHIST_ATTACH (Fcons (Qdefvar, symbol));
+ LOADHIST_ATTACH (symbol);
if (!NILP (docstring))
Fput (symbol, Qvariable_documentation, docstring);
This means that M-x set-variable recognizes it.
See also `user-variable-p'.
If INITVALUE is missing, SYMBOL's value is not set.
+
+If SYMBOL has a local binding, then this form affects the local
+binding. This is usually not what you want. Thus, if you need to
+load a file defining variables, with this form or with `defconst' or
+`defcustom', you should always load that file _outside_ any bindings
+for these variables. \(`defconst' and `defcustom' behave similarly in
+this respect.)
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
(args)
Lisp_Object args;
{
if (NILP (tem))
Fset_default (sym, Feval (Fcar (tail)));
+ else
+ { /* Check if there is really a global binding rather than just a let
+ binding that shadows the global unboundness of the var. */
+ volatile struct specbinding *pdl = specpdl_ptr;
+ while (--pdl >= specpdl)
+ {
+ if (EQ (pdl->symbol, sym) && !pdl->func
+ && EQ (pdl->old_value, Qunbound))
+ {
+ message_with_string ("Warning: defvar ignored because %s is let-bound",
+ SYMBOL_NAME (sym), 1);
+ break;
+ }
+ }
+ }
tail = Fcdr (tail);
tem = Fcar (tail);
if (!NILP (tem))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
- LOADHIST_ATTACH (Fcons (Qdefvar, sym));
+ LOADHIST_ATTACH (sym);
}
else
/* Simple (defvar <var>) should not count as a definition at all.
If SYMBOL is buffer-local, its default value is what is set;
buffer-local values are not affected.
DOCSTRING is optional.
+
+If SYMBOL has a local binding, then this form sets the local binding's
+value. However, you should normally not make local bindings for
+variables defined with this form.
usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
(args)
Lisp_Object args;
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
- LOADHIST_ATTACH (Fcons (Qdefvar, sym));
+ LOADHIST_ATTACH (sym);
return sym;
}
/* Save the value in the tag. */
catch->val = value;
- /* Restore the polling-suppression count. */
+ /* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
interrupt_input_blocked = catch->interrupt_input_blocked;
+ handling_signal = 0;
+ immediate_quit = 0;
do
{
Lisp_Object val;
int count = SPECPDL_INDEX ();
- record_unwind_protect (0, Fcdr (args));
+ record_unwind_protect (Fprogn, Fcdr (args));
val = Feval (Fcar (args));
return unbind_to (count, val);
}
The value of the last BODY form is returned from the condition-case.
See also the function `signal' for more info.
-usage: (condition-case VAR BODYFORM HANDLERS...) */)
+usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(args)
Lisp_Object args;
{
handlers = Fcdr (Fcdr (args));
CHECK_SYMBOL (var);
- for (val = handlers; ! NILP (val); val = Fcdr (val))
+ for (val = handlers; CONSP (val); val = XCDR (val))
{
Lisp_Object tem;
- tem = Fcar (val);
+ tem = XCAR (val);
if (! (NILP (tem)
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
The symbol `error' should normally be one of them.
DATA should be a list. Its elements are printed as part of the error message.
+See Info anchor `(elisp)Definition of signal' for some details on how this
+error message is constructed.
If the signal is handled, DATA is made available to the handler.
See also the function `condition-case'. */)
(error_symbol, data)
struct backtrace *bp;
immediate_quit = handling_signal = 0;
+ abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
abort ();
/* Lists may represent commands. */
if (!CONSP (fun))
return Qnil;
- funcar = Fcar (fun);
- if (!SYMBOLP (funcar))
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ funcar = XCAR (fun);
if (EQ (funcar, Qlambda))
- return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
+ return Fassq (Qinteractive, Fcdr (XCDR (fun)));
if (EQ (funcar, Qautoload))
- return Fcar (Fcdr (Fcdr (Fcdr (fun))));
+ return Fcar (Fcdr (Fcdr (XCDR (fun))));
else
return Qnil;
}
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
backtrace_list = backtrace.next;
-#ifdef HAVE_CARBON
- mac_check_for_quit_char();
-#endif
return val;
}
\f
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun;
- int nvars;
+ struct gcpro gcpro1;
fun = args [0];
funcall_args = 0;
* sizeof (Lisp_Object));
for (i = numargs; i < XSUBR (fun)->max_args;)
funcall_args[++i] = Qnil;
- nvars = 1 + XSUBR (fun)->max_args;
+ GCPRO1 (*funcall_args);
+ gcpro1.nvars = 1 + XSUBR (fun)->max_args;
}
}
funcall:
{
funcall_args = (Lisp_Object *) alloca ((1 + numargs)
* sizeof (Lisp_Object));
- nvars = 1 + numargs;
+ GCPRO1 (*funcall_args);
+ gcpro1.nvars = 1 + numargs;
}
bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
spread_arg = XCDR (spread_arg);
}
- return Ffuncall (nvars, funcall_args);
+ /* By convention, the caller needs to gcpro Ffuncall's args. */
+ RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}
\f
/* Run hook variables in various ways. */
#endif /* not NO_ARG_ARRAY */
}
+/* The caller should GCPRO all the elements of ARGS. */
+
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
doc: /* Call first argument as a function, passing remaining arguments to it.
Return the value that function returns.
while (specpdl_ptr != specpdl + count)
{
- --specpdl_ptr;
-
- if (specpdl_ptr->func != 0)
- (*specpdl_ptr->func) (specpdl_ptr->old_value);
- /* Note that a "binding" of nil is really an unwind protect,
- so in that case the "old value" is a list of forms to evaluate. */
- else if (NILP (specpdl_ptr->symbol))
- Fprogn (specpdl_ptr->old_value);
+ /* Copy the binding, and decrement specpdl_ptr, before we do
+ the work to unbind it. We decrement first
+ so that an error in unbinding won't try to unbind
+ the same entry again, and we copy the binding first
+ in case more bindings are made during some of the code we run. */
+
+ struct specbinding this_binding;
+ this_binding = *--specpdl_ptr;
+
+ if (this_binding.func != 0)
+ (*this_binding.func) (this_binding.old_value);
/* If the symbol is a list, it is really (SYMBOL WHERE
. CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
frame. If WHERE is a buffer or frame, this indicates we
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
was current when the variable was bound. */
- else if (CONSP (specpdl_ptr->symbol))
+ else if (CONSP (this_binding.symbol))
{
Lisp_Object symbol, where;
- symbol = XCAR (specpdl_ptr->symbol);
- where = XCAR (XCDR (specpdl_ptr->symbol));
+ symbol = XCAR (this_binding.symbol);
+ where = XCAR (XCDR (this_binding.symbol));
if (NILP (where))
- Fset_default (symbol, specpdl_ptr->old_value);
+ Fset_default (symbol, this_binding.old_value);
else if (BUFFERP (where))
- set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1);
+ set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
else
- set_internal (symbol, specpdl_ptr->old_value, NULL, 1);
+ set_internal (symbol, this_binding.old_value, NULL, 1);
}
else
{
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
- if (!MISCP (SYMBOL_VALUE (specpdl_ptr->symbol)))
- SET_SYMBOL_VALUE (specpdl_ptr->symbol, specpdl_ptr->old_value);
+ if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
+ SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
else
- set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
+ set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
}
}
}
\f
+void
+mark_backtrace ()
+{
+ register struct backtrace *backlist;
+ register int i;
+
+ for (backlist = backtrace_list; backlist; backlist = backlist->next)
+ {
+ mark_object (*backlist->function);
+
+ if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
+ i = 0;
+ else
+ i = backlist->nargs - 1;
+ for (; i >= 0; i--)
+ mark_object (backlist->args[i]);
+ }
+}
+
void
syms_of_eval ()
{
DEFVAR_LISP ("quit-flag", &Vquit_flag,
doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
-Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'. */);
+If the value is t, that means do an ordinary quit.
+If the value equals `throw-on-input', that means quit by throwing
+to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
+Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
+but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
Vquit_flag = Qnil;
DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
Qdefun = intern ("defun");
staticpro (&Qdefun);
- Qdefvar = intern ("defvar");
- staticpro (&Qdefvar);
-
Qand_rest = intern ("&rest");
staticpro (&Qand_rest);
defsubr (&Scondition_case);
defsubr (&Ssignal);
defsubr (&Sinteractive_p);
+ defsubr (&Scalled_interactively_p);
defsubr (&Scommandp);
defsubr (&Sautoload);
defsubr (&Seval);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
}
+
+/* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
+ (do not change this comment) */