comparison src/eval.c @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

/* Evaluator for GNU Emacs Lisp interpreter.
   Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 2002
     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

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */


#include <config.h>
#include "lisp.h"
#include "blockinput.h"

#ifdef DEBUG_GCPRO
/* Count levels of GCPRO to detect failure to UNGCPRO.  */
int gcpro_level;
#endif

Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun, Qdefvar;
Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;

Lisp_Object Vrun_hooks;

/* Non-nil means record all fset's and provide's, to be undone
   if the file being autoloaded is not fully loaded.
   They are recorded by being consed onto the front of Vautoload_queue:
   (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide.  */

Lisp_Object Vautoload_queue;

/* Current number of specbindings allocated in specpdl.  */

struct specbinding *specpdl;

/* Pointer to first unused element in specpdl.  */

struct specbinding *specpdl_ptr;

/* Maximum size allowed for specpdl allocation */

EMACS_INT max_specpdl_size;

init_eval_once ()
{
  specpdl_size = 50;
  specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
  specpdl_ptr = specpdl;
  max_specpdl_size = 600;
  max_lisp_eval_depth = 300;

  Vrun_hooks = Qnil;
}

#endif
  /* This is less than the initial value of num_nonmacro_input_events.  */
  when_entered_debugger = -1;
}

Lisp_Object
call_debugger (arg)
     Lisp_Object arg;
{
  int debug_while_redisplaying;
  int count = SPECPDL_INDEX ();
  Lisp_Object val;

  if (lisp_eval_depth + 20 > max_lisp_eval_depth)
    max_lisp_eval_depth = lisp_eval_depth + 20;

  if (specpdl_size + 40 > max_specpdl_size)
    max_specpdl_size = specpdl_size + 40;

#ifdef HAVE_X_WINDOWS
  if (display_hourglass_p)
    cancel_hourglass ();
#endif

  debug_while_redisplaying = redisplaying_p;
  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

If all args return nil, return nil.
usage: (or CONDITIONS ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val;
  Lisp_Object args_left;
  struct gcpro gcpro1;

  if (NILP(args))
    return Qnil;

  args_left = args;
  GCPRO1 (args_left);

  do
    {
      val = Feval (Fcar (args_left));
      if (!NILP (val))
	break;
      args_left = Fcdr (args_left);
    }
  while (!NILP(args_left));

  UNGCPRO;
  return val;
}

If no arg yields nil, return the last arg's value.
usage: (and CONDITIONS ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val;
  Lisp_Object args_left;
  struct gcpro gcpro1;

  if (NILP(args))
    return Qt;

  args_left = args;
  GCPRO1 (args_left);

  do
    {
      val = Feval (Fcar (args_left));
      if (NILP (val))
	break;
      args_left = Fcdr (args_left);
    }
  while (!NILP(args_left));

  UNGCPRO;
  return val;
}

       doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val;
  Lisp_Object args_left;
  struct gcpro gcpro1;

  if (NILP(args))
    return Qnil;

  args_left = args;
  GCPRO1 (args_left);

  do
    {
      val = Feval (Fcar (args_left));
      args_left = Fcdr (args_left);
    }
  while (!NILP(args_left));

  UNGCPRO;
  return val;
}

  UNGCPRO;
  return val;
}

DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
       doc: /* Eval X, Y and BODY sequentially; value from Y.
The value of Y is saved during the evaluation of the remaining args,
whose values are discarded.
usage: (prog2 X Y BODY...)  */)
     (args)
     Lisp_Object args;
{
  Lisp_Object val;
  register Lisp_Object args_left;

  return Fcar (args);
}


DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
       doc: /* Return t 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 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

     int exclude_subrs_p;
{
  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)
    btp = btp->next;

  /* If we're running an Emacs 18-style byte-compiled function, there
     may be a frame for Fbytecode at the top level.  In any version of
     Emacs there can be Fbytecode frames for subexpressions evaluated

{
  register Lisp_Object fn_name;
  register Lisp_Object defn;

  fn_name = Fcar (args);
  defn = Fcons (Qlambda, Fcdr (args));
  if (!NILP (Vpurify_flag))
    defn = Fpurecopy (defn);
  if (CONSP (XSYMBOL (fn_name)->function)
      && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, fn_name));
  Ffset (fn_name, defn);
  LOADHIST_ATTACH (fn_name);
  return fn_name;
}

DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
       doc: /* Define NAME as a macro.

  (declare SPECS...)
The elements can look like this:
  (indent INDENT)
	Set NAME's `lisp-indent-function' property to INDENT.

  (edebug DEBUG)
	Set NAME's `edebug-form-spec' property to DEBUG.  (This is
	equivalent to writing a `def-edebug-spec' for the macro.)
usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
     (args)
     Lisp_Object args;

  register Lisp_Object fn_name;
  register Lisp_Object defn;
  Lisp_Object lambda_list, doc, tail;

  fn_name = Fcar (args);
  lambda_list = Fcar (Fcdr (args));
  tail = Fcdr (Fcdr (args));

  doc = Qnil;
  if (STRINGP (Fcar (tail)))
    {
      doc = Fcar (tail);
      tail = Fcdr (tail);
    }

  while (CONSP (Fcar (tail))
	 && EQ (Fcar (Fcar (tail)), Qdeclare))
    {

    defn = Fpurecopy (defn);
  if (CONSP (XSYMBOL (fn_name)->function)
      && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, fn_name));
  Ffset (fn_name, defn);
  LOADHIST_ATTACH (fn_name);
  return fn_name;
}


DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
       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.  */)
     (symbol, aliased, docstring)
     Lisp_Object symbol, aliased, docstring;
{
  struct Lisp_Symbol *sym;

  CHECK_SYMBOL (symbol);
  CHECK_SYMBOL (aliased);

  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 (Fcons (Qdefvar, symbol));
  if (!NILP (docstring))
    Fput (symbol, Qvariable_documentation, docstring);

  return aliased;
}


DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
       doc: /* Define SYMBOL as a variable.
You are not required to define a variable in order to use it,
but the definition can supply documentation and an initial value
in a way that tags can recognize.

INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.

INITVALUE and DOCSTRING are optional.
If DOCSTRING starts with *, this variable is identified as a user option.
 This means that M-x set-variable recognizes it.
 See also `user-variable-p'.
If INITVALUE is missing, SYMBOL's value is not set.
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object sym, tem, tail;

  sym = Fcar (args);
  tail = Fcdr (args);
  if (!NILP (Fcdr (Fcdr (tail))))
    error ("too many arguments");

  tem = Fdefault_boundp (sym);
  if (!NILP (tail))
    {
      if (NILP (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 (Fcons (Qdefvar, sym));
    }
  else
    /* Simple (defvar <var>) should not count as a definition at all.
       It could get in the way of other definitions, and unloading this
       package could try to make the variable unbound.  */

The intent is that neither programs nor users should ever change this value.
Always sets the value of SYMBOL to the result of evalling INITVALUE.
If SYMBOL is buffer-local, its default value is what is set;
 buffer-local values are not affected.
DOCSTRING is optional.
usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object sym, tem;

  sym = Fcar (args);
  if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
    error ("too many arguments");

  tem = Feval (Fcar (Fcdr (args)));
  if (!NILP (Vpurify_flag))
    tem = Fpurecopy (tem);
  Fset_default (sym, tem);

    {
      if (!NILP (Vpurify_flag))
	tem = Fpurecopy (tem);
      Fput (sym, Qvariable_documentation, tem);
    }
  LOADHIST_ATTACH (Fcons (Qdefvar, sym));
  return sym;
}

DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
       doc: /* Returns t if VARIABLE is intended to be set and modified by users.
\(The alternative is a variable used internally in a Lisp program.)
Determined by whether the first character of the documentation
for the variable is `*' or if the variable is customizable (has a non-nil
value of `standard-value' or of `custom-autoload' on its property list).  */)
     (variable)
     Lisp_Object variable;
{
  Lisp_Object documentation;

  if (!SYMBOLP (variable))
      return Qnil;

  documentation = Fget (variable, Qvariable_documentation);
  if (INTEGERP (documentation) && XINT (documentation) < 0)
    return Qt;
  if (STRINGP (documentation)
      && ((unsigned char) SREF (documentation, 0) == '*'))
    return Qt;
  /* If it is (STRING . INTEGER), a negative integer means a user variable.  */
  if (CONSP (documentation)
      && STRINGP (XCAR (documentation))
      && INTEGERP (XCDR (documentation))
      && XINT (XCDR (documentation)) < 0)
    return Qt;
  /* Customizable?  See `custom-variable-p'. */
  if ((!NILP (Fget (variable, intern ("standard-value"))))
      || (!NILP (Fget (variable, intern ("custom-autoload")))))
    return Qt;
  return Qnil;
}

DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
       doc: /* Bind variables according to VARLIST then eval BODY.
The value of the last form in BODY is returned.

  register int last_time;

  /* Save the value in the tag.  */
  catch->val = value;

  /* Restore the polling-suppression count.  */
  set_poll_suppress_count (catch->poll_suppress_count);
  interrupt_input_blocked = catch->interrupt_input_blocked;

  do
    {
      last_time = catchlist == catch;

     Lisp_Object args;
{
  Lisp_Object val;
  int count = SPECPDL_INDEX ();

  record_unwind_protect (0, Fcdr (args));
  val = Feval (Fcar (args));
  return unbind_to (count, val);
}

/* Chain of condition handlers currently in effect.

with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
VAR may be nil; then you do not get access to the signal information.

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...)  */)
     (args)
     Lisp_Object args;
{
  Lisp_Object val;
  struct catchtag c;
  struct handler h;
  register Lisp_Object bodyform, handlers;
  volatile Lisp_Object var;

  var      = Fcar (args);
  bodyform = Fcar (Fcdr (args));
  handlers = Fcdr (Fcdr (args));
  CHECK_SYMBOL (var);

  for (val = handlers; ! NILP (val); val = Fcdr (val))
    {
      Lisp_Object tem;
      tem = Fcar (val);
      if (! (NILP (tem)
	     || (CONSP (tem)
		 && (SYMBOLP (XCAR (tem))
		     || CONSP (XCAR (tem))))))
	error ("Invalid condition handler", tem);

that is a list of condition names.
A handler for any of those names will get to handle this signal.
The symbol `error' should normally be one of them.

DATA should be a list.  Its elements are printed as part of the error message.
If the signal is handled, DATA is made available to the handler.
See also the function `condition-case'.  */)
     (error_symbol, data)
     Lisp_Object error_symbol, data;
{

  Lisp_Object string;
  Lisp_Object real_error_symbol;
  struct backtrace *bp;

  immediate_quit = handling_signal = 0;
  if (gc_in_progress || waiting_for_input)
    abort ();

  if (NILP (error_symbol))
    real_error_symbol = Fcar (data);

#endif

  /* This hook is used by edebug.  */
  if (! NILP (Vsignal_hook_function)
      && ! NILP (error_symbol))
    call2 (Vsignal_hook_function, error_symbol, data);

  conditions = Fget (real_error_symbol, Qerror_conditions);

  /* Remember from where signal was called.  Skip over the frame for
     `signal' itself.  If a frame for `error' follows, skip that,

  for (; handlerlist; handlerlist = handlerlist->next)
    {
      register Lisp_Object clause;

      if (lisp_eval_depth + 20 > max_lisp_eval_depth)
	max_lisp_eval_depth = lisp_eval_depth + 20;

      if (specpdl_size + 40 > max_specpdl_size)
	max_specpdl_size = specpdl_size + 40;

      clause = find_handler_clause (handlerlist->handler, conditions,
				    error_symbol, data, &debugger_value);

      if (EQ (clause, Qlambda))
	{

   There are two ways to pass SIG and DATA:
    = SIG is the error symbol, and DATA is the rest of the data.
    = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
       This is for memory-full errors only.

   Store value returned from debugger into *DEBUGGER_VALUE_PTR.  */

static Lisp_Object
find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
     Lisp_Object handlers, conditions, sig, data;
     Lisp_Object *debugger_value_ptr;

     and run the debugger if that is enabled.  */
  if (EQ (handlers, Qerror)
      || !NILP (Vdebug_on_signal)) /* This says call debugger even if
				      there is a handler.  */
    {
      int count = SPECPDL_INDEX ();
      int debugger_called = 0;
      Lisp_Object sig_symbol, combined_data;
      /* This is set to 1 if we are handling a memory-full error,
	 because these must not run the debugger.
	 (There is no room in memory to do that!)  */

	  sig_symbol = sig;
	}

      if (wants_debugger (Vstack_trace_on_error, conditions))
	{
#ifdef PROTOTYPES
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
					       Qnil);
#else
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       Fbacktrace, Qnil);
#endif
	}
      if (! no_debugger
	  && (EQ (sig_symbol, Qquit)
	      ? debug_on_quit
	      : wants_debugger (Vdebug_on_error, conditions))
	  && ! skip_debugger (conditions, combined_data)
	  && when_entered_debugger < num_nonmacro_input_events)
	{
	  specbind (Qdebug_on_error, Qnil);
	  *debugger_value_ptr
	    = call_debugger (Fcons (Qerror,
				    Fcons (combined_data, Qnil)));
	  debugger_called = 1;
	}
      /* If there is no handler, return saying whether we ran the debugger.  */
      if (EQ (handlers, Qerror))
	{
	  if (debugger_called)
	    return unbind_to (count, Qlambda);
	  return Qt;
	}
    }
  for (h = handlers; CONSP (h); h = Fcdr (h))
    {

    return Qt;

  /* Lists may represent commands.  */
  if (!CONSP (fun))
    return Qnil;
  funcar = Fcar (fun);
  if (!SYMBOLP (funcar))
    return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
  if (EQ (funcar, Qlambda))
    return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
  if (EQ (funcar, Qautoload))
    return Fcar (Fcdr (Fcdr (Fcdr (fun))));
  else
    return Qnil;
}

/* ARGSUSED */

     oldqueue is the shadowed value to leave in Vautoload_queue.  */
  queue = Vautoload_queue;
  Vautoload_queue = oldqueue;
  while (CONSP (queue))
    {
      first = Fcar (queue);
      second = Fcdr (first);
      first = Fcar (first);
      if (EQ (second, Qnil))
	Vfeatures = first;
      else
	Ffset (first, second);
      queue = Fcdr (queue);
    }
  return Qnil;
}

/* Load an autoloaded function.

  fun = funname;
  CHECK_SYMBOL (funname);
  GCPRO3 (fun, funname, fundef);

  /* Preserve the match data.  */
  record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));

  /* Value saved here is to be restored into Vautoload_queue.  */
  record_unwind_protect (un_autoload, Vautoload_queue);
  Vautoload_queue = Qt;
  Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt);

  /* Save the old autoloads, in case we ever do an unload.  */
  queue = Vautoload_queue;
  while (CONSP (queue))
    {
      first = Fcar (queue);
      second = Fcdr (first);
      first = Fcar (first);

      /* Note: This test is subtle.  The cdr of an autoload-queue entry
	 may be an atom if the autoload entry was generated by a defalias
	 or fset.  */
      if (CONSP (second))
	Fput (first, Qautoload, (Fcdr (second)));

      queue = Fcdr (queue);
    }

  /* Once loading finishes, don't undo it.  */
  Vautoload_queue = Qt;
  unbind_to (count, Qnil);

    return Fsymbol_value (form);
  if (!CONSP (form))
    return form;

  QUIT;
  if (consing_since_gc > gc_cons_threshold)
    {
      GCPRO1 (form);
      Fgarbage_collect ();
      UNGCPRO;
    }

  if (++lisp_eval_depth > max_lisp_eval_depth)
    {
      if (max_lisp_eval_depth < 100)
	max_lisp_eval_depth = 100;
      if (lisp_eval_depth > max_lisp_eval_depth)
	error ("Lisp nesting exceeds max-lisp-eval-depth");
    }

  original_fun = Fcar (form);
  original_args = Fcdr (form);

      Lisp_Object args_left;
      register int i, maxargs;

      args_left = original_args;
      numargs = Flength (args_left);

      if (XINT (numargs) < XSUBR (fun)->min_args ||
	  (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
	return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));

	val = apply_lambda (fun, original_args, 1);
      else
	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
    }
 done:
  lisp_eval_depth--;
  if (backtrace.debug_on_exit)
    val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
  backtrace_list = backtrace.next;

#ifdef HAVE_CARBON
  mac_check_for_quit_char();
#endif
  return val;
}

DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
       doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.

    {
      funcall_args [i++] = XCAR (spread_arg);
      spread_arg = XCDR (spread_arg);
    }

  RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}

/* Run hook variables in various ways.  */

enum run_hooks_condition {to_completion, until_success, until_failure};
static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
					   enum run_hooks_condition));

DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
       doc: /* Run each hook in HOOKS.  Major mode functions use this.
Each argument should be a symbol, a hook variable.
These symbols are processed in the order specified.
If a hook symbol has a non-nil value, that value may be a function
or a list of functions to be called to run the hook.
If the value is a function, it is called with no arguments.
If it is a list, the elements are called, in order, with no arguments.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hooks &rest HOOKS)  */)
     (nargs, args)

value, that value may be a function or a list of functions to be
called to run the hook.  If the value is a function, it is called with
the given arguments and its return value is returned.  If it is a list
of functions, those functions are called, in order,
with the given arguments ARGS.
It is best not to depend on the value return by `run-hook-with-args',
as that may change.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args HOOK &rest ARGS)  */)

}

DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
       Srun_hook_with_args_until_success, 1, MANY, 0,
       doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable.  Its value should
be a list of functions.  We call those functions, one by one,
passing arguments ARGS to each of them, until one of them
returns a non-nil value.  Then we return that value.
If all the functions return nil, we return nil.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-success HOOK &rest ARGS)  */)
     (nargs, args)

}

DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
       Srun_hook_with_args_until_failure, 1, MANY, 0,
       doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable.  Its value should
be a list of functions.  We call those functions, one by one,
passing arguments ARGS to each of them, until one of them
returns nil.  Then we return nil.
If all the functions return non-nil, we return non-nil.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-failure HOOK &rest ARGS)  */)
     (nargs, args)

  gcpro1.nvars = 7;
  RETURN_UNGCPRO (Ffuncall (7, &fn));
#endif /* not NO_ARG_ARRAY */
}

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.
Thus, (funcall 'cons 'x 'y) returns (x . y).
usage: (funcall FUNCTION &rest ARGUMENTS)  */)

  struct backtrace backtrace;
  register Lisp_Object *internal_args;
  register int i;

  QUIT;
  if (consing_since_gc > gc_cons_threshold)
    Fgarbage_collect ();

  if (++lisp_eval_depth > max_lisp_eval_depth)
    {
      if (max_lisp_eval_depth < 100)
	max_lisp_eval_depth = 100;
      if (lisp_eval_depth > max_lisp_eval_depth)
	error ("Lisp nesting exceeds max-lisp-eval-depth");
    }

  backtrace.next = backtrace_list;
  backtrace_list = &backtrace;
  backtrace.function = &args[0];

  backtrace.debug_on_exit = 0;

  if (debug_on_next_call)
    do_debug_on_call (Qlambda);

 retry:

  fun = args[0];

  fun = Findirect_function (fun);

  if (SUBRP (fun))
    {
      if (numargs < XSUBR (fun)->min_args
	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
	{
	  XSETFASTINT (lisp_numargs, numargs);
	  return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil)));
	}

	  goto done;
	case 1:
	  val = (*XSUBR (fun)->function) (internal_args[0]);
	  goto done;
	case 2:
	  val = (*XSUBR (fun)->function) (internal_args[0],
					  internal_args[1]);
	  goto done;
	case 3:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
					  internal_args[2]);
	  goto done;
	case 4:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
					  internal_args[2],
					  internal_args[3]);
	  goto done;
	case 5:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
					  internal_args[2], internal_args[3],
					  internal_args[4]);

      if (EQ (funcar, Qlambda))
	val = funcall_lambda (fun, numargs, args + 1);
      else if (EQ (funcar, Qautoload))
	{
	  do_autoload (fun, args[0]);
	  goto retry;
	}
      else
	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
    }
 done:
  lisp_eval_depth--;
  if (backtrace.debug_on_exit)
    val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
  backtrace_list = backtrace.next;
  return val;

  if (specpdl_size >= max_specpdl_size)
    {
      if (max_specpdl_size < 400)
	max_specpdl_size = 400;
      if (specpdl_size >= max_specpdl_size)
	{
	  if (!NILP (Vdebug_on_error))
	    /* Leave room for some specpdl in the debugger.  */
	    max_specpdl_size = specpdl_size + 100;
	  Fsignal (Qerror,
		   Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
	}
    }
  specpdl_size *= 2;
  if (specpdl_size > max_specpdl_size)
    specpdl_size = max_specpdl_size;
  specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));

Lisp_Object
unbind_to (count, value)
     int count;
     Lisp_Object value;
{
  int quitf = !NILP (Vquit_flag);
  struct gcpro gcpro1;

  GCPRO1 (value);
  Vquit_flag = Qnil;

  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 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 frame-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, where;

	  symbol = XCAR (specpdl_ptr->symbol);
	  where = XCAR (XCDR (specpdl_ptr->symbol));

	  if (NILP (where))
	    Fset_default (symbol, specpdl_ptr->old_value);
	  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 (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);
	}
    }

  if (NILP (Vquit_flag) && quitf)
    Vquit_flag = Qt;

  UNGCPRO;
  return value;
}


    }
}


void
syms_of_eval ()
{
  DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
	      doc: /* *Limit on number of Lisp variable bindings & unwind-protects.
If Lisp code tries to make more than this many at once,
an error is signaled.
You can safely use a value considerably larger than the default value,
if that proves inconveniently small.  However, if you increase it too far,
Emacs could run out of memory trying to make the stack bigger.  */);

if that proves inconveniently small.  However, if you increase it too far,
Emacs could overflow the real C stack, and crash.  */);

  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'.  */);
  Vquit_flag = Qnil;

  DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
	       doc: /* Non-nil inhibits C-g quitting from happening immediately.
Note that `quit-flag' will still be set by typing C-g,

  Qcommandp = intern ("commandp");
  staticpro (&Qcommandp);

  Qdefun = intern ("defun");
  staticpro (&Qdefun);

  Qdefvar = intern ("defvar");
  staticpro (&Qdefvar);

  Qand_rest = intern ("&rest");
  staticpro (&Qand_rest);

  Qand_optional = intern ("&optional");

This overrides the variable `debug-on-error'.
It does not apply to errors handled by `condition-case'.  */);
  Vdebug_ignored_errors = Qnil;

  DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
	       doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
Does not apply if quit is handled by a `condition-case'.
When you evaluate an expression interactively, this variable
is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil.  */);
  debug_on_quit = 0;

  DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
	       doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'.  */);

  defsubr (&Sthrow);
  defsubr (&Sunwind_protect);
  defsubr (&Scondition_case);
  defsubr (&Ssignal);
  defsubr (&Sinteractive_p);
  defsubr (&Scommandp);
  defsubr (&Sautoload);
  defsubr (&Seval);
  defsubr (&Sapply);
  defsubr (&Sfuncall);

  defsubr (&Sfetch_bytecode);
  defsubr (&Sbacktrace_debug);
  defsubr (&Sbacktrace);
  defsubr (&Sbacktrace_frame);
}

88155:d7ddb3e565de

/* Evaluator for GNU Emacs Lisp interpreter.
   Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
                 2002, 2003, 2004, 2005 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

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */


#include <config.h>
#include "lisp.h"
#include "blockinput.h"

#ifdef DEBUG_GCPRO
/* Count levels of GCPRO to detect failure to UNGCPRO.  */
int gcpro_level;
#endif

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;
Lisp_Object Qdeclare;

Lisp_Object Vrun_hooks;

/* Non-nil means record all fset's and provide's, to be undone
   if the file being autoloaded is not fully loaded.
   They are recorded by being consed onto the front of Vautoload_queue:
   (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide.  */

Lisp_Object Vautoload_queue;

/* Current number of specbindings allocated in specpdl.  */

struct specbinding *specpdl;

/* Pointer to first unused element in specpdl.  */

volatile struct specbinding *specpdl_ptr;

/* Maximum size allowed for specpdl allocation */

EMACS_INT max_specpdl_size;

init_eval_once ()
{
  specpdl_size = 50;
  specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
  specpdl_ptr = specpdl;
  max_specpdl_size = 1000;
  max_lisp_eval_depth = 300;

  Vrun_hooks = Qnil;
}

#endif
  /* This is less than the initial value of num_nonmacro_input_events.  */
  when_entered_debugger = -1;
}

/* unwind-protect function used by call_debugger.  */

static Lisp_Object
restore_stack_limits (data)
     Lisp_Object data;
{
  max_specpdl_size = XINT (XCAR (data));
  max_lisp_eval_depth = XINT (XCDR (data));
  return Qnil;
}

/* Call the Lisp debugger, giving it argument ARG.  */

Lisp_Object
call_debugger (arg)
     Lisp_Object arg;
{
  int debug_while_redisplaying;
  int count = SPECPDL_INDEX ();
  Lisp_Object val;
  int old_max = max_specpdl_size;

  /* Temporarily bump up the stack limits,
     so the debugger won't run out of stack.  */

  max_specpdl_size += 1;
  record_unwind_protect (restore_stack_limits,
			 Fcons (make_number (old_max),
				make_number (max_lisp_eval_depth)));
  max_specpdl_size = old_max;

  if (lisp_eval_depth + 40 > max_lisp_eval_depth)
    max_lisp_eval_depth = lisp_eval_depth + 40;

  if (SPECPDL_INDEX () + 100 > max_specpdl_size)
    max_specpdl_size = SPECPDL_INDEX () + 100;

#ifdef HAVE_X_WINDOWS
  if (display_hourglass_p)
    cancel_hourglass ();
#endif

  debug_while_redisplaying = redisplaying_p;
  redisplaying_p = 0;
  specbind (intern ("debugger-may-continue"),
	    debug_while_redisplaying ? Qnil : Qt);
  specbind (Qinhibit_redisplay, Qnil);
  specbind (Qdebug_on_error, 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

If all args return nil, return nil.
usage: (or CONDITIONS ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val = Qnil;
  struct gcpro gcpro1;

  GCPRO1 (args);

  while (CONSP (args))
    {
      val = Feval (XCAR (args));
      if (!NILP (val))
	break;
      args = XCDR (args);
    }

  UNGCPRO;
  return val;
}

If no arg yields nil, return the last arg's value.
usage: (and CONDITIONS ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val = Qt;
  struct gcpro gcpro1;

  GCPRO1 (args);

  while (CONSP (args))
    {
      val = Feval (XCAR (args));
      if (NILP (val))
	break;
      args = XCDR (args);
    }

  UNGCPRO;
  return val;
}

       doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val = Qnil;
  struct gcpro gcpro1;

  GCPRO1 (args);

  while (CONSP (args))
    {
      val = Feval (XCAR (args));
      args = XCDR (args);
    }

  UNGCPRO;
  return val;
}

  UNGCPRO;
  return val;
}

DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
       doc: /* Eval FORM1, FORM2 and BODY sequentially; value from FORM2.
The value of FORM2 is saved during the evaluation of the
remaining args, whose values are discarded.
usage: (prog2 FORM1 FORM2 BODY...)  */)
     (args)
     Lisp_Object args;
{
  Lisp_Object val;
  register Lisp_Object args_left;

  return Fcar (args);
}


DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
       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 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' 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 using
    call-interactively.

    EXCLUDE_SUBRS_P non-zero means always return 0 if the function
    called is a built-in.  */

int

     int exclude_subrs_p;
{
  struct backtrace *btp;
  Lisp_Object fun;

  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
		      || XSUBR (fun) == &Scalled_interactively_p))
    btp = btp->next;

  /* If we're running an Emacs 18-style byte-compiled function, there
     may be a frame for Fbytecode at the top level.  In any version of
     Emacs there can be Fbytecode frames for subexpressions evaluated

{
  register Lisp_Object fn_name;
  register Lisp_Object defn;

  fn_name = Fcar (args);
  CHECK_SYMBOL (fn_name);
  defn = Fcons (Qlambda, Fcdr (args));
  if (!NILP (Vpurify_flag))
    defn = Fpurecopy (defn);
  if (CONSP (XSYMBOL (fn_name)->function)
      && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, fn_name));
  Ffset (fn_name, defn);
  LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
  return fn_name;
}

DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
       doc: /* Define NAME as a macro.

  (declare SPECS...)
The elements can look like this:
  (indent INDENT)
	Set NAME's `lisp-indent-function' property to INDENT.

  (debug DEBUG)
	Set NAME's `edebug-form-spec' property to DEBUG.  (This is
	equivalent to writing a `def-edebug-spec' for the macro.)
usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
     (args)
     Lisp_Object args;

  register Lisp_Object fn_name;
  register Lisp_Object defn;
  Lisp_Object lambda_list, doc, tail;

  fn_name = Fcar (args);
  CHECK_SYMBOL (fn_name);
  lambda_list = Fcar (Fcdr (args));
  tail = Fcdr (Fcdr (args));

  doc = Qnil;
  if (STRINGP (Fcar (tail)))
    {
      doc = XCAR (tail);
      tail = XCDR (tail);
    }

  while (CONSP (Fcar (tail))
	 && EQ (Fcar (Fcar (tail)), Qdeclare))
    {

    defn = Fpurecopy (defn);
  if (CONSP (XSYMBOL (fn_name)->function)
      && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
    LOADHIST_ATTACH (Fcons (Qt, fn_name));
  Ffset (fn_name, defn);
  LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
  return fn_name;
}


DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
       doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
Setting the value of NEW-ALIAS will subsequently set the value of BASE-VARIABLE,
 and getting the value of NEW-ALIAS will return the value BASE-VARIABLE has.
Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS.  If it is
 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
 itself an alias.
The return value is BASE-VARIABLE.  */)
     (new_alias, base_variable, docstring)
     Lisp_Object new_alias, base_variable, docstring;
{
  struct Lisp_Symbol *sym;

  CHECK_SYMBOL (new_alias);
  CHECK_SYMBOL (base_variable);

  if (SYMBOL_CONSTANT_P (new_alias))
    error ("Cannot make a constant an alias");

  sym = XSYMBOL (new_alias);
  sym->indirect_variable = 1;
  sym->value = base_variable;
  sym->constant = SYMBOL_CONSTANT_P (base_variable);
  LOADHIST_ATTACH (new_alias);
  if (!NILP (docstring))
    Fput (new_alias, Qvariable_documentation, docstring);
  else
    Fput (new_alias, Qvariable_documentation, Qnil);

  return base_variable;
}


DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
       doc: /* Define SYMBOL as a variable, and return SYMBOL.
You are not required to define a variable in order to use it,
but the definition can supply documentation and an initial value
in a way that tags can recognize.

INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.

INITVALUE and DOCSTRING are optional.
If DOCSTRING starts with *, this variable is identified as a user option.
 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;
{
  register Lisp_Object sym, tem, tail;

  sym = Fcar (args);
  tail = Fcdr (args);
  if (!NILP (Fcdr (Fcdr (tail))))
    error ("Too many arguments");

  tem = Fdefault_boundp (sym);
  if (!NILP (tail))
    {
      if (SYMBOL_CONSTANT_P (sym))
	{
	  /* For upward compatibility, allow (defvar :foo (quote :foo)).  */
	  Lisp_Object tem = Fcar (tail);
	  if (! (CONSP (tem)
		 && EQ (XCAR (tem), Qquote)
		 && CONSP (XCDR (tem))
		 && EQ (XCAR (XCDR (tem)), sym)))
	    error ("Constant symbol `%s' specified in defvar",
		   SDATA (SYMBOL_NAME (sym)));
	}

      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))
	{
	  if (!NILP (Vpurify_flag))
	    tem = Fpurecopy (tem);
	  Fput (sym, Qvariable_documentation, tem);
	}
      LOADHIST_ATTACH (sym);
    }
  else
    /* Simple (defvar <var>) should not count as a definition at all.
       It could get in the way of other definitions, and unloading this
       package could try to make the variable unbound.  */

The intent is that neither programs nor users should ever change this value.
Always sets the value of SYMBOL to the result of evalling INITVALUE.
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;
{
  register Lisp_Object sym, tem;

  sym = Fcar (args);
  if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
    error ("Too many arguments");

  tem = Feval (Fcar (Fcdr (args)));
  if (!NILP (Vpurify_flag))
    tem = Fpurecopy (tem);
  Fset_default (sym, tem);

    {
      if (!NILP (Vpurify_flag))
	tem = Fpurecopy (tem);
      Fput (sym, Qvariable_documentation, tem);
    }
  LOADHIST_ATTACH (sym);
  return sym;
}

/* Error handler used in Fuser_variable_p.  */
static Lisp_Object
user_variable_p_eh (ignore)
     Lisp_Object ignore;
{
  return Qnil;
}

DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
       doc: /* Return t if VARIABLE is intended to be set and modified by users.
\(The alternative is a variable used internally in a Lisp program.)
A variable is a user variable if
\(1) the first character of its documentation is `*', or
\(2) it is customizable (its property list contains a non-nil value
    of `standard-value' or `custom-autoload'), or
\(3) it is an alias for another user variable.
Return nil if VARIABLE is an alias and there is a loop in the
chain of symbols.  */)
     (variable)
     Lisp_Object variable;
{
  Lisp_Object documentation;

  if (!SYMBOLP (variable))
      return Qnil;

  /* If indirect and there's an alias loop, don't check anything else.  */
  if (XSYMBOL (variable)->indirect_variable
      && NILP (internal_condition_case_1 (indirect_variable, variable,
                                          Qt, user_variable_p_eh)))
    return Qnil;

  while (1)
    {
      documentation = Fget (variable, Qvariable_documentation);
      if (INTEGERP (documentation) && XINT (documentation) < 0)
        return Qt;
      if (STRINGP (documentation)
          && ((unsigned char) SREF (documentation, 0) == '*'))
        return Qt;
      /* If it is (STRING . INTEGER), a negative integer means a user variable.  */
      if (CONSP (documentation)
          && STRINGP (XCAR (documentation))
          && INTEGERP (XCDR (documentation))
          && XINT (XCDR (documentation)) < 0)
        return Qt;
      /* Customizable?  See `custom-variable-p'.  */
      if ((!NILP (Fget (variable, intern ("standard-value"))))
          || (!NILP (Fget (variable, intern ("custom-autoload")))))
        return Qt;

      if (!XSYMBOL (variable)->indirect_variable)
        return Qnil;

      /* An indirect variable?  Let's follow the chain.  */
      variable = XSYMBOL (variable)->value;
    }
}

DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
       doc: /* Bind variables according to VARLIST then eval BODY.
The value of the last form in BODY is returned.

  register int last_time;

  /* Save the value in the tag.  */
  catch->val = value;

  /* Restore certain special C variables.  */
  set_poll_suppress_count (catch->poll_suppress_count);
  UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
  handling_signal = 0;
  immediate_quit = 0;

  do
    {
      last_time = catchlist == catch;

     Lisp_Object args;
{
  Lisp_Object val;
  int count = SPECPDL_INDEX ();

  record_unwind_protect (Fprogn, Fcdr (args));
  val = Feval (Fcar (args));
  return unbind_to (count, val);
}

/* Chain of condition handlers currently in effect.

with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
VAR may be nil; then you do not get access to the signal information.

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 &rest HANDLERS)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object bodyform, handlers;
  volatile Lisp_Object var;

  var      = Fcar (args);
  bodyform = Fcar (Fcdr (args));
  handlers = Fcdr (Fcdr (args));

  return internal_lisp_condition_case (var, bodyform, handlers);
}

/* Like Fcondition_case, but the args are separate
   rather than passed in a list.  Used by Fbyte_code.  */

Lisp_Object
internal_lisp_condition_case (var, bodyform, handlers)
     volatile Lisp_Object var;
     Lisp_Object bodyform, handlers;
{
  Lisp_Object val;
  struct catchtag c;
  struct handler h;

  CHECK_SYMBOL (var);

  for (val = handlers; CONSP (val); val = XCDR (val))
    {
      Lisp_Object tem;
      tem = XCAR (val);
      if (! (NILP (tem)
	     || (CONSP (tem)
		 && (SYMBOLP (XCAR (tem))
		     || CONSP (XCAR (tem))))))
	error ("Invalid condition handler", tem);

that is a list of condition names.
A handler for any of those names will get to handle this signal.
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)
     Lisp_Object error_symbol, data;
{

  Lisp_Object string;
  Lisp_Object real_error_symbol;
  struct backtrace *bp;

  immediate_quit = handling_signal = 0;
  abort_on_gc = 0;
  if (gc_in_progress || waiting_for_input)
    abort ();

  if (NILP (error_symbol))
    real_error_symbol = Fcar (data);

#endif

  /* This hook is used by edebug.  */
  if (! NILP (Vsignal_hook_function)
      && ! NILP (error_symbol))
    {
      /* Edebug takes care of restoring these variables when it exits.  */
      if (lisp_eval_depth + 20 > max_lisp_eval_depth)
	max_lisp_eval_depth = lisp_eval_depth + 20;

      if (SPECPDL_INDEX () + 40 > max_specpdl_size)
	max_specpdl_size = SPECPDL_INDEX () + 40;

      call2 (Vsignal_hook_function, error_symbol, data);
    }

  conditions = Fget (real_error_symbol, Qerror_conditions);

  /* Remember from where signal was called.  Skip over the frame for
     `signal' itself.  If a frame for `error' follows, skip that,

  for (; handlerlist; handlerlist = handlerlist->next)
    {
      register Lisp_Object clause;

      clause = find_handler_clause (handlerlist->handler, conditions,
				    error_symbol, data, &debugger_value);

      if (EQ (clause, Qlambda))
	{

   There are two ways to pass SIG and DATA:
    = SIG is the error symbol, and DATA is the rest of the data.
    = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
       This is for memory-full errors only.

   Store value returned from debugger into *DEBUGGER_VALUE_PTR.

   We need to increase max_specpdl_size temporarily around
   anything we do that can push on the specpdl, so as not to get
   a second error here in case we're handling specpdl overflow.  */

static Lisp_Object
find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
     Lisp_Object handlers, conditions, sig, data;
     Lisp_Object *debugger_value_ptr;

     and run the debugger if that is enabled.  */
  if (EQ (handlers, Qerror)
      || !NILP (Vdebug_on_signal)) /* This says call debugger even if
				      there is a handler.  */
    {
      int debugger_called = 0;
      Lisp_Object sig_symbol, combined_data;
      /* This is set to 1 if we are handling a memory-full error,
	 because these must not run the debugger.
	 (There is no room in memory to do that!)  */

	  sig_symbol = sig;
	}

      if (wants_debugger (Vstack_trace_on_error, conditions))
	{
	  max_specpdl_size++;
#ifdef PROTOTYPES
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
					       Qnil);
#else
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       Fbacktrace, Qnil);
#endif
	  max_specpdl_size--;
	}
      if (! no_debugger
	  && (EQ (sig_symbol, Qquit)
	      ? debug_on_quit
	      : wants_debugger (Vdebug_on_error, conditions))
	  && ! skip_debugger (conditions, combined_data)
	  && when_entered_debugger < num_nonmacro_input_events)
	{
	  *debugger_value_ptr
	    = call_debugger (Fcons (Qerror,
				    Fcons (combined_data, Qnil)));
	  debugger_called = 1;
	}
      /* If there is no handler, return saying whether we ran the debugger.  */
      if (EQ (handlers, Qerror))
	{
	  if (debugger_called)
	    return Qlambda;
	  return Qt;
	}
    }
  for (h = handlers; CONSP (h); h = Fcdr (h))
    {

    return Qt;

  /* Lists may represent commands.  */
  if (!CONSP (fun))
    return Qnil;
  funcar = XCAR (fun);
  if (EQ (funcar, Qlambda))
    return Fassq (Qinteractive, Fcdr (XCDR (fun)));
  if (EQ (funcar, Qautoload))
    return Fcar (Fcdr (Fcdr (XCDR (fun))));
  else
    return Qnil;
}

/* ARGSUSED */

     oldqueue is the shadowed value to leave in Vautoload_queue.  */
  queue = Vautoload_queue;
  Vautoload_queue = oldqueue;
  while (CONSP (queue))
    {
      first = XCAR (queue);
      second = Fcdr (first);
      first = Fcar (first);
      if (EQ (first, make_number (0)))
	Vfeatures = second;
      else
	Ffset (first, second);
      queue = XCDR (queue);
    }
  return Qnil;
}

/* Load an autoloaded function.

  fun = funname;
  CHECK_SYMBOL (funname);
  GCPRO3 (fun, funname, fundef);

  /* Preserve the match data.  */
  record_unwind_save_match_data ();

  /* Value saved here is to be restored into Vautoload_queue.  */
  record_unwind_protect (un_autoload, Vautoload_queue);
  Vautoload_queue = Qt;
  Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt);

  /* Save the old autoloads, in case we ever do an unload.  */
  queue = Vautoload_queue;
  while (CONSP (queue))
    {
      first = XCAR (queue);
      second = Fcdr (first);
      first = Fcar (first);

      if (SYMBOLP (first) && CONSP (second) && EQ (XCAR (second), Qautoload))
	Fput (first, Qautoload, (XCDR (second)));

      queue = XCDR (queue);
    }

  /* Once loading finishes, don't undo it.  */
  Vautoload_queue = Qt;
  unbind_to (count, Qnil);

    return Fsymbol_value (form);
  if (!CONSP (form))
    return form;

  QUIT;
  if ((consing_since_gc > gc_cons_threshold
       && consing_since_gc > gc_relative_threshold)
      ||
      (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
    {
      GCPRO1 (form);
      Fgarbage_collect ();
      UNGCPRO;
    }

  if (++lisp_eval_depth > max_lisp_eval_depth)
    {
      if (max_lisp_eval_depth < 100)
	max_lisp_eval_depth = 100;
      if (lisp_eval_depth > max_lisp_eval_depth)
	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
    }

  original_fun = Fcar (form);
  original_args = Fcdr (form);

      Lisp_Object args_left;
      register int i, maxargs;

      args_left = original_args;
      numargs = Flength (args_left);

      CHECK_CONS_LIST ();

      if (XINT (numargs) < XSUBR (fun)->min_args ||
	  (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
	return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));

	val = apply_lambda (fun, original_args, 1);
      else
	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
    }
 done:
  CHECK_CONS_LIST ();

  lisp_eval_depth--;
  if (backtrace.debug_on_exit)
    val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
  backtrace_list = backtrace.next;

  return val;
}

DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
       doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.

    {
      funcall_args [i++] = XCAR (spread_arg);
      spread_arg = XCDR (spread_arg);
    }

  /* By convention, the caller needs to gcpro Ffuncall's args.  */
  RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}

/* Run hook variables in various ways.  */

enum run_hooks_condition {to_completion, until_success, until_failure};
static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
					   enum run_hooks_condition));

DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
       doc: /* Run each hook in HOOKS.
Each argument should be a symbol, a hook variable.
These symbols are processed in the order specified.
If a hook symbol has a non-nil value, that value may be a function
or a list of functions to be called to run the hook.
If the value is a function, it is called with no arguments.
If it is a list, the elements are called, in order, with no arguments.

Major modes should not use this function directly to run their mode
hook; they should use `run-mode-hooks' instead.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hooks &rest HOOKS)  */)
     (nargs, args)

value, that value may be a function or a list of functions to be
called to run the hook.  If the value is a function, it is called with
the given arguments and its return value is returned.  If it is a list
of functions, those functions are called, in order,
with the given arguments ARGS.
It is best not to depend on the value returned by `run-hook-with-args',
as that may change.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args HOOK &rest ARGS)  */)

}

DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
       Srun_hook_with_args_until_success, 1, MANY, 0,
       doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable.  If HOOK has a non-nil
value, that value may be a function or a list of functions to be
called to run the hook.  If the value is a function, it is called with
the given arguments and its return value is returned.
If it is a list of functions, those functions are called, in order,
with the given arguments ARGS, until one of them
returns a non-nil value.  Then we return that value.
However, if they all return nil, we return nil.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-success HOOK &rest ARGS)  */)
     (nargs, args)

}

DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
       Srun_hook_with_args_until_failure, 1, MANY, 0,
       doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable.  If HOOK has a non-nil
value, that value may be a function or a list of functions to be
called to run the hook.  If the value is a function, it is called with
the given arguments and its return value is returned.
If it is a list of functions, those functions are called, in order,
with the given arguments ARGS, until one of them returns nil.
Then we return nil.  However, if they all return non-nil, we return non-nil.

Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args-until-failure HOOK &rest ARGS)  */)
     (nargs, args)

  gcpro1.nvars = 7;
  RETURN_UNGCPRO (Ffuncall (7, &fn));
#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.
Thus, (funcall 'cons 'x 'y) returns (x . y).
usage: (funcall FUNCTION &rest ARGUMENTS)  */)

  struct backtrace backtrace;
  register Lisp_Object *internal_args;
  register int i;

  QUIT;
  if ((consing_since_gc > gc_cons_threshold
       && consing_since_gc > gc_relative_threshold)
      ||
      (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
    Fgarbage_collect ();

  if (++lisp_eval_depth > max_lisp_eval_depth)
    {
      if (max_lisp_eval_depth < 100)
	max_lisp_eval_depth = 100;
      if (lisp_eval_depth > max_lisp_eval_depth)
	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
    }

  backtrace.next = backtrace_list;
  backtrace_list = &backtrace;
  backtrace.function = &args[0];

  backtrace.debug_on_exit = 0;

  if (debug_on_next_call)
    do_debug_on_call (Qlambda);

  CHECK_CONS_LIST ();

 retry:

  fun = args[0];

  fun = Findirect_function (fun);

  if (SUBRP (fun))
    {
       if (numargs < XSUBR (fun)->min_args
	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
	{
	  XSETFASTINT (lisp_numargs, numargs);
	  return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil)));
	}

	  goto done;
	case 1:
	  val = (*XSUBR (fun)->function) (internal_args[0]);
	  goto done;
	case 2:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]);
	  goto done;
	case 3:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
					  internal_args[2]);
	  goto done;
	case 4:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
					  internal_args[2], internal_args[3]);
	  goto done;
	case 5:
	  val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
					  internal_args[2], internal_args[3],
					  internal_args[4]);

      if (EQ (funcar, Qlambda))
	val = funcall_lambda (fun, numargs, args + 1);
      else if (EQ (funcar, Qautoload))
	{
	  do_autoload (fun, args[0]);
	  CHECK_CONS_LIST ();
	  goto retry;
	}
      else
	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
    }
 done:
  CHECK_CONS_LIST ();
  lisp_eval_depth--;
  if (backtrace.debug_on_exit)
    val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
  backtrace_list = backtrace.next;
  return val;

  if (specpdl_size >= max_specpdl_size)
    {
      if (max_specpdl_size < 400)
	max_specpdl_size = 400;
      if (specpdl_size >= max_specpdl_size)
	Fsignal (Qerror,
		 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
    }
  specpdl_size *= 2;
  if (specpdl_size > max_specpdl_size)
    specpdl_size = max_specpdl_size;
  specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));

Lisp_Object
unbind_to (count, value)
     int count;
     Lisp_Object value;
{
  Lisp_Object quitf = Vquit_flag;
  struct gcpro gcpro1, gcpro2;

  GCPRO2 (value, quitf);
  Vquit_flag = Qnil;

  while (specpdl_ptr != specpdl + count)
    {
      /* 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
	 bound a variable that had a buffer-local or frame-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 (this_binding.symbol))
	{
	  Lisp_Object symbol, where;

	  symbol = XCAR (this_binding.symbol);
	  where = XCAR (XCDR (this_binding.symbol));

	  if (NILP (where))
	    Fset_default (symbol, this_binding.old_value);
	  else if (BUFFERP (where))
	    set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
	  else
	    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 (this_binding.symbol)))
	    SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
	  else
	    set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
	}
    }

  if (NILP (Vquit_flag) && !NILP (quitf))
    Vquit_flag = quitf;

  UNGCPRO;
  return value;
}


    }
}


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_INT ("max-specpdl-size", &max_specpdl_size,
	      doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
If Lisp code tries to increase the total number past this amount,
an error is signaled.
You can safely use a value considerably larger than the default value,
if that proves inconveniently small.  However, if you increase it too far,
Emacs could run out of memory trying to make the stack bigger.  */);

if that proves inconveniently small.  However, if you increase it too far,
Emacs could overflow the real C stack, and crash.  */);

  DEFVAR_LISP ("quit-flag", &Vquit_flag,
	       doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
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,
	       doc: /* Non-nil inhibits C-g quitting from happening immediately.
Note that `quit-flag' will still be set by typing C-g,

  Qcommandp = intern ("commandp");
  staticpro (&Qcommandp);

  Qdefun = intern ("defun");
  staticpro (&Qdefun);

  Qand_rest = intern ("&rest");
  staticpro (&Qand_rest);

  Qand_optional = intern ("&optional");

This overrides the variable `debug-on-error'.
It does not apply to errors handled by `condition-case'.  */);
  Vdebug_ignored_errors = Qnil;

  DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
    doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
Does not apply if quit is handled by a `condition-case'.  */);
  debug_on_quit = 0;

  DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
	       doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'.  */);

  defsubr (&Sthrow);
  defsubr (&Sunwind_protect);
  defsubr (&Scondition_case);
  defsubr (&Ssignal);
  defsubr (&Sinteractive_p);
  defsubr (&Scalled_interactively_p);
  defsubr (&Scommandp);
  defsubr (&Sautoload);
  defsubr (&Seval);
  defsubr (&Sapply);
  defsubr (&Sfuncall);

  defsubr (&Sfetch_bytecode);
  defsubr (&Sbacktrace_debug);
  defsubr (&Sbacktrace);
  defsubr (&Sbacktrace_frame);
}

/* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
   (do not change this comment) */