1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include "blockinput.h"
28 #include "dispextern.h"
29 #include "frame.h" /* For XFRAME. */
35 /* This definition is duplicated in alloc.c and keyboard.c */
36 /* Putting it in lisp.h makes cc bomb out! */
40 struct backtrace
*next
;
41 Lisp_Object
*function
;
42 Lisp_Object
*args
; /* Points to vector of args. */
43 int nargs
; /* Length of vector.
44 If nargs is UNEVALLED, args points to slot holding
45 list of unevalled args */
47 /* Nonzero means call value of debugger when done with this operation. */
51 struct backtrace
*backtrace_list
;
53 struct catchtag
*catchlist
;
56 /* Count levels of GCPRO to detect failure to UNGCPRO. */
60 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
61 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
62 Lisp_Object Qand_rest
, Qand_optional
;
63 Lisp_Object Qdebug_on_error
;
66 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
69 extern Lisp_Object Qinteractive_form
;
71 /* This holds either the symbol `run-hooks' or nil.
72 It is nil at an early stage of startup, and when Emacs
75 Lisp_Object Vrun_hooks
;
77 /* Non-nil means record all fset's and provide's, to be undone
78 if the file being autoloaded is not fully loaded.
79 They are recorded by being consed onto the front of Vautoload_queue:
80 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
82 Lisp_Object Vautoload_queue
;
84 /* When lexical binding is being used, this is non-nil, and contains an
85 alist of lexically-bound variable, or t, indicating an empty
86 environment. The lisp name of this variable is
87 `internal-interpreter-lexical-environment'. */
89 Lisp_Object Vinternal_interpreter_environment
;
91 /* Current number of specbindings allocated in specpdl. */
95 /* Pointer to beginning of specpdl. */
97 struct specbinding
*specpdl
;
99 /* Pointer to first unused element in specpdl. */
101 struct specbinding
*specpdl_ptr
;
103 /* Maximum size allowed for specpdl allocation */
105 EMACS_INT max_specpdl_size
;
107 /* Depth in Lisp evaluations and function calls. */
111 /* Maximum allowed depth in Lisp evaluations and function calls. */
113 EMACS_INT max_lisp_eval_depth
;
115 /* Nonzero means enter debugger before next function call */
117 int debug_on_next_call
;
119 /* Non-zero means debugger may continue. This is zero when the
120 debugger is called during redisplay, where it might not be safe to
121 continue the interrupted redisplay. */
123 int debugger_may_continue
;
125 /* List of conditions (non-nil atom means all) which cause a backtrace
126 if an error is handled by the command loop's error handler. */
128 Lisp_Object Vstack_trace_on_error
;
130 /* List of conditions (non-nil atom means all) which enter the debugger
131 if an error is handled by the command loop's error handler. */
133 Lisp_Object Vdebug_on_error
;
135 /* List of conditions and regexps specifying error messages which
136 do not enter the debugger even if Vdebug_on_error says they should. */
138 Lisp_Object Vdebug_ignored_errors
;
140 /* Non-nil means call the debugger even if the error will be handled. */
142 Lisp_Object Vdebug_on_signal
;
144 /* Hook for edebug to use. */
146 Lisp_Object Vsignal_hook_function
;
148 /* Nonzero means enter debugger if a quit signal
149 is handled by the command loop's error handler. */
153 /* The value of num_nonmacro_input_events as of the last time we
154 started to enter the debugger. If we decide to enter the debugger
155 again when this is still equal to num_nonmacro_input_events, then we
156 know that the debugger itself has an error, and we should just
157 signal the error instead of entering an infinite loop of debugger
160 int when_entered_debugger
;
162 Lisp_Object Vdebugger
;
164 /* The function from which the last `signal' was called. Set in
167 Lisp_Object Vsignaling_function
;
169 /* Set to non-zero while processing X events. Checked in Feval to
170 make sure the Lisp interpreter isn't called from a signal handler,
171 which is unsafe because the interpreter isn't reentrant. */
175 /* Function to process declarations in defmacro forms. */
177 Lisp_Object Vmacro_declaration_function
;
179 extern Lisp_Object Qrisky_local_variable
;
180 extern Lisp_Object Qfunction
;
182 static Lisp_Object
funcall_lambda (Lisp_Object
, int, Lisp_Object
*,
184 static void unwind_to_catch (struct catchtag
*, Lisp_Object
) NO_RETURN
;
187 init_eval_once (void)
190 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
191 specpdl_ptr
= specpdl
;
192 /* Don't forget to update docs (lispref node "Local Variables"). */
193 max_specpdl_size
= 1000;
194 max_lisp_eval_depth
= 500;
202 specpdl_ptr
= specpdl
;
207 debug_on_next_call
= 0;
212 /* This is less than the initial value of num_nonmacro_input_events. */
213 when_entered_debugger
= -1;
216 /* unwind-protect function used by call_debugger. */
219 restore_stack_limits (Lisp_Object data
)
221 max_specpdl_size
= XINT (XCAR (data
));
222 max_lisp_eval_depth
= XINT (XCDR (data
));
226 /* Call the Lisp debugger, giving it argument ARG. */
229 call_debugger (Lisp_Object arg
)
231 int debug_while_redisplaying
;
232 int count
= SPECPDL_INDEX ();
234 int old_max
= max_specpdl_size
;
236 /* Temporarily bump up the stack limits,
237 so the debugger won't run out of stack. */
239 max_specpdl_size
+= 1;
240 record_unwind_protect (restore_stack_limits
,
241 Fcons (make_number (old_max
),
242 make_number (max_lisp_eval_depth
)));
243 max_specpdl_size
= old_max
;
245 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
246 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
248 if (SPECPDL_INDEX () + 100 > max_specpdl_size
)
249 max_specpdl_size
= SPECPDL_INDEX () + 100;
251 #ifdef HAVE_WINDOW_SYSTEM
252 if (display_hourglass_p
)
256 debug_on_next_call
= 0;
257 when_entered_debugger
= num_nonmacro_input_events
;
259 /* Resetting redisplaying_p to 0 makes sure that debug output is
260 displayed if the debugger is invoked during redisplay. */
261 debug_while_redisplaying
= redisplaying_p
;
263 specbind (intern ("debugger-may-continue"),
264 debug_while_redisplaying
? Qnil
: Qt
);
265 specbind (Qinhibit_redisplay
, Qnil
);
266 specbind (Qdebug_on_error
, Qnil
);
268 #if 0 /* Binding this prevents execution of Lisp code during
269 redisplay, which necessarily leads to display problems. */
270 specbind (Qinhibit_eval_during_redisplay
, Qt
);
273 val
= apply1 (Vdebugger
, arg
);
275 /* Interrupting redisplay and resuming it later is not safe under
276 all circumstances. So, when the debugger returns, abort the
277 interrupted redisplay by going back to the top-level. */
278 if (debug_while_redisplaying
)
281 return unbind_to (count
, val
);
285 do_debug_on_call (Lisp_Object code
)
287 debug_on_next_call
= 0;
288 backtrace_list
->debug_on_exit
= 1;
289 call_debugger (Fcons (code
, Qnil
));
292 /* NOTE!!! Every function that can call EVAL must protect its args
293 and temporaries from garbage collection while it needs them.
294 The definition of `For' shows what you have to do. */
296 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
297 doc
: /* Eval args until one of them yields non-nil, then return that value.
298 The remaining args are not evalled at all.
299 If all args return nil, return nil.
300 usage: (or CONDITIONS...) */)
303 register Lisp_Object val
= Qnil
;
310 val
= Feval (XCAR (args
));
320 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
321 doc
: /* Eval args until one of them yields nil, then return nil.
322 The remaining args are not evalled at all.
323 If no arg yields nil, return the last arg's value.
324 usage: (and CONDITIONS...) */)
327 register Lisp_Object val
= Qt
;
334 val
= Feval (XCAR (args
));
344 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
345 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
346 Returns the value of THEN or the value of the last of the ELSE's.
347 THEN must be one expression, but ELSE... can be zero or more expressions.
348 If COND yields nil, and there are no ELSE's, the value is nil.
349 usage: (if COND THEN ELSE...) */)
352 register Lisp_Object cond
;
356 cond
= Feval (Fcar (args
));
360 return Feval (Fcar (Fcdr (args
)));
361 return Fprogn (Fcdr (Fcdr (args
)));
364 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
365 doc
: /* Try each clause until one succeeds.
366 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
367 and, if the value is non-nil, this clause succeeds:
368 then the expressions in BODY are evaluated and the last one's
369 value is the value of the cond-form.
370 If no clause succeeds, cond returns nil.
371 If a clause has one element, as in (CONDITION),
372 CONDITION's value if non-nil is returned from the cond-form.
373 usage: (cond CLAUSES...) */)
376 register Lisp_Object clause
, val
;
383 clause
= Fcar (args
);
384 val
= Feval (Fcar (clause
));
387 if (!EQ (XCDR (clause
), Qnil
))
388 val
= Fprogn (XCDR (clause
));
398 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
399 doc
: /* Eval BODY forms sequentially and return value of last one.
400 usage: (progn BODY...) */)
403 register Lisp_Object val
= Qnil
;
410 val
= Feval (XCAR (args
));
418 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
419 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
420 The value of FIRST is saved during the evaluation of the remaining args,
421 whose values are discarded.
422 usage: (prog1 FIRST BODY...) */)
426 register Lisp_Object args_left
;
427 struct gcpro gcpro1
, gcpro2
;
428 register int argnum
= 0;
440 val
= Feval (Fcar (args_left
));
442 Feval (Fcar (args_left
));
443 args_left
= Fcdr (args_left
);
445 while (!NILP(args_left
));
451 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
452 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
453 The value of FORM2 is saved during the evaluation of the
454 remaining args, whose values are discarded.
455 usage: (prog2 FORM1 FORM2 BODY...) */)
459 register Lisp_Object args_left
;
460 struct gcpro gcpro1
, gcpro2
;
461 register int argnum
= -1;
475 val
= Feval (Fcar (args_left
));
477 Feval (Fcar (args_left
));
478 args_left
= Fcdr (args_left
);
480 while (!NILP (args_left
));
486 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
487 doc
: /* Set each SYM to the value of its VAL.
488 The symbols SYM are variables; they are literal (not evaluated).
489 The values VAL are expressions; they are evaluated.
490 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
491 The second VAL is not computed until after the first SYM is set, and so on;
492 each VAL can use the new value of variables set earlier in the `setq'.
493 The return value of the `setq' form is the value of the last VAL.
494 usage: (setq [SYM VAL]...) */)
497 register Lisp_Object args_left
;
498 register Lisp_Object val
, sym
, lex_binding
;
509 val
= Feval (Fcar (Fcdr (args_left
)));
510 sym
= Fcar (args_left
);
512 if (!NILP (Vinternal_interpreter_environment
)
514 && !XSYMBOL (sym
)->declared_special
515 && !NILP (lex_binding
= Fassq (sym
, Vinternal_interpreter_environment
)))
516 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
518 Fset (sym
, val
); /* SYM is dynamically bound. */
520 args_left
= Fcdr (Fcdr (args_left
));
522 while (!NILP(args_left
));
528 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
529 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
530 usage: (quote ARG) */)
533 if (!NILP (Fcdr (args
)))
534 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
538 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
539 doc
: /* Like `quote', but preferred for objects which are functions.
540 In byte compilation, `function' causes its argument to be compiled.
541 `quote' cannot do that.
542 usage: (function ARG) */)
545 Lisp_Object quoted
= XCAR (args
);
547 if (!NILP (Fcdr (args
)))
548 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
550 if (!NILP (Vinternal_interpreter_environment
)
552 && EQ (XCAR (quoted
), Qlambda
))
553 /* This is a lambda expression within a lexical environment;
554 return an interpreted closure instead of a simple lambda. */
555 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
, quoted
));
557 /* Simply quote the argument. */
562 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
563 doc
: /* Return t if the containing function was run directly by user input.
564 This means that the function was called with `call-interactively'
565 \(which includes being called as the binding of a key)
566 and input is currently coming from the keyboard (not a keyboard macro),
567 and Emacs is not running in batch mode (`noninteractive' is nil).
569 The only known proper use of `interactive-p' is in deciding whether to
570 display a helpful message, or how to display it. If you're thinking
571 of using it for any other purpose, it is quite likely that you're
572 making a mistake. Think: what do you want to do when the command is
573 called from a keyboard macro?
575 To test whether your function was called with `call-interactively',
576 either (i) add an extra optional argument and give it an `interactive'
577 spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
578 use `called-interactively-p'. */)
581 return interactive_p (1) ? Qt
: Qnil
;
585 DEFUN ("called-interactively-p", Fcalled_interactively_p
, Scalled_interactively_p
, 0, 1, 0,
586 doc
: /* Return t if the containing function was called by `call-interactively'.
587 If KIND is `interactive', then only return t if the call was made
588 interactively by the user, i.e. not in `noninteractive' mode nor
589 when `executing-kbd-macro'.
590 If KIND is `any', on the other hand, it will return t for any kind of
591 interactive call, including being called as the binding of a key, or
592 from a keyboard macro, or in `noninteractive' mode.
594 The only known proper use of `interactive' for KIND is in deciding
595 whether to display a helpful message, or how to display it. If you're
596 thinking of using it for any other purpose, it is quite likely that
597 you're making a mistake. Think: what do you want to do when the
598 command is called from a keyboard macro?
600 This function is meant for implementing advice and other
601 function-modifying features. Instead of using this, it is sometimes
602 cleaner to give your function an extra optional argument whose
603 `interactive' spec specifies non-nil unconditionally (\"p\" is a good
604 way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
607 return ((INTERACTIVE
|| !EQ (kind
, intern ("interactive")))
608 && interactive_p (1)) ? Qt
: Qnil
;
612 /* Return 1 if function in which this appears was called using
615 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
616 called is a built-in. */
619 interactive_p (int exclude_subrs_p
)
621 struct backtrace
*btp
;
624 btp
= backtrace_list
;
626 /* If this isn't a byte-compiled function, there may be a frame at
627 the top for Finteractive_p. If so, skip it. */
628 fun
= Findirect_function (*btp
->function
, Qnil
);
629 if (SUBRP (fun
) && (XSUBR (fun
) == &Sinteractive_p
630 || XSUBR (fun
) == &Scalled_interactively_p
))
633 /* If we're running an Emacs 18-style byte-compiled function, there
634 may be a frame for Fbytecode at the top level. In any version of
635 Emacs there can be Fbytecode frames for subexpressions evaluated
636 inside catch and condition-case. Skip past them.
638 If this isn't a byte-compiled function, then we may now be
639 looking at several frames for special forms. Skip past them. */
641 && (EQ (*btp
->function
, Qbytecode
)
642 || btp
->nargs
== UNEVALLED
))
645 /* btp now points at the frame of the innermost function that isn't
646 a special form, ignoring frames for Finteractive_p and/or
647 Fbytecode at the top. If this frame is for a built-in function
648 (such as load or eval-region) return nil. */
649 fun
= Findirect_function (*btp
->function
, Qnil
);
650 if (exclude_subrs_p
&& SUBRP (fun
))
653 /* btp points to the frame of a Lisp function that called interactive-p.
654 Return t if that function was called interactively. */
655 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
661 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
662 doc
: /* Define NAME as a function.
663 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
664 See also the function `interactive'.
665 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
668 register Lisp_Object fn_name
;
669 register Lisp_Object defn
;
671 fn_name
= Fcar (args
);
672 CHECK_SYMBOL (fn_name
);
673 defn
= Fcons (Qlambda
, Fcdr (args
));
674 if (! NILP (Vinternal_interpreter_environment
))
675 defn
= Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
, defn
));
676 if (!NILP (Vpurify_flag
))
677 defn
= Fpurecopy (defn
);
678 if (CONSP (XSYMBOL (fn_name
)->function
)
679 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
680 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
681 Ffset (fn_name
, defn
);
682 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
686 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
687 doc
: /* Define NAME as a macro.
688 The actual definition looks like
689 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
690 When the macro is called, as in (NAME ARGS...),
691 the function (lambda ARGLIST BODY...) is applied to
692 the list ARGS... as it appears in the expression,
693 and the result should be a form to be evaluated instead of the original.
695 DECL is a declaration, optional, which can specify how to indent
696 calls to this macro, how Edebug should handle it, and which argument
697 should be treated as documentation. It looks like this:
699 The elements can look like this:
701 Set NAME's `lisp-indent-function' property to INDENT.
704 Set NAME's `edebug-form-spec' property to DEBUG. (This is
705 equivalent to writing a `def-edebug-spec' for the macro.)
708 Set NAME's `doc-string-elt' property to ELT.
710 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
713 register Lisp_Object fn_name
;
714 register Lisp_Object defn
;
715 Lisp_Object lambda_list
, doc
, tail
;
717 fn_name
= Fcar (args
);
718 CHECK_SYMBOL (fn_name
);
719 lambda_list
= Fcar (Fcdr (args
));
720 tail
= Fcdr (Fcdr (args
));
723 if (STRINGP (Fcar (tail
)))
729 while (CONSP (Fcar (tail
))
730 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
732 if (!NILP (Vmacro_declaration_function
))
736 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
744 tail
= Fcons (lambda_list
, tail
);
746 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
748 defn
= Fcons (Qlambda
, tail
);
749 if (! NILP (Vinternal_interpreter_environment
))
750 defn
= Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
, defn
));
751 defn
= Fcons (Qmacro
, defn
);
753 if (!NILP (Vpurify_flag
))
754 defn
= Fpurecopy (defn
);
755 if (CONSP (XSYMBOL (fn_name
)->function
)
756 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
757 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
758 Ffset (fn_name
, defn
);
759 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
764 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
765 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
766 Aliased variables always have the same value; setting one sets the other.
767 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
768 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
769 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
770 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
771 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
772 The return value is BASE-VARIABLE. */)
773 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
775 struct Lisp_Symbol
*sym
;
777 CHECK_SYMBOL (new_alias
);
778 CHECK_SYMBOL (base_variable
);
780 sym
= XSYMBOL (new_alias
);
783 /* Not sure why, but why not? */
784 error ("Cannot make a constant an alias");
786 switch (sym
->redirect
)
788 case SYMBOL_FORWARDED
:
789 error ("Cannot make an internal variable an alias");
790 case SYMBOL_LOCALIZED
:
791 error ("Don't know how to make a localized variable an alias");
794 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
795 If n_a is bound, but b_v is not, set the value of b_v to n_a,
796 so that old-code that affects n_a before the aliasing is setup
798 if (NILP (Fboundp (base_variable
)))
799 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
802 struct specbinding
*p
;
804 for (p
= specpdl_ptr
- 1; p
>= specpdl
; p
--)
807 CONSP (p
->symbol
) ? XCAR (p
->symbol
) : p
->symbol
)))
808 error ("Don't know how to make a let-bound variable an alias");
811 sym
->declared_special
= 1;
812 sym
->redirect
= SYMBOL_VARALIAS
;
813 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
814 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
815 LOADHIST_ATTACH (new_alias
);
816 /* Even if docstring is nil: remove old docstring. */
817 Fput (new_alias
, Qvariable_documentation
, docstring
);
819 return base_variable
;
823 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
824 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
825 You are not required to define a variable in order to use it,
826 but the definition can supply documentation and an initial value
827 in a way that tags can recognize.
829 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
830 If SYMBOL is buffer-local, its default value is what is set;
831 buffer-local values are not affected.
832 INITVALUE and DOCSTRING are optional.
833 If DOCSTRING starts with *, this variable is identified as a user option.
834 This means that M-x set-variable recognizes it.
835 See also `user-variable-p'.
836 If INITVALUE is missing, SYMBOL's value is not set.
838 If SYMBOL has a local binding, then this form affects the local
839 binding. This is usually not what you want. Thus, if you need to
840 load a file defining variables, with this form or with `defconst' or
841 `defcustom', you should always load that file _outside_ any bindings
842 for these variables. \(`defconst' and `defcustom' behave similarly in
844 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
847 register Lisp_Object sym
, tem
, tail
;
851 if (!NILP (Fcdr (Fcdr (tail
))))
852 error ("Too many arguments");
854 tem
= Fdefault_boundp (sym
);
857 if (SYMBOL_CONSTANT_P (sym
))
859 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
860 Lisp_Object tem
= Fcar (tail
);
862 && EQ (XCAR (tem
), Qquote
)
863 && CONSP (XCDR (tem
))
864 && EQ (XCAR (XCDR (tem
)), sym
)))
865 error ("Constant symbol `%s' specified in defvar",
866 SDATA (SYMBOL_NAME (sym
)));
870 Fset_default (sym
, Feval (Fcar (tail
)));
872 { /* Check if there is really a global binding rather than just a let
873 binding that shadows the global unboundness of the var. */
874 volatile struct specbinding
*pdl
= specpdl_ptr
;
875 while (--pdl
>= specpdl
)
877 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
878 && EQ (pdl
->old_value
, Qunbound
))
880 message_with_string ("Warning: defvar ignored because %s is let-bound",
881 SYMBOL_NAME (sym
), 1);
890 if (!NILP (Vpurify_flag
))
891 tem
= Fpurecopy (tem
);
892 Fput (sym
, Qvariable_documentation
, tem
);
894 LOADHIST_ATTACH (sym
);
897 /* Simple (defvar <var>) should not count as a definition at all.
898 It could get in the way of other definitions, and unloading this
899 package could try to make the variable unbound. */
903 XSYMBOL (sym
)->declared_special
= 1;
908 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
909 doc
: /* Define SYMBOL as a constant variable.
910 The intent is that neither programs nor users should ever change this value.
911 Always sets the value of SYMBOL to the result of evalling INITVALUE.
912 If SYMBOL is buffer-local, its default value is what is set;
913 buffer-local values are not affected.
914 DOCSTRING is optional.
916 If SYMBOL has a local binding, then this form sets the local binding's
917 value. However, you should normally not make local bindings for
918 variables defined with this form.
919 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
922 register Lisp_Object sym
, tem
;
925 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
926 error ("Too many arguments");
928 tem
= Feval (Fcar (Fcdr (args
)));
929 if (!NILP (Vpurify_flag
))
930 tem
= Fpurecopy (tem
);
931 Fset_default (sym
, tem
);
932 XSYMBOL (sym
)->declared_special
= 1;
933 tem
= Fcar (Fcdr (Fcdr (args
)));
936 if (!NILP (Vpurify_flag
))
937 tem
= Fpurecopy (tem
);
938 Fput (sym
, Qvariable_documentation
, tem
);
940 Fput (sym
, Qrisky_local_variable
, Qt
);
941 LOADHIST_ATTACH (sym
);
945 /* Error handler used in Fuser_variable_p. */
947 user_variable_p_eh (Lisp_Object ignore
)
953 lisp_indirect_variable (Lisp_Object sym
)
955 XSETSYMBOL (sym
, indirect_variable (XSYMBOL (sym
)));
959 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
960 doc
: /* Return t if VARIABLE is intended to be set and modified by users.
961 \(The alternative is a variable used internally in a Lisp program.)
962 A variable is a user variable if
963 \(1) the first character of its documentation is `*', or
964 \(2) it is customizable (its property list contains a non-nil value
965 of `standard-value' or `custom-autoload'), or
966 \(3) it is an alias for another user variable.
967 Return nil if VARIABLE is an alias and there is a loop in the
968 chain of symbols. */)
969 (Lisp_Object variable
)
971 Lisp_Object documentation
;
973 if (!SYMBOLP (variable
))
976 /* If indirect and there's an alias loop, don't check anything else. */
977 if (XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
978 && NILP (internal_condition_case_1 (lisp_indirect_variable
, variable
,
979 Qt
, user_variable_p_eh
)))
984 documentation
= Fget (variable
, Qvariable_documentation
);
985 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
987 if (STRINGP (documentation
)
988 && ((unsigned char) SREF (documentation
, 0) == '*'))
990 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
991 if (CONSP (documentation
)
992 && STRINGP (XCAR (documentation
))
993 && INTEGERP (XCDR (documentation
))
994 && XINT (XCDR (documentation
)) < 0)
996 /* Customizable? See `custom-variable-p'. */
997 if ((!NILP (Fget (variable
, intern ("standard-value"))))
998 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
1001 if (!(XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
))
1004 /* An indirect variable? Let's follow the chain. */
1005 XSETSYMBOL (variable
, SYMBOL_ALIAS (XSYMBOL (variable
)));
1009 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
1010 doc
: /* Bind variables according to VARLIST then eval BODY.
1011 The value of the last form in BODY is returned.
1012 Each element of VARLIST is a symbol (which is bound to nil)
1013 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1014 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
1015 usage: (let* VARLIST BODY...) */)
1018 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
1019 int count
= SPECPDL_INDEX ();
1020 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1022 GCPRO3 (args
, elt
, varlist
);
1024 lexenv
= Vinternal_interpreter_environment
;
1026 varlist
= Fcar (args
);
1027 while (CONSP (varlist
))
1031 elt
= XCAR (varlist
);
1037 else if (! NILP (Fcdr (Fcdr (elt
))))
1038 signal_error ("`let' bindings can have only one value-form", elt
);
1042 val
= Feval (Fcar (Fcdr (elt
)));
1045 if (!NILP (lexenv
) && SYMBOLP (var
) && !XSYMBOL (var
)->declared_special
)
1046 /* Lexically bind VAR by adding it to the interpreter's binding
1049 lexenv
= Fcons (Fcons (var
, val
), lexenv
);
1050 specbind (Qinternal_interpreter_environment
, lexenv
);
1053 specbind (var
, val
);
1055 varlist
= XCDR (varlist
);
1060 val
= Fprogn (Fcdr (args
));
1062 return unbind_to (count
, val
);
1065 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
1066 doc
: /* Bind variables according to VARLIST then eval BODY.
1067 The value of the last form in BODY is returned.
1068 Each element of VARLIST is a symbol (which is bound to nil)
1069 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1070 All the VALUEFORMs are evalled before any symbols are bound.
1071 usage: (let VARLIST BODY...) */)
1074 Lisp_Object
*temps
, tem
, lexenv
;
1075 register Lisp_Object elt
, varlist
;
1076 int count
= SPECPDL_INDEX ();
1077 register int argnum
;
1078 struct gcpro gcpro1
, gcpro2
;
1080 varlist
= Fcar (args
);
1082 /* Make space to hold the values to give the bound variables */
1083 elt
= Flength (varlist
);
1084 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
1086 /* Compute the values and store them in `temps' */
1088 GCPRO2 (args
, *temps
);
1091 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1094 elt
= XCAR (varlist
);
1096 temps
[argnum
++] = Qnil
;
1097 else if (! NILP (Fcdr (Fcdr (elt
))))
1098 signal_error ("`let' bindings can have only one value-form", elt
);
1100 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
1101 gcpro2
.nvars
= argnum
;
1105 lexenv
= Vinternal_interpreter_environment
;
1107 varlist
= Fcar (args
);
1108 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1112 elt
= XCAR (varlist
);
1113 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
1114 tem
= temps
[argnum
++];
1116 if (!NILP (lexenv
) && SYMBOLP (var
) && !XSYMBOL (var
)->declared_special
)
1117 /* Lexically bind VAR by adding it to the lexenv alist. */
1118 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
1120 /* Dynamically bind VAR. */
1121 specbind (var
, tem
);
1124 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
1125 /* Instantiate a new lexical environment. */
1126 specbind (Qinternal_interpreter_environment
, lexenv
);
1128 elt
= Fprogn (Fcdr (args
));
1130 return unbind_to (count
, elt
);
1133 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
1134 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
1135 The order of execution is thus TEST, BODY, TEST, BODY and so on
1136 until TEST returns nil.
1137 usage: (while TEST BODY...) */)
1140 Lisp_Object test
, body
;
1141 struct gcpro gcpro1
, gcpro2
;
1143 GCPRO2 (test
, body
);
1147 while (!NILP (Feval (test
)))
1157 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1158 doc
: /* Return result of expanding macros at top level of FORM.
1159 If FORM is not a macro call, it is returned unchanged.
1160 Otherwise, the macro is expanded and the expansion is considered
1161 in place of FORM. When a non-macro-call results, it is returned.
1163 The second optional arg ENVIRONMENT specifies an environment of macro
1164 definitions to shadow the loaded ones for use in file byte-compilation. */)
1165 (Lisp_Object form
, Lisp_Object environment
)
1167 /* With cleanups from Hallvard Furuseth. */
1168 register Lisp_Object expander
, sym
, def
, tem
;
1172 /* Come back here each time we expand a macro call,
1173 in case it expands into another macro call. */
1176 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1177 def
= sym
= XCAR (form
);
1179 /* Trace symbols aliases to other symbols
1180 until we get a symbol that is not an alias. */
1181 while (SYMBOLP (def
))
1185 tem
= Fassq (sym
, environment
);
1188 def
= XSYMBOL (sym
)->function
;
1189 if (!EQ (def
, Qunbound
))
1194 /* Right now TEM is the result from SYM in ENVIRONMENT,
1195 and if TEM is nil then DEF is SYM's function definition. */
1198 /* SYM is not mentioned in ENVIRONMENT.
1199 Look at its function definition. */
1200 if (EQ (def
, Qunbound
) || !CONSP (def
))
1201 /* Not defined or definition not suitable */
1203 if (EQ (XCAR (def
), Qautoload
))
1205 /* Autoloading function: will it be a macro when loaded? */
1206 tem
= Fnth (make_number (4), def
);
1207 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1208 /* Yes, load it and try again. */
1210 struct gcpro gcpro1
;
1212 do_autoload (def
, sym
);
1219 else if (!EQ (XCAR (def
), Qmacro
))
1221 else expander
= XCDR (def
);
1225 expander
= XCDR (tem
);
1226 if (NILP (expander
))
1229 form
= apply1 (expander
, XCDR (form
));
1234 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1235 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1236 TAG is evalled to get the tag to use; it must not be nil.
1238 Then the BODY is executed.
1239 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1240 If no throw happens, `catch' returns the value of the last BODY form.
1241 If a throw happens, it specifies the value to return from `catch'.
1242 usage: (catch TAG BODY...) */)
1245 register Lisp_Object tag
;
1246 struct gcpro gcpro1
;
1249 tag
= Feval (Fcar (args
));
1251 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1254 /* Set up a catch, then call C function FUNC on argument ARG.
1255 FUNC should return a Lisp_Object.
1256 This is how catches are done from within C code. */
1259 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
1261 /* This structure is made part of the chain `catchlist'. */
1264 /* Fill in the components of c, and put it on the list. */
1268 c
.backlist
= backtrace_list
;
1269 c
.handlerlist
= handlerlist
;
1270 c
.lisp_eval_depth
= lisp_eval_depth
;
1271 c
.pdlcount
= SPECPDL_INDEX ();
1272 c
.poll_suppress_count
= poll_suppress_count
;
1273 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1274 c
.gcpro
= gcprolist
;
1275 c
.byte_stack
= byte_stack_list
;
1279 if (! _setjmp (c
.jmp
))
1280 c
.val
= (*func
) (arg
);
1282 /* Throw works by a longjmp that comes right here. */
1287 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1288 jump to that CATCH, returning VALUE as the value of that catch.
1290 This is the guts Fthrow and Fsignal; they differ only in the way
1291 they choose the catch tag to throw to. A catch tag for a
1292 condition-case form has a TAG of Qnil.
1294 Before each catch is discarded, unbind all special bindings and
1295 execute all unwind-protect clauses made above that catch. Unwind
1296 the handler stack as we go, so that the proper handlers are in
1297 effect for each unwind-protect clause we run. At the end, restore
1298 some static info saved in CATCH, and longjmp to the location
1301 This is used for correct unwinding in Fthrow and Fsignal. */
1304 unwind_to_catch (struct catchtag
*catch, Lisp_Object value
)
1306 register int last_time
;
1308 /* Save the value in the tag. */
1311 /* Restore certain special C variables. */
1312 set_poll_suppress_count (catch->poll_suppress_count
);
1313 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1314 handling_signal
= 0;
1319 last_time
= catchlist
== catch;
1321 /* Unwind the specpdl stack, and then restore the proper set of
1323 unbind_to (catchlist
->pdlcount
, Qnil
);
1324 handlerlist
= catchlist
->handlerlist
;
1325 catchlist
= catchlist
->next
;
1327 while (! last_time
);
1330 /* If x_catch_errors was done, turn it off now.
1331 (First we give unbind_to a chance to do that.) */
1332 #if 0 /* This would disable x_catch_errors after x_connection_closed.
1333 The catch must remain in effect during that delicate
1334 state. --lorentey */
1335 x_fully_uncatch_errors ();
1339 byte_stack_list
= catch->byte_stack
;
1340 gcprolist
= catch->gcpro
;
1343 gcpro_level
= gcprolist
->level
+ 1;
1347 backtrace_list
= catch->backlist
;
1348 lisp_eval_depth
= catch->lisp_eval_depth
;
1350 _longjmp (catch->jmp
, 1);
1353 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1354 doc
: /* Throw to the catch for TAG and return VALUE from it.
1355 Both TAG and VALUE are evalled. */)
1356 (register Lisp_Object tag
, Lisp_Object value
)
1358 register struct catchtag
*c
;
1361 for (c
= catchlist
; c
; c
= c
->next
)
1363 if (EQ (c
->tag
, tag
))
1364 unwind_to_catch (c
, value
);
1366 xsignal2 (Qno_catch
, tag
, value
);
1370 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1371 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1372 If BODYFORM completes normally, its value is returned
1373 after executing the UNWINDFORMS.
1374 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1375 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1379 int count
= SPECPDL_INDEX ();
1381 record_unwind_protect (Fprogn
, Fcdr (args
));
1382 val
= Feval (Fcar (args
));
1383 return unbind_to (count
, val
);
1386 /* Chain of condition handlers currently in effect.
1387 The elements of this chain are contained in the stack frames
1388 of Fcondition_case and internal_condition_case.
1389 When an error is signaled (by calling Fsignal, below),
1390 this chain is searched for an element that applies. */
1392 struct handler
*handlerlist
;
1394 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1395 doc
: /* Regain control when an error is signaled.
1396 Executes BODYFORM and returns its value if no error happens.
1397 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1398 where the BODY is made of Lisp expressions.
1400 A handler is applicable to an error
1401 if CONDITION-NAME is one of the error's condition names.
1402 If an error happens, the first applicable handler is run.
1404 The car of a handler may be a list of condition names
1405 instead of a single condition name. Then it handles all of them.
1407 When a handler handles an error, control returns to the `condition-case'
1408 and it executes the handler's BODY...
1409 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1410 \(If VAR is nil, the handler can't access that information.)
1411 Then the value of the last BODY form is returned from the `condition-case'
1414 See also the function `signal' for more info.
1415 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1418 register Lisp_Object bodyform
, handlers
;
1419 volatile Lisp_Object var
;
1422 bodyform
= Fcar (Fcdr (args
));
1423 handlers
= Fcdr (Fcdr (args
));
1425 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1428 /* Like Fcondition_case, but the args are separate
1429 rather than passed in a list. Used by Fbyte_code. */
1432 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
1433 Lisp_Object handlers
)
1441 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1447 && (SYMBOLP (XCAR (tem
))
1448 || CONSP (XCAR (tem
))))))
1449 error ("Invalid condition handler", tem
);
1454 c
.backlist
= backtrace_list
;
1455 c
.handlerlist
= handlerlist
;
1456 c
.lisp_eval_depth
= lisp_eval_depth
;
1457 c
.pdlcount
= SPECPDL_INDEX ();
1458 c
.poll_suppress_count
= poll_suppress_count
;
1459 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1460 c
.gcpro
= gcprolist
;
1461 c
.byte_stack
= byte_stack_list
;
1462 if (_setjmp (c
.jmp
))
1465 specbind (h
.var
, c
.val
);
1466 val
= Fprogn (Fcdr (h
.chosen_clause
));
1468 /* Note that this just undoes the binding of h.var; whoever
1469 longjumped to us unwound the stack to c.pdlcount before
1471 unbind_to (c
.pdlcount
, Qnil
);
1478 h
.handler
= handlers
;
1479 h
.next
= handlerlist
;
1483 val
= Feval (bodyform
);
1485 handlerlist
= h
.next
;
1489 /* Call the function BFUN with no arguments, catching errors within it
1490 according to HANDLERS. If there is an error, call HFUN with
1491 one argument which is the data that describes the error:
1494 HANDLERS can be a list of conditions to catch.
1495 If HANDLERS is Qt, catch all errors.
1496 If HANDLERS is Qerror, catch all errors
1497 but allow the debugger to run if that is enabled. */
1500 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
1501 Lisp_Object (*hfun
) (Lisp_Object
))
1507 /* Since Fsignal will close off all calls to x_catch_errors,
1508 we will get the wrong results if some are not closed now. */
1510 if (x_catching_errors ())
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
;
1538 handlerlist
= h
.next
;
1542 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1545 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
1546 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
1552 /* Since Fsignal will close off all calls to x_catch_errors,
1553 we will get the wrong results if some are not closed now. */
1555 if (x_catching_errors ())
1561 c
.backlist
= backtrace_list
;
1562 c
.handlerlist
= handlerlist
;
1563 c
.lisp_eval_depth
= lisp_eval_depth
;
1564 c
.pdlcount
= SPECPDL_INDEX ();
1565 c
.poll_suppress_count
= poll_suppress_count
;
1566 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1567 c
.gcpro
= gcprolist
;
1568 c
.byte_stack
= byte_stack_list
;
1569 if (_setjmp (c
.jmp
))
1571 return (*hfun
) (c
.val
);
1575 h
.handler
= handlers
;
1577 h
.next
= handlerlist
;
1581 val
= (*bfun
) (arg
);
1583 handlerlist
= h
.next
;
1587 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1591 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1594 Lisp_Object handlers
,
1595 Lisp_Object (*hfun
) (Lisp_Object
))
1601 /* Since Fsignal will close off all calls to x_catch_errors,
1602 we will get the wrong results if some are not closed now. */
1604 if (x_catching_errors ())
1610 c
.backlist
= backtrace_list
;
1611 c
.handlerlist
= handlerlist
;
1612 c
.lisp_eval_depth
= lisp_eval_depth
;
1613 c
.pdlcount
= SPECPDL_INDEX ();
1614 c
.poll_suppress_count
= poll_suppress_count
;
1615 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1616 c
.gcpro
= gcprolist
;
1617 c
.byte_stack
= byte_stack_list
;
1618 if (_setjmp (c
.jmp
))
1620 return (*hfun
) (c
.val
);
1624 h
.handler
= handlers
;
1626 h
.next
= handlerlist
;
1630 val
= (*bfun
) (arg1
, arg2
);
1632 handlerlist
= h
.next
;
1636 /* Like internal_condition_case but call BFUN with NARGS as first,
1637 and ARGS as second argument. */
1640 internal_condition_case_n (Lisp_Object (*bfun
) (int, Lisp_Object
*),
1643 Lisp_Object handlers
,
1644 Lisp_Object (*hfun
) (Lisp_Object
))
1650 /* Since Fsignal will close off all calls to x_catch_errors,
1651 we will get the wrong results if some are not closed now. */
1653 if (x_catching_errors ())
1659 c
.backlist
= backtrace_list
;
1660 c
.handlerlist
= handlerlist
;
1661 c
.lisp_eval_depth
= lisp_eval_depth
;
1662 c
.pdlcount
= SPECPDL_INDEX ();
1663 c
.poll_suppress_count
= poll_suppress_count
;
1664 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1665 c
.gcpro
= gcprolist
;
1666 c
.byte_stack
= byte_stack_list
;
1667 if (_setjmp (c
.jmp
))
1669 return (*hfun
) (c
.val
);
1673 h
.handler
= handlers
;
1675 h
.next
= handlerlist
;
1679 val
= (*bfun
) (nargs
, args
);
1681 handlerlist
= h
.next
;
1686 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
,
1687 Lisp_Object
, Lisp_Object
);
1689 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1690 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1691 This function does not return.
1693 An error symbol is a symbol with an `error-conditions' property
1694 that is a list of condition names.
1695 A handler for any of those names will get to handle this signal.
1696 The symbol `error' should normally be one of them.
1698 DATA should be a list. Its elements are printed as part of the error message.
1699 See Info anchor `(elisp)Definition of signal' for some details on how this
1700 error message is constructed.
1701 If the signal is handled, DATA is made available to the handler.
1702 See also the function `condition-case'. */)
1703 (Lisp_Object error_symbol
, Lisp_Object data
)
1705 /* When memory is full, ERROR-SYMBOL is nil,
1706 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1707 That is a special case--don't do this in other situations. */
1708 register struct handler
*allhandlers
= handlerlist
;
1709 Lisp_Object conditions
;
1710 extern int gc_in_progress
;
1711 extern int waiting_for_input
;
1713 Lisp_Object real_error_symbol
;
1714 struct backtrace
*bp
;
1716 immediate_quit
= handling_signal
= 0;
1718 if (gc_in_progress
|| waiting_for_input
)
1721 if (NILP (error_symbol
))
1722 real_error_symbol
= Fcar (data
);
1724 real_error_symbol
= error_symbol
;
1726 #if 0 /* rms: I don't know why this was here,
1727 but it is surely wrong for an error that is handled. */
1728 #ifdef HAVE_WINDOW_SYSTEM
1729 if (display_hourglass_p
)
1730 cancel_hourglass ();
1734 /* This hook is used by edebug. */
1735 if (! NILP (Vsignal_hook_function
)
1736 && ! NILP (error_symbol
))
1738 /* Edebug takes care of restoring these variables when it exits. */
1739 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1740 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1742 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1743 max_specpdl_size
= SPECPDL_INDEX () + 40;
1745 call2 (Vsignal_hook_function
, error_symbol
, data
);
1748 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1750 /* Remember from where signal was called. Skip over the frame for
1751 `signal' itself. If a frame for `error' follows, skip that,
1752 too. Don't do this when ERROR_SYMBOL is nil, because that
1753 is a memory-full error. */
1754 Vsignaling_function
= Qnil
;
1755 if (backtrace_list
&& !NILP (error_symbol
))
1757 bp
= backtrace_list
->next
;
1758 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1760 if (bp
&& bp
->function
)
1761 Vsignaling_function
= *bp
->function
;
1764 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1766 register Lisp_Object clause
;
1768 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1769 error_symbol
, data
);
1771 if (EQ (clause
, Qlambda
))
1773 /* We can't return values to code which signaled an error, but we
1774 can continue code which has signaled a quit. */
1775 if (EQ (real_error_symbol
, Qquit
))
1778 error ("Cannot return from the debugger in an error");
1783 Lisp_Object unwind_data
;
1784 struct handler
*h
= handlerlist
;
1786 handlerlist
= allhandlers
;
1788 if (NILP (error_symbol
))
1791 unwind_data
= Fcons (error_symbol
, data
);
1792 h
->chosen_clause
= clause
;
1793 unwind_to_catch (h
->tag
, unwind_data
);
1797 handlerlist
= allhandlers
;
1798 /* If no handler is present now, try to run the debugger,
1799 and if that fails, throw to top level. */
1800 find_handler_clause (Qerror
, conditions
, error_symbol
, data
);
1802 Fthrow (Qtop_level
, Qt
);
1804 if (! NILP (error_symbol
))
1805 data
= Fcons (error_symbol
, data
);
1807 string
= Ferror_message_string (data
);
1808 fatal ("%s", SDATA (string
), 0);
1811 /* Internal version of Fsignal that never returns.
1812 Used for anything but Qquit (which can return from Fsignal). */
1815 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1817 Fsignal (error_symbol
, data
);
1821 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1824 xsignal0 (Lisp_Object error_symbol
)
1826 xsignal (error_symbol
, Qnil
);
1830 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1832 xsignal (error_symbol
, list1 (arg
));
1836 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1838 xsignal (error_symbol
, list2 (arg1
, arg2
));
1842 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1844 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1847 /* Signal `error' with message S, and additional arg ARG.
1848 If ARG is not a genuine list, make it a one-element list. */
1851 signal_error (const char *s
, Lisp_Object arg
)
1853 Lisp_Object tortoise
, hare
;
1855 hare
= tortoise
= arg
;
1856 while (CONSP (hare
))
1863 tortoise
= XCDR (tortoise
);
1865 if (EQ (hare
, tortoise
))
1870 arg
= Fcons (arg
, Qnil
); /* Make it a list. */
1872 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1876 /* Return nonzero if LIST is a non-nil atom or
1877 a list containing one of CONDITIONS. */
1880 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1887 while (CONSP (conditions
))
1889 Lisp_Object
this, tail
;
1890 this = XCAR (conditions
);
1891 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1892 if (EQ (XCAR (tail
), this))
1894 conditions
= XCDR (conditions
);
1899 /* Return 1 if an error with condition-symbols CONDITIONS,
1900 and described by SIGNAL-DATA, should skip the debugger
1901 according to debugger-ignored-errors. */
1904 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1907 int first_string
= 1;
1908 Lisp_Object error_message
;
1910 error_message
= Qnil
;
1911 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1913 if (STRINGP (XCAR (tail
)))
1917 error_message
= Ferror_message_string (data
);
1921 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1926 Lisp_Object contail
;
1928 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1929 if (EQ (XCAR (tail
), XCAR (contail
)))
1937 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1938 SIG and DATA describe the signal, as in find_handler_clause. */
1941 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1943 Lisp_Object combined_data
;
1945 combined_data
= Fcons (sig
, data
);
1948 /* Don't try to run the debugger with interrupts blocked.
1949 The editing loop would return anyway. */
1951 /* Does user want to enter debugger for this kind of error? */
1954 : wants_debugger (Vdebug_on_error
, conditions
))
1955 && ! skip_debugger (conditions
, combined_data
)
1956 /* rms: what's this for? */
1957 && when_entered_debugger
< num_nonmacro_input_events
)
1959 call_debugger (Fcons (Qerror
, Fcons (combined_data
, Qnil
)));
1966 /* Value of Qlambda means we have called debugger and user has continued.
1967 There are two ways to pass SIG and DATA:
1968 = SIG is the error symbol, and DATA is the rest of the data.
1969 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1970 This is for memory-full errors only.
1972 We need to increase max_specpdl_size temporarily around
1973 anything we do that can push on the specpdl, so as not to get
1974 a second error here in case we're handling specpdl overflow. */
1977 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
,
1978 Lisp_Object sig
, Lisp_Object data
)
1980 register Lisp_Object h
;
1981 register Lisp_Object tem
;
1982 int debugger_called
= 0;
1983 int debugger_considered
= 0;
1985 /* t is used by handlers for all conditions, set up by C code. */
1986 if (EQ (handlers
, Qt
))
1989 /* Don't run the debugger for a memory-full error.
1990 (There is no room in memory to do that!) */
1992 debugger_considered
= 1;
1994 /* error is used similarly, but means print an error message
1995 and run the debugger if that is enabled. */
1996 if (EQ (handlers
, Qerror
)
1997 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1998 there is a handler. */
2000 if (!NILP (sig
) && wants_debugger (Vstack_trace_on_error
, conditions
))
2002 max_lisp_eval_depth
+= 15;
2007 internal_with_output_to_temp_buffer
2009 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
2012 max_lisp_eval_depth
-= 15;
2015 if (!debugger_considered
)
2017 debugger_considered
= 1;
2018 debugger_called
= maybe_call_debugger (conditions
, sig
, data
);
2021 /* If there is no handler, return saying whether we ran the debugger. */
2022 if (EQ (handlers
, Qerror
))
2024 if (debugger_called
)
2030 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
2032 Lisp_Object handler
, condit
;
2035 if (!CONSP (handler
))
2037 condit
= Fcar (handler
);
2038 /* Handle a single condition name in handler HANDLER. */
2039 if (SYMBOLP (condit
))
2041 tem
= Fmemq (Fcar (handler
), conditions
);
2045 /* Handle a list of condition names in handler HANDLER. */
2046 else if (CONSP (condit
))
2049 for (tail
= condit
; CONSP (tail
); tail
= XCDR (tail
))
2051 tem
= Fmemq (Fcar (tail
), conditions
);
2054 /* This handler is going to apply.
2055 Does it allow the debugger to run first? */
2056 if (! debugger_considered
&& !NILP (Fmemq (Qdebug
, condit
)))
2057 maybe_call_debugger (conditions
, sig
, data
);
2068 /* dump an error message; called like vprintf */
2070 verror (const char *m
, va_list ap
)
2085 used
= doprnt (buffer
, size
, m
, m
+ mlen
, ap
);
2090 buffer
= (char *) xrealloc (buffer
, size
);
2093 buffer
= (char *) xmalloc (size
);
2098 string
= build_string (buffer
);
2102 xsignal1 (Qerror
, string
);
2106 /* dump an error message; called like printf */
2110 error (const char *m
, ...)
2118 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
2119 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
2120 This means it contains a description for how to read arguments to give it.
2121 The value is nil for an invalid function or a symbol with no function
2124 Interactively callable functions include strings and vectors (treated
2125 as keyboard macros), lambda-expressions that contain a top-level call
2126 to `interactive', autoload definitions made by `autoload' with non-nil
2127 fourth argument, and some of the built-in functions of Lisp.
2129 Also, a symbol satisfies `commandp' if its function definition does so.
2131 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
2132 then strings and vectors are not accepted. */)
2133 (Lisp_Object function
, Lisp_Object for_call_interactively
)
2135 register Lisp_Object fun
;
2136 register Lisp_Object funcar
;
2137 Lisp_Object if_prop
= Qnil
;
2141 fun
= indirect_function (fun
); /* Check cycles. */
2142 if (NILP (fun
) || EQ (fun
, Qunbound
))
2145 /* Check an `interactive-form' property if present, analogous to the
2146 function-documentation property. */
2148 while (SYMBOLP (fun
))
2150 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
2153 fun
= Fsymbol_function (fun
);
2156 /* Emacs primitives are interactive if their DEFUN specifies an
2157 interactive spec. */
2159 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
2161 /* Bytecode objects are interactive if they are long enough to
2162 have an element whose index is COMPILED_INTERACTIVE, which is
2163 where the interactive spec is stored. */
2164 else if (COMPILEDP (fun
))
2165 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
2168 /* Strings and vectors are keyboard macros. */
2169 if (STRINGP (fun
) || VECTORP (fun
))
2170 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
2172 /* Lists may represent commands. */
2175 funcar
= XCAR (fun
);
2176 if (EQ (funcar
, Qlambda
))
2177 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
2178 if (EQ (funcar
, Qautoload
))
2179 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
2184 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
2185 doc
: /* Define FUNCTION to autoload from FILE.
2186 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
2187 Third arg DOCSTRING is documentation for the function.
2188 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
2189 Fifth arg TYPE indicates the type of the object:
2190 nil or omitted says FUNCTION is a function,
2191 `keymap' says FUNCTION is really a keymap, and
2192 `macro' or t says FUNCTION is really a macro.
2193 Third through fifth args give info about the real definition.
2194 They default to nil.
2195 If FUNCTION is already defined other than as an autoload,
2196 this does nothing and returns nil. */)
2197 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
2199 CHECK_SYMBOL (function
);
2200 CHECK_STRING (file
);
2202 /* If function is defined and not as an autoload, don't override */
2203 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
2204 && !(CONSP (XSYMBOL (function
)->function
)
2205 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
2208 if (NILP (Vpurify_flag
))
2209 /* Only add entries after dumping, because the ones before are
2210 not useful and else we get loads of them from the loaddefs.el. */
2211 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
2213 /* We don't want the docstring in purespace (instead,
2214 Snarf-documentation should (hopefully) overwrite it).
2215 We used to use 0 here, but that leads to accidental sharing in
2216 purecopy's hash-consing, so we use a (hopefully) unique integer
2218 docstring
= make_number (XHASH (function
));
2219 return Ffset (function
,
2220 Fpurecopy (list5 (Qautoload
, file
, docstring
,
2221 interactive
, type
)));
2225 un_autoload (Lisp_Object oldqueue
)
2227 register Lisp_Object queue
, first
, second
;
2229 /* Queue to unwind is current value of Vautoload_queue.
2230 oldqueue is the shadowed value to leave in Vautoload_queue. */
2231 queue
= Vautoload_queue
;
2232 Vautoload_queue
= oldqueue
;
2233 while (CONSP (queue
))
2235 first
= XCAR (queue
);
2236 second
= Fcdr (first
);
2237 first
= Fcar (first
);
2238 if (EQ (first
, make_number (0)))
2241 Ffset (first
, second
);
2242 queue
= XCDR (queue
);
2247 /* Load an autoloaded function.
2248 FUNNAME is the symbol which is the function's name.
2249 FUNDEF is the autoload definition (a list). */
2252 do_autoload (Lisp_Object fundef
, Lisp_Object funname
)
2254 int count
= SPECPDL_INDEX ();
2256 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2258 /* This is to make sure that loadup.el gives a clear picture
2259 of what files are preloaded and when. */
2260 if (! NILP (Vpurify_flag
))
2261 error ("Attempt to autoload %s while preparing to dump",
2262 SDATA (SYMBOL_NAME (funname
)));
2265 CHECK_SYMBOL (funname
);
2266 GCPRO3 (fun
, funname
, fundef
);
2268 /* Preserve the match data. */
2269 record_unwind_save_match_data ();
2271 /* If autoloading gets an error (which includes the error of failing
2272 to define the function being called), we use Vautoload_queue
2273 to undo function definitions and `provide' calls made by
2274 the function. We do this in the specific case of autoloading
2275 because autoloading is not an explicit request "load this file",
2276 but rather a request to "call this function".
2278 The value saved here is to be restored into Vautoload_queue. */
2279 record_unwind_protect (un_autoload
, Vautoload_queue
);
2280 Vautoload_queue
= Qt
;
2281 Fload (Fcar (Fcdr (fundef
)), Qnil
, Qt
, Qnil
, Qt
);
2283 /* Once loading finishes, don't undo it. */
2284 Vautoload_queue
= Qt
;
2285 unbind_to (count
, Qnil
);
2287 fun
= Findirect_function (fun
, Qnil
);
2289 if (!NILP (Fequal (fun
, fundef
)))
2290 error ("Autoloading failed to define function %s",
2291 SDATA (SYMBOL_NAME (funname
)));
2296 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
2297 doc
: /* Evaluate FORM and return its value. */)
2300 Lisp_Object fun
, val
, original_fun
, original_args
;
2302 struct backtrace backtrace
;
2303 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2305 if (handling_signal
)
2310 /* If there's an active lexical environment, and the variable
2311 isn't declared special, look up its binding in the lexical
2313 if (!NILP (Vinternal_interpreter_environment
)
2314 && !XSYMBOL (form
)->declared_special
)
2316 Lisp_Object lex_binding
2317 = Fassq (form
, Vinternal_interpreter_environment
);
2319 /* If we found a lexical binding for FORM, return the value.
2320 Otherwise, we just drop through and look for a dynamic
2321 binding -- the variable isn't declared special, but there's
2322 not much else we can do, and Fsymbol_value will take care
2323 of signaling an error if there is no binding at all. */
2324 if (CONSP (lex_binding
))
2325 return XCDR (lex_binding
);
2328 return Fsymbol_value (form
);
2335 if ((consing_since_gc
> gc_cons_threshold
2336 && consing_since_gc
> gc_relative_threshold
)
2338 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2341 Fgarbage_collect ();
2345 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2347 if (max_lisp_eval_depth
< 100)
2348 max_lisp_eval_depth
= 100;
2349 if (lisp_eval_depth
> max_lisp_eval_depth
)
2350 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2353 original_fun
= Fcar (form
);
2354 original_args
= Fcdr (form
);
2356 backtrace
.next
= backtrace_list
;
2357 backtrace_list
= &backtrace
;
2358 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2359 backtrace
.args
= &original_args
;
2360 backtrace
.nargs
= UNEVALLED
;
2361 backtrace
.evalargs
= 1;
2362 backtrace
.debug_on_exit
= 0;
2364 if (debug_on_next_call
)
2365 do_debug_on_call (Qt
);
2367 /* At this point, only original_fun and original_args
2368 have values that will be used below */
2371 /* Optimize for no indirection. */
2373 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2374 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2375 fun
= indirect_function (fun
);
2379 Lisp_Object numargs
;
2380 Lisp_Object argvals
[8];
2381 Lisp_Object args_left
;
2382 register int i
, maxargs
;
2384 args_left
= original_args
;
2385 numargs
= Flength (args_left
);
2389 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2390 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2391 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2393 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2395 backtrace
.evalargs
= 0;
2396 val
= (XSUBR (fun
)->function
.aUNEVALLED
) (args_left
);
2400 if (XSUBR (fun
)->max_args
== MANY
)
2402 /* Pass a vector of evaluated arguments */
2404 register int argnum
= 0;
2406 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2408 GCPRO3 (args_left
, fun
, fun
);
2412 while (!NILP (args_left
))
2414 vals
[argnum
++] = Feval (Fcar (args_left
));
2415 args_left
= Fcdr (args_left
);
2416 gcpro3
.nvars
= argnum
;
2419 backtrace
.args
= vals
;
2420 backtrace
.nargs
= XINT (numargs
);
2422 val
= (XSUBR (fun
)->function
.aMANY
) (XINT (numargs
), vals
);
2427 GCPRO3 (args_left
, fun
, fun
);
2428 gcpro3
.var
= argvals
;
2431 maxargs
= XSUBR (fun
)->max_args
;
2432 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2434 argvals
[i
] = Feval (Fcar (args_left
));
2440 backtrace
.args
= argvals
;
2441 backtrace
.nargs
= XINT (numargs
);
2446 val
= (XSUBR (fun
)->function
.a0
) ();
2449 val
= (XSUBR (fun
)->function
.a1
) (argvals
[0]);
2452 val
= (XSUBR (fun
)->function
.a2
) (argvals
[0], argvals
[1]);
2455 val
= (XSUBR (fun
)->function
.a3
) (argvals
[0], argvals
[1],
2459 val
= (XSUBR (fun
)->function
.a4
) (argvals
[0], argvals
[1],
2460 argvals
[2], argvals
[3]);
2463 val
= (XSUBR (fun
)->function
.a5
) (argvals
[0], argvals
[1], argvals
[2],
2464 argvals
[3], argvals
[4]);
2467 val
= (XSUBR (fun
)->function
.a6
) (argvals
[0], argvals
[1], argvals
[2],
2468 argvals
[3], argvals
[4], argvals
[5]);
2471 val
= (XSUBR (fun
)->function
.a7
) (argvals
[0], argvals
[1], argvals
[2],
2472 argvals
[3], argvals
[4], argvals
[5],
2477 val
= (XSUBR (fun
)->function
.a8
) (argvals
[0], argvals
[1], argvals
[2],
2478 argvals
[3], argvals
[4], argvals
[5],
2479 argvals
[6], argvals
[7]);
2483 /* Someone has created a subr that takes more arguments than
2484 is supported by this code. We need to either rewrite the
2485 subr to use a different argument protocol, or add more
2486 cases to this switch. */
2491 val
= apply_lambda (fun
, original_args
, 1, Qnil
);
2494 if (EQ (fun
, Qunbound
))
2495 xsignal1 (Qvoid_function
, original_fun
);
2497 xsignal1 (Qinvalid_function
, original_fun
);
2498 funcar
= XCAR (fun
);
2499 if (!SYMBOLP (funcar
))
2500 xsignal1 (Qinvalid_function
, original_fun
);
2501 if (EQ (funcar
, Qautoload
))
2503 do_autoload (fun
, original_fun
);
2506 if (EQ (funcar
, Qmacro
))
2507 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2508 else if (EQ (funcar
, Qlambda
))
2509 val
= apply_lambda (fun
, original_args
, 1,
2510 /* Only pass down the current lexical environment
2511 if FUN is lexically embedded in FORM. */
2512 (CONSP (original_fun
)
2513 ? Vinternal_interpreter_environment
2515 else if (EQ (funcar
, Qclosure
)
2516 && CONSP (XCDR (fun
))
2517 && CONSP (XCDR (XCDR (fun
)))
2518 && EQ (XCAR (XCDR (XCDR (fun
))), Qlambda
))
2519 val
= apply_lambda (XCDR (XCDR (fun
)), original_args
, 1,
2522 xsignal1 (Qinvalid_function
, original_fun
);
2528 if (backtrace
.debug_on_exit
)
2529 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2530 backtrace_list
= backtrace
.next
;
2535 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2536 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2537 Then return the value FUNCTION returns.
2538 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2539 usage: (apply FUNCTION &rest ARGUMENTS) */)
2540 (int nargs
, Lisp_Object
*args
)
2542 register int i
, numargs
;
2543 register Lisp_Object spread_arg
;
2544 register Lisp_Object
*funcall_args
;
2546 struct gcpro gcpro1
;
2550 spread_arg
= args
[nargs
- 1];
2551 CHECK_LIST (spread_arg
);
2553 numargs
= XINT (Flength (spread_arg
));
2556 return Ffuncall (nargs
- 1, args
);
2557 else if (numargs
== 1)
2559 args
[nargs
- 1] = XCAR (spread_arg
);
2560 return Ffuncall (nargs
, args
);
2563 numargs
+= nargs
- 2;
2565 /* Optimize for no indirection. */
2566 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2567 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2568 fun
= indirect_function (fun
);
2569 if (EQ (fun
, Qunbound
))
2571 /* Let funcall get the error */
2578 if (numargs
< XSUBR (fun
)->min_args
2579 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2580 goto funcall
; /* Let funcall get the error */
2581 else if (XSUBR (fun
)->max_args
> numargs
)
2583 /* Avoid making funcall cons up a yet another new vector of arguments
2584 by explicitly supplying nil's for optional values */
2585 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2586 * sizeof (Lisp_Object
));
2587 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2588 funcall_args
[++i
] = Qnil
;
2589 GCPRO1 (*funcall_args
);
2590 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2594 /* We add 1 to numargs because funcall_args includes the
2595 function itself as well as its arguments. */
2598 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2599 * sizeof (Lisp_Object
));
2600 GCPRO1 (*funcall_args
);
2601 gcpro1
.nvars
= 1 + numargs
;
2604 memcpy (funcall_args
, args
, nargs
* sizeof (Lisp_Object
));
2605 /* Spread the last arg we got. Its first element goes in
2606 the slot that it used to occupy, hence this value of I. */
2608 while (!NILP (spread_arg
))
2610 funcall_args
[i
++] = XCAR (spread_arg
);
2611 spread_arg
= XCDR (spread_arg
);
2614 /* By convention, the caller needs to gcpro Ffuncall's args. */
2615 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2618 /* Run hook variables in various ways. */
2620 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2621 static Lisp_Object
run_hook_with_args (int, Lisp_Object
*,
2622 enum run_hooks_condition
);
2624 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2625 doc
: /* Run each hook in HOOKS.
2626 Each argument should be a symbol, a hook variable.
2627 These symbols are processed in the order specified.
2628 If a hook symbol has a non-nil value, that value may be a function
2629 or a list of functions to be called to run the hook.
2630 If the value is a function, it is called with no arguments.
2631 If it is a list, the elements are called, in order, with no arguments.
2633 Major modes should not use this function directly to run their mode
2634 hook; they should use `run-mode-hooks' instead.
2636 Do not use `make-local-variable' to make a hook variable buffer-local.
2637 Instead, use `add-hook' and specify t for the LOCAL argument.
2638 usage: (run-hooks &rest HOOKS) */)
2639 (int nargs
, Lisp_Object
*args
)
2641 Lisp_Object hook
[1];
2644 for (i
= 0; i
< nargs
; i
++)
2647 run_hook_with_args (1, hook
, to_completion
);
2653 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2654 Srun_hook_with_args
, 1, MANY
, 0,
2655 doc
: /* Run HOOK with the specified arguments ARGS.
2656 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2657 value, that value may be a function or a list of functions to be
2658 called to run the hook. If the value is a function, it is called with
2659 the given arguments and its return value is returned. If it is a list
2660 of functions, those functions are called, in order,
2661 with the given arguments ARGS.
2662 It is best not to depend on the value returned by `run-hook-with-args',
2665 Do not use `make-local-variable' to make a hook variable buffer-local.
2666 Instead, use `add-hook' and specify t for the LOCAL argument.
2667 usage: (run-hook-with-args HOOK &rest ARGS) */)
2668 (int nargs
, Lisp_Object
*args
)
2670 return run_hook_with_args (nargs
, args
, to_completion
);
2673 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2674 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2675 doc
: /* Run HOOK with the specified arguments ARGS.
2676 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2677 value, that value may be a function or a list of functions to be
2678 called to run the hook. If the value is a function, it is called with
2679 the given arguments and its return value is returned.
2680 If it is a list of functions, those functions are called, in order,
2681 with the given arguments ARGS, until one of them
2682 returns a non-nil value. Then we return that value.
2683 However, if they all return nil, we return nil.
2685 Do not use `make-local-variable' to make a hook variable buffer-local.
2686 Instead, use `add-hook' and specify t for the LOCAL argument.
2687 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2688 (int nargs
, Lisp_Object
*args
)
2690 return run_hook_with_args (nargs
, args
, until_success
);
2693 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2694 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2695 doc
: /* Run HOOK with the specified arguments ARGS.
2696 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2697 value, that value may be a function or a list of functions to be
2698 called to run the hook. If the value is a function, it is called with
2699 the given arguments and its return value is returned.
2700 If it is a list of functions, those functions are called, in order,
2701 with the given arguments ARGS, until one of them returns nil.
2702 Then we return nil. However, if they all return non-nil, we return non-nil.
2704 Do not use `make-local-variable' to make a hook variable buffer-local.
2705 Instead, use `add-hook' and specify t for the LOCAL argument.
2706 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2707 (int nargs
, Lisp_Object
*args
)
2709 return run_hook_with_args (nargs
, args
, until_failure
);
2712 /* ARGS[0] should be a hook symbol.
2713 Call each of the functions in the hook value, passing each of them
2714 as arguments all the rest of ARGS (all NARGS - 1 elements).
2715 COND specifies a condition to test after each call
2716 to decide whether to stop.
2717 The caller (or its caller, etc) must gcpro all of ARGS,
2718 except that it isn't necessary to gcpro ARGS[0]. */
2721 run_hook_with_args (int nargs
, Lisp_Object
*args
, enum run_hooks_condition cond
)
2723 Lisp_Object sym
, val
, ret
;
2724 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2726 /* If we are dying or still initializing,
2727 don't do anything--it would probably crash if we tried. */
2728 if (NILP (Vrun_hooks
))
2732 val
= find_symbol_value (sym
);
2733 ret
= (cond
== until_failure
? Qt
: Qnil
);
2735 if (EQ (val
, Qunbound
) || NILP (val
))
2737 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2740 return Ffuncall (nargs
, args
);
2744 Lisp_Object globals
= Qnil
;
2745 GCPRO3 (sym
, val
, globals
);
2748 CONSP (val
) && ((cond
== to_completion
)
2749 || (cond
== until_success
? NILP (ret
)
2753 if (EQ (XCAR (val
), Qt
))
2755 /* t indicates this hook has a local binding;
2756 it means to run the global binding too. */
2757 globals
= Fdefault_value (sym
);
2758 if (NILP (globals
)) continue;
2760 if (!CONSP (globals
) || EQ (XCAR (globals
), Qlambda
))
2763 ret
= Ffuncall (nargs
, args
);
2768 CONSP (globals
) && ((cond
== to_completion
)
2769 || (cond
== until_success
? NILP (ret
)
2771 globals
= XCDR (globals
))
2773 args
[0] = XCAR (globals
);
2774 /* In a global value, t should not occur. If it does, we
2775 must ignore it to avoid an endless loop. */
2776 if (!EQ (args
[0], Qt
))
2777 ret
= Ffuncall (nargs
, args
);
2783 args
[0] = XCAR (val
);
2784 ret
= Ffuncall (nargs
, args
);
2793 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2794 present value of that symbol.
2795 Call each element of FUNLIST,
2796 passing each of them the rest of ARGS.
2797 The caller (or its caller, etc) must gcpro all of ARGS,
2798 except that it isn't necessary to gcpro ARGS[0]. */
2801 run_hook_list_with_args (Lisp_Object funlist
, int nargs
, Lisp_Object
*args
)
2805 Lisp_Object globals
;
2806 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2810 GCPRO3 (sym
, val
, globals
);
2812 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2814 if (EQ (XCAR (val
), Qt
))
2816 /* t indicates this hook has a local binding;
2817 it means to run the global binding too. */
2819 for (globals
= Fdefault_value (sym
);
2821 globals
= XCDR (globals
))
2823 args
[0] = XCAR (globals
);
2824 /* In a global value, t should not occur. If it does, we
2825 must ignore it to avoid an endless loop. */
2826 if (!EQ (args
[0], Qt
))
2827 Ffuncall (nargs
, args
);
2832 args
[0] = XCAR (val
);
2833 Ffuncall (nargs
, args
);
2840 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2843 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
2845 Lisp_Object temp
[3];
2850 Frun_hook_with_args (3, temp
);
2853 /* Apply fn to arg */
2855 apply1 (Lisp_Object fn
, Lisp_Object arg
)
2857 struct gcpro gcpro1
;
2861 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2864 Lisp_Object args
[2];
2868 RETURN_UNGCPRO (Fapply (2, args
));
2872 /* Call function fn on no arguments */
2874 call0 (Lisp_Object fn
)
2876 struct gcpro gcpro1
;
2879 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2882 /* Call function fn with 1 argument arg1 */
2885 call1 (Lisp_Object fn
, Lisp_Object arg1
)
2887 struct gcpro gcpro1
;
2888 Lisp_Object args
[2];
2894 RETURN_UNGCPRO (Ffuncall (2, args
));
2897 /* Call function fn with 2 arguments arg1, arg2 */
2900 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
2902 struct gcpro gcpro1
;
2903 Lisp_Object args
[3];
2909 RETURN_UNGCPRO (Ffuncall (3, args
));
2912 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2915 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
2917 struct gcpro gcpro1
;
2918 Lisp_Object args
[4];
2925 RETURN_UNGCPRO (Ffuncall (4, args
));
2928 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2931 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2934 struct gcpro gcpro1
;
2935 Lisp_Object args
[5];
2943 RETURN_UNGCPRO (Ffuncall (5, args
));
2946 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2949 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2950 Lisp_Object arg4
, Lisp_Object arg5
)
2952 struct gcpro gcpro1
;
2953 Lisp_Object args
[6];
2962 RETURN_UNGCPRO (Ffuncall (6, args
));
2965 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2968 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2969 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
2971 struct gcpro gcpro1
;
2972 Lisp_Object args
[7];
2982 RETURN_UNGCPRO (Ffuncall (7, args
));
2985 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
2988 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
2989 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
2991 struct gcpro gcpro1
;
2992 Lisp_Object args
[8];
3003 RETURN_UNGCPRO (Ffuncall (8, args
));
3006 /* The caller should GCPRO all the elements of ARGS. */
3008 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
3009 doc
: /* Return non-nil if OBJECT is a type of object that can be called as a function. */)
3013 if (SYMBOLP (object
) && !NILP (Ffboundp (object
)))
3015 object
= Findirect_function (object
, Qnil
);
3017 if (CONSP (object
) && EQ (XCAR (object
), Qautoload
))
3019 /* Autoloaded symbols are functions, except if they load
3020 macros or keymaps. */
3022 for (i
= 0; i
< 4 && CONSP (object
); i
++)
3023 object
= XCDR (object
);
3025 return (CONSP (object
) && !NILP (XCAR (object
))) ? Qnil
: Qt
;
3030 return (XSUBR (object
)->max_args
!= UNEVALLED
) ? Qt
: Qnil
;
3031 else if (FUNVECP (object
))
3033 else if (CONSP (object
))
3035 Lisp_Object car
= XCAR (object
);
3036 return (EQ (car
, Qlambda
) || EQ (car
, Qclosure
)) ? Qt
: Qnil
;
3042 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
3043 doc
: /* Call first argument as a function, passing remaining arguments to it.
3044 Return the value that function returns.
3045 Thus, (funcall 'cons 'x 'y) returns (x . y).
3046 usage: (funcall FUNCTION &rest ARGUMENTS) */)
3047 (int nargs
, Lisp_Object
*args
)
3049 Lisp_Object fun
, original_fun
;
3051 int numargs
= nargs
- 1;
3052 Lisp_Object lisp_numargs
;
3054 struct backtrace backtrace
;
3055 register Lisp_Object
*internal_args
;
3059 if ((consing_since_gc
> gc_cons_threshold
3060 && consing_since_gc
> gc_relative_threshold
)
3062 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
3063 Fgarbage_collect ();
3065 if (++lisp_eval_depth
> max_lisp_eval_depth
)
3067 if (max_lisp_eval_depth
< 100)
3068 max_lisp_eval_depth
= 100;
3069 if (lisp_eval_depth
> max_lisp_eval_depth
)
3070 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
3073 backtrace
.next
= backtrace_list
;
3074 backtrace_list
= &backtrace
;
3075 backtrace
.function
= &args
[0];
3076 backtrace
.args
= &args
[1];
3077 backtrace
.nargs
= nargs
- 1;
3078 backtrace
.evalargs
= 0;
3079 backtrace
.debug_on_exit
= 0;
3081 if (debug_on_next_call
)
3082 do_debug_on_call (Qlambda
);
3086 original_fun
= args
[0];
3090 /* Optimize for no indirection. */
3092 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
3093 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
3094 fun
= indirect_function (fun
);
3098 if (numargs
< XSUBR (fun
)->min_args
3099 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
3101 XSETFASTINT (lisp_numargs
, numargs
);
3102 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
3105 if (XSUBR (fun
)->max_args
== UNEVALLED
)
3106 xsignal1 (Qinvalid_function
, original_fun
);
3108 if (XSUBR (fun
)->max_args
== MANY
)
3110 val
= (XSUBR (fun
)->function
.aMANY
) (numargs
, args
+ 1);
3114 if (XSUBR (fun
)->max_args
> numargs
)
3116 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
3117 memcpy (internal_args
, args
+ 1, numargs
* sizeof (Lisp_Object
));
3118 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
3119 internal_args
[i
] = Qnil
;
3122 internal_args
= args
+ 1;
3123 switch (XSUBR (fun
)->max_args
)
3126 val
= (XSUBR (fun
)->function
.a0
) ();
3129 val
= (XSUBR (fun
)->function
.a1
) (internal_args
[0]);
3132 val
= (XSUBR (fun
)->function
.a2
) (internal_args
[0], internal_args
[1]);
3135 val
= (XSUBR (fun
)->function
.a3
) (internal_args
[0], internal_args
[1],
3139 val
= (XSUBR (fun
)->function
.a4
) (internal_args
[0], internal_args
[1],
3140 internal_args
[2], internal_args
[3]);
3143 val
= (XSUBR (fun
)->function
.a5
) (internal_args
[0], internal_args
[1],
3144 internal_args
[2], internal_args
[3],
3148 val
= (XSUBR (fun
)->function
.a6
) (internal_args
[0], internal_args
[1],
3149 internal_args
[2], internal_args
[3],
3150 internal_args
[4], internal_args
[5]);
3153 val
= (XSUBR (fun
)->function
.a7
) (internal_args
[0], internal_args
[1],
3154 internal_args
[2], internal_args
[3],
3155 internal_args
[4], internal_args
[5],
3160 val
= (XSUBR (fun
)->function
.a8
) (internal_args
[0], internal_args
[1],
3161 internal_args
[2], internal_args
[3],
3162 internal_args
[4], internal_args
[5],
3163 internal_args
[6], internal_args
[7]);
3168 /* If a subr takes more than 8 arguments without using MANY
3169 or UNEVALLED, we need to extend this function to support it.
3170 Until this is done, there is no way to call the function. */
3176 val
= funcall_lambda (fun
, numargs
, args
+ 1, Qnil
);
3179 if (EQ (fun
, Qunbound
))
3180 xsignal1 (Qvoid_function
, original_fun
);
3182 xsignal1 (Qinvalid_function
, original_fun
);
3183 funcar
= XCAR (fun
);
3184 if (!SYMBOLP (funcar
))
3185 xsignal1 (Qinvalid_function
, original_fun
);
3186 if (EQ (funcar
, Qlambda
))
3187 val
= funcall_lambda (fun
, numargs
, args
+ 1, Qnil
);
3188 else if (EQ (funcar
, Qclosure
)
3189 && CONSP (XCDR (fun
))
3190 && CONSP (XCDR (XCDR (fun
)))
3191 && EQ (XCAR (XCDR (XCDR (fun
))), Qlambda
))
3192 val
= funcall_lambda (XCDR (XCDR (fun
)), numargs
, args
+ 1,
3194 else if (EQ (funcar
, Qautoload
))
3196 do_autoload (fun
, original_fun
);
3201 xsignal1 (Qinvalid_function
, original_fun
);
3206 if (backtrace
.debug_on_exit
)
3207 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
3208 backtrace_list
= backtrace
.next
;
3213 apply_lambda (Lisp_Object fun
, Lisp_Object args
, int eval_flag
,
3216 Lisp_Object args_left
;
3217 Lisp_Object numargs
;
3218 register Lisp_Object
*arg_vector
;
3219 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3221 register Lisp_Object tem
;
3223 numargs
= Flength (args
);
3224 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
3227 GCPRO3 (*arg_vector
, args_left
, fun
);
3230 for (i
= 0; i
< XINT (numargs
);)
3232 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
3233 if (eval_flag
) tem
= Feval (tem
);
3234 arg_vector
[i
++] = tem
;
3242 backtrace_list
->args
= arg_vector
;
3243 backtrace_list
->nargs
= i
;
3245 backtrace_list
->evalargs
= 0;
3246 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
, lexenv
);
3248 /* Do the debug-on-exit now, while arg_vector still exists. */
3249 if (backtrace_list
->debug_on_exit
)
3250 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
3251 /* Don't do it again when we return to eval. */
3252 backtrace_list
->debug_on_exit
= 0;
3257 /* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
3261 funcall_funvec (fun
, nargs
, args
)
3266 int size
= FUNVEC_SIZE (fun
);
3267 Lisp_Object tag
= (size
> 0 ? AREF (fun
, 0) : Qnil
);
3269 if (EQ (tag
, Qcurry
))
3271 /* A curried function is a way to attach arguments to a another
3272 function. The first element of the vector is the identifier
3273 `curry', the second is the wrapped function, and remaining
3274 elements are the attached arguments. */
3275 int num_curried_args
= size
- 2;
3276 /* Offset of the curried and user args in the final arglist. Curried
3277 args are first in the new arg vector, after the function. User
3279 int curried_args_offs
= 1;
3280 int user_args_offs
= curried_args_offs
+ num_curried_args
;
3281 /* The curried function and arguments. */
3282 Lisp_Object
*curry_params
= XVECTOR (fun
)->contents
+ 1;
3283 /* The arguments in the curry vector. */
3284 Lisp_Object
*curried_args
= curry_params
+ 1;
3285 /* The number of arguments with which we'll call funcall, and the
3286 arguments themselves. */
3287 int num_funcall_args
= 1 + num_curried_args
+ nargs
;
3288 Lisp_Object
*funcall_args
3289 = (Lisp_Object
*) alloca (num_funcall_args
* sizeof (Lisp_Object
));
3291 /* First comes the real function. */
3292 funcall_args
[0] = curry_params
[0];
3294 /* Then the arguments in the appropriate order. */
3295 memcpy (funcall_args
+ curried_args_offs
, curried_args
,
3296 num_curried_args
* sizeof (Lisp_Object
));
3297 memcpy (funcall_args
+ user_args_offs
, args
,
3298 nargs
* sizeof (Lisp_Object
));
3300 return Ffuncall (num_funcall_args
, funcall_args
);
3303 xsignal1 (Qinvalid_function
, fun
);
3307 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
3308 and return the result of evaluation.
3309 FUN must be either a lambda-expression or a compiled-code object. */
3312 funcall_lambda (Lisp_Object fun
, int nargs
,
3313 register Lisp_Object
*arg_vector
,
3316 Lisp_Object val
, syms_left
, next
;
3317 int count
= SPECPDL_INDEX ();
3318 int i
, optional
, rest
;
3321 && FUNVEC_SIZE (fun
) > COMPILED_PUSH_ARGS
3322 && ! NILP (XVECTOR (fun
)->contents
[COMPILED_PUSH_ARGS
]))
3323 /* A byte-code object with a non-nil `push args' slot means we
3324 shouldn't bind any arguments, instead just call the byte-code
3325 interpreter directly; it will push arguments as necessary.
3327 Byte-code objects with either a non-existant, or a nil value for
3328 the `push args' slot (the default), have dynamically-bound
3329 arguments, and use the argument-binding code below instead (as do
3330 all interpreted functions, even lexically bound ones). */
3332 /* If we have not actually read the bytecode string
3333 and constants vector yet, fetch them from the file. */
3334 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3335 Ffetch_bytecode (fun
);
3336 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3337 AREF (fun
, COMPILED_CONSTANTS
),
3338 AREF (fun
, COMPILED_STACK_DEPTH
),
3339 AREF (fun
, COMPILED_ARGLIST
),
3343 if (FUNVECP (fun
) && !FUNVEC_COMPILED_P (fun
))
3344 /* Byte-compiled functions are handled directly below, but we
3345 call other funvec types via funcall_funvec. */
3346 return funcall_funvec (fun
, nargs
, arg_vector
);
3350 syms_left
= XCDR (fun
);
3351 if (CONSP (syms_left
))
3352 syms_left
= XCAR (syms_left
);
3354 xsignal1 (Qinvalid_function
, fun
);
3356 else if (COMPILEDP (fun
))
3357 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
3361 i
= optional
= rest
= 0;
3362 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
3366 next
= XCAR (syms_left
);
3367 if (!SYMBOLP (next
))
3368 xsignal1 (Qinvalid_function
, fun
);
3370 if (EQ (next
, Qand_rest
))
3372 else if (EQ (next
, Qand_optional
))
3376 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
3383 /* Get the argument's actual value. */
3385 val
= arg_vector
[i
++];
3387 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3391 /* Bind the argument. */
3393 && SYMBOLP (next
) && !XSYMBOL (next
)->declared_special
)
3394 /* Lexically bind NEXT by adding it to the lexenv alist. */
3395 lexenv
= Fcons (Fcons (next
, val
), lexenv
);
3397 /* Dynamically bind NEXT. */
3398 specbind (next
, val
);
3402 if (!NILP (syms_left
))
3403 xsignal1 (Qinvalid_function
, fun
);
3405 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3407 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3408 /* Instantiate a new lexical environment. */
3409 specbind (Qinternal_interpreter_environment
, lexenv
);
3412 val
= Fprogn (XCDR (XCDR (fun
)));
3415 /* If we have not actually read the bytecode string
3416 and constants vector yet, fetch them from the file. */
3417 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3418 Ffetch_bytecode (fun
);
3419 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3420 AREF (fun
, COMPILED_CONSTANTS
),
3421 AREF (fun
, COMPILED_STACK_DEPTH
),
3425 return unbind_to (count
, val
);
3428 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3430 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3431 (Lisp_Object object
)
3435 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3437 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3440 tem
= AREF (object
, COMPILED_BYTECODE
);
3441 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3442 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3444 error ("Invalid byte code");
3446 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3447 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3455 register int count
= SPECPDL_INDEX ();
3456 if (specpdl_size
>= max_specpdl_size
)
3458 if (max_specpdl_size
< 400)
3459 max_specpdl_size
= 400;
3460 if (specpdl_size
>= max_specpdl_size
)
3461 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil
);
3464 if (specpdl_size
> max_specpdl_size
)
3465 specpdl_size
= max_specpdl_size
;
3466 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3467 specpdl_ptr
= specpdl
+ count
;
3470 /* specpdl_ptr->symbol is a field which describes which variable is
3471 let-bound, so it can be properly undone when we unbind_to.
3472 It can have the following two shapes:
3473 - SYMBOL : if it's a plain symbol, it means that we have let-bound
3474 a symbol that is not buffer-local (at least at the time
3475 the let binding started). Note also that it should not be
3476 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3478 - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
3479 variable SYMBOL which can be buffer-local. WHERE tells us
3480 which buffer is affected (or nil if the let-binding affects the
3481 global value of the variable) and BUFFER tells us which buffer was
3482 current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
3483 BUFFER did not yet have a buffer-local value). */
3486 specbind (Lisp_Object symbol
, Lisp_Object value
)
3488 struct Lisp_Symbol
*sym
;
3490 eassert (!handling_signal
);
3492 CHECK_SYMBOL (symbol
);
3493 sym
= XSYMBOL (symbol
);
3494 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3498 switch (sym
->redirect
)
3500 case SYMBOL_VARALIAS
:
3501 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3502 case SYMBOL_PLAINVAL
:
3503 /* The most common case is that of a non-constant symbol with a
3504 trivial value. Make that as fast as we can. */
3505 specpdl_ptr
->symbol
= symbol
;
3506 specpdl_ptr
->old_value
= SYMBOL_VAL (sym
);
3507 specpdl_ptr
->func
= NULL
;
3510 SET_SYMBOL_VAL (sym
, value
);
3512 set_internal (symbol
, value
, Qnil
, 1);
3514 case SYMBOL_LOCALIZED
:
3515 if (SYMBOL_BLV (sym
)->frame_local
)
3516 error ("Frame-local vars cannot be let-bound");
3517 case SYMBOL_FORWARDED
:
3519 Lisp_Object ovalue
= find_symbol_value (symbol
);
3520 specpdl_ptr
->func
= 0;
3521 specpdl_ptr
->old_value
= ovalue
;
3523 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3524 || (EQ (SYMBOL_BLV (sym
)->where
,
3525 SYMBOL_BLV (sym
)->frame_local
?
3526 Fselected_frame () : Fcurrent_buffer ())));
3528 if (sym
->redirect
== SYMBOL_LOCALIZED
3529 || BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3531 Lisp_Object where
, cur_buf
= Fcurrent_buffer ();
3533 /* For a local variable, record both the symbol and which
3534 buffer's or frame's value we are saving. */
3535 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3537 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3538 || (BLV_FOUND (SYMBOL_BLV (sym
))
3539 && EQ (cur_buf
, SYMBOL_BLV (sym
)->where
)));
3542 else if (sym
->redirect
== SYMBOL_LOCALIZED
3543 && BLV_FOUND (SYMBOL_BLV (sym
)))
3544 where
= SYMBOL_BLV (sym
)->where
;
3548 /* We're not using the `unused' slot in the specbinding
3549 structure because this would mean we have to do more
3550 work for simple variables. */
3551 /* FIXME: The third value `current_buffer' is only used in
3552 let_shadows_buffer_binding_p which is itself only used
3553 in set_internal for local_if_set. */
3554 eassert (NILP (where
) || EQ (where
, cur_buf
));
3555 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, cur_buf
));
3557 /* If SYMBOL is a per-buffer variable which doesn't have a
3558 buffer-local value here, make the `let' change the global
3559 value by changing the value of SYMBOL in all buffers not
3560 having their own value. This is consistent with what
3561 happens with other buffer-local variables. */
3563 && sym
->redirect
== SYMBOL_FORWARDED
)
3565 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)));
3567 Fset_default (symbol
, value
);
3572 specpdl_ptr
->symbol
= symbol
;
3575 set_internal (symbol
, value
, Qnil
, 1);
3583 record_unwind_protect (Lisp_Object (*function
) (Lisp_Object
), Lisp_Object arg
)
3585 eassert (!handling_signal
);
3587 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3589 specpdl_ptr
->func
= function
;
3590 specpdl_ptr
->symbol
= Qnil
;
3591 specpdl_ptr
->old_value
= arg
;
3596 unbind_to (int count
, Lisp_Object value
)
3598 Lisp_Object quitf
= Vquit_flag
;
3599 struct gcpro gcpro1
, gcpro2
;
3601 GCPRO2 (value
, quitf
);
3604 while (specpdl_ptr
!= specpdl
+ count
)
3606 /* Copy the binding, and decrement specpdl_ptr, before we do
3607 the work to unbind it. We decrement first
3608 so that an error in unbinding won't try to unbind
3609 the same entry again, and we copy the binding first
3610 in case more bindings are made during some of the code we run. */
3612 struct specbinding this_binding
;
3613 this_binding
= *--specpdl_ptr
;
3615 if (this_binding
.func
!= 0)
3616 (*this_binding
.func
) (this_binding
.old_value
);
3617 /* If the symbol is a list, it is really (SYMBOL WHERE
3618 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3619 frame. If WHERE is a buffer or frame, this indicates we
3620 bound a variable that had a buffer-local or frame-local
3621 binding. WHERE nil means that the variable had the default
3622 value when it was bound. CURRENT-BUFFER is the buffer that
3623 was current when the variable was bound. */
3624 else if (CONSP (this_binding
.symbol
))
3626 Lisp_Object symbol
, where
;
3628 symbol
= XCAR (this_binding
.symbol
);
3629 where
= XCAR (XCDR (this_binding
.symbol
));
3632 Fset_default (symbol
, this_binding
.old_value
);
3633 /* If `where' is non-nil, reset the value in the appropriate
3634 local binding, but only if that binding still exists. */
3635 else if (BUFFERP (where
)
3636 ? !NILP (Flocal_variable_p (symbol
, where
))
3637 : !NILP (Fassq (symbol
, XFRAME (where
)->param_alist
)))
3638 set_internal (symbol
, this_binding
.old_value
, where
, 1);
3640 /* If variable has a trivial value (no forwarding), we can
3641 just set it. No need to check for constant symbols here,
3642 since that was already done by specbind. */
3643 else if (XSYMBOL (this_binding
.symbol
)->redirect
== SYMBOL_PLAINVAL
)
3644 SET_SYMBOL_VAL (XSYMBOL (this_binding
.symbol
),
3645 this_binding
.old_value
);
3647 /* NOTE: we only ever come here if make_local_foo was used for
3648 the first time on this var within this let. */
3649 Fset_default (this_binding
.symbol
, this_binding
.old_value
);
3652 if (NILP (Vquit_flag
) && !NILP (quitf
))
3661 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
3662 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3663 A special variable is one that will be bound dynamically, even in a
3664 context where binding is lexical by default. */)
3668 CHECK_SYMBOL (symbol
);
3669 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3674 DEFUN ("curry", Fcurry
, Scurry
, 1, MANY
, 0,
3675 doc
: /* Return FUN curried with ARGS.
3676 The result is a function-like object that will append any arguments it
3677 is called with to ARGS, and call FUN with the resulting list of arguments.
3680 (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2)
3682 (mapcar (curry 'concat "The ") '("a" "b" "c"))
3683 => ("The a" "The b" "The c")
3685 usage: (curry FUN &rest ARGS) */)
3690 return make_funvec (Qcurry
, 0, nargs
, args
);
3694 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3695 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3696 The debugger is entered when that frame exits, if the flag is non-nil. */)
3697 (Lisp_Object level
, Lisp_Object flag
)
3699 register struct backtrace
*backlist
= backtrace_list
;
3702 CHECK_NUMBER (level
);
3704 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3706 backlist
= backlist
->next
;
3710 backlist
->debug_on_exit
= !NILP (flag
);
3715 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3716 doc
: /* Print a trace of Lisp function calls currently active.
3717 Output stream used is value of `standard-output'. */)
3720 register struct backtrace
*backlist
= backtrace_list
;
3724 extern Lisp_Object Vprint_level
;
3725 struct gcpro gcpro1
;
3727 XSETFASTINT (Vprint_level
, 3);
3734 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3735 if (backlist
->nargs
== UNEVALLED
)
3737 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3738 write_string ("\n", -1);
3742 tem
= *backlist
->function
;
3743 Fprin1 (tem
, Qnil
); /* This can QUIT */
3744 write_string ("(", -1);
3745 if (backlist
->nargs
== MANY
)
3747 for (tail
= *backlist
->args
, i
= 0;
3749 tail
= Fcdr (tail
), i
++)
3751 if (i
) write_string (" ", -1);
3752 Fprin1 (Fcar (tail
), Qnil
);
3757 for (i
= 0; i
< backlist
->nargs
; i
++)
3759 if (i
) write_string (" ", -1);
3760 Fprin1 (backlist
->args
[i
], Qnil
);
3763 write_string (")\n", -1);
3765 backlist
= backlist
->next
;
3768 Vprint_level
= Qnil
;
3773 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3774 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3775 If that frame has not evaluated the arguments yet (or is a special form),
3776 the value is (nil FUNCTION ARG-FORMS...).
3777 If that frame has evaluated its arguments and called its function already,
3778 the value is (t FUNCTION ARG-VALUES...).
3779 A &rest arg is represented as the tail of the list ARG-VALUES.
3780 FUNCTION is whatever was supplied as car of evaluated list,
3781 or a lambda expression for macro calls.
3782 If NFRAMES is more than the number of frames, the value is nil. */)
3783 (Lisp_Object nframes
)
3785 register struct backtrace
*backlist
= backtrace_list
;
3789 CHECK_NATNUM (nframes
);
3791 /* Find the frame requested. */
3792 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3793 backlist
= backlist
->next
;
3797 if (backlist
->nargs
== UNEVALLED
)
3798 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3801 if (backlist
->nargs
== MANY
)
3802 tem
= *backlist
->args
;
3804 tem
= Flist (backlist
->nargs
, backlist
->args
);
3806 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3812 mark_backtrace (void)
3814 register struct backtrace
*backlist
;
3817 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3819 mark_object (*backlist
->function
);
3821 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
3824 i
= backlist
->nargs
- 1;
3826 mark_object (backlist
->args
[i
]);
3833 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3834 doc
: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3835 If Lisp code tries to increase the total number past this amount,
3836 an error is signaled.
3837 You can safely use a value considerably larger than the default value,
3838 if that proves inconveniently small. However, if you increase it too far,
3839 Emacs could run out of memory trying to make the stack bigger. */);
3841 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3842 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3844 This limit serves to catch infinite recursions for you before they cause
3845 actual stack overflow in C, which would be fatal for Emacs.
3846 You can safely make it considerably larger than its default value,
3847 if that proves inconveniently small. However, if you increase it too far,
3848 Emacs could overflow the real C stack, and crash. */);
3850 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3851 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3852 If the value is t, that means do an ordinary quit.
3853 If the value equals `throw-on-input', that means quit by throwing
3854 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3855 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3856 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3859 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3860 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3861 Note that `quit-flag' will still be set by typing C-g,
3862 so a quit will be signaled as soon as `inhibit-quit' is nil.
3863 To prevent this happening, set `quit-flag' to nil
3864 before making `inhibit-quit' nil. */);
3865 Vinhibit_quit
= Qnil
;
3867 Qinhibit_quit
= intern_c_string ("inhibit-quit");
3868 staticpro (&Qinhibit_quit
);
3870 Qautoload
= intern_c_string ("autoload");
3871 staticpro (&Qautoload
);
3873 Qdebug_on_error
= intern_c_string ("debug-on-error");
3874 staticpro (&Qdebug_on_error
);
3876 Qmacro
= intern_c_string ("macro");
3877 staticpro (&Qmacro
);
3879 Qdeclare
= intern_c_string ("declare");
3880 staticpro (&Qdeclare
);
3882 /* Note that the process handling also uses Qexit, but we don't want
3883 to staticpro it twice, so we just do it here. */
3884 Qexit
= intern_c_string ("exit");
3887 Qinteractive
= intern_c_string ("interactive");
3888 staticpro (&Qinteractive
);
3890 Qcommandp
= intern_c_string ("commandp");
3891 staticpro (&Qcommandp
);
3893 Qdefun
= intern_c_string ("defun");
3894 staticpro (&Qdefun
);
3896 Qand_rest
= intern_c_string ("&rest");
3897 staticpro (&Qand_rest
);
3899 Qand_optional
= intern_c_string ("&optional");
3900 staticpro (&Qand_optional
);
3902 Qclosure
= intern_c_string ("closure");
3903 staticpro (&Qclosure
);
3905 Qcurry
= intern_c_string ("curry");
3906 staticpro (&Qcurry
);
3908 Qdebug
= intern_c_string ("debug");
3909 staticpro (&Qdebug
);
3911 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3912 doc
: /* *Non-nil means errors display a backtrace buffer.
3913 More precisely, this happens for any error that is handled
3914 by the editor command loop.
3915 If the value is a list, an error only means to display a backtrace
3916 if one of its condition symbols appears in the list. */);
3917 Vstack_trace_on_error
= Qnil
;
3919 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3920 doc
: /* *Non-nil means enter debugger if an error is signaled.
3921 Does not apply to errors handled by `condition-case' or those
3922 matched by `debug-ignored-errors'.
3923 If the value is a list, an error only means to enter the debugger
3924 if one of its condition symbols appears in the list.
3925 When you evaluate an expression interactively, this variable
3926 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3927 The command `toggle-debug-on-error' toggles this.
3928 See also the variable `debug-on-quit'. */);
3929 Vdebug_on_error
= Qnil
;
3931 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3932 doc
: /* *List of errors for which the debugger should not be called.
3933 Each element may be a condition-name or a regexp that matches error messages.
3934 If any element applies to a given error, that error skips the debugger
3935 and just returns to top level.
3936 This overrides the variable `debug-on-error'.
3937 It does not apply to errors handled by `condition-case'. */);
3938 Vdebug_ignored_errors
= Qnil
;
3940 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3941 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3942 Does not apply if quit is handled by a `condition-case'. */);
3945 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3946 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3948 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3949 doc
: /* Non-nil means debugger may continue execution.
3950 This is nil when the debugger is called under circumstances where it
3951 might not be safe to continue. */);
3952 debugger_may_continue
= 1;
3954 DEFVAR_LISP ("debugger", &Vdebugger
,
3955 doc
: /* Function to call to invoke debugger.
3956 If due to frame exit, args are `exit' and the value being returned;
3957 this function's value will be returned instead of that.
3958 If due to error, args are `error' and a list of the args to `signal'.
3959 If due to `apply' or `funcall' entry, one arg, `lambda'.
3960 If due to `eval' entry, one arg, t. */);
3963 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3964 doc
: /* If non-nil, this is a function for `signal' to call.
3965 It receives the same arguments that `signal' was given.
3966 The Edebug package uses this to regain control. */);
3967 Vsignal_hook_function
= Qnil
;
3969 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3970 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3971 Note that `debug-on-error', `debug-on-quit' and friends
3972 still determine whether to handle the particular condition. */);
3973 Vdebug_on_signal
= Qnil
;
3975 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3976 doc
: /* Function to process declarations in a macro definition.
3977 The function will be called with two args MACRO and DECL.
3978 MACRO is the name of the macro being defined.
3979 DECL is a list `(declare ...)' containing the declarations.
3980 The value the function returns is not used. */);
3981 Vmacro_declaration_function
= Qnil
;
3983 Qinternal_interpreter_environment
3984 = intern_c_string ("internal-interpreter-environment");
3985 staticpro (&Qinternal_interpreter_environment
);
3986 DEFVAR_LISP ("internal-interpreter-environment",
3987 &Vinternal_interpreter_environment
,
3988 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
3989 When lexical binding is not being used, this variable is nil.
3990 A value of `(t)' indicates an empty environment, otherwise it is an
3991 alist of active lexical bindings. */);
3992 Vinternal_interpreter_environment
= Qnil
;
3994 Vrun_hooks
= intern_c_string ("run-hooks");
3995 staticpro (&Vrun_hooks
);
3997 staticpro (&Vautoload_queue
);
3998 Vautoload_queue
= Qnil
;
3999 staticpro (&Vsignaling_function
);
4000 Vsignaling_function
= Qnil
;
4011 defsubr (&Sfunction
);
4013 defsubr (&Sdefmacro
);
4015 defsubr (&Sdefvaralias
);
4016 defsubr (&Sdefconst
);
4017 defsubr (&Suser_variable_p
);
4021 defsubr (&Smacroexpand
);
4024 defsubr (&Sunwind_protect
);
4025 defsubr (&Scondition_case
);
4027 defsubr (&Sinteractive_p
);
4028 defsubr (&Scalled_interactively_p
);
4029 defsubr (&Scommandp
);
4030 defsubr (&Sautoload
);
4033 defsubr (&Sfuncall
);
4034 defsubr (&Srun_hooks
);
4035 defsubr (&Srun_hook_with_args
);
4036 defsubr (&Srun_hook_with_args_until_success
);
4037 defsubr (&Srun_hook_with_args_until_failure
);
4038 defsubr (&Sfetch_bytecode
);
4040 defsubr (&Sbacktrace_debug
);
4041 defsubr (&Sbacktrace
);
4042 defsubr (&Sbacktrace_frame
);
4044 defsubr (&Sspecial_variable_p
);
4045 defsubr (&Sfunctionp
);
4048 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
4049 (do not change this comment) */