1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
3 2002, 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
25 #include "blockinput.h"
28 #include "dispextern.h"
31 /* This definition is duplicated in alloc.c and keyboard.c */
32 /* Putting it in lisp.h makes cc bomb out! */
36 struct backtrace
*next
;
37 Lisp_Object
*function
;
38 Lisp_Object
*args
; /* Points to vector of args. */
39 int nargs
; /* Length of vector.
40 If nargs is UNEVALLED, args points to slot holding
41 list of unevalled args */
43 /* Nonzero means call value of debugger when done with this operation. */
47 struct backtrace
*backtrace_list
;
49 /* This structure helps implement the `catch' and `throw' control
50 structure. A struct catchtag contains all the information needed
51 to restore the state of the interpreter after a non-local jump.
53 Handlers for error conditions (represented by `struct handler'
54 structures) just point to a catch tag to do the cleanup required
57 catchtag structures are chained together in the C calling stack;
58 the `next' member points to the next outer catchtag.
60 A call like (throw TAG VAL) searches for a catchtag whose `tag'
61 member is TAG, and then unbinds to it. The `val' member is used to
62 hold VAL while the stack is unwound; `val' is returned as the value
65 All the other members are concerned with restoring the interpreter
72 struct catchtag
*next
;
75 struct backtrace
*backlist
;
76 struct handler
*handlerlist
;
79 int poll_suppress_count
;
80 int interrupt_input_blocked
;
81 struct byte_stack
*byte_stack
;
84 struct catchtag
*catchlist
;
87 /* Count levels of GCPRO to detect failure to UNGCPRO. */
91 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
92 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
93 Lisp_Object Qand_rest
, Qand_optional
;
94 Lisp_Object Qdebug_on_error
;
97 /* This holds either the symbol `run-hooks' or nil.
98 It is nil at an early stage of startup, and when Emacs
101 Lisp_Object Vrun_hooks
;
103 /* Non-nil means record all fset's and provide's, to be undone
104 if the file being autoloaded is not fully loaded.
105 They are recorded by being consed onto the front of Vautoload_queue:
106 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
108 Lisp_Object Vautoload_queue
;
110 /* Current number of specbindings allocated in specpdl. */
114 /* Pointer to beginning of specpdl. */
116 struct specbinding
*specpdl
;
118 /* Pointer to first unused element in specpdl. */
120 volatile struct specbinding
*specpdl_ptr
;
122 /* Maximum size allowed for specpdl allocation */
124 EMACS_INT max_specpdl_size
;
126 /* Depth in Lisp evaluations and function calls. */
130 /* Maximum allowed depth in Lisp evaluations and function calls. */
132 EMACS_INT max_lisp_eval_depth
;
134 /* Nonzero means enter debugger before next function call */
136 int debug_on_next_call
;
138 /* Non-zero means debugger may continue. This is zero when the
139 debugger is called during redisplay, where it might not be safe to
140 continue the interrupted redisplay. */
142 int debugger_may_continue
;
144 /* List of conditions (non-nil atom means all) which cause a backtrace
145 if an error is handled by the command loop's error handler. */
147 Lisp_Object Vstack_trace_on_error
;
149 /* List of conditions (non-nil atom means all) which enter the debugger
150 if an error is handled by the command loop's error handler. */
152 Lisp_Object Vdebug_on_error
;
154 /* List of conditions and regexps specifying error messages which
155 do not enter the debugger even if Vdebug_on_error says they should. */
157 Lisp_Object Vdebug_ignored_errors
;
159 /* Non-nil means call the debugger even if the error will be handled. */
161 Lisp_Object Vdebug_on_signal
;
163 /* Hook for edebug to use. */
165 Lisp_Object Vsignal_hook_function
;
167 /* Nonzero means enter debugger if a quit signal
168 is handled by the command loop's error handler. */
172 /* The value of num_nonmacro_input_events as of the last time we
173 started to enter the debugger. If we decide to enter the debugger
174 again when this is still equal to num_nonmacro_input_events, then we
175 know that the debugger itself has an error, and we should just
176 signal the error instead of entering an infinite loop of debugger
179 int when_entered_debugger
;
181 Lisp_Object Vdebugger
;
183 /* The function from which the last `signal' was called. Set in
186 Lisp_Object Vsignaling_function
;
188 /* Set to non-zero while processing X events. Checked in Feval to
189 make sure the Lisp interpreter isn't called from a signal handler,
190 which is unsafe because the interpreter isn't reentrant. */
194 /* Function to process declarations in defmacro forms. */
196 Lisp_Object Vmacro_declaration_function
;
199 static Lisp_Object funcall_lambda
P_ ((Lisp_Object
, int, Lisp_Object
*));
205 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
206 specpdl_ptr
= specpdl
;
207 max_specpdl_size
= 1000;
208 max_lisp_eval_depth
= 300;
216 specpdl_ptr
= specpdl
;
221 debug_on_next_call
= 0;
226 /* This is less than the initial value of num_nonmacro_input_events. */
227 when_entered_debugger
= -1;
230 /* unwind-protect function used by call_debugger. */
233 restore_stack_limits (data
)
236 max_specpdl_size
= XINT (XCAR (data
));
237 max_lisp_eval_depth
= XINT (XCDR (data
));
240 /* Call the Lisp debugger, giving it argument ARG. */
246 int debug_while_redisplaying
;
247 int count
= SPECPDL_INDEX ();
249 int old_max
= max_specpdl_size
;
251 /* Temporarily bump up the stack limits,
252 so the debugger won't run out of stack. */
254 max_specpdl_size
+= 1;
255 record_unwind_protect (restore_stack_limits
,
256 Fcons (make_number (old_max
),
257 make_number (max_lisp_eval_depth
)));
258 max_specpdl_size
= old_max
;
260 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
261 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
263 if (SPECPDL_INDEX () + 100 > max_specpdl_size
)
264 max_specpdl_size
= SPECPDL_INDEX () + 100;
266 #ifdef HAVE_X_WINDOWS
267 if (display_hourglass_p
)
271 debug_on_next_call
= 0;
272 when_entered_debugger
= num_nonmacro_input_events
;
274 /* Resetting redisplaying_p to 0 makes sure that debug output is
275 displayed if the debugger is invoked during redisplay. */
276 debug_while_redisplaying
= redisplaying_p
;
278 specbind (intern ("debugger-may-continue"),
279 debug_while_redisplaying
? Qnil
: Qt
);
280 specbind (Qinhibit_redisplay
, Qnil
);
281 specbind (Qdebug_on_error
, Qnil
);
283 #if 0 /* Binding this prevents execution of Lisp code during
284 redisplay, which necessarily leads to display problems. */
285 specbind (Qinhibit_eval_during_redisplay
, Qt
);
288 val
= apply1 (Vdebugger
, arg
);
290 /* Interrupting redisplay and resuming it later is not safe under
291 all circumstances. So, when the debugger returns, abort the
292 interrupted redisplay by going back to the top-level. */
293 if (debug_while_redisplaying
)
296 return unbind_to (count
, val
);
300 do_debug_on_call (code
)
303 debug_on_next_call
= 0;
304 backtrace_list
->debug_on_exit
= 1;
305 call_debugger (Fcons (code
, Qnil
));
308 /* NOTE!!! Every function that can call EVAL must protect its args
309 and temporaries from garbage collection while it needs them.
310 The definition of `For' shows what you have to do. */
312 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
313 doc
: /* Eval args until one of them yields non-nil, then return that value.
314 The remaining args are not evalled at all.
315 If all args return nil, return nil.
316 usage: (or CONDITIONS ...) */)
320 register Lisp_Object val
= Qnil
;
327 val
= Feval (XCAR (args
));
337 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
338 doc
: /* Eval args until one of them yields nil, then return nil.
339 The remaining args are not evalled at all.
340 If no arg yields nil, return the last arg's value.
341 usage: (and CONDITIONS ...) */)
345 register Lisp_Object val
= Qt
;
352 val
= Feval (XCAR (args
));
362 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
363 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
364 Returns the value of THEN or the value of the last of the ELSE's.
365 THEN must be one expression, but ELSE... can be zero or more expressions.
366 If COND yields nil, and there are no ELSE's, the value is nil.
367 usage: (if COND THEN ELSE...) */)
371 register Lisp_Object cond
;
375 cond
= Feval (Fcar (args
));
379 return Feval (Fcar (Fcdr (args
)));
380 return Fprogn (Fcdr (Fcdr (args
)));
383 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
384 doc
: /* Try each clause until one succeeds.
385 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
386 and, if the value is non-nil, this clause succeeds:
387 then the expressions in BODY are evaluated and the last one's
388 value is the value of the cond-form.
389 If no clause succeeds, cond returns nil.
390 If a clause has one element, as in (CONDITION),
391 CONDITION's value if non-nil is returned from the cond-form.
392 usage: (cond CLAUSES...) */)
396 register Lisp_Object clause
, val
;
403 clause
= Fcar (args
);
404 val
= Feval (Fcar (clause
));
407 if (!EQ (XCDR (clause
), Qnil
))
408 val
= Fprogn (XCDR (clause
));
418 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
419 doc
: /* Eval BODY forms sequentially and return value of last one.
420 usage: (progn BODY ...) */)
424 register Lisp_Object val
= Qnil
;
431 val
= Feval (XCAR (args
));
439 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
440 doc
: /* Eval FIRST and BODY sequentially; value from FIRST.
441 The value of FIRST is saved during the evaluation of the remaining args,
442 whose values are discarded.
443 usage: (prog1 FIRST BODY...) */)
448 register Lisp_Object args_left
;
449 struct gcpro gcpro1
, gcpro2
;
450 register int argnum
= 0;
462 val
= Feval (Fcar (args_left
));
464 Feval (Fcar (args_left
));
465 args_left
= Fcdr (args_left
);
467 while (!NILP(args_left
));
473 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
474 doc
: /* Eval FORM1, FORM2 and BODY sequentially; value from FORM2.
475 The value of FORM2 is saved during the evaluation of the
476 remaining args, whose values are discarded.
477 usage: (prog2 FORM1 FORM2 BODY...) */)
482 register Lisp_Object args_left
;
483 struct gcpro gcpro1
, gcpro2
;
484 register int argnum
= -1;
498 val
= Feval (Fcar (args_left
));
500 Feval (Fcar (args_left
));
501 args_left
= Fcdr (args_left
);
503 while (!NILP (args_left
));
509 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
510 doc
: /* Set each SYM to the value of its VAL.
511 The symbols SYM are variables; they are literal (not evaluated).
512 The values VAL are expressions; they are evaluated.
513 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
514 The second VAL is not computed until after the first SYM is set, and so on;
515 each VAL can use the new value of variables set earlier in the `setq'.
516 The return value of the `setq' form is the value of the last VAL.
517 usage: (setq SYM VAL SYM VAL ...) */)
521 register Lisp_Object args_left
;
522 register Lisp_Object val
, sym
;
533 val
= Feval (Fcar (Fcdr (args_left
)));
534 sym
= Fcar (args_left
);
536 args_left
= Fcdr (Fcdr (args_left
));
538 while (!NILP(args_left
));
544 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
545 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
546 usage: (quote ARG) */)
553 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
554 doc
: /* Like `quote', but preferred for objects which are functions.
555 In byte compilation, `function' causes its argument to be compiled.
556 `quote' cannot do that.
557 usage: (function ARG) */)
565 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
566 doc
: /* Return t if the function was run directly by user input.
567 This means that the function was called with `call-interactively'
568 \(which includes being called as the binding of a key)
569 and input is currently coming from the keyboard (not in keyboard macro),
570 and Emacs is not running in batch mode (`noninteractive' is nil).
572 The only known proper use of `interactive-p' is in deciding whether to
573 display a helpful message, or how to display it. If you're thinking
574 of using it for any other purpose, it is quite likely that you're
575 making a mistake. Think: what do you want to do when the command is
576 called from a keyboard macro?
578 If you want to test whether your function was called with
579 `call-interactively', the way to do that is by adding an extra
580 optional argument, and making the `interactive' spec specify non-nil
581 unconditionally for that argument. (`p' is a good way to do this.) */)
584 return (INTERACTIVE
&& interactive_p (1)) ? Qt
: Qnil
;
588 DEFUN ("called-interactively-p", Fcalled_interactively_p
, Scalled_interactively_p
, 0, 0, 0,
589 doc
: /* Return t if the function using this was called with `call-interactively'.
590 This is used for implementing advice and other function-modifying
593 The cleanest way to test whether your function was called with
594 `call-interactively' is by adding an extra optional argument,
595 and making the `interactive' spec specify non-nil unconditionally
596 for that argument. (`p' is a good way to do this.) */)
599 return interactive_p (1) ? Qt
: Qnil
;
603 /* Return 1 if function in which this appears was called using
606 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
607 called is a built-in. */
610 interactive_p (exclude_subrs_p
)
613 struct backtrace
*btp
;
616 btp
= backtrace_list
;
618 /* If this isn't a byte-compiled function, there may be a frame at
619 the top for Finteractive_p. If so, skip it. */
620 fun
= Findirect_function (*btp
->function
);
621 if (SUBRP (fun
) && (XSUBR (fun
) == &Sinteractive_p
622 || XSUBR (fun
) == &Scalled_interactively_p
))
625 /* If we're running an Emacs 18-style byte-compiled function, there
626 may be a frame for Fbytecode at the top level. In any version of
627 Emacs there can be Fbytecode frames for subexpressions evaluated
628 inside catch and condition-case. Skip past them.
630 If this isn't a byte-compiled function, then we may now be
631 looking at several frames for special forms. Skip past them. */
633 && (EQ (*btp
->function
, Qbytecode
)
634 || btp
->nargs
== UNEVALLED
))
637 /* btp now points at the frame of the innermost function that isn't
638 a special form, ignoring frames for Finteractive_p and/or
639 Fbytecode at the top. If this frame is for a built-in function
640 (such as load or eval-region) return nil. */
641 fun
= Findirect_function (*btp
->function
);
642 if (exclude_subrs_p
&& SUBRP (fun
))
645 /* btp points to the frame of a Lisp function that called interactive-p.
646 Return t if that function was called interactively. */
647 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
653 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
654 doc
: /* Define NAME as a function.
655 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
656 See also the function `interactive'.
657 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
661 register Lisp_Object fn_name
;
662 register Lisp_Object defn
;
664 fn_name
= Fcar (args
);
665 CHECK_SYMBOL (fn_name
);
666 defn
= Fcons (Qlambda
, Fcdr (args
));
667 if (!NILP (Vpurify_flag
))
668 defn
= Fpurecopy (defn
);
669 if (CONSP (XSYMBOL (fn_name
)->function
)
670 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
671 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
672 Ffset (fn_name
, defn
);
673 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
677 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
678 doc
: /* Define NAME as a macro.
679 The actual definition looks like
680 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
681 When the macro is called, as in (NAME ARGS...),
682 the function (lambda ARGLIST BODY...) is applied to
683 the list ARGS... as it appears in the expression,
684 and the result should be a form to be evaluated instead of the original.
686 DECL is a declaration, optional, which can specify how to indent
687 calls to this macro and how Edebug should handle it. It looks like this:
689 The elements can look like this:
691 Set NAME's `lisp-indent-function' property to INDENT.
694 Set NAME's `edebug-form-spec' property to DEBUG. (This is
695 equivalent to writing a `def-edebug-spec' for the macro.)
696 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
700 register Lisp_Object fn_name
;
701 register Lisp_Object defn
;
702 Lisp_Object lambda_list
, doc
, tail
;
704 fn_name
= Fcar (args
);
705 CHECK_SYMBOL (fn_name
);
706 lambda_list
= Fcar (Fcdr (args
));
707 tail
= Fcdr (Fcdr (args
));
710 if (STRINGP (Fcar (tail
)))
716 while (CONSP (Fcar (tail
))
717 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
719 if (!NILP (Vmacro_declaration_function
))
723 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
731 tail
= Fcons (lambda_list
, tail
);
733 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
734 defn
= Fcons (Qmacro
, Fcons (Qlambda
, tail
));
736 if (!NILP (Vpurify_flag
))
737 defn
= Fpurecopy (defn
);
738 if (CONSP (XSYMBOL (fn_name
)->function
)
739 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
740 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
741 Ffset (fn_name
, defn
);
742 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
747 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
748 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
749 Setting the value of NEW-ALIAS will subsequently set the value of BASE-VARIABLE,
750 and getting the value of NEW-ALIAS will return the value BASE-VARIABLE has.
751 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
752 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
753 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
755 The return value is BASE-VARIABLE. */)
756 (new_alias
, base_variable
, docstring
)
757 Lisp_Object new_alias
, base_variable
, docstring
;
759 struct Lisp_Symbol
*sym
;
761 CHECK_SYMBOL (new_alias
);
762 CHECK_SYMBOL (base_variable
);
764 if (SYMBOL_CONSTANT_P (new_alias
))
765 error ("Cannot make a constant an alias");
767 sym
= XSYMBOL (new_alias
);
768 sym
->indirect_variable
= 1;
769 sym
->value
= base_variable
;
770 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
771 LOADHIST_ATTACH (new_alias
);
772 if (!NILP (docstring
))
773 Fput (new_alias
, Qvariable_documentation
, docstring
);
775 Fput (new_alias
, Qvariable_documentation
, Qnil
);
777 return base_variable
;
781 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
782 doc
: /* Define SYMBOL as a variable.
783 You are not required to define a variable in order to use it,
784 but the definition can supply documentation and an initial value
785 in a way that tags can recognize.
787 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
788 If SYMBOL is buffer-local, its default value is what is set;
789 buffer-local values are not affected.
790 INITVALUE and DOCSTRING are optional.
791 If DOCSTRING starts with *, this variable is identified as a user option.
792 This means that M-x set-variable recognizes it.
793 See also `user-variable-p'.
794 If INITVALUE is missing, SYMBOL's value is not set.
796 If SYMBOL has a local binding, then this form affects the local
797 binding. This is usually not what you want. Thus, if you need to
798 load a file defining variables, with this form or with `defconst' or
799 `defcustom', you should always load that file _outside_ any bindings
800 for these variables. \(`defconst' and `defcustom' behave similarly in
802 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
806 register Lisp_Object sym
, tem
, tail
;
809 if (SYMBOL_CONSTANT_P (sym
))
811 /* For updward compatibility, allow (defvar :foo (quote :foo)). */
812 tem
= Fcar (Fcdr (args
));
814 && EQ (XCAR (tem
), Qquote
)
815 && CONSP (XCDR (tem
))
816 && EQ (XCAR (XCDR (tem
)), sym
)))
817 error ("Constant symbol `%s' specified in defvar",
818 SDATA (SYMBOL_NAME (sym
)));
822 if (!NILP (Fcdr (Fcdr (tail
))))
823 error ("Too many arguments");
825 tem
= Fdefault_boundp (sym
);
829 Fset_default (sym
, Feval (Fcar (tail
)));
831 { /* Check if there is really a global binding rather than just a let
832 binding that shadows the global unboundness of the var. */
833 volatile struct specbinding
*pdl
= specpdl_ptr
;
834 while (--pdl
>= specpdl
)
836 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
837 && EQ (pdl
->old_value
, Qunbound
))
839 message_with_string ("Warning: defvar ignored because %s is let-bound",
840 SYMBOL_NAME (sym
), 1);
849 if (!NILP (Vpurify_flag
))
850 tem
= Fpurecopy (tem
);
851 Fput (sym
, Qvariable_documentation
, tem
);
853 LOADHIST_ATTACH (sym
);
856 /* Simple (defvar <var>) should not count as a definition at all.
857 It could get in the way of other definitions, and unloading this
858 package could try to make the variable unbound. */
864 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
865 doc
: /* Define SYMBOL as a constant variable.
866 The intent is that neither programs nor users should ever change this value.
867 Always sets the value of SYMBOL to the result of evalling INITVALUE.
868 If SYMBOL is buffer-local, its default value is what is set;
869 buffer-local values are not affected.
870 DOCSTRING is optional.
872 If SYMBOL has a local binding, then this form sets the local binding's
873 value. However, you should normally not make local bindings for
874 variables defined with this form.
875 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
879 register Lisp_Object sym
, tem
;
882 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
883 error ("Too many arguments");
885 tem
= Feval (Fcar (Fcdr (args
)));
886 if (!NILP (Vpurify_flag
))
887 tem
= Fpurecopy (tem
);
888 Fset_default (sym
, tem
);
889 tem
= Fcar (Fcdr (Fcdr (args
)));
892 if (!NILP (Vpurify_flag
))
893 tem
= Fpurecopy (tem
);
894 Fput (sym
, Qvariable_documentation
, tem
);
896 LOADHIST_ATTACH (sym
);
900 /* Error handler used in Fuser_variable_p. */
902 user_variable_p_eh (ignore
)
908 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
909 doc
: /* Return t if VARIABLE is intended to be set and modified by users.
910 \(The alternative is a variable used internally in a Lisp program.)
911 A variable is a user variable if
912 \(1) the first character of its documentation is `*', or
913 \(2) it is customizable (its property list contains a non-nil value
914 of `standard-value' or `custom-autoload'), or
915 \(3) it is an alias for another user variable.
916 Return nil if VARIABLE is an alias and there is a loop in the
917 chain of symbols. */)
919 Lisp_Object variable
;
921 Lisp_Object documentation
;
923 if (!SYMBOLP (variable
))
926 /* If indirect and there's an alias loop, don't check anything else. */
927 if (XSYMBOL (variable
)->indirect_variable
928 && NILP (internal_condition_case_1 (indirect_variable
, variable
,
929 Qt
, user_variable_p_eh
)))
934 documentation
= Fget (variable
, Qvariable_documentation
);
935 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
937 if (STRINGP (documentation
)
938 && ((unsigned char) SREF (documentation
, 0) == '*'))
940 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
941 if (CONSP (documentation
)
942 && STRINGP (XCAR (documentation
))
943 && INTEGERP (XCDR (documentation
))
944 && XINT (XCDR (documentation
)) < 0)
946 /* Customizable? See `custom-variable-p'. */
947 if ((!NILP (Fget (variable
, intern ("standard-value"))))
948 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
951 if (!XSYMBOL (variable
)->indirect_variable
)
954 /* An indirect variable? Let's follow the chain. */
955 variable
= XSYMBOL (variable
)->value
;
959 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
960 doc
: /* Bind variables according to VARLIST then eval BODY.
961 The value of the last form in BODY is returned.
962 Each element of VARLIST is a symbol (which is bound to nil)
963 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
964 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
965 usage: (let* VARLIST BODY...) */)
969 Lisp_Object varlist
, val
, elt
;
970 int count
= SPECPDL_INDEX ();
971 struct gcpro gcpro1
, gcpro2
, gcpro3
;
973 GCPRO3 (args
, elt
, varlist
);
975 varlist
= Fcar (args
);
976 while (!NILP (varlist
))
979 elt
= Fcar (varlist
);
981 specbind (elt
, Qnil
);
982 else if (! NILP (Fcdr (Fcdr (elt
))))
984 Fcons (build_string ("`let' bindings can have only one value-form"),
988 val
= Feval (Fcar (Fcdr (elt
)));
989 specbind (Fcar (elt
), val
);
991 varlist
= Fcdr (varlist
);
994 val
= Fprogn (Fcdr (args
));
995 return unbind_to (count
, val
);
998 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
999 doc
: /* Bind variables according to VARLIST then eval BODY.
1000 The value of the last form in BODY is returned.
1001 Each element of VARLIST is a symbol (which is bound to nil)
1002 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1003 All the VALUEFORMs are evalled before any symbols are bound.
1004 usage: (let VARLIST BODY...) */)
1008 Lisp_Object
*temps
, tem
;
1009 register Lisp_Object elt
, varlist
;
1010 int count
= SPECPDL_INDEX ();
1011 register int argnum
;
1012 struct gcpro gcpro1
, gcpro2
;
1014 varlist
= Fcar (args
);
1016 /* Make space to hold the values to give the bound variables */
1017 elt
= Flength (varlist
);
1018 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
1020 /* Compute the values and store them in `temps' */
1022 GCPRO2 (args
, *temps
);
1025 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
1028 elt
= Fcar (varlist
);
1030 temps
[argnum
++] = Qnil
;
1031 else if (! NILP (Fcdr (Fcdr (elt
))))
1033 Fcons (build_string ("`let' bindings can have only one value-form"),
1036 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
1037 gcpro2
.nvars
= argnum
;
1041 varlist
= Fcar (args
);
1042 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
1044 elt
= Fcar (varlist
);
1045 tem
= temps
[argnum
++];
1047 specbind (elt
, tem
);
1049 specbind (Fcar (elt
), tem
);
1052 elt
= Fprogn (Fcdr (args
));
1053 return unbind_to (count
, elt
);
1056 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
1057 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
1058 The order of execution is thus TEST, BODY, TEST, BODY and so on
1059 until TEST returns nil.
1060 usage: (while TEST BODY...) */)
1064 Lisp_Object test
, body
;
1065 struct gcpro gcpro1
, gcpro2
;
1067 GCPRO2 (test
, body
);
1071 while (!NILP (Feval (test
)))
1081 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1082 doc
: /* Return result of expanding macros at top level of FORM.
1083 If FORM is not a macro call, it is returned unchanged.
1084 Otherwise, the macro is expanded and the expansion is considered
1085 in place of FORM. When a non-macro-call results, it is returned.
1087 The second optional arg ENVIRONMENT specifies an environment of macro
1088 definitions to shadow the loaded ones for use in file byte-compilation. */)
1091 Lisp_Object environment
;
1093 /* With cleanups from Hallvard Furuseth. */
1094 register Lisp_Object expander
, sym
, def
, tem
;
1098 /* Come back here each time we expand a macro call,
1099 in case it expands into another macro call. */
1102 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1103 def
= sym
= XCAR (form
);
1105 /* Trace symbols aliases to other symbols
1106 until we get a symbol that is not an alias. */
1107 while (SYMBOLP (def
))
1111 tem
= Fassq (sym
, environment
);
1114 def
= XSYMBOL (sym
)->function
;
1115 if (!EQ (def
, Qunbound
))
1120 /* Right now TEM is the result from SYM in ENVIRONMENT,
1121 and if TEM is nil then DEF is SYM's function definition. */
1124 /* SYM is not mentioned in ENVIRONMENT.
1125 Look at its function definition. */
1126 if (EQ (def
, Qunbound
) || !CONSP (def
))
1127 /* Not defined or definition not suitable */
1129 if (EQ (XCAR (def
), Qautoload
))
1131 /* Autoloading function: will it be a macro when loaded? */
1132 tem
= Fnth (make_number (4), def
);
1133 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1134 /* Yes, load it and try again. */
1136 struct gcpro gcpro1
;
1138 do_autoload (def
, sym
);
1145 else if (!EQ (XCAR (def
), Qmacro
))
1147 else expander
= XCDR (def
);
1151 expander
= XCDR (tem
);
1152 if (NILP (expander
))
1155 form
= apply1 (expander
, XCDR (form
));
1160 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1161 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1162 TAG is evalled to get the tag to use; it must not be nil.
1164 Then the BODY is executed.
1165 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1166 If no throw happens, `catch' returns the value of the last BODY form.
1167 If a throw happens, it specifies the value to return from `catch'.
1168 usage: (catch TAG BODY...) */)
1172 register Lisp_Object tag
;
1173 struct gcpro gcpro1
;
1176 tag
= Feval (Fcar (args
));
1178 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1181 /* Set up a catch, then call C function FUNC on argument ARG.
1182 FUNC should return a Lisp_Object.
1183 This is how catches are done from within C code. */
1186 internal_catch (tag
, func
, arg
)
1188 Lisp_Object (*func
) ();
1191 /* This structure is made part of the chain `catchlist'. */
1194 /* Fill in the components of c, and put it on the list. */
1198 c
.backlist
= backtrace_list
;
1199 c
.handlerlist
= handlerlist
;
1200 c
.lisp_eval_depth
= lisp_eval_depth
;
1201 c
.pdlcount
= SPECPDL_INDEX ();
1202 c
.poll_suppress_count
= poll_suppress_count
;
1203 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1204 c
.gcpro
= gcprolist
;
1205 c
.byte_stack
= byte_stack_list
;
1209 if (! _setjmp (c
.jmp
))
1210 c
.val
= (*func
) (arg
);
1212 /* Throw works by a longjmp that comes right here. */
1217 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1218 jump to that CATCH, returning VALUE as the value of that catch.
1220 This is the guts Fthrow and Fsignal; they differ only in the way
1221 they choose the catch tag to throw to. A catch tag for a
1222 condition-case form has a TAG of Qnil.
1224 Before each catch is discarded, unbind all special bindings and
1225 execute all unwind-protect clauses made above that catch. Unwind
1226 the handler stack as we go, so that the proper handlers are in
1227 effect for each unwind-protect clause we run. At the end, restore
1228 some static info saved in CATCH, and longjmp to the location
1231 This is used for correct unwinding in Fthrow and Fsignal. */
1234 unwind_to_catch (catch, value
)
1235 struct catchtag
*catch;
1238 register int last_time
;
1240 /* Save the value in the tag. */
1243 /* Restore certain special C variables. */
1244 set_poll_suppress_count (catch->poll_suppress_count
);
1245 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1246 handling_signal
= 0;
1251 last_time
= catchlist
== catch;
1253 /* Unwind the specpdl stack, and then restore the proper set of
1255 unbind_to (catchlist
->pdlcount
, Qnil
);
1256 handlerlist
= catchlist
->handlerlist
;
1257 catchlist
= catchlist
->next
;
1259 while (! last_time
);
1261 byte_stack_list
= catch->byte_stack
;
1262 gcprolist
= catch->gcpro
;
1265 gcpro_level
= gcprolist
->level
+ 1;
1269 backtrace_list
= catch->backlist
;
1270 lisp_eval_depth
= catch->lisp_eval_depth
;
1272 _longjmp (catch->jmp
, 1);
1275 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1276 doc
: /* Throw to the catch for TAG and return VALUE from it.
1277 Both TAG and VALUE are evalled. */)
1279 register Lisp_Object tag
, value
;
1281 register struct catchtag
*c
;
1286 for (c
= catchlist
; c
; c
= c
->next
)
1288 if (EQ (c
->tag
, tag
))
1289 unwind_to_catch (c
, value
);
1291 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1296 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1297 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1298 If BODYFORM completes normally, its value is returned
1299 after executing the UNWINDFORMS.
1300 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1301 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1306 int count
= SPECPDL_INDEX ();
1308 record_unwind_protect (Fprogn
, Fcdr (args
));
1309 val
= Feval (Fcar (args
));
1310 return unbind_to (count
, val
);
1313 /* Chain of condition handlers currently in effect.
1314 The elements of this chain are contained in the stack frames
1315 of Fcondition_case and internal_condition_case.
1316 When an error is signaled (by calling Fsignal, below),
1317 this chain is searched for an element that applies. */
1319 struct handler
*handlerlist
;
1321 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1322 doc
: /* Regain control when an error is signaled.
1323 Executes BODYFORM and returns its value if no error happens.
1324 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1325 where the BODY is made of Lisp expressions.
1327 A handler is applicable to an error
1328 if CONDITION-NAME is one of the error's condition names.
1329 If an error happens, the first applicable handler is run.
1331 The car of a handler may be a list of condition names
1332 instead of a single condition name.
1334 When a handler handles an error,
1335 control returns to the condition-case and the handler BODY... is executed
1336 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1337 VAR may be nil; then you do not get access to the signal information.
1339 The value of the last BODY form is returned from the condition-case.
1340 See also the function `signal' for more info.
1341 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1348 register Lisp_Object bodyform
, handlers
;
1349 volatile Lisp_Object var
;
1352 bodyform
= Fcar (Fcdr (args
));
1353 handlers
= Fcdr (Fcdr (args
));
1356 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1362 && (SYMBOLP (XCAR (tem
))
1363 || CONSP (XCAR (tem
))))))
1364 error ("Invalid condition handler", tem
);
1369 c
.backlist
= backtrace_list
;
1370 c
.handlerlist
= handlerlist
;
1371 c
.lisp_eval_depth
= lisp_eval_depth
;
1372 c
.pdlcount
= SPECPDL_INDEX ();
1373 c
.poll_suppress_count
= poll_suppress_count
;
1374 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1375 c
.gcpro
= gcprolist
;
1376 c
.byte_stack
= byte_stack_list
;
1377 if (_setjmp (c
.jmp
))
1380 specbind (h
.var
, c
.val
);
1381 val
= Fprogn (Fcdr (h
.chosen_clause
));
1383 /* Note that this just undoes the binding of h.var; whoever
1384 longjumped to us unwound the stack to c.pdlcount before
1386 unbind_to (c
.pdlcount
, Qnil
);
1393 h
.handler
= handlers
;
1394 h
.next
= handlerlist
;
1398 val
= Feval (bodyform
);
1400 handlerlist
= h
.next
;
1404 /* Call the function BFUN with no arguments, catching errors within it
1405 according to HANDLERS. If there is an error, call HFUN with
1406 one argument which is the data that describes the error:
1409 HANDLERS can be a list of conditions to catch.
1410 If HANDLERS is Qt, catch all errors.
1411 If HANDLERS is Qerror, catch all errors
1412 but allow the debugger to run if that is enabled. */
1415 internal_condition_case (bfun
, handlers
, hfun
)
1416 Lisp_Object (*bfun
) ();
1417 Lisp_Object handlers
;
1418 Lisp_Object (*hfun
) ();
1424 #if 0 /* We now handle interrupt_input_blocked properly.
1425 What we still do not handle is exiting a signal handler. */
1431 c
.backlist
= backtrace_list
;
1432 c
.handlerlist
= handlerlist
;
1433 c
.lisp_eval_depth
= lisp_eval_depth
;
1434 c
.pdlcount
= SPECPDL_INDEX ();
1435 c
.poll_suppress_count
= poll_suppress_count
;
1436 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1437 c
.gcpro
= gcprolist
;
1438 c
.byte_stack
= byte_stack_list
;
1439 if (_setjmp (c
.jmp
))
1441 return (*hfun
) (c
.val
);
1445 h
.handler
= handlers
;
1447 h
.next
= handlerlist
;
1453 handlerlist
= h
.next
;
1457 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1460 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1461 Lisp_Object (*bfun
) ();
1463 Lisp_Object handlers
;
1464 Lisp_Object (*hfun
) ();
1472 c
.backlist
= backtrace_list
;
1473 c
.handlerlist
= handlerlist
;
1474 c
.lisp_eval_depth
= lisp_eval_depth
;
1475 c
.pdlcount
= SPECPDL_INDEX ();
1476 c
.poll_suppress_count
= poll_suppress_count
;
1477 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1478 c
.gcpro
= gcprolist
;
1479 c
.byte_stack
= byte_stack_list
;
1480 if (_setjmp (c
.jmp
))
1482 return (*hfun
) (c
.val
);
1486 h
.handler
= handlers
;
1488 h
.next
= handlerlist
;
1492 val
= (*bfun
) (arg
);
1494 handlerlist
= h
.next
;
1499 /* Like internal_condition_case but call BFUN with NARGS as first,
1500 and ARGS as second argument. */
1503 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1504 Lisp_Object (*bfun
) ();
1507 Lisp_Object handlers
;
1508 Lisp_Object (*hfun
) ();
1516 c
.backlist
= backtrace_list
;
1517 c
.handlerlist
= handlerlist
;
1518 c
.lisp_eval_depth
= lisp_eval_depth
;
1519 c
.pdlcount
= SPECPDL_INDEX ();
1520 c
.poll_suppress_count
= poll_suppress_count
;
1521 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1522 c
.gcpro
= gcprolist
;
1523 c
.byte_stack
= byte_stack_list
;
1524 if (_setjmp (c
.jmp
))
1526 return (*hfun
) (c
.val
);
1530 h
.handler
= handlers
;
1532 h
.next
= handlerlist
;
1536 val
= (*bfun
) (nargs
, args
);
1538 handlerlist
= h
.next
;
1543 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1544 Lisp_Object
, Lisp_Object
,
1547 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1548 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1549 This function does not return.
1551 An error symbol is a symbol with an `error-conditions' property
1552 that is a list of condition names.
1553 A handler for any of those names will get to handle this signal.
1554 The symbol `error' should normally be one of them.
1556 DATA should be a list. Its elements are printed as part of the error message.
1557 See Info anchor `(elisp)Definition of signal' for some details on how this
1558 error message is constructed.
1559 If the signal is handled, DATA is made available to the handler.
1560 See also the function `condition-case'. */)
1561 (error_symbol
, data
)
1562 Lisp_Object error_symbol
, data
;
1564 /* When memory is full, ERROR-SYMBOL is nil,
1565 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1566 That is a special case--don't do this in other situations. */
1567 register struct handler
*allhandlers
= handlerlist
;
1568 Lisp_Object conditions
;
1569 extern int gc_in_progress
;
1570 extern int waiting_for_input
;
1571 Lisp_Object debugger_value
;
1573 Lisp_Object real_error_symbol
;
1574 struct backtrace
*bp
;
1576 immediate_quit
= handling_signal
= 0;
1578 if (gc_in_progress
|| waiting_for_input
)
1581 if (NILP (error_symbol
))
1582 real_error_symbol
= Fcar (data
);
1584 real_error_symbol
= error_symbol
;
1586 #if 0 /* rms: I don't know why this was here,
1587 but it is surely wrong for an error that is handled. */
1588 #ifdef HAVE_X_WINDOWS
1589 if (display_hourglass_p
)
1590 cancel_hourglass ();
1594 /* This hook is used by edebug. */
1595 if (! NILP (Vsignal_hook_function
)
1596 && ! NILP (error_symbol
))
1598 /* Edebug takes care of restoring these variables when it exits. */
1599 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1600 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1602 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1603 max_specpdl_size
= SPECPDL_INDEX () + 40;
1605 call2 (Vsignal_hook_function
, error_symbol
, data
);
1608 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1610 /* Remember from where signal was called. Skip over the frame for
1611 `signal' itself. If a frame for `error' follows, skip that,
1612 too. Don't do this when ERROR_SYMBOL is nil, because that
1613 is a memory-full error. */
1614 Vsignaling_function
= Qnil
;
1615 if (backtrace_list
&& !NILP (error_symbol
))
1617 bp
= backtrace_list
->next
;
1618 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1620 if (bp
&& bp
->function
)
1621 Vsignaling_function
= *bp
->function
;
1624 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1626 register Lisp_Object clause
;
1628 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1629 error_symbol
, data
, &debugger_value
);
1631 if (EQ (clause
, Qlambda
))
1633 /* We can't return values to code which signaled an error, but we
1634 can continue code which has signaled a quit. */
1635 if (EQ (real_error_symbol
, Qquit
))
1638 error ("Cannot return from the debugger in an error");
1643 Lisp_Object unwind_data
;
1644 struct handler
*h
= handlerlist
;
1646 handlerlist
= allhandlers
;
1648 if (NILP (error_symbol
))
1651 unwind_data
= Fcons (error_symbol
, data
);
1652 h
->chosen_clause
= clause
;
1653 unwind_to_catch (h
->tag
, unwind_data
);
1657 handlerlist
= allhandlers
;
1658 /* If no handler is present now, try to run the debugger,
1659 and if that fails, throw to top level. */
1660 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1662 Fthrow (Qtop_level
, Qt
);
1664 if (! NILP (error_symbol
))
1665 data
= Fcons (error_symbol
, data
);
1667 string
= Ferror_message_string (data
);
1668 fatal ("%s", SDATA (string
), 0);
1671 /* Return nonzero iff LIST is a non-nil atom or
1672 a list containing one of CONDITIONS. */
1675 wants_debugger (list
, conditions
)
1676 Lisp_Object list
, conditions
;
1683 while (CONSP (conditions
))
1685 Lisp_Object
this, tail
;
1686 this = XCAR (conditions
);
1687 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1688 if (EQ (XCAR (tail
), this))
1690 conditions
= XCDR (conditions
);
1695 /* Return 1 if an error with condition-symbols CONDITIONS,
1696 and described by SIGNAL-DATA, should skip the debugger
1697 according to debugger-ignored-errors. */
1700 skip_debugger (conditions
, data
)
1701 Lisp_Object conditions
, data
;
1704 int first_string
= 1;
1705 Lisp_Object error_message
;
1707 error_message
= Qnil
;
1708 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1710 if (STRINGP (XCAR (tail
)))
1714 error_message
= Ferror_message_string (data
);
1718 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1723 Lisp_Object contail
;
1725 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1726 if (EQ (XCAR (tail
), XCAR (contail
)))
1734 /* Value of Qlambda means we have called debugger and user has continued.
1735 There are two ways to pass SIG and DATA:
1736 = SIG is the error symbol, and DATA is the rest of the data.
1737 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1738 This is for memory-full errors only.
1740 Store value returned from debugger into *DEBUGGER_VALUE_PTR.
1742 We need to increase max_specpdl_size temporarily around
1743 anything we do that can push on the specpdl, so as not to get
1744 a second error here in case we're handling specpdl overflow. */
1747 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1748 Lisp_Object handlers
, conditions
, sig
, data
;
1749 Lisp_Object
*debugger_value_ptr
;
1751 register Lisp_Object h
;
1752 register Lisp_Object tem
;
1754 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1756 /* error is used similarly, but means print an error message
1757 and run the debugger if that is enabled. */
1758 if (EQ (handlers
, Qerror
)
1759 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1760 there is a handler. */
1762 int debugger_called
= 0;
1763 Lisp_Object sig_symbol
, combined_data
;
1764 /* This is set to 1 if we are handling a memory-full error,
1765 because these must not run the debugger.
1766 (There is no room in memory to do that!) */
1767 int no_debugger
= 0;
1771 combined_data
= data
;
1772 sig_symbol
= Fcar (data
);
1777 combined_data
= Fcons (sig
, data
);
1781 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1785 internal_with_output_to_temp_buffer ("*Backtrace*",
1786 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1789 internal_with_output_to_temp_buffer ("*Backtrace*",
1795 && (EQ (sig_symbol
, Qquit
)
1797 : wants_debugger (Vdebug_on_error
, conditions
))
1798 && ! skip_debugger (conditions
, combined_data
)
1799 && when_entered_debugger
< num_nonmacro_input_events
)
1802 = call_debugger (Fcons (Qerror
,
1803 Fcons (combined_data
, Qnil
)));
1804 debugger_called
= 1;
1806 /* If there is no handler, return saying whether we ran the debugger. */
1807 if (EQ (handlers
, Qerror
))
1809 if (debugger_called
)
1814 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1816 Lisp_Object handler
, condit
;
1819 if (!CONSP (handler
))
1821 condit
= Fcar (handler
);
1822 /* Handle a single condition name in handler HANDLER. */
1823 if (SYMBOLP (condit
))
1825 tem
= Fmemq (Fcar (handler
), conditions
);
1829 /* Handle a list of condition names in handler HANDLER. */
1830 else if (CONSP (condit
))
1832 while (CONSP (condit
))
1834 tem
= Fmemq (Fcar (condit
), conditions
);
1837 condit
= XCDR (condit
);
1844 /* dump an error message; called like printf */
1848 error (m
, a1
, a2
, a3
)
1868 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1873 buffer
= (char *) xrealloc (buffer
, size
);
1876 buffer
= (char *) xmalloc (size
);
1881 string
= build_string (buffer
);
1885 Fsignal (Qerror
, Fcons (string
, Qnil
));
1889 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1890 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1891 This means it contains a description for how to read arguments to give it.
1892 The value is nil for an invalid function or a symbol with no function
1895 Interactively callable functions include strings and vectors (treated
1896 as keyboard macros), lambda-expressions that contain a top-level call
1897 to `interactive', autoload definitions made by `autoload' with non-nil
1898 fourth argument, and some of the built-in functions of Lisp.
1900 Also, a symbol satisfies `commandp' if its function definition does so.
1902 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1903 then strings and vectors are not accepted. */)
1904 (function
, for_call_interactively
)
1905 Lisp_Object function
, for_call_interactively
;
1907 register Lisp_Object fun
;
1908 register Lisp_Object funcar
;
1912 fun
= indirect_function (fun
);
1913 if (EQ (fun
, Qunbound
))
1916 /* Emacs primitives are interactive if their DEFUN specifies an
1917 interactive spec. */
1920 if (XSUBR (fun
)->prompt
)
1926 /* Bytecode objects are interactive if they are long enough to
1927 have an element whose index is COMPILED_INTERACTIVE, which is
1928 where the interactive spec is stored. */
1929 else if (COMPILEDP (fun
))
1930 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1933 /* Strings and vectors are keyboard macros. */
1934 if (NILP (for_call_interactively
) && (STRINGP (fun
) || VECTORP (fun
)))
1937 /* Lists may represent commands. */
1940 funcar
= XCAR (fun
);
1941 if (EQ (funcar
, Qlambda
))
1942 return Fassq (Qinteractive
, Fcdr (XCDR (fun
)));
1943 if (EQ (funcar
, Qautoload
))
1944 return Fcar (Fcdr (Fcdr (XCDR (fun
))));
1950 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1951 doc
: /* Define FUNCTION to autoload from FILE.
1952 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1953 Third arg DOCSTRING is documentation for the function.
1954 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1955 Fifth arg TYPE indicates the type of the object:
1956 nil or omitted says FUNCTION is a function,
1957 `keymap' says FUNCTION is really a keymap, and
1958 `macro' or t says FUNCTION is really a macro.
1959 Third through fifth args give info about the real definition.
1960 They default to nil.
1961 If FUNCTION is already defined other than as an autoload,
1962 this does nothing and returns nil. */)
1963 (function
, file
, docstring
, interactive
, type
)
1964 Lisp_Object function
, file
, docstring
, interactive
, type
;
1967 Lisp_Object args
[4];
1970 CHECK_SYMBOL (function
);
1971 CHECK_STRING (file
);
1973 /* If function is defined and not as an autoload, don't override */
1974 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1975 && !(CONSP (XSYMBOL (function
)->function
)
1976 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1979 if (NILP (Vpurify_flag
))
1980 /* Only add entries after dumping, because the ones before are
1981 not useful and else we get loads of them from the loaddefs.el. */
1982 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1986 args
[1] = docstring
;
1987 args
[2] = interactive
;
1990 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1991 #else /* NO_ARG_ARRAY */
1992 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1993 #endif /* not NO_ARG_ARRAY */
1997 un_autoload (oldqueue
)
1998 Lisp_Object oldqueue
;
2000 register Lisp_Object queue
, first
, second
;
2002 /* Queue to unwind is current value of Vautoload_queue.
2003 oldqueue is the shadowed value to leave in Vautoload_queue. */
2004 queue
= Vautoload_queue
;
2005 Vautoload_queue
= oldqueue
;
2006 while (CONSP (queue
))
2008 first
= XCAR (queue
);
2009 second
= Fcdr (first
);
2010 first
= Fcar (first
);
2011 if (EQ (second
, Qnil
))
2014 Ffset (first
, second
);
2015 queue
= XCDR (queue
);
2020 /* Load an autoloaded function.
2021 FUNNAME is the symbol which is the function's name.
2022 FUNDEF is the autoload definition (a list). */
2025 do_autoload (fundef
, funname
)
2026 Lisp_Object fundef
, funname
;
2028 int count
= SPECPDL_INDEX ();
2029 Lisp_Object fun
, queue
, first
, second
;
2030 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2032 /* This is to make sure that loadup.el gives a clear picture
2033 of what files are preloaded and when. */
2034 if (! NILP (Vpurify_flag
))
2035 error ("Attempt to autoload %s while preparing to dump",
2036 SDATA (SYMBOL_NAME (funname
)));
2039 CHECK_SYMBOL (funname
);
2040 GCPRO3 (fun
, funname
, fundef
);
2042 /* Preserve the match data. */
2043 record_unwind_save_match_data ();
2045 /* Value saved here is to be restored into Vautoload_queue. */
2046 record_unwind_protect (un_autoload
, Vautoload_queue
);
2047 Vautoload_queue
= Qt
;
2048 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
2050 /* Save the old autoloads, in case we ever do an unload. */
2051 queue
= Vautoload_queue
;
2052 while (CONSP (queue
))
2054 first
= XCAR (queue
);
2055 second
= Fcdr (first
);
2056 first
= Fcar (first
);
2058 if (CONSP (second
) && EQ (XCAR (second
), Qautoload
))
2059 Fput (first
, Qautoload
, (XCDR (second
)));
2061 queue
= XCDR (queue
);
2064 /* Once loading finishes, don't undo it. */
2065 Vautoload_queue
= Qt
;
2066 unbind_to (count
, Qnil
);
2068 fun
= Findirect_function (fun
);
2070 if (!NILP (Fequal (fun
, fundef
)))
2071 error ("Autoloading failed to define function %s",
2072 SDATA (SYMBOL_NAME (funname
)));
2077 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
2078 doc
: /* Evaluate FORM and return its value. */)
2082 Lisp_Object fun
, val
, original_fun
, original_args
;
2084 struct backtrace backtrace
;
2085 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2087 if (handling_signal
)
2091 return Fsymbol_value (form
);
2096 if (consing_since_gc
> gc_cons_combined_threshold
)
2099 Fgarbage_collect ();
2103 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2105 if (max_lisp_eval_depth
< 100)
2106 max_lisp_eval_depth
= 100;
2107 if (lisp_eval_depth
> max_lisp_eval_depth
)
2108 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2111 original_fun
= Fcar (form
);
2112 original_args
= Fcdr (form
);
2114 backtrace
.next
= backtrace_list
;
2115 backtrace_list
= &backtrace
;
2116 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2117 backtrace
.args
= &original_args
;
2118 backtrace
.nargs
= UNEVALLED
;
2119 backtrace
.evalargs
= 1;
2120 backtrace
.debug_on_exit
= 0;
2122 if (debug_on_next_call
)
2123 do_debug_on_call (Qt
);
2125 /* At this point, only original_fun and original_args
2126 have values that will be used below */
2128 fun
= Findirect_function (original_fun
);
2132 Lisp_Object numargs
;
2133 Lisp_Object argvals
[8];
2134 Lisp_Object args_left
;
2135 register int i
, maxargs
;
2137 args_left
= original_args
;
2138 numargs
= Flength (args_left
);
2142 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2143 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2144 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2146 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2148 backtrace
.evalargs
= 0;
2149 val
= (*XSUBR (fun
)->function
) (args_left
);
2153 if (XSUBR (fun
)->max_args
== MANY
)
2155 /* Pass a vector of evaluated arguments */
2157 register int argnum
= 0;
2159 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2161 GCPRO3 (args_left
, fun
, fun
);
2165 while (!NILP (args_left
))
2167 vals
[argnum
++] = Feval (Fcar (args_left
));
2168 args_left
= Fcdr (args_left
);
2169 gcpro3
.nvars
= argnum
;
2172 backtrace
.args
= vals
;
2173 backtrace
.nargs
= XINT (numargs
);
2175 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2180 GCPRO3 (args_left
, fun
, fun
);
2181 gcpro3
.var
= argvals
;
2184 maxargs
= XSUBR (fun
)->max_args
;
2185 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2187 argvals
[i
] = Feval (Fcar (args_left
));
2193 backtrace
.args
= argvals
;
2194 backtrace
.nargs
= XINT (numargs
);
2199 val
= (*XSUBR (fun
)->function
) ();
2202 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2205 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2208 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2212 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2213 argvals
[2], argvals
[3]);
2216 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2217 argvals
[3], argvals
[4]);
2220 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2221 argvals
[3], argvals
[4], argvals
[5]);
2224 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2225 argvals
[3], argvals
[4], argvals
[5],
2230 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2231 argvals
[3], argvals
[4], argvals
[5],
2232 argvals
[6], argvals
[7]);
2236 /* Someone has created a subr that takes more arguments than
2237 is supported by this code. We need to either rewrite the
2238 subr to use a different argument protocol, or add more
2239 cases to this switch. */
2243 if (COMPILEDP (fun
))
2244 val
= apply_lambda (fun
, original_args
, 1);
2248 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2249 funcar
= Fcar (fun
);
2250 if (!SYMBOLP (funcar
))
2251 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2252 if (EQ (funcar
, Qautoload
))
2254 do_autoload (fun
, original_fun
);
2257 if (EQ (funcar
, Qmacro
))
2258 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2259 else if (EQ (funcar
, Qlambda
))
2260 val
= apply_lambda (fun
, original_args
, 1);
2262 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2268 if (backtrace
.debug_on_exit
)
2269 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2270 backtrace_list
= backtrace
.next
;
2275 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2276 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2277 Then return the value FUNCTION returns.
2278 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2279 usage: (apply FUNCTION &rest ARGUMENTS) */)
2284 register int i
, numargs
;
2285 register Lisp_Object spread_arg
;
2286 register Lisp_Object
*funcall_args
;
2288 struct gcpro gcpro1
;
2292 spread_arg
= args
[nargs
- 1];
2293 CHECK_LIST (spread_arg
);
2295 numargs
= XINT (Flength (spread_arg
));
2298 return Ffuncall (nargs
- 1, args
);
2299 else if (numargs
== 1)
2301 args
[nargs
- 1] = XCAR (spread_arg
);
2302 return Ffuncall (nargs
, args
);
2305 numargs
+= nargs
- 2;
2307 fun
= indirect_function (fun
);
2308 if (EQ (fun
, Qunbound
))
2310 /* Let funcall get the error */
2317 if (numargs
< XSUBR (fun
)->min_args
2318 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2319 goto funcall
; /* Let funcall get the error */
2320 else if (XSUBR (fun
)->max_args
> numargs
)
2322 /* Avoid making funcall cons up a yet another new vector of arguments
2323 by explicitly supplying nil's for optional values */
2324 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2325 * sizeof (Lisp_Object
));
2326 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2327 funcall_args
[++i
] = Qnil
;
2328 GCPRO1 (*funcall_args
);
2329 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2333 /* We add 1 to numargs because funcall_args includes the
2334 function itself as well as its arguments. */
2337 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2338 * sizeof (Lisp_Object
));
2339 GCPRO1 (*funcall_args
);
2340 gcpro1
.nvars
= 1 + numargs
;
2343 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2344 /* Spread the last arg we got. Its first element goes in
2345 the slot that it used to occupy, hence this value of I. */
2347 while (!NILP (spread_arg
))
2349 funcall_args
[i
++] = XCAR (spread_arg
);
2350 spread_arg
= XCDR (spread_arg
);
2353 /* By convention, the caller needs to gcpro Ffuncall's args. */
2354 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2357 /* Run hook variables in various ways. */
2359 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2360 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2361 enum run_hooks_condition
));
2363 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2364 doc
: /* Run each hook in HOOKS.
2365 Each argument should be a symbol, a hook variable.
2366 These symbols are processed in the order specified.
2367 If a hook symbol has a non-nil value, that value may be a function
2368 or a list of functions to be called to run the hook.
2369 If the value is a function, it is called with no arguments.
2370 If it is a list, the elements are called, in order, with no arguments.
2372 Major modes should not use this function directly to run their mode
2373 hook; they should use `run-mode-hooks' instead.
2375 Do not use `make-local-variable' to make a hook variable buffer-local.
2376 Instead, use `add-hook' and specify t for the LOCAL argument.
2377 usage: (run-hooks &rest HOOKS) */)
2382 Lisp_Object hook
[1];
2385 for (i
= 0; i
< nargs
; i
++)
2388 run_hook_with_args (1, hook
, to_completion
);
2394 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2395 Srun_hook_with_args
, 1, MANY
, 0,
2396 doc
: /* Run HOOK with the specified arguments ARGS.
2397 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2398 value, that value may be a function or a list of functions to be
2399 called to run the hook. If the value is a function, it is called with
2400 the given arguments and its return value is returned. If it is a list
2401 of functions, those functions are called, in order,
2402 with the given arguments ARGS.
2403 It is best not to depend on the value returned by `run-hook-with-args',
2406 Do not use `make-local-variable' to make a hook variable buffer-local.
2407 Instead, use `add-hook' and specify t for the LOCAL argument.
2408 usage: (run-hook-with-args HOOK &rest ARGS) */)
2413 return run_hook_with_args (nargs
, args
, to_completion
);
2416 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2417 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2418 doc
: /* Run HOOK with the specified arguments ARGS.
2419 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2420 value, that value may be a function or a list of functions to be
2421 called to run the hook. If the value is a function, it is called with
2422 the given arguments and its return value is returned.
2423 If it is a list of functions, those functions are called, in order,
2424 with the given arguments ARGS, until one of them
2425 returns a non-nil value. Then we return that value.
2426 However, if they all return nil, we return nil.
2428 Do not use `make-local-variable' to make a hook variable buffer-local.
2429 Instead, use `add-hook' and specify t for the LOCAL argument.
2430 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2435 return run_hook_with_args (nargs
, args
, until_success
);
2438 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2439 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2440 doc
: /* Run HOOK with the specified arguments ARGS.
2441 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2442 value, that value may be a function or a list of functions to be
2443 called to run the hook. If the value is a function, it is called with
2444 the given arguments and its return value is returned.
2445 If it is a list of functions, those functions are called, in order,
2446 with the given arguments ARGS, until one of them returns nil.
2447 Then we return nil. However, if they all return non-nil, we return non-nil.
2449 Do not use `make-local-variable' to make a hook variable buffer-local.
2450 Instead, use `add-hook' and specify t for the LOCAL argument.
2451 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2456 return run_hook_with_args (nargs
, args
, until_failure
);
2459 /* ARGS[0] should be a hook symbol.
2460 Call each of the functions in the hook value, passing each of them
2461 as arguments all the rest of ARGS (all NARGS - 1 elements).
2462 COND specifies a condition to test after each call
2463 to decide whether to stop.
2464 The caller (or its caller, etc) must gcpro all of ARGS,
2465 except that it isn't necessary to gcpro ARGS[0]. */
2468 run_hook_with_args (nargs
, args
, cond
)
2471 enum run_hooks_condition cond
;
2473 Lisp_Object sym
, val
, ret
;
2474 Lisp_Object globals
;
2475 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2477 /* If we are dying or still initializing,
2478 don't do anything--it would probably crash if we tried. */
2479 if (NILP (Vrun_hooks
))
2483 val
= find_symbol_value (sym
);
2484 ret
= (cond
== until_failure
? Qt
: Qnil
);
2486 if (EQ (val
, Qunbound
) || NILP (val
))
2488 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2491 return Ffuncall (nargs
, args
);
2496 GCPRO3 (sym
, val
, globals
);
2499 CONSP (val
) && ((cond
== to_completion
)
2500 || (cond
== until_success
? NILP (ret
)
2504 if (EQ (XCAR (val
), Qt
))
2506 /* t indicates this hook has a local binding;
2507 it means to run the global binding too. */
2509 for (globals
= Fdefault_value (sym
);
2510 CONSP (globals
) && ((cond
== to_completion
)
2511 || (cond
== until_success
? NILP (ret
)
2513 globals
= XCDR (globals
))
2515 args
[0] = XCAR (globals
);
2516 /* In a global value, t should not occur. If it does, we
2517 must ignore it to avoid an endless loop. */
2518 if (!EQ (args
[0], Qt
))
2519 ret
= Ffuncall (nargs
, args
);
2524 args
[0] = XCAR (val
);
2525 ret
= Ffuncall (nargs
, args
);
2534 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2535 present value of that symbol.
2536 Call each element of FUNLIST,
2537 passing each of them the rest of ARGS.
2538 The caller (or its caller, etc) must gcpro all of ARGS,
2539 except that it isn't necessary to gcpro ARGS[0]. */
2542 run_hook_list_with_args (funlist
, nargs
, args
)
2543 Lisp_Object funlist
;
2549 Lisp_Object globals
;
2550 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2554 GCPRO3 (sym
, val
, globals
);
2556 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2558 if (EQ (XCAR (val
), Qt
))
2560 /* t indicates this hook has a local binding;
2561 it means to run the global binding too. */
2563 for (globals
= Fdefault_value (sym
);
2565 globals
= XCDR (globals
))
2567 args
[0] = XCAR (globals
);
2568 /* In a global value, t should not occur. If it does, we
2569 must ignore it to avoid an endless loop. */
2570 if (!EQ (args
[0], Qt
))
2571 Ffuncall (nargs
, args
);
2576 args
[0] = XCAR (val
);
2577 Ffuncall (nargs
, args
);
2584 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2587 run_hook_with_args_2 (hook
, arg1
, arg2
)
2588 Lisp_Object hook
, arg1
, arg2
;
2590 Lisp_Object temp
[3];
2595 Frun_hook_with_args (3, temp
);
2598 /* Apply fn to arg */
2601 Lisp_Object fn
, arg
;
2603 struct gcpro gcpro1
;
2607 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2611 Lisp_Object args
[2];
2615 RETURN_UNGCPRO (Fapply (2, args
));
2617 #else /* not NO_ARG_ARRAY */
2618 RETURN_UNGCPRO (Fapply (2, &fn
));
2619 #endif /* not NO_ARG_ARRAY */
2622 /* Call function fn on no arguments */
2627 struct gcpro gcpro1
;
2630 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2633 /* Call function fn with 1 argument arg1 */
2637 Lisp_Object fn
, arg1
;
2639 struct gcpro gcpro1
;
2641 Lisp_Object args
[2];
2647 RETURN_UNGCPRO (Ffuncall (2, args
));
2648 #else /* not NO_ARG_ARRAY */
2651 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2652 #endif /* not NO_ARG_ARRAY */
2655 /* Call function fn with 2 arguments arg1, arg2 */
2658 call2 (fn
, arg1
, arg2
)
2659 Lisp_Object fn
, arg1
, arg2
;
2661 struct gcpro gcpro1
;
2663 Lisp_Object args
[3];
2669 RETURN_UNGCPRO (Ffuncall (3, args
));
2670 #else /* not NO_ARG_ARRAY */
2673 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2674 #endif /* not NO_ARG_ARRAY */
2677 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2680 call3 (fn
, arg1
, arg2
, arg3
)
2681 Lisp_Object fn
, arg1
, arg2
, arg3
;
2683 struct gcpro gcpro1
;
2685 Lisp_Object args
[4];
2692 RETURN_UNGCPRO (Ffuncall (4, args
));
2693 #else /* not NO_ARG_ARRAY */
2696 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2697 #endif /* not NO_ARG_ARRAY */
2700 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2703 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2704 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2706 struct gcpro gcpro1
;
2708 Lisp_Object args
[5];
2716 RETURN_UNGCPRO (Ffuncall (5, args
));
2717 #else /* not NO_ARG_ARRAY */
2720 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2721 #endif /* not NO_ARG_ARRAY */
2724 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2727 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2728 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2730 struct gcpro gcpro1
;
2732 Lisp_Object args
[6];
2741 RETURN_UNGCPRO (Ffuncall (6, args
));
2742 #else /* not NO_ARG_ARRAY */
2745 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2746 #endif /* not NO_ARG_ARRAY */
2749 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2752 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2753 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2755 struct gcpro gcpro1
;
2757 Lisp_Object args
[7];
2767 RETURN_UNGCPRO (Ffuncall (7, args
));
2768 #else /* not NO_ARG_ARRAY */
2771 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2772 #endif /* not NO_ARG_ARRAY */
2775 /* The caller should GCPRO all the elements of ARGS. */
2777 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2778 doc
: /* Call first argument as a function, passing remaining arguments to it.
2779 Return the value that function returns.
2780 Thus, (funcall 'cons 'x 'y) returns (x . y).
2781 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2788 int numargs
= nargs
- 1;
2789 Lisp_Object lisp_numargs
;
2791 struct backtrace backtrace
;
2792 register Lisp_Object
*internal_args
;
2796 if (consing_since_gc
> gc_cons_combined_threshold
)
2797 Fgarbage_collect ();
2799 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2801 if (max_lisp_eval_depth
< 100)
2802 max_lisp_eval_depth
= 100;
2803 if (lisp_eval_depth
> max_lisp_eval_depth
)
2804 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2807 backtrace
.next
= backtrace_list
;
2808 backtrace_list
= &backtrace
;
2809 backtrace
.function
= &args
[0];
2810 backtrace
.args
= &args
[1];
2811 backtrace
.nargs
= nargs
- 1;
2812 backtrace
.evalargs
= 0;
2813 backtrace
.debug_on_exit
= 0;
2815 if (debug_on_next_call
)
2816 do_debug_on_call (Qlambda
);
2824 fun
= Findirect_function (fun
);
2828 if (numargs
< XSUBR (fun
)->min_args
2829 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2831 XSETFASTINT (lisp_numargs
, numargs
);
2832 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2835 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2836 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2838 if (XSUBR (fun
)->max_args
== MANY
)
2840 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2844 if (XSUBR (fun
)->max_args
> numargs
)
2846 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2847 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2848 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2849 internal_args
[i
] = Qnil
;
2852 internal_args
= args
+ 1;
2853 switch (XSUBR (fun
)->max_args
)
2856 val
= (*XSUBR (fun
)->function
) ();
2859 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2862 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1]);
2865 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2869 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2870 internal_args
[2], internal_args
[3]);
2873 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2874 internal_args
[2], internal_args
[3],
2878 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2879 internal_args
[2], internal_args
[3],
2880 internal_args
[4], internal_args
[5]);
2883 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2884 internal_args
[2], internal_args
[3],
2885 internal_args
[4], internal_args
[5],
2890 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2891 internal_args
[2], internal_args
[3],
2892 internal_args
[4], internal_args
[5],
2893 internal_args
[6], internal_args
[7]);
2898 /* If a subr takes more than 8 arguments without using MANY
2899 or UNEVALLED, we need to extend this function to support it.
2900 Until this is done, there is no way to call the function. */
2904 if (COMPILEDP (fun
))
2905 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2909 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2910 funcar
= Fcar (fun
);
2911 if (!SYMBOLP (funcar
))
2912 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2913 if (EQ (funcar
, Qlambda
))
2914 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2915 else if (EQ (funcar
, Qautoload
))
2917 do_autoload (fun
, args
[0]);
2922 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2927 if (backtrace
.debug_on_exit
)
2928 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2929 backtrace_list
= backtrace
.next
;
2934 apply_lambda (fun
, args
, eval_flag
)
2935 Lisp_Object fun
, args
;
2938 Lisp_Object args_left
;
2939 Lisp_Object numargs
;
2940 register Lisp_Object
*arg_vector
;
2941 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2943 register Lisp_Object tem
;
2945 numargs
= Flength (args
);
2946 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2949 GCPRO3 (*arg_vector
, args_left
, fun
);
2952 for (i
= 0; i
< XINT (numargs
);)
2954 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2955 if (eval_flag
) tem
= Feval (tem
);
2956 arg_vector
[i
++] = tem
;
2964 backtrace_list
->args
= arg_vector
;
2965 backtrace_list
->nargs
= i
;
2967 backtrace_list
->evalargs
= 0;
2968 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2970 /* Do the debug-on-exit now, while arg_vector still exists. */
2971 if (backtrace_list
->debug_on_exit
)
2972 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2973 /* Don't do it again when we return to eval. */
2974 backtrace_list
->debug_on_exit
= 0;
2978 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2979 and return the result of evaluation.
2980 FUN must be either a lambda-expression or a compiled-code object. */
2983 funcall_lambda (fun
, nargs
, arg_vector
)
2986 register Lisp_Object
*arg_vector
;
2988 Lisp_Object val
, syms_left
, next
;
2989 int count
= SPECPDL_INDEX ();
2990 int i
, optional
, rest
;
2994 syms_left
= XCDR (fun
);
2995 if (CONSP (syms_left
))
2996 syms_left
= XCAR (syms_left
);
2998 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
3000 else if (COMPILEDP (fun
))
3001 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
3005 i
= optional
= rest
= 0;
3006 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
3010 next
= XCAR (syms_left
);
3011 while (!SYMBOLP (next
))
3012 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
3014 if (EQ (next
, Qand_rest
))
3016 else if (EQ (next
, Qand_optional
))
3020 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
3024 specbind (next
, arg_vector
[i
++]);
3026 return Fsignal (Qwrong_number_of_arguments
,
3027 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
3029 specbind (next
, Qnil
);
3032 if (!NILP (syms_left
))
3033 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
3035 return Fsignal (Qwrong_number_of_arguments
,
3036 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
3039 val
= Fprogn (XCDR (XCDR (fun
)));
3042 /* If we have not actually read the bytecode string
3043 and constants vector yet, fetch them from the file. */
3044 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3045 Ffetch_bytecode (fun
);
3046 val
= Fbyte_code (AREF (fun
, COMPILED_BYTECODE
),
3047 AREF (fun
, COMPILED_CONSTANTS
),
3048 AREF (fun
, COMPILED_STACK_DEPTH
));
3051 return unbind_to (count
, val
);
3054 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3056 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3062 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3064 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3067 tem
= AREF (object
, COMPILED_BYTECODE
);
3068 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3069 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3071 error ("Invalid byte code");
3073 AREF (object
, COMPILED_BYTECODE
) = XCAR (tem
);
3074 AREF (object
, COMPILED_CONSTANTS
) = XCDR (tem
);
3082 register int count
= SPECPDL_INDEX ();
3083 if (specpdl_size
>= max_specpdl_size
)
3085 if (max_specpdl_size
< 400)
3086 max_specpdl_size
= 400;
3087 if (specpdl_size
>= max_specpdl_size
)
3089 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
3092 if (specpdl_size
> max_specpdl_size
)
3093 specpdl_size
= max_specpdl_size
;
3094 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3095 specpdl_ptr
= specpdl
+ count
;
3099 specbind (symbol
, value
)
3100 Lisp_Object symbol
, value
;
3103 Lisp_Object valcontents
;
3105 CHECK_SYMBOL (symbol
);
3106 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3109 /* The most common case is that of a non-constant symbol with a
3110 trivial value. Make that as fast as we can. */
3111 valcontents
= SYMBOL_VALUE (symbol
);
3112 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
3114 specpdl_ptr
->symbol
= symbol
;
3115 specpdl_ptr
->old_value
= valcontents
;
3116 specpdl_ptr
->func
= NULL
;
3118 SET_SYMBOL_VALUE (symbol
, value
);
3122 Lisp_Object valcontents
;
3124 ovalue
= find_symbol_value (symbol
);
3125 specpdl_ptr
->func
= 0;
3126 specpdl_ptr
->old_value
= ovalue
;
3128 valcontents
= XSYMBOL (symbol
)->value
;
3130 if (BUFFER_LOCAL_VALUEP (valcontents
)
3131 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
3132 || BUFFER_OBJFWDP (valcontents
))
3134 Lisp_Object where
, current_buffer
;
3136 current_buffer
= Fcurrent_buffer ();
3138 /* For a local variable, record both the symbol and which
3139 buffer's or frame's value we are saving. */
3140 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3141 where
= current_buffer
;
3142 else if (!BUFFER_OBJFWDP (valcontents
)
3143 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3144 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3148 /* We're not using the `unused' slot in the specbinding
3149 structure because this would mean we have to do more
3150 work for simple variables. */
3151 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3153 /* If SYMBOL is a per-buffer variable which doesn't have a
3154 buffer-local value here, make the `let' change the global
3155 value by changing the value of SYMBOL in all buffers not
3156 having their own value. This is consistent with what
3157 happens with other buffer-local variables. */
3159 && BUFFER_OBJFWDP (valcontents
))
3162 Fset_default (symbol
, value
);
3167 specpdl_ptr
->symbol
= symbol
;
3170 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3171 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3173 set_internal (symbol
, value
, 0, 1);
3178 record_unwind_protect (function
, arg
)
3179 Lisp_Object (*function
) P_ ((Lisp_Object
));
3182 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3184 specpdl_ptr
->func
= function
;
3185 specpdl_ptr
->symbol
= Qnil
;
3186 specpdl_ptr
->old_value
= arg
;
3191 unbind_to (count
, value
)
3195 Lisp_Object quitf
= Vquit_flag
;
3196 struct gcpro gcpro1
, gcpro2
;
3198 GCPRO2 (value
, quitf
);
3201 while (specpdl_ptr
!= specpdl
+ count
)
3203 /* Copy the binding, and decrement specpdl_ptr, before we do
3204 the work to unbind it. We decrement first
3205 so that an error in unbinding won't try to unbind
3206 the same entry again, and we copy the binding first
3207 in case more bindings are made during some of the code we run. */
3209 struct specbinding this_binding
;
3210 this_binding
= *--specpdl_ptr
;
3212 if (this_binding
.func
!= 0)
3213 (*this_binding
.func
) (this_binding
.old_value
);
3214 /* If the symbol is a list, it is really (SYMBOL WHERE
3215 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3216 frame. If WHERE is a buffer or frame, this indicates we
3217 bound a variable that had a buffer-local or frame-local
3218 binding. WHERE nil means that the variable had the default
3219 value when it was bound. CURRENT-BUFFER is the buffer that
3220 was current when the variable was bound. */
3221 else if (CONSP (this_binding
.symbol
))
3223 Lisp_Object symbol
, where
;
3225 symbol
= XCAR (this_binding
.symbol
);
3226 where
= XCAR (XCDR (this_binding
.symbol
));
3229 Fset_default (symbol
, this_binding
.old_value
);
3230 else if (BUFFERP (where
))
3231 set_internal (symbol
, this_binding
.old_value
, XBUFFER (where
), 1);
3233 set_internal (symbol
, this_binding
.old_value
, NULL
, 1);
3237 /* If variable has a trivial value (no forwarding), we can
3238 just set it. No need to check for constant symbols here,
3239 since that was already done by specbind. */
3240 if (!MISCP (SYMBOL_VALUE (this_binding
.symbol
)))
3241 SET_SYMBOL_VALUE (this_binding
.symbol
, this_binding
.old_value
);
3243 set_internal (this_binding
.symbol
, this_binding
.old_value
, 0, 1);
3247 if (NILP (Vquit_flag
) && !NILP (quitf
))
3254 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3255 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3256 The debugger is entered when that frame exits, if the flag is non-nil. */)
3258 Lisp_Object level
, flag
;
3260 register struct backtrace
*backlist
= backtrace_list
;
3263 CHECK_NUMBER (level
);
3265 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3267 backlist
= backlist
->next
;
3271 backlist
->debug_on_exit
= !NILP (flag
);
3276 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3277 doc
: /* Print a trace of Lisp function calls currently active.
3278 Output stream used is value of `standard-output'. */)
3281 register struct backtrace
*backlist
= backtrace_list
;
3285 extern Lisp_Object Vprint_level
;
3286 struct gcpro gcpro1
;
3288 XSETFASTINT (Vprint_level
, 3);
3295 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3296 if (backlist
->nargs
== UNEVALLED
)
3298 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3299 write_string ("\n", -1);
3303 tem
= *backlist
->function
;
3304 Fprin1 (tem
, Qnil
); /* This can QUIT */
3305 write_string ("(", -1);
3306 if (backlist
->nargs
== MANY
)
3308 for (tail
= *backlist
->args
, i
= 0;
3310 tail
= Fcdr (tail
), i
++)
3312 if (i
) write_string (" ", -1);
3313 Fprin1 (Fcar (tail
), Qnil
);
3318 for (i
= 0; i
< backlist
->nargs
; i
++)
3320 if (i
) write_string (" ", -1);
3321 Fprin1 (backlist
->args
[i
], Qnil
);
3324 write_string (")\n", -1);
3326 backlist
= backlist
->next
;
3329 Vprint_level
= Qnil
;
3334 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3335 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3336 If that frame has not evaluated the arguments yet (or is a special form),
3337 the value is (nil FUNCTION ARG-FORMS...).
3338 If that frame has evaluated its arguments and called its function already,
3339 the value is (t FUNCTION ARG-VALUES...).
3340 A &rest arg is represented as the tail of the list ARG-VALUES.
3341 FUNCTION is whatever was supplied as car of evaluated list,
3342 or a lambda expression for macro calls.
3343 If NFRAMES is more than the number of frames, the value is nil. */)
3345 Lisp_Object nframes
;
3347 register struct backtrace
*backlist
= backtrace_list
;
3351 CHECK_NATNUM (nframes
);
3353 /* Find the frame requested. */
3354 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3355 backlist
= backlist
->next
;
3359 if (backlist
->nargs
== UNEVALLED
)
3360 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3363 if (backlist
->nargs
== MANY
)
3364 tem
= *backlist
->args
;
3366 tem
= Flist (backlist
->nargs
, backlist
->args
);
3368 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3376 register struct backtrace
*backlist
;
3379 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3381 mark_object (*backlist
->function
);
3383 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
3386 i
= backlist
->nargs
- 1;
3388 mark_object (backlist
->args
[i
]);
3395 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3396 doc
: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3397 If Lisp code tries to increase the total number past this amount,
3398 an error is signaled.
3399 You can safely use a value considerably larger than the default value,
3400 if that proves inconveniently small. However, if you increase it too far,
3401 Emacs could run out of memory trying to make the stack bigger. */);
3403 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3404 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3406 This limit serves to catch infinite recursions for you before they cause
3407 actual stack overflow in C, which would be fatal for Emacs.
3408 You can safely make it considerably larger than its default value,
3409 if that proves inconveniently small. However, if you increase it too far,
3410 Emacs could overflow the real C stack, and crash. */);
3412 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3413 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3414 If the value is t, that means do an ordinary quit.
3415 If the value equals `throw-on-input', that means quit by throwing
3416 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3417 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3418 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3421 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3422 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3423 Note that `quit-flag' will still be set by typing C-g,
3424 so a quit will be signaled as soon as `inhibit-quit' is nil.
3425 To prevent this happening, set `quit-flag' to nil
3426 before making `inhibit-quit' nil. */);
3427 Vinhibit_quit
= Qnil
;
3429 Qinhibit_quit
= intern ("inhibit-quit");
3430 staticpro (&Qinhibit_quit
);
3432 Qautoload
= intern ("autoload");
3433 staticpro (&Qautoload
);
3435 Qdebug_on_error
= intern ("debug-on-error");
3436 staticpro (&Qdebug_on_error
);
3438 Qmacro
= intern ("macro");
3439 staticpro (&Qmacro
);
3441 Qdeclare
= intern ("declare");
3442 staticpro (&Qdeclare
);
3444 /* Note that the process handling also uses Qexit, but we don't want
3445 to staticpro it twice, so we just do it here. */
3446 Qexit
= intern ("exit");
3449 Qinteractive
= intern ("interactive");
3450 staticpro (&Qinteractive
);
3452 Qcommandp
= intern ("commandp");
3453 staticpro (&Qcommandp
);
3455 Qdefun
= intern ("defun");
3456 staticpro (&Qdefun
);
3458 Qand_rest
= intern ("&rest");
3459 staticpro (&Qand_rest
);
3461 Qand_optional
= intern ("&optional");
3462 staticpro (&Qand_optional
);
3464 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3465 doc
: /* *Non-nil means errors display a backtrace buffer.
3466 More precisely, this happens for any error that is handled
3467 by the editor command loop.
3468 If the value is a list, an error only means to display a backtrace
3469 if one of its condition symbols appears in the list. */);
3470 Vstack_trace_on_error
= Qnil
;
3472 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3473 doc
: /* *Non-nil means enter debugger if an error is signaled.
3474 Does not apply to errors handled by `condition-case' or those
3475 matched by `debug-ignored-errors'.
3476 If the value is a list, an error only means to enter the debugger
3477 if one of its condition symbols appears in the list.
3478 When you evaluate an expression interactively, this variable
3479 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3480 See also variable `debug-on-quit'. */);
3481 Vdebug_on_error
= Qnil
;
3483 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3484 doc
: /* *List of errors for which the debugger should not be called.
3485 Each element may be a condition-name or a regexp that matches error messages.
3486 If any element applies to a given error, that error skips the debugger
3487 and just returns to top level.
3488 This overrides the variable `debug-on-error'.
3489 It does not apply to errors handled by `condition-case'. */);
3490 Vdebug_ignored_errors
= Qnil
;
3492 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3493 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3494 Does not apply if quit is handled by a `condition-case'. */);
3497 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3498 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3500 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3501 doc
: /* Non-nil means debugger may continue execution.
3502 This is nil when the debugger is called under circumstances where it
3503 might not be safe to continue. */);
3504 debugger_may_continue
= 1;
3506 DEFVAR_LISP ("debugger", &Vdebugger
,
3507 doc
: /* Function to call to invoke debugger.
3508 If due to frame exit, args are `exit' and the value being returned;
3509 this function's value will be returned instead of that.
3510 If due to error, args are `error' and a list of the args to `signal'.
3511 If due to `apply' or `funcall' entry, one arg, `lambda'.
3512 If due to `eval' entry, one arg, t. */);
3515 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3516 doc
: /* If non-nil, this is a function for `signal' to call.
3517 It receives the same arguments that `signal' was given.
3518 The Edebug package uses this to regain control. */);
3519 Vsignal_hook_function
= Qnil
;
3521 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3522 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3523 Note that `debug-on-error', `debug-on-quit' and friends
3524 still determine whether to handle the particular condition. */);
3525 Vdebug_on_signal
= Qnil
;
3527 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3528 doc
: /* Function to process declarations in a macro definition.
3529 The function will be called with two args MACRO and DECL.
3530 MACRO is the name of the macro being defined.
3531 DECL is a list `(declare ...)' containing the declarations.
3532 The value the function returns is not used. */);
3533 Vmacro_declaration_function
= Qnil
;
3535 Vrun_hooks
= intern ("run-hooks");
3536 staticpro (&Vrun_hooks
);
3538 staticpro (&Vautoload_queue
);
3539 Vautoload_queue
= Qnil
;
3540 staticpro (&Vsignaling_function
);
3541 Vsignaling_function
= Qnil
;
3552 defsubr (&Sfunction
);
3554 defsubr (&Sdefmacro
);
3556 defsubr (&Sdefvaralias
);
3557 defsubr (&Sdefconst
);
3558 defsubr (&Suser_variable_p
);
3562 defsubr (&Smacroexpand
);
3565 defsubr (&Sunwind_protect
);
3566 defsubr (&Scondition_case
);
3568 defsubr (&Sinteractive_p
);
3569 defsubr (&Scalled_interactively_p
);
3570 defsubr (&Scommandp
);
3571 defsubr (&Sautoload
);
3574 defsubr (&Sfuncall
);
3575 defsubr (&Srun_hooks
);
3576 defsubr (&Srun_hook_with_args
);
3577 defsubr (&Srun_hook_with_args_until_success
);
3578 defsubr (&Srun_hook_with_args_until_failure
);
3579 defsubr (&Sfetch_bytecode
);
3580 defsubr (&Sbacktrace_debug
);
3581 defsubr (&Sbacktrace
);
3582 defsubr (&Sbacktrace_frame
);
3585 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
3586 (do not change this comment) */