/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001
Free Software Foundation, Inc.
This file is part of GNU Emacs.
max_specpdl_size = specpdl_size + 40;
#ifdef HAVE_X_WINDOWS
- if (display_busy_cursor_p)
- cancel_busy_cursor ();
+ if (display_hourglass_p)
+ cancel_hourglass ();
#endif
debug_on_next_call = 0;
redisplaying_p = 0;
specbind (intern ("debugger-may-continue"),
debug_while_redisplaying ? Qnil : Qt);
+ specbind (Qinhibit_redisplay, Qnil);
+
+#if 0 /* Binding this prevents execution of Lisp code during
+ redisplay, which necessarily leads to display problems. */
+ specbind (Qinhibit_eval_during_redisplay, Qt);
+#endif
val = apply1 (Vdebugger, arg);
return Fcar (args);
}
+
DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
"Return t if function in which this appears was called interactively.\n\
This means that the function was called with call-interactively (which\n\
and input is currently coming from the keyboard (not in keyboard macro).")
()
{
- register struct backtrace *btp;
- register Lisp_Object fun;
+ 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).
+
+ EXCLUDE_SUBRS_P non-zero means always return 0 if the function
+ called is a built-in. */
+
+int
+interactive_p (exclude_subrs_p)
+ int exclude_subrs_p;
+{
+ struct backtrace *btp;
+ Lisp_Object fun;
if (!INTERACTIVE)
- return Qnil;
+ return 0;
btp = backtrace_list;
/* If this isn't a byte-compiled function, there may be a frame at
- the top for Finteractive_p itself. If so, skip it. */
+ the top for Finteractive_p. If so, skip it. */
fun = Findirect_function (*btp->function);
if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
btp = btp->next;
Fbytecode at the top. If this frame is for a built-in function
(such as load or eval-region) return nil. */
fun = Findirect_function (*btp->function);
- if (SUBRP (fun))
- return Qnil;
+ if (exclude_subrs_p && SUBRP (fun))
+ return 0;
+
/* btp points to the frame of a Lisp function that called interactive-p.
Return t if that function was called interactively. */
if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
- return Qt;
- return Qnil;
+ return 1;
+ return 0;
}
+
DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
"Define NAME as a function.\n\
The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
return fn_name;
}
+
+DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 2, 0,
+ "Make SYMBOL a variable alias for symbol ALIASED.\n\
+Setting the value of SYMBOL will subsequently set the value of ALIASED,\n\
+and getting the value of SYMBOL will return the value ALIASED has.\n\
+ALIASED nil means remove the alias; SYMBOL is unbound after that.")
+ (symbol, aliased)
+ Lisp_Object symbol, aliased;
+{
+ struct Lisp_Symbol *sym;
+
+ CHECK_SYMBOL (symbol, 0);
+ CHECK_SYMBOL (aliased, 1);
+
+ if (SYMBOL_CONSTANT_P (symbol))
+ error ("Cannot make a constant an alias");
+
+ sym = XSYMBOL (symbol);
+ sym->indirect_variable = 1;
+ sym->value = aliased;
+ sym->constant = SYMBOL_CONSTANT_P (aliased);
+ LOADHIST_ATTACH (symbol);
+
+ return aliased;
+}
+
+
DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
"Define SYMBOL as a variable.\n\
You are not required to define a variable in order to use it,\n\
buffer-local values are not affected.\n\
INITVALUE and DOCSTRING are optional.\n\
If DOCSTRING starts with *, this variable is identified as a user option.\n\
- This means that M-x set-variable and M-x edit-options recognize it.\n\
+ This means that M-x set-variable recognizes it.\n\
+ See also `user-variable-p'.\n\
If INITVALUE is missing, SYMBOL's value is not set.")
(args)
Lisp_Object args;
if (!NILP (Fcdr (Fcdr (tail))))
error ("too many arguments");
+ tem = Fdefault_boundp (sym);
if (!NILP (tail))
{
- tem = Fdefault_boundp (sym);
if (NILP (tem))
- Fset_default (sym, Feval (Fcar (Fcdr (args))));
- }
- tail = Fcdr (Fcdr (args));
- if (!NILP (Fcar (tail)))
- {
- tem = Fcar (tail);
- if (!NILP (Vpurify_flag))
- tem = Fpurecopy (tem);
- Fput (sym, Qvariable_documentation, tem);
+ Fset_default (sym, Feval (Fcar (tail)));
+ tail = Fcdr (tail);
+ if (!NILP (Fcar (tail)))
+ {
+ tem = Fcar (tail);
+ if (!NILP (Vpurify_flag))
+ tem = Fpurecopy (tem);
+ Fput (sym, Qvariable_documentation, tem);
+ }
+ LOADHIST_ATTACH (sym);
}
- LOADHIST_ATTACH (sym);
+ else
+ /* A (defvar <var>) should not take precedence in the load-history over
+ an earlier (defvar <var> <val>), so only add to history if the default
+ value is still unbound. */
+ if (NILP (tem))
+ LOADHIST_ATTACH (sym);
+
return sym;
}
If FORM is not a macro call, it is returned unchanged.\n\
Otherwise, the macro is expanded and the expansion is considered\n\
in place of FORM. When a non-macro-call results, it is returned.\n\n\
-The second optional arg ENVIRONMENT species an environment of macro\n\
+The second optional arg ENVIRONMENT specifies an environment of macro\n\
definitions to shadow the loaded ones for use in file byte-compilation.")
(form, environment)
Lisp_Object form;
Lisp_Object val;
struct catchtag c;
struct handler h;
- register Lisp_Object var, bodyform, handlers;
+ register Lisp_Object bodyform, handlers;
+ volatile Lisp_Object var;
var = Fcar (args);
bodyform = Fcar (Fcdr (args));
Lisp_Object debugger_value;
Lisp_Object string;
Lisp_Object real_error_symbol;
- extern int display_busy_cursor_p;
+ extern int display_hourglass_p;
struct backtrace *bp;
- immediate_quit = 0;
+ immediate_quit = handling_signal = 0;
if (gc_in_progress || waiting_for_input)
abort ();
real_error_symbol = error_symbol;
#ifdef HAVE_X_WINDOWS
- if (display_busy_cursor_p)
- cancel_busy_cursor ();
+ if (display_hourglass_p)
+ cancel_hourglass ();
#endif
/* This hook is used by edebug. */
int first_string = 1;
Lisp_Object error_message;
- for (tail = Vdebug_ignored_errors; CONSP (tail);
- tail = XCDR (tail))
+ error_message = Qnil;
+ for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail))
{
if (STRINGP (XCAR (tail)))
{
error_message = Ferror_message_string (data);
first_string = 0;
}
+
if (fast_string_match (XCAR (tail), error_message) >= 0)
return 1;
}
{
Lisp_Object contail;
- for (contail = conditions; CONSP (contail);
- contail = XCDR (contail))
+ for (contail = conditions; CONSP (contail); contail = XCDR (contail))
if (EQ (XCAR (tail), XCAR (contail)))
return 1;
}
string = build_string (buffer);
if (allocated)
- free (buffer);
+ xfree (buffer);
Fsignal (Qerror, Fcons (string, Qnil));
+ abort ();
}
\f
DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
enum run_hooks_condition {to_completion, until_success, until_failure};
-DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 1, MANY, 0,
+DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
"Run each hook in HOOKS. Major mode functions use this.\n\
Each argument should be a symbol, a hook variable.\n\
These symbols are processed in the order specified.\n\
Lisp_Object symbol, value;
{
Lisp_Object ovalue;
+ Lisp_Object valcontents;
CHECK_SYMBOL (symbol, 0);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
- /* The most common case is that a non-constant symbol with a trivial
- value. Make that as fast as we can. */
- if (!MISCP (XSYMBOL (symbol)->value)
- && !EQ (symbol, Qnil)
- && !EQ (symbol, Qt)
- && !(XSYMBOL (symbol)->name->data[0] == ':'
- && EQ (XSYMBOL (symbol)->obarray, initial_obarray)
- && !EQ (value, symbol)))
+ /* The most common case is that of a non-constant symbol with a
+ trivial value. Make that as fast as we can. */
+ valcontents = SYMBOL_VALUE (symbol);
+ if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
{
specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = XSYMBOL (symbol)->value;
+ specpdl_ptr->old_value = valcontents;
specpdl_ptr->func = NULL;
++specpdl_ptr;
- XSYMBOL (symbol)->value = value;
+ SET_SYMBOL_VALUE (symbol, value);
}
else
{
+ Lisp_Object valcontents;
+
ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
- if (BUFFER_LOCAL_VALUEP (XSYMBOL (symbol)->value)
- || SOME_BUFFER_LOCAL_VALUEP (XSYMBOL (symbol)->value)
- || BUFFER_OBJFWDP (XSYMBOL (symbol)->value))
+ valcontents = XSYMBOL (symbol)->value;
+
+ if (BUFFER_LOCAL_VALUEP (valcontents)
+ || SOME_BUFFER_LOCAL_VALUEP (valcontents)
+ || BUFFER_OBJFWDP (valcontents))
{
- Lisp_Object current_buffer, binding_buffer;
- /* For a local variable, record both the symbol and which
- buffer's value we are saving. */
+ Lisp_Object where, current_buffer;
+
current_buffer = Fcurrent_buffer ();
- binding_buffer = current_buffer;
- /* If the variable is not local in this buffer,
- we are saving the global value, so restore that. */
- if (NILP (Flocal_variable_p (symbol, binding_buffer)))
- binding_buffer = Qnil;
- specpdl_ptr->symbol
- = Fcons (symbol, Fcons (binding_buffer, current_buffer));
+
+ /* For a local variable, record both the symbol and which
+ buffer's or frame's value we are saving. */
+ if (!NILP (Flocal_variable_p (symbol, Qnil)))
+ where = current_buffer;
+ else if (!BUFFER_OBJFWDP (valcontents)
+ && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
+ where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
+ else
+ where = Qnil;
+
+ /* We're not using the `unused' slot in the specbinding
+ structure because this would mean we have to do more
+ work for simple variables. */
+ specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
+
+ /* If SYMBOL is a per-buffer variable which doesn't have a
+ buffer-local value here, make the `let' change the global
+ value by changing the value of SYMBOL in all buffers not
+ having their own value. This is consistent with what
+ happens with other buffer-local variables. */
+ if (NILP (where)
+ && BUFFER_OBJFWDP (valcontents))
+ {
+ ++specpdl_ptr;
+ Fset_default (symbol, value);
+ return;
+ }
}
else
specpdl_ptr->symbol = symbol;
specpdl_ptr++;
if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
- store_symval_forwarding (symbol, ovalue, value);
+ store_symval_forwarding (symbol, ovalue, value, NULL);
else
set_internal (symbol, value, 0, 1);
}
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);
- /* If the symbol is a list, it is really
- (SYMBOL BINDING_BUFFER . CURRENT_BUFFER)
- and it indicates we bound a variable that has
- buffer-local bindings. */
+ /* 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
+ bound a variable that had a buffer-local or frmae-local
+ 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))
{
- Lisp_Object symbol, buffer;
+ Lisp_Object symbol, where;
symbol = XCAR (specpdl_ptr->symbol);
- buffer = XCAR (XCDR (specpdl_ptr->symbol));
+ where = XCAR (XCDR (specpdl_ptr->symbol));
- /* Handle restoring a default value. */
- if (NILP (buffer))
+ if (NILP (where))
Fset_default (symbol, specpdl_ptr->old_value);
- /* Handle restoring a value saved from a live buffer. */
- else
- set_internal (symbol, specpdl_ptr->old_value, XBUFFER (buffer), 1);
+ else if (BUFFERP (where))
+ set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1);
+ else
+ set_internal (symbol, specpdl_ptr->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 (XSYMBOL (specpdl_ptr->symbol)->value))
- XSYMBOL (specpdl_ptr->symbol)->value = specpdl_ptr->old_value;
+ if (!MISCP (SYMBOL_VALUE (specpdl_ptr->symbol)))
+ SET_SYMBOL_VALUE (specpdl_ptr->symbol, specpdl_ptr->old_value);
else
set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
}
return Qnil;
}
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, "",
+DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
"Return the function and arguments NFRAMES up from current execution point.\n\
If that frame has not evaluated the arguments yet (or is a special form),\n\
the value is (nil FUNCTION ARG-FORMS...).\n\
DEFVAR_LISP ("debug-on-error", &Vdebug_on_error,
"*Non-nil means enter debugger if an error is signaled.\n\
-Does not apply to errors handled by `condition-case'.\n\
+Does not apply to errors handled by `condition-case' or those\n\
+matched by `debug-ignored-errors'.\n\
If the value is a list, an error only means to enter the debugger\n\
if one of its condition symbols appears in the list.\n\
See also variable `debug-on-quit'.");
defsubr (&Sdefun);
defsubr (&Sdefmacro);
defsubr (&Sdefvar);
+ defsubr (&Sdefvaralias);
defsubr (&Sdefconst);
defsubr (&Suser_variable_p);
defsubr (&Slet);