/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
if an error is handled by the command loop's error handler. */
Lisp_Object Vdebug_on_error;
+/* List of conditions and regexps specifying error messages which
+ do not enter the debugger even if Vdebug_on_errors says they should. */
+Lisp_Object Vdebug_ignored_errors;
+
/* Nonzero means enter debugger if a quit signal
is handled by the command loop's error handler. */
int debug_on_quit;
void specbind (), record_unwind_protect ();
+Lisp_Object run_hook_with_args ();
+
Lisp_Object funcall_lambda ();
extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
init_eval_once ()
{
specpdl_size = 50;
- specpdl = (struct specbinding *) malloc (specpdl_size * sizeof (struct specbinding));
+ specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
max_specpdl_size = 600;
max_lisp_eval_depth = 200;
+
+ Vrun_hooks = Qnil;
}
init_eval ()
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
- when_entered_debugger = 0;
+ /* This is less than the initial value of num_nonmacro_input_chars. */
+ when_entered_debugger = -1;
}
Lisp_Object
if (!EQ (Vmocklisp_arguments, Qt))
{
val = make_number (0);
- while (!NILP (args) && (tem = Fcar (args), XTYPE (tem) == Lisp_Symbol))
+ while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem)))
{
QUIT;
specbind (tem, val), args = Fcdr (args);
}
DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
- "(prog1 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
+ "(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\
The value of Y is saved during the evaluation of the remaining args,\n\
whose values are discarded.")
(args)
val = Qnil;
- if (NILP(args))
+ if (NILP (args))
return Qnil;
args_left = args;
Feval (Fcar (args_left));
args_left = Fcdr (args_left);
}
- while (!NILP(args_left));
+ while (!NILP (args_left));
UNGCPRO;
return val;
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
"(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\
-The SYMs are not evaluated. Thus (setq x y) sets x to the value of y.\n\
-Each SYM is set before the next VAL is computed.")
+The symbols SYM are variables; they are literal (not evaluated).\n\
+The values VAL are expressions; they are evaluated.\n\
+Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.\n\
+The second VAL is not computed until after the first SYM is set, and so on;\n\
+each VAL can use the new value of variables set earlier in the `setq'.\n\
+The return value of the `setq' form is the value of the last VAL.")
(args)
Lisp_Object args;
{
/* If this isn't a byte-compiled function, there may be a frame at
the top for Finteractive_p itself. If so, skip it. */
fun = Findirect_function (*btp->function);
- if (XTYPE (fun) == Lisp_Subr
- && (struct Lisp_Subr *) XPNTR (fun) == &Sinteractive_p)
+ if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
btp = btp->next;
/* If we're running an Emacs 18-style byte-compiled function, there
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 (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
return Qnil;
/* btp points to the frame of a Lisp function that called interactive-p.
Return t if that function was called interactively. */
(args)
Lisp_Object args;
{
- register Lisp_Object sym, tem;
+ register Lisp_Object sym, tem, tail;
sym = Fcar (args);
- tem = Fcdr (args);
- if (!NILP (tem))
+ tail = Fcdr (args);
+ if (!NILP (Fcdr (Fcdr (tail))))
+ error ("too many arguments");
+
+ if (!NILP (tail))
{
tem = Fdefault_boundp (sym);
if (NILP (tem))
Fset_default (sym, Feval (Fcar (Fcdr (args))));
}
- tem = Fcar (Fcdr (Fcdr (args)));
- if (!NILP (tem))
+ tail = Fcdr (Fcdr (args));
+ if (!NILP (Fcar (tail)))
{
+ tem = Fcar (tail);
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
register Lisp_Object sym, tem;
sym = Fcar (args);
+ if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+ error ("too many arguments");
+
Fset_default (sym, Feval (Fcar (Fcdr (args))));
tem = Fcar (Fcdr (Fcdr (args)));
if (!NILP (tem))
"Returns t if VARIABLE is intended to be set and modified by users.\n\
\(The alternative is a variable used internally in a Lisp program.)\n\
Determined by whether the first character of the documentation\n\
-for the variable is \"*\"")
+for the variable is `*'.")
(variable)
Lisp_Object variable;
{
Lisp_Object documentation;
documentation = Fget (variable, Qvariable_documentation);
- if (XTYPE (documentation) == Lisp_Int && XINT (documentation) < 0)
+ if (INTEGERP (documentation) && XINT (documentation) < 0)
return Qt;
- if ((XTYPE (documentation) == Lisp_String) &&
- ((unsigned char) XSTRING (documentation)->data[0] == '*'))
+ if (STRINGP (documentation)
+ && ((unsigned char) XSTRING (documentation)->data[0] == '*'))
+ return Qt;
+ /* If it is (STRING . INTEGER), a negative integer means a user variable. */
+ if (CONSP (documentation)
+ && STRINGP (XCONS (documentation)->car)
+ && INTEGERP (XCONS (documentation)->cdr)
+ && XINT (XCONS (documentation)->cdr) < 0)
return Qt;
return Qnil;
}
{
QUIT;
elt = Fcar (varlist);
- if (XTYPE (elt) == Lisp_Symbol)
+ if (SYMBOLP (elt))
specbind (elt, Qnil);
else if (! NILP (Fcdr (Fcdr (elt))))
Fsignal (Qerror,
{
QUIT;
elt = Fcar (varlist);
- if (XTYPE (elt) == Lisp_Symbol)
+ if (SYMBOLP (elt))
temps [argnum++] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
Fsignal (Qerror,
{
elt = Fcar (varlist);
tem = temps[argnum++];
- if (XTYPE (elt) == Lisp_Symbol)
+ if (SYMBOLP (elt))
specbind (elt, tem);
else
specbind (Fcar (elt), tem);
{
/* Come back here each time we expand a macro call,
in case it expands into another macro call. */
- if (XTYPE (form) != Lisp_Cons)
+ if (!CONSP (form))
break;
/* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
def = sym = XCONS (form)->car;
tem = Qnil;
/* Trace symbols aliases to other symbols
until we get a symbol that is not an alias. */
- while (XTYPE (def) == Lisp_Symbol)
+ while (SYMBOLP (def))
{
QUIT;
sym = def;
{
/* SYM is not mentioned in ENV.
Look at its function definition. */
- if (EQ (def, Qunbound)
- || XTYPE (def) != Lisp_Cons)
+ if (EQ (def, Qunbound) || !CONSP (def))
/* Not defined or definition not suitable */
break;
if (EQ (XCONS (def)->car, Qautoload))
if CONDITION-NAME is one of the error's condition names.\n\
If an error happens, the first applicable handler is run.\n\
\n\
+The car of a handler may be a list of condition names\n\
+instead of a single condition name.\n\
+\n\
When a handler handles an error,\n\
control returns to the condition-case and the handler BODY... is executed\n\
with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
{
Lisp_Object tem;
tem = Fcar (val);
- if ((!NILP (tem)) &&
- (!CONSP (tem) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol)))
+ if (! (NILP (tem)
+ || (CONSP (tem)
+ && (SYMBOLP (XCONS (tem)->car)
+ || CONSP (XCONS (tem)->car)))))
error ("Invalid condition handler", tem);
}
if (_setjmp (c.jmp))
{
if (!NILP (h.var))
- specbind (h.var, Fcdr (c.val));
- val = Fprogn (Fcdr (Fcar (c.val)));
+ specbind (h.var, c.val);
+ val = Fprogn (Fcdr (h.chosen_clause));
/* Note that this just undoes the binding of h.var; whoever
longjumped to us unwound the stack to c.pdlcount before
struct catchtag c;
struct handler h;
+ /* Since Fsignal resets this to 0, it had better be 0 now
+ or else we have a potential bug. */
+ if (interrupt_input_blocked != 0)
+ abort ();
+
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
c.gcpro = gcprolist;
if (_setjmp (c.jmp))
{
- return (*hfun) (Fcdr (c.val));
+ return (*hfun) (c.val);
}
c.next = catchlist;
catchlist = &c;
return val;
}
+Lisp_Object
+internal_condition_case_1 (bfun, arg, handlers, hfun)
+ Lisp_Object (*bfun) ();
+ Lisp_Object arg;
+ Lisp_Object handlers;
+ Lisp_Object (*hfun) ();
+{
+ Lisp_Object val;
+ struct catchtag c;
+ struct handler h;
+
+ c.tag = Qnil;
+ c.val = Qnil;
+ c.backlist = backtrace_list;
+ c.handlerlist = handlerlist;
+ c.lisp_eval_depth = lisp_eval_depth;
+ c.pdlcount = specpdl_ptr - specpdl;
+ c.poll_suppress_count = poll_suppress_count;
+ c.gcpro = gcprolist;
+ if (_setjmp (c.jmp))
+ {
+ return (*hfun) (c.val);
+ }
+ c.next = catchlist;
+ catchlist = &c;
+ h.handler = handlers;
+ h.var = Qnil;
+ h.next = handlerlist;
+ h.tag = &c;
+ handlerlist = &h;
+
+ val = (*bfun) (arg);
+ catchlist = c.next;
+ handlerlist = h.next;
+ return val;
+}
+\f
static Lisp_Object find_handler_clause ();
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
- "Signal an error. Args are SIGNAL-NAME, and associated DATA.\n\
+ "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\
This function does not return.\n\n\
-A signal name is a symbol with an `error-conditions' property\n\
+An error symbol is a symbol with an `error-conditions' property\n\
that is a list of condition names.\n\
A handler for any of those names will get to handle this signal.\n\
The symbol `error' should normally be one of them.\n\
DATA should be a list. Its elements are printed as part of the error message.\n\
If the signal is handled, DATA is made available to the handler.\n\
See also the function `condition-case'.")
- (sig, data)
- Lisp_Object sig, data;
+ (error_symbol, data)
+ Lisp_Object error_symbol, data;
{
register struct handler *allhandlers = handlerlist;
Lisp_Object conditions;
TOTALLY_UNBLOCK_INPUT;
#endif
- conditions = Fget (sig, Qerror_conditions);
+ conditions = Fget (error_symbol, Qerror_conditions);
for (; handlerlist; handlerlist = handlerlist->next)
{
register Lisp_Object clause;
clause = find_handler_clause (handlerlist->handler, conditions,
- sig, data, &debugger_value);
+ error_symbol, data, &debugger_value);
#if 0 /* Most callers are not prepared to handle gc if this returns.
So, since this feature is not very useful, take it out. */
{
/* We can't return values to code which signalled an error, but we
can continue code which has signalled a quit. */
- if (EQ (sig, Qquit))
+ if (EQ (error_symbol, Qquit))
return Qnil;
else
error ("Cannot return from the debugger in an error");
if (!NILP (clause))
{
+ Lisp_Object unwind_data;
struct handler *h = handlerlist;
+
handlerlist = allhandlers;
- unwind_to_catch (h->tag, Fcons (clause, Fcons (sig, data)));
+ if (EQ (data, memory_signal_data))
+ unwind_data = memory_signal_data;
+ else
+ unwind_data = Fcons (error_symbol, data);
+ h->chosen_clause = clause;
+ unwind_to_catch (h->tag, unwind_data);
}
}
handlerlist = allhandlers;
/* If no handler is present now, try to run the debugger,
and if that fails, throw to top level. */
- find_handler_clause (Qerror, conditions, sig, data, &debugger_value);
+ find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
Fthrow (Qtop_level, Qt);
}
return 0;
}
+/* Return 1 if an error with condition-symbols CONDITIONS,
+ and described by SIGNAL-DATA, should skip the debugger
+ according to debugger-ignore-errors. */
+
+static int
+skip_debugger (conditions, data)
+ Lisp_Object conditions, data;
+{
+ Lisp_Object tail;
+ int first_string = 1;
+ Lisp_Object error_message;
+
+ for (tail = Vdebug_ignored_errors; CONSP (tail);
+ tail = XCONS (tail)->cdr)
+ {
+ if (STRINGP (XCONS (tail)->car))
+ {
+ if (first_string)
+ {
+ error_message = Ferror_message_string (data);
+ first_string = 0;
+ }
+ if (fast_string_match (XCONS (tail)->car, error_message) >= 0)
+ return 1;
+ }
+ else
+ {
+ Lisp_Object contail;
+
+ for (contail = conditions; CONSP (contail);
+ contail = XCONS (contail)->cdr)
+ if (EQ (XCONS (tail)->car, XCONS (contail)->car))
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
/* Value of Qlambda means we have called debugger and user has continued.
Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
{
register Lisp_Object h;
register Lisp_Object tem;
- register Lisp_Object tem1;
if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */
return Qt;
if ((EQ (sig, Qquit)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
+ && ! skip_debugger (conditions, Fcons (sig, data))
&& when_entered_debugger < num_nonmacro_input_chars)
{
int count = specpdl_ptr - specpdl;
specbind (Qdebug_on_error, Qnil);
- *debugger_value_ptr =
- call_debugger (Fcons (Qerror,
- Fcons (Fcons (sig, data),
- Qnil)));
+ *debugger_value_ptr
+ = call_debugger (Fcons (Qerror,
+ Fcons (Fcons (sig, data),
+ Qnil)));
return unbind_to (count, Qlambda);
}
return Qt;
}
for (h = handlers; CONSP (h); h = Fcdr (h))
{
- tem1 = Fcar (h);
- if (!CONSP (tem1))
+ Lisp_Object handler, condit;
+
+ handler = Fcar (h);
+ if (!CONSP (handler))
continue;
- tem = Fmemq (Fcar (tem1), conditions);
- if (!NILP (tem))
- return tem1;
+ condit = Fcar (handler);
+ /* Handle a single condition name in handler HANDLER. */
+ if (SYMBOLP (condit))
+ {
+ tem = Fmemq (Fcar (handler), conditions);
+ if (!NILP (tem))
+ return handler;
+ }
+ /* Handle a list of condition names in handler HANDLER. */
+ else if (CONSP (condit))
+ {
+ while (CONSP (condit))
+ {
+ tem = Fmemq (Fcar (condit), conditions);
+ if (!NILP (tem))
+ return handler;
+ condit = XCONS (condit)->cdr;
+ }
+ }
}
return Qnil;
}
void
error (m, a1, a2, a3)
char *m;
+ char *a1, *a2, *a3;
{
char buf[200];
- sprintf (buf, m, a1, a2, a3);
+ int size = 200;
+ int mlen;
+ char *buffer = buf;
+ char *args[3];
+ int allocated = 0;
+ Lisp_Object string;
+
+ args[0] = a1;
+ args[1] = a2;
+ args[2] = a3;
+
+ mlen = strlen (m);
while (1)
- Fsignal (Qerror, Fcons (build_string (buf), Qnil));
+ {
+ int used = doprnt (buf, size, m, m + mlen, 3, args);
+ if (used < size)
+ break;
+ size *= 2;
+ if (allocated)
+ buffer = (char *) xrealloc (buffer, size);
+ else
+ {
+ buffer = (char *) xmalloc (size);
+ allocated = 1;
+ }
+ }
+
+ string = build_string (buf);
+ if (allocated)
+ free (buffer);
+
+ Fsignal (Qerror, Fcons (string, Qnil));
}
\f
DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
if (XSUBR (fun)->prompt)
return Qt;
/* Bytecode objects are interactive if they are long enough to
have an element whose index is COMPILED_INTERACTIVE, which is
where the interactive spec is stored. */
- else if (XTYPE (fun) == Lisp_Compiled)
- return (XVECTOR (fun)->size > COMPILED_INTERACTIVE
+ else if (COMPILEDP (fun))
+ return ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
? Qt : Qnil);
/* Strings and vectors are keyboard macros. */
- if (XTYPE (fun) == Lisp_String
- || XTYPE (fun) == Lisp_Vector)
+ if (STRINGP (fun) || VECTORP (fun))
return Qt;
/* Lists may represent commands. */
if (!CONSP (fun))
return Qnil;
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
/* If function is defined and not as an autoload, don't override */
if (!EQ (XSYMBOL (function)->function, Qunbound)
- && !(XTYPE (XSYMBOL (function)->function) == Lisp_Cons
+ && !(CONSP (XSYMBOL (function)->function)
&& EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload)))
return Qnil;
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
- if (XTYPE (form) == Lisp_Symbol)
+ if (SYMBOLP (form))
{
if (EQ (Vmocklisp_arguments, Qt))
return Fsymbol_value (form);
val = Fsymbol_value (form);
if (NILP (val))
- XFASTINT (val) = 0;
+ XSETFASTINT (val, 0);
else if (EQ (val, Qt))
- XFASTINT (val) = 1;
+ XSETFASTINT (val, 1);
return val;
}
if (!CONSP (form))
retry:
fun = Findirect_function (original_fun);
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
Lisp_Object numargs;
Lisp_Object argvals[7];
abort ();
}
}
- if (XTYPE (fun) == Lisp_Compiled)
+ if (COMPILEDP (fun))
val = apply_lambda (fun, original_args, 1);
else
{
if (!CONSP (fun))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qautoload))
{
if (!EQ (Vmocklisp_arguments, Qt))
{
if (NILP (val))
- XFASTINT (val) = 0;
+ XSETFASTINT (val, 0);
else if (EQ (val, Qt))
- XFASTINT (val) = 1;
+ XSETFASTINT (val, 1);
}
lisp_eval_depth--;
if (backtrace.debug_on_exit)
\f
DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
"Call FUNCTION with our remaining args, using our last arg as list of args.\n\
+Then return the value FUNCTION returns.\n\
Thus, (apply '+ 1 2 '(3 4)) returns 10.")
(nargs, args)
int nargs;
goto funcall;
}
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}
\f
+/* Run hook variables in various ways. */
+
+enum run_hooks_condition {to_completion, until_success, until_failure};
+
+DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 1, 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\
+If a hook symbol has a non-nil value, that value may be a function\n\
+or a list of functions to be called to run the hook.\n\
+If the value is a function, it is called with no arguments.\n\
+If it is a list, the elements are called, in order, with no arguments.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object hook[1];
+ register int i;
+
+ for (i = 0; i < nargs; i++)
+ {
+ hook[0] = args[i];
+ run_hook_with_args (1, hook, to_completion);
+ }
+
+ return Qnil;
+}
+
+DEFUN ("run-hook-with-args",
+ Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0,
+ "Run HOOK with the specified arguments ARGS.\n\
+HOOK should be a symbol, a hook variable. If HOOK has a non-nil\n\
+value, that value may be a function or a list of functions to be\n\
+called to run the hook. If the value is a function, it is called with\n\
+the given arguments and its return value is returned. If it is a list\n\
+of functions, those functions are called, in order,\n\
+with the given arguments ARGS.\n\
+It is best not to depend on the value return by `run-hook-with-args',\n\
+as that may change.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ return run_hook_with_args (nargs, args, to_completion);
+}
+
+DEFUN ("run-hook-with-args-until-success",
+ Frun_hook_with_args_until_success, Srun_hook_with_args_until_success,
+ 1, MANY, 0,
+ "Run HOOK with the specified arguments ARGS.\n\
+HOOK should be a symbol, a hook variable. Its value should\n\
+be a list of functions. We call those functions, one by one,\n\
+passing arguments ARGS to each of them, until one of them\n\
+returns a non-nil value. Then we return that value.\n\
+If all the functions return nil, we return nil.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ return run_hook_with_args (nargs, args, until_success);
+}
+
+DEFUN ("run-hook-with-args-until-failure",
+ Frun_hook_with_args_until_failure, Srun_hook_with_args_until_failure,
+ 1, MANY, 0,
+ "Run HOOK with the specified arguments ARGS.\n\
+HOOK should be a symbol, a hook variable. Its value should\n\
+be a list of functions. We call those functions, one by one,\n\
+passing arguments ARGS to each of them, until one of them\n\
+returns nil. Then we return nil.\n\
+If all the functions return non-nil, we return non-nil.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ return run_hook_with_args (nargs, args, until_failure);
+}
+
+/* ARGS[0] should be a hook symbol.
+ Call each of the functions in the hook value, passing each of them
+ as arguments all the rest of ARGS (all NARGS - 1 elements).
+ COND specifies a condition to test after each call
+ to decide whether to stop.
+ The caller (or its caller, etc) must gcpro all of ARGS,
+ except that it isn't necessary to gcpro ARGS[0]. */
+
+Lisp_Object
+run_hook_with_args (nargs, args, cond)
+ int nargs;
+ Lisp_Object *args;
+ enum run_hooks_condition cond;
+{
+ Lisp_Object sym, val, ret;
+ struct gcpro gcpro1, gcpro2;
+
+ sym = args[0];
+ val = find_symbol_value (sym);
+ ret = (cond == until_failure ? Qt : Qnil);
+
+ if (EQ (val, Qunbound) || NILP (val))
+ return ret;
+ else if (!CONSP (val) || EQ (XCONS (val)->car, Qlambda))
+ {
+ args[0] = val;
+ return Ffuncall (nargs, args);
+ }
+ else
+ {
+ GCPRO2 (sym, val);
+
+ for (;
+ CONSP (val) && ((cond == to_completion)
+ || (cond == until_success ? NILP (ret)
+ : !NILP (ret)));
+ val = XCONS (val)->cdr)
+ {
+ if (EQ (XCONS (val)->car, Qt))
+ {
+ /* t indicates this hook has a local binding;
+ it means to run the global binding too. */
+ Lisp_Object globals;
+
+ for (globals = Fdefault_value (sym);
+ CONSP (globals) && ((cond == to_completion)
+ || (cond == until_success ? NILP (ret)
+ : !NILP (ret)));
+ globals = XCONS (globals)->cdr)
+ {
+ args[0] = XCONS (globals)->car;
+ /* In a global value, t should not occur. If it does, we
+ must ignore it to avoid an endless loop. */
+ if (!EQ (args[0], Qt))
+ ret = Ffuncall (nargs, args);
+ }
+ }
+ else
+ {
+ args[0] = XCONS (val)->car;
+ ret = Ffuncall (nargs, args);
+ }
+ }
+
+ UNGCPRO;
+ return ret;
+ }
+}
+
+/* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
+ present value of that symbol.
+ Call each element of FUNLIST,
+ passing each of them the rest of ARGS.
+ The caller (or its caller, etc) must gcpro all of ARGS,
+ except that it isn't necessary to gcpro ARGS[0]. */
+
+Lisp_Object
+run_hook_list_with_args (funlist, nargs, args)
+ Lisp_Object funlist;
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object sym;
+ Lisp_Object val;
+ struct gcpro gcpro1, gcpro2;
+
+ sym = args[0];
+ GCPRO2 (sym, val);
+
+ for (val = funlist; CONSP (val); val = XCONS (val)->cdr)
+ {
+ if (EQ (XCONS (val)->car, Qt))
+ {
+ /* t indicates this hook has a local binding;
+ it means to run the global binding too. */
+ Lisp_Object globals;
+
+ for (globals = Fdefault_value (sym);
+ CONSP (globals);
+ globals = XCONS (globals)->cdr)
+ {
+ args[0] = XCONS (globals)->car;
+ /* In a global value, t should not occur. If it does, we
+ must ignore it to avoid an endless loop. */
+ if (!EQ (args[0], Qt))
+ Ffuncall (nargs, args);
+ }
+ }
+ else
+ {
+ args[0] = XCONS (val)->car;
+ Ffuncall (nargs, args);
+ }
+ }
+ UNGCPRO;
+ return Qnil;
+}
+
+/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
+
+void
+run_hook_with_args_2 (hook, arg1, arg2)
+ Lisp_Object hook, arg1, arg2;
+{
+ Lisp_Object temp[3];
+ temp[0] = hook;
+ temp[1] = arg1;
+ temp[2] = arg2;
+
+ Frun_hook_with_args (3, temp);
+}
+\f
/* Apply fn to arg */
Lisp_Object
apply1 (fn, arg)
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
"Call first argument as a function, passing remaining arguments to it.\n\
+Return the value that function returns.\n\
Thus, (funcall 'cons 'x 'y) returns (x . y).")
(nargs, args)
int nargs;
fun = Findirect_function (fun);
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
{
- XFASTINT (lisp_numargs) = numargs;
+ XSETFASTINT (lisp_numargs, numargs);
return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil)));
}
abort ();
}
}
- if (XTYPE (fun) == Lisp_Compiled)
+ if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
if (!CONSP (fun))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (funcar, Qlambda))
val = funcall_lambda (fun, numargs, args + 1);
specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */
- XFASTINT (numargs) = nargs;
+ XSETFASTINT (numargs, nargs);
- if (XTYPE (fun) == Lisp_Cons)
+ if (CONSP (fun))
syms_left = Fcar (Fcdr (fun));
- else if (XTYPE (fun) == Lisp_Compiled)
+ else if (COMPILEDP (fun))
syms_left = XVECTOR (fun)->contents[COMPILED_ARGLIST];
else abort ();
{
QUIT;
next = Fcar (syms_left);
- while (XTYPE (next) != Lisp_Symbol)
+ while (!SYMBOLP (next))
next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));
if (EQ (next, Qand_rest))
rest = 1;
if (i < nargs)
return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
- if (XTYPE (fun) == Lisp_Cons)
+ if (CONSP (fun))
val = Fprogn (Fcdr (Fcdr (fun)));
else
- val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE],
- XVECTOR (fun)->contents[COMPILED_CONSTANTS],
- XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]);
+ {
+ /* If we have not actually read the bytecode string
+ and constants vector yet, fetch them from the file. */
+ if (CONSP (XVECTOR (fun)->contents[COMPILED_BYTECODE]))
+ Ffetch_bytecode (fun);
+ val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE],
+ XVECTOR (fun)->contents[COMPILED_CONSTANTS],
+ XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]);
+ }
return unbind_to (count, val);
}
+
+DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
+ 1, 1, 0,
+ "If byte-compiled OBJECT is lazy-loaded, fetch it now.")
+ (object)
+ Lisp_Object object;
+{
+ Lisp_Object tem;
+
+ if (COMPILEDP (object)
+ && CONSP (XVECTOR (object)->contents[COMPILED_BYTECODE]))
+ {
+ tem = read_doc_string (XVECTOR (object)->contents[COMPILED_BYTECODE]);
+ if (!CONSP (tem))
+ error ("invalid byte code");
+ XVECTOR (object)->contents[COMPILED_BYTECODE] = XCONS (tem)->car;
+ XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCONS (tem)->cdr;
+ }
+ return object;
+}
\f
void
grow_specpdl ()
specbind (symbol, value)
Lisp_Object symbol, value;
{
- extern void store_symval_forwarding (); /* in eval.c */
Lisp_Object ovalue;
CHECK_SYMBOL (symbol, 0);
grow_specpdl ();
specpdl_ptr->symbol = symbol;
specpdl_ptr->func = 0;
- ovalue = XSYMBOL (symbol)->value;
- specpdl_ptr->old_value = EQ (ovalue, Qunbound) ? Qunbound : Fsymbol_value (symbol);
+ specpdl_ptr->old_value = ovalue = find_symbol_value (symbol);
specpdl_ptr++;
- if (XTYPE (ovalue) == Lisp_Buffer_Objfwd)
+ if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
store_symval_forwarding (symbol, ovalue, value);
else
Fset (symbol, value);
extern Lisp_Object Vprint_level;
struct gcpro gcpro1;
- XFASTINT (Vprint_level) = 3;
+ XSETFASTINT (Vprint_level, 3);
tail = Qnil;
GCPRO1 (tail);
if (backlist->nargs == UNEVALLED)
{
Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
+ write_string ("\n", -1);
}
else
{
Fprin1 (backlist->args[i], Qnil);
}
}
+ write_string (")\n", -1);
}
- write_string (")\n", -1);
backlist = backlist->next;
}
CHECK_NATNUM (nframes, 0);
/* Find the frame requested. */
- for (i = 0; i < XFASTINT (nframes); i++)
+ for (i = 0; backlist && i < XFASTINT (nframes); i++)
backlist = backlist->next;
if (!backlist)
DEFVAR_LISP ("quit-flag", &Vquit_flag,
"Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\
-Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
+Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
Vquit_flag = Qnil;
DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
See also variable `debug-on-quit'.");
Vdebug_on_error = Qnil;
+ DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,
+ "*List of errors for which the debugger should not be called.\n\
+Each element may be a condition-name or a regexp that matches error messages.\n\
+If any element applies to a given error, that error skips the debugger\n\
+and just returns to top level.\n\
+This overrides the variable `debug-on-error'.\n\
+It does not apply to errors handled by `condition-case'.");
+ Vdebug_ignored_errors = Qnil;
+
DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
- "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
+ "*Non-nil means enter debugger if quit is signaled (C-g, for example).\n\
Does not apply if quit is handled by a `condition-case'.");
debug_on_quit = 0;
DEFVAR_LISP ("run-hooks", &Vrun_hooks,
"Set to the function `run-hooks', if that function has been defined.\n\
Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
- Vrun_hooks = Qnil;
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
+ defsubr (&Srun_hooks);
+ defsubr (&Srun_hook_with_args);
+ defsubr (&Srun_hook_with_args_until_success);
+ defsubr (&Srun_hook_with_args_until_failure);
+ defsubr (&Sfetch_bytecode);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);