/* Evaluator for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+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 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
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. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
if (SPECPDL_INDEX () + 100 > max_specpdl_size)
max_specpdl_size = SPECPDL_INDEX () + 100;
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
}
DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
- doc: /* Eval FIRST and BODY sequentially; value from FIRST.
+ doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
The value of FIRST is saved during the evaluation of the remaining args,
whose values are discarded.
usage: (prog1 FIRST BODY...) */)
struct gcpro gcpro1, gcpro2;
register int argnum = 0;
- if (NILP(args))
+ if (NILP (args))
return Qnil;
args_left = args;
}
DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
- doc: /* Eval FORM1, FORM2 and BODY sequentially; value from FORM2.
+ doc: /* Eval FORM1, FORM2 and BODY sequentially; return 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...) */)
and the result should be a form to be evaluated instead of the original.
DECL is a declaration, optional, which can specify how to indent
-calls to this macro and how Edebug should handle it. It looks like this:
+calls to this macro, how Edebug should handle it, and which argument
+should be treated as documentation. It looks like this:
(declare SPECS...)
The elements can look like this:
(indent INDENT)
(debug DEBUG)
Set NAME's `edebug-form-spec' property to DEBUG. (This is
equivalent to writing a `def-edebug-spec' for the macro.)
+
+ (doc-string ELT)
+ Set NAME's `doc-string-elt' property to ELT.
+
usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
(args)
Lisp_Object args;
doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
Aliased variables always have the same value; setting one sets the other.
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.
+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. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
+then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
The return value is BASE-VARIABLE. */)
(new_alias, base_variable, docstring)
Lisp_Object new_alias, base_variable, docstring;
error ("Cannot make a constant an alias");
sym = XSYMBOL (new_alias);
+ /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
+ If n_a is bound, but b_v is not, set the value of b_v to n_a.
+ This is for the sake of define-obsolete-variable-alias and user
+ customizations. */
+ if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias)))
+ XSYMBOL(base_variable)->value = sym->value;
sym->indirect_variable = 1;
sym->value = base_variable;
sym->constant = SYMBOL_CONSTANT_P (base_variable);
return Qnil;
}
+static Lisp_Object
+lisp_indirect_variable (Lisp_Object sym)
+{
+ XSETSYMBOL (sym, indirect_variable (XSYMBOL (sym)));
+ return sym;
+}
+
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.)
/* 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,
+ && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
Qt, user_variable_p_eh)))
return Qnil;
GCPRO2 (args, *temps);
gcpro2.nvars = 0;
- for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
+ for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
QUIT;
- elt = Fcar (varlist);
+ elt = XCAR (varlist);
if (SYMBOLP (elt))
temps [argnum++] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
UNGCPRO;
varlist = Fcar (args);
- for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
+ for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
- elt = Fcar (varlist);
+ elt = XCAR (varlist);
tem = temps[argnum++];
if (SYMBOLP (elt))
specbind (elt, tem);
When a handler handles an error, control returns to the `condition-case'
and it executes the handler's BODY...
-with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA) from the error.
+with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
(If VAR is nil, the handler can't access that information.)
Then the value of the last BODY form is returned from the `condition-case'
expression.
#if 0 /* rms: I don't know why this was here,
but it is surely wrong for an error that is handled. */
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
return 0;
}
+/* Call the debugger if calling it is currently enabled for CONDITIONS.
+ SIG and DATA describe the signal, as in find_handler_clause. */
+
+static int
+maybe_call_debugger (conditions, sig, data)
+ Lisp_Object conditions, sig, data;
+{
+ Lisp_Object combined_data;
+
+ combined_data = Fcons (sig, data);
+
+ if (
+ /* Don't try to run the debugger with interrupts blocked.
+ The editing loop would return anyway. */
+ ! INPUT_BLOCKED_P
+ /* Does user want to enter debugger for this kind of error? */
+ && (EQ (sig, Qquit)
+ ? debug_on_quit
+ : wants_debugger (Vdebug_on_error, conditions))
+ && ! skip_debugger (conditions, combined_data)
+ /* rms: what's this for? */
+ && when_entered_debugger < num_nonmacro_input_events)
+ {
+ call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
+ return 1;
+ }
+
+ return 0;
+}
+
/* Value of Qlambda means we have called debugger and user has continued.
There are two ways to pass SIG and DATA:
= SIG is the error symbol, and DATA is the rest of the data.
{
if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
{
+ max_lisp_eval_depth += 15;
max_specpdl_size++;
- #ifdef PROTOTYPES
+#ifdef PROTOTYPES
internal_with_output_to_temp_buffer ("*Backtrace*",
(Lisp_Object (*) (Lisp_Object)) Fbacktrace,
Qnil);
- #else
+#else
internal_with_output_to_temp_buffer ("*Backtrace*",
Fbacktrace, Qnil);
- #endif
+#endif
max_specpdl_size--;
+ max_lisp_eval_depth -= 15;
}
if (!debugger_considered)
return Qnil;
}
-/* Call the debugger if calling it is currently enabled for CONDITIONS.
- SIG and DATA describe the signal, as in find_handler_clause. */
-
-int
-maybe_call_debugger (conditions, sig, data)
- Lisp_Object conditions, sig, data;
-{
- Lisp_Object combined_data;
-
- combined_data = Fcons (sig, data);
-
- if (
- /* Don't try to run the debugger with interrupts blocked.
- The editing loop would return anyway. */
- ! INPUT_BLOCKED_P
- /* Does user wants to enter debugger for this kind of error? */
- && (EQ (sig, Qquit)
- ? debug_on_quit
- : wants_debugger (Vdebug_on_error, conditions))
- && ! skip_debugger (conditions, combined_data)
- /* rms: what's this for? */
- && when_entered_debugger < num_nonmacro_input_events)
- {
- call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
- return 1;
- }
-
- return 0;
-}
-
/* dump an error message; called like printf */
/* VARARGS 1 */
Lisp_Object fundef, funname;
{
int count = SPECPDL_INDEX ();
- Lisp_Object fun, queue, first, second;
+ Lisp_Object fun;
struct gcpro gcpro1, gcpro2, gcpro3;
/* This is to make sure that loadup.el gives a clear picture
/* Preserve the match data. */
record_unwind_save_match_data ();
- /* Value saved here is to be restored into Vautoload_queue. */
+ /* If autoloading gets an error (which includes the error of failing
+ to define the function being called), we use Vautoload_queue
+ to undo function definitions and `provide' calls made by
+ the function. We do this in the specific case of autoloading
+ because autoloading is not an explicit request "load this file",
+ but rather a request to "call this function".
+
+ The 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, Qt, 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);
else
error ("Invalid byte code");
}
- AREF (object, COMPILED_BYTECODE) = XCAR (tem);
- AREF (object, COMPILED_CONSTANTS) = XCDR (tem);
+ ASET (object, COMPILED_BYTECODE, XCAR (tem));
+ ASET (object, COMPILED_CONSTANTS, XCDR (tem));
}
return object;
}
specbind (symbol, value)
Lisp_Object symbol, value;
{
- Lisp_Object ovalue;
Lisp_Object valcontents;
CHECK_SYMBOL (symbol);
}
else
{
- Lisp_Object valcontents;
-
- ovalue = find_symbol_value (symbol);
+ Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
valcontents = XSYMBOL (symbol)->value;
if (BUFFER_LOCAL_VALUEP (valcontents)
- || SOME_BUFFER_LOCAL_VALUEP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
{
Lisp_Object where, current_buffer;
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (symbol, Qnil)))
where = current_buffer;
- else if (!BUFFER_OBJFWDP (valcontents)
+ else if (BUFFER_LOCAL_VALUEP (valcontents)
&& XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
else
specpdl_ptr->symbol = symbol;
specpdl_ptr++;
- if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
- store_symval_forwarding (symbol, ovalue, value, NULL);
- else
- set_internal (symbol, value, 0, 1);
+ /* We used to do
+ if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
+ store_symval_forwarding (symbol, ovalue, value, NULL);
+ else
+ but ovalue comes from find_symbol_value which should never return
+ such an internal value. */
+ eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)));
+ set_internal (symbol, value, 0, 1);
}
}
if one of its condition symbols appears in the list.
When you evaluate an expression interactively, this variable
is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
-See also variable `debug-on-quit'. */);
+The command `toggle-debug-on-error' toggles this.
+See also the variable `debug-on-quit'. */);
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,