1 /* Evaluator for GNU Emacs Lisp interpreter.
3 Copyright (C) 1985-1987, 1993-1995, 1999-2014 Free Software Foundation,
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/>. */
26 #include "blockinput.h"
29 #include "dispextern.h"
32 static void unbind_once (void *ignore
);
34 /* Chain of condition and catch handlers currently in effect. */
36 struct handler
*handlerlist
;
39 /* Count levels of GCPRO to detect failure to UNGCPRO. */
43 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
;
44 Lisp_Object Qinhibit_quit
;
45 Lisp_Object Qand_rest
;
46 static Lisp_Object Qand_optional
;
47 static Lisp_Object Qinhibit_debugger
;
48 static Lisp_Object Qdeclare
;
49 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
51 static Lisp_Object Qdebug
;
53 /* This holds either the symbol `run-hooks' or nil.
54 It is nil at an early stage of startup, and when Emacs
57 Lisp_Object Vrun_hooks
;
59 /* Non-nil means record all fset's and provide's, to be undone
60 if the file being autoloaded is not fully loaded.
61 They are recorded by being consed onto the front of Vautoload_queue:
62 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
64 Lisp_Object Vautoload_queue
;
66 /* Current number of specbindings allocated in specpdl, not counting
67 the dummy entry specpdl[-1]. */
69 ptrdiff_t specpdl_size
;
71 /* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists
72 only so that its address can be taken. */
74 union specbinding
*specpdl
;
76 /* Pointer to first unused element in specpdl. */
78 union specbinding
*specpdl_ptr
;
80 /* Depth in Lisp evaluations and function calls. */
82 EMACS_INT lisp_eval_depth
;
84 /* The value of num_nonmacro_input_events as of the last time we
85 started to enter the debugger. If we decide to enter the debugger
86 again when this is still equal to num_nonmacro_input_events, then we
87 know that the debugger itself has an error, and we should just
88 signal the error instead of entering an infinite loop of debugger
91 static EMACS_INT when_entered_debugger
;
93 /* The function from which the last `signal' was called. Set in
95 /* FIXME: We should probably get rid of this! */
96 Lisp_Object Vsignaling_function
;
98 /* If non-nil, Lisp code must not be run since some part of Emacs is
99 in an inconsistent state. Currently, x-create-frame uses this to
100 avoid triggering window-configuration-change-hook while the new
101 frame is half-initialized. */
102 Lisp_Object inhibit_lisp_code
;
104 static Lisp_Object
funcall_lambda (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
105 static Lisp_Object
apply_lambda (Lisp_Object fun
, Lisp_Object args
);
108 specpdl_symbol (union specbinding
*pdl
)
110 eassert (pdl
->kind
>= SPECPDL_LET
);
111 return pdl
->let
.symbol
;
115 specpdl_old_value (union specbinding
*pdl
)
117 eassert (pdl
->kind
>= SPECPDL_LET
);
118 return pdl
->let
.old_value
;
122 set_specpdl_old_value (union specbinding
*pdl
, Lisp_Object val
)
124 eassert (pdl
->kind
>= SPECPDL_LET
);
125 pdl
->let
.old_value
= val
;
129 specpdl_where (union specbinding
*pdl
)
131 eassert (pdl
->kind
> SPECPDL_LET
);
132 return pdl
->let
.where
;
136 make_catch_handler (Lisp_Object tag
)
138 struct handler
*c
= xmalloc (sizeof (*c
));
144 c
->next
= handlerlist
;
145 c
->lisp_eval_depth
= lisp_eval_depth
;
146 c
->interrupt_input_blocked
= interrupt_input_blocked
;
147 c
->ptag
= make_prompt_tag ();
152 make_condition_handler (Lisp_Object tag
)
154 struct handler
*c
= xmalloc (sizeof (*c
));
155 c
->type
= CONDITION_CASE
;
160 c
->next
= handlerlist
;
161 c
->lisp_eval_depth
= lisp_eval_depth
;
162 c
->interrupt_input_blocked
= interrupt_input_blocked
;
163 c
->ptag
= make_prompt_tag ();
167 static Lisp_Object eval_fn
;
168 static Lisp_Object funcall_fn
;
171 init_eval_once (void)
174 union specbinding
*pdlvec
= xmalloc ((size
+ 1) * sizeof *specpdl
);
176 specpdl
= specpdl_ptr
= pdlvec
+ 1;
177 /* Don't forget to update docs (lispref node "Local Variables"). */
178 max_specpdl_size
= 10000; /* 1000 is not enough for CEDET's c-by.el. */
179 max_lisp_eval_depth
= 10000;
183 eval_fn
= scm_c_public_ref ("language elisp runtime", "eval-elisp");
184 funcall_fn
= scm_c_public_ref ("elisp-functions", "funcall");
186 //scm_set_smob_apply (lisp_vectorlike_tag, apply_lambda, 0, 0, 1);
189 static struct handler
*handlerlist_sentinel
;
194 specpdl_ptr
= specpdl
;
195 handlerlist_sentinel
= make_catch_handler (Qunbound
);
196 handlerlist
= handlerlist_sentinel
;
198 debug_on_next_call
= 0;
203 /* This is less than the initial value of num_nonmacro_input_events. */
204 when_entered_debugger
= -1;
207 /* Unwind-protect function used by call_debugger. */
210 restore_stack_limits (Lisp_Object data
)
212 max_specpdl_size
= XINT (XCAR (data
));
213 max_lisp_eval_depth
= XINT (XCDR (data
));
216 static void grow_specpdl (void);
218 /* Call the Lisp debugger, giving it argument ARG. */
221 call_debugger (Lisp_Object arg
)
223 bool debug_while_redisplaying
;
226 EMACS_INT old_depth
= max_lisp_eval_depth
;
227 /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
228 EMACS_INT old_max
= max_specpdl_size
;
230 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
231 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
233 /* Restore limits after leaving the debugger. */
234 record_unwind_protect (restore_stack_limits
,
235 Fcons (make_number (old_max
),
236 make_number (old_depth
)));
238 #ifdef HAVE_WINDOW_SYSTEM
239 if (display_hourglass_p
)
243 debug_on_next_call
= 0;
244 when_entered_debugger
= num_nonmacro_input_events
;
246 /* Resetting redisplaying_p to 0 makes sure that debug output is
247 displayed if the debugger is invoked during redisplay. */
248 debug_while_redisplaying
= redisplaying_p
;
250 specbind (intern ("debugger-may-continue"),
251 debug_while_redisplaying
? Qnil
: Qt
);
252 specbind (Qinhibit_redisplay
, Qnil
);
253 specbind (Qinhibit_debugger
, Qt
);
255 #if 0 /* Binding this prevents execution of Lisp code during
256 redisplay, which necessarily leads to display problems. */
257 specbind (Qinhibit_eval_during_redisplay
, Qt
);
260 val
= apply1 (Vdebugger
, arg
);
262 /* Interrupting redisplay and resuming it later is not safe under
263 all circumstances. So, when the debugger returns, abort the
264 interrupted redisplay by going back to the top-level. */
265 if (debug_while_redisplaying
)
273 Fprogn (Lisp_Object body
)
275 Lisp_Object val
= Qnil
;
282 val
= eval_sub (XCAR (body
));
290 /* Evaluate BODY sequentially, discarding its value. Suitable for
291 record_unwind_protect. */
294 unwind_body (Lisp_Object body
)
300 Ffunction (Lisp_Object args
)
302 Lisp_Object quoted
= XCAR (args
);
304 if (CONSP (XCDR (args
)))
305 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
307 if (!NILP (Vinternal_interpreter_environment
)
309 && EQ (XCAR (quoted
), Qlambda
))
310 /* This is a lambda expression within a lexical environment;
311 return an interpreted closure instead of a simple lambda. */
312 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
315 /* Simply quote the argument. */
319 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
320 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
321 Aliased variables always have the same value; setting one sets the other.
322 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
323 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
324 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
325 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
326 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
327 The return value is BASE-VARIABLE. */)
328 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
332 CHECK_SYMBOL (new_alias
);
333 CHECK_SYMBOL (base_variable
);
335 sym
= XSYMBOL (new_alias
);
337 if (SYMBOL_CONSTANT (sym
))
338 /* Not sure why, but why not? */
339 error ("Cannot make a constant an alias");
341 switch (SYMBOL_REDIRECT (sym
))
343 case SYMBOL_FORWARDED
:
344 error ("Cannot make an internal variable an alias");
345 case SYMBOL_LOCALIZED
:
346 error ("Don't know how to make a localized variable an alias");
349 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
350 If n_a is bound, but b_v is not, set the value of b_v to n_a,
351 so that old-code that affects n_a before the aliasing is setup
353 if (NILP (Fboundp (base_variable
)))
354 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
357 union specbinding
*p
;
359 for (p
= specpdl_ptr
; p
> specpdl
; )
360 if ((--p
)->kind
>= SPECPDL_LET
361 && (EQ (new_alias
, specpdl_symbol (p
))))
362 error ("Don't know how to make a let-bound variable an alias");
365 SET_SYMBOL_DECLARED_SPECIAL (sym
, 1);
366 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (base_variable
), 1);
367 SET_SYMBOL_REDIRECT (sym
, SYMBOL_VARALIAS
);
368 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
369 SET_SYMBOL_CONSTANT (sym
, SYMBOL_CONSTANT_P (base_variable
));
370 LOADHIST_ATTACH (new_alias
);
371 /* Even if docstring is nil: remove old docstring. */
372 Fput (new_alias
, Qvariable_documentation
, docstring
);
374 return base_variable
;
377 static union specbinding
*
378 default_toplevel_binding (Lisp_Object symbol
)
380 union specbinding
*binding
= NULL
;
381 union specbinding
*pdl
= specpdl_ptr
;
382 while (pdl
> specpdl
)
384 switch ((--pdl
)->kind
)
386 case SPECPDL_LET_DEFAULT
:
388 if (EQ (specpdl_symbol (pdl
), symbol
))
396 DEFUN ("default-toplevel-value", Fdefault_toplevel_value
, Sdefault_toplevel_value
, 1, 1, 0,
397 doc
: /* Return SYMBOL's toplevel default value.
398 "Toplevel" means outside of any let binding. */)
401 union specbinding
*binding
= default_toplevel_binding (symbol
);
403 = binding
? specpdl_old_value (binding
) : Fdefault_value (symbol
);
404 if (!EQ (value
, Qunbound
))
406 xsignal1 (Qvoid_variable
, symbol
);
409 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value
,
410 Sset_default_toplevel_value
, 2, 2, 0,
411 doc
: /* Set SYMBOL's toplevel default value to VALUE.
412 "Toplevel" means outside of any let binding. */)
413 (Lisp_Object symbol
, Lisp_Object value
)
415 union specbinding
*binding
= default_toplevel_binding (symbol
);
417 set_specpdl_old_value (binding
, value
);
419 Fset_default (symbol
, value
);
423 /* Make SYMBOL lexically scoped. */
424 DEFUN ("internal-make-var-non-special", Fmake_var_non_special
,
425 Smake_var_non_special
, 1, 1, 0,
426 doc
: /* Internal function. */)
429 CHECK_SYMBOL (symbol
);
430 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (symbol
), 0);
435 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
436 doc
: /* Return result of expanding macros at top level of FORM.
437 If FORM is not a macro call, it is returned unchanged.
438 Otherwise, the macro is expanded and the expansion is considered
439 in place of FORM. When a non-macro-call results, it is returned.
441 The second optional arg ENVIRONMENT specifies an environment of macro
442 definitions to shadow the loaded ones for use in file byte-compilation. */)
443 (Lisp_Object form
, Lisp_Object environment
)
445 /* With cleanups from Hallvard Furuseth. */
446 register Lisp_Object expander
, sym
, def
, tem
;
450 /* Come back here each time we expand a macro call,
451 in case it expands into another macro call. */
454 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
455 def
= sym
= XCAR (form
);
457 /* Trace symbols aliases to other symbols
458 until we get a symbol that is not an alias. */
459 while (SYMBOLP (def
))
463 tem
= Fassq (sym
, environment
);
466 def
= SYMBOL_FUNCTION (sym
);
472 /* Right now TEM is the result from SYM in ENVIRONMENT,
473 and if TEM is nil then DEF is SYM's function definition. */
476 /* SYM is not mentioned in ENVIRONMENT.
477 Look at its function definition. */
480 def
= Fautoload_do_load (def
, sym
, Qmacro
);
483 /* Not defined or definition not suitable. */
485 if (!EQ (XCAR (def
), Qmacro
))
487 else expander
= XCDR (def
);
491 expander
= XCDR (tem
);
496 Lisp_Object newform
= apply1 (expander
, XCDR (form
));
497 if (EQ (form
, newform
))
506 DEFUN ("call-with-catch", Fcatch
, Scatch
, 2, 2, 0,
507 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
508 TAG is evalled to get the tag to use; it must not be nil.
510 Then the BODY is executed.
511 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
512 If no throw happens, `catch' returns the value of the last BODY form.
513 If a throw happens, it specifies the value to return from `catch'.
514 usage: (catch TAG BODY...) */)
515 (Lisp_Object tag
, Lisp_Object thunk
)
517 return internal_catch (tag
, call0
, thunk
);
520 /* Assert that E is true, as a comment only. Use this instead of
521 eassert (E) when E contains variables that might be clobbered by a
524 #define clobbered_eassert(E) ((void) 0)
527 set_handlerlist (void *data
)
533 restore_handler (void *data
)
535 struct handler
*c
= data
;
536 unblock_input_to (c
->interrupt_input_blocked
);
542 enum { ICC_0
, ICC_1
, ICC_2
, ICC_3
, ICC_N
} type
;
545 Lisp_Object (*fun0
) (void);
546 Lisp_Object (*fun1
) (Lisp_Object
);
547 Lisp_Object (*fun2
) (Lisp_Object
, Lisp_Object
);
548 Lisp_Object (*fun3
) (Lisp_Object
, Lisp_Object
, Lisp_Object
);
549 Lisp_Object (*funn
) (ptrdiff_t, Lisp_Object
*);
569 icc_thunk (void *data
)
572 struct icc_thunk_env
*e
= data
;
573 scm_dynwind_begin (0);
574 scm_dynwind_unwind_handler (restore_handler
, e
->c
, 0);
575 scm_dynwind_unwind_handler (set_handlerlist
,
577 SCM_F_WIND_EXPLICITLY
);
585 tem
= e
->fun1 (e
->arg1
);
588 tem
= e
->fun2 (e
->arg1
, e
->arg2
);
591 tem
= e
->fun3 (e
->arg1
, e
->arg2
, e
->arg3
);
594 tem
= e
->funn (e
->nargs
, e
->args
);
604 icc_handler (void *data
, Lisp_Object k
, Lisp_Object v
)
606 Lisp_Object (*f
) (Lisp_Object
) = data
;
610 struct icc_handler_n_env
612 Lisp_Object (*fun
) (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
618 icc_handler_n (void *data
, Lisp_Object k
, Lisp_Object v
)
620 struct icc_handler_n_env
*e
= data
;
621 return e
->fun (v
, e
->nargs
, e
->args
);
625 icc_lisp_handler (void *data
, Lisp_Object k
, Lisp_Object val
)
628 struct handler
*h
= data
;
629 Lisp_Object var
= h
->var
;
630 scm_dynwind_begin (0);
634 if (!NILP (Vinternal_interpreter_environment
))
635 specbind (Qinternal_interpreter_environment
,
636 Fcons (Fcons (var
, val
),
637 Vinternal_interpreter_environment
));
642 tem
= Fprogn (h
->body
);
647 /* Set up a catch, then call C function FUNC on argument ARG.
648 FUNC should return a Lisp_Object.
649 This is how catches are done from within C code. */
652 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
654 struct handler
*c
= make_catch_handler (tag
);
655 struct icc_thunk_env env
= { .type
= ICC_1
,
659 return call_with_prompt (c
->ptag
,
660 make_c_closure (icc_thunk
, &env
, 0, 0),
661 make_c_closure (icc_handler
, Fidentity
, 2, 0));
664 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
665 jump to that CATCH, returning VALUE as the value of that catch.
667 This is the guts of Fthrow and Fsignal; they differ only in the way
668 they choose the catch tag to throw to. A catch tag for a
669 condition-case form has a TAG of Qnil.
671 Before each catch is discarded, unbind all special bindings and
672 execute all unwind-protect clauses made above that catch. Unwind
673 the handler stack as we go, so that the proper handlers are in
674 effect for each unwind-protect clause we run. At the end, restore
675 some static info saved in CATCH, and longjmp to the location
678 This is used for correct unwinding in Fthrow and Fsignal. */
680 static Lisp_Object
unbind_to_1 (ptrdiff_t, Lisp_Object
, bool);
682 static _Noreturn
void
683 unwind_to_catch (struct handler
*catch, Lisp_Object value
)
685 abort_to_prompt (catch->ptag
, scm_list_1 (value
));
688 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
689 doc
: /* Throw to the catch for TAG and return VALUE from it.
690 Both TAG and VALUE are evalled. */)
691 (register Lisp_Object tag
, Lisp_Object value
)
696 for (c
= handlerlist
; c
; c
= c
->next
)
698 if (c
->type
== CATCHER
&& EQ (c
->tag_or_ch
, tag
))
699 unwind_to_catch (c
, value
);
701 xsignal2 (Qno_catch
, tag
, value
);
704 DEFUN ("call-with-handler", Fcall_with_handler
, Scall_with_handler
, 4, 4, 0,
705 doc
: /* Regain control when an error is signaled.
706 Executes BODYFORM and returns its value if no error happens.
707 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
708 where the BODY is made of Lisp expressions.
710 A handler is applicable to an error
711 if CONDITION-NAME is one of the error's condition names.
712 If an error happens, the first applicable handler is run.
714 The car of a handler may be a list of condition names instead of a
715 single condition name; then it handles all of them. If the special
716 condition name `debug' is present in this list, it allows another
717 condition in the list to run the debugger if `debug-on-error' and the
718 other usual mechanisms says it should (otherwise, `condition-case'
719 suppresses the debugger).
721 When a handler handles an error, control returns to the `condition-case'
722 and it executes the handler's BODY...
723 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
724 \(If VAR is nil, the handler can't access that information.)
725 Then the value of the last BODY form is returned from the `condition-case'
728 See also the function `signal' for more info.
729 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
731 Lisp_Object conditions
,
735 return internal_lisp_condition_case (var
,
736 list2 (intern ("funcall"), thunk
),
737 list1 (list2 (conditions
, list2 (intern ("funcall"), hthunk
))));
741 ilcc1 (Lisp_Object var
, Lisp_Object bodyform
, Lisp_Object handlers
)
743 if (CONSP (handlers
))
745 Lisp_Object clause
= XCAR (handlers
);
746 Lisp_Object condition
= XCAR (clause
);
747 Lisp_Object body
= XCDR (clause
);
748 if (!CONSP (condition
))
749 condition
= Fcons (condition
, Qnil
);
750 struct handler
*c
= make_condition_handler (condition
);
753 struct icc_thunk_env env
= { .type
= ICC_3
,
757 .arg3
= XCDR (handlers
),
759 return call_with_prompt (c
->ptag
,
760 make_c_closure (icc_thunk
, &env
, 0, 0),
761 make_c_closure (icc_lisp_handler
, c
, 2, 0));
765 return eval_sub (bodyform
);
769 /* Like Fcondition_case, but the args are separate
770 rather than passed in a list. Used by Fbyte_code. */
773 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
774 Lisp_Object handlers
)
778 struct handler
*oldhandlerlist
= handlerlist
;
782 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
784 Lisp_Object tem
= XCAR (val
);
787 && (SYMBOLP (XCAR (tem
))
788 || CONSP (XCAR (tem
))))))
789 error ("Invalid condition handler: %s",
790 SDATA (Fprin1_to_string (tem
, Qt
)));
793 return ilcc1 (var
, bodyform
, Freverse (handlers
));
796 /* Call the function BFUN with no arguments, catching errors within it
797 according to HANDLERS. If there is an error, call HFUN with
798 one argument which is the data that describes the error:
801 HANDLERS can be a list of conditions to catch.
802 If HANDLERS is Qt, catch all errors.
803 If HANDLERS is Qerror, catch all errors
804 but allow the debugger to run if that is enabled. */
807 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
808 Lisp_Object (*hfun
) (Lisp_Object
))
811 struct handler
*c
= make_condition_handler (handlers
);
813 struct icc_thunk_env env
= { .type
= ICC_0
, .fun0
= bfun
, .c
= c
};
814 return call_with_prompt (c
->ptag
,
815 make_c_closure (icc_thunk
, &env
, 0, 0),
816 make_c_closure (icc_handler
, hfun
, 2, 0));
819 /* Like internal_condition_case but call BFUN with ARG as its argument. */
822 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
823 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
826 struct handler
*c
= make_condition_handler (handlers
);
828 struct icc_thunk_env env
= { .type
= ICC_1
,
832 return call_with_prompt (c
->ptag
,
833 make_c_closure (icc_thunk
, &env
, 0, 0),
834 make_c_closure (icc_handler
, hfun
, 2, 0));
837 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
841 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
844 Lisp_Object handlers
,
845 Lisp_Object (*hfun
) (Lisp_Object
))
848 struct handler
*c
= make_condition_handler (handlers
);
849 struct icc_thunk_env env
= { .type
= ICC_2
,
854 return call_with_prompt (c
->ptag
,
855 make_c_closure (icc_thunk
, &env
, 0, 0),
856 make_c_closure (icc_handler
, hfun
, 2, 0));
859 /* Like internal_condition_case but call BFUN with NARGS as first,
860 and ARGS as second argument. */
863 internal_condition_case_n (Lisp_Object (*bfun
) (ptrdiff_t, Lisp_Object
*),
866 Lisp_Object handlers
,
867 Lisp_Object (*hfun
) (Lisp_Object err
,
872 struct handler
*c
= make_condition_handler (handlers
);
874 struct icc_thunk_env env
= { .type
= ICC_N
,
879 struct icc_handler_n_env henv
= { .fun
= hfun
, .nargs
= nargs
, .args
= args
};
880 return call_with_prompt (c
->ptag
,
881 make_c_closure (icc_thunk
, &env
, 0, 0),
882 make_c_closure (icc_handler_n
, &henv
, 2, 0));
886 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
);
887 static bool maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
891 process_quit_flag (void)
893 Lisp_Object flag
= Vquit_flag
;
895 if (EQ (flag
, Qkill_emacs
))
897 if (EQ (Vthrow_on_input
, flag
))
898 Fthrow (Vthrow_on_input
, Qt
);
899 Fsignal (Qquit
, Qnil
);
902 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
903 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
904 This function does not return.
906 An error symbol is a symbol with an `error-conditions' property
907 that is a list of condition names.
908 A handler for any of those names will get to handle this signal.
909 The symbol `error' should normally be one of them.
911 DATA should be a list. Its elements are printed as part of the error message.
912 See Info anchor `(elisp)Definition of signal' for some details on how this
913 error message is constructed.
914 If the signal is handled, DATA is made available to the handler.
915 See also the function `condition-case'. */)
916 (Lisp_Object error_symbol
, Lisp_Object data
)
918 /* When memory is full, ERROR-SYMBOL is nil,
919 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
920 That is a special case--don't do this in other situations. */
921 Lisp_Object conditions
;
923 Lisp_Object real_error_symbol
924 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
925 register Lisp_Object clause
= Qnil
;
929 if (waiting_for_input
)
932 #if 0 /* rms: I don't know why this was here,
933 but it is surely wrong for an error that is handled. */
934 #ifdef HAVE_WINDOW_SYSTEM
935 if (display_hourglass_p
)
940 /* This hook is used by edebug. */
941 if (! NILP (Vsignal_hook_function
)
942 && ! NILP (error_symbol
))
944 /* Edebug takes care of restoring these variables when it exits. */
945 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
946 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
948 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
949 max_specpdl_size
= SPECPDL_INDEX () + 40;
951 call2 (Vsignal_hook_function
, error_symbol
, data
);
954 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
956 for (h
= handlerlist
; h
; h
= h
->next
)
958 if (h
->type
!= CONDITION_CASE
)
960 clause
= find_handler_clause (h
->tag_or_ch
, conditions
);
965 if (/* Don't run the debugger for a memory-full error.
966 (There is no room in memory to do that!) */
968 && (!NILP (Vdebug_on_signal
)
969 /* If no handler is present now, try to run the debugger. */
971 /* A `debug' symbol in the handler list disables the normal
972 suppression of the debugger. */
973 || (CONSP (clause
) && CONSP (clause
)
974 && !NILP (Fmemq (Qdebug
, clause
)))
975 /* Special handler that means "print a message and run debugger
977 || EQ (h
->tag_or_ch
, Qerror
)))
980 = maybe_call_debugger (conditions
, error_symbol
, data
);
981 /* We can't return values to code which signaled an error, but we
982 can continue code which has signaled a quit. */
983 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
989 Lisp_Object unwind_data
990 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
992 unwind_to_catch (h
, unwind_data
);
996 if (handlerlist
!= handlerlist_sentinel
)
997 /* FIXME: This will come right back here if there's no `top-level'
998 catcher. A better solution would be to abort here, and instead
999 add a catch-all condition handler so we never come here. */
1000 Fthrow (Qtop_level
, Qt
);
1003 if (! NILP (error_symbol
))
1004 data
= Fcons (error_symbol
, data
);
1006 string
= Ferror_message_string (data
);
1007 fatal ("%s", SDATA (string
));
1010 /* Internal version of Fsignal that never returns.
1011 Used for anything but Qquit (which can return from Fsignal). */
1014 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1016 Fsignal (error_symbol
, data
);
1020 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1023 xsignal0 (Lisp_Object error_symbol
)
1025 xsignal (error_symbol
, Qnil
);
1029 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1031 xsignal (error_symbol
, list1 (arg
));
1035 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1037 xsignal (error_symbol
, list2 (arg1
, arg2
));
1041 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1043 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1046 /* Signal `error' with message S, and additional arg ARG.
1047 If ARG is not a genuine list, make it a one-element list. */
1050 signal_error (const char *s
, Lisp_Object arg
)
1052 Lisp_Object tortoise
, hare
;
1054 hare
= tortoise
= arg
;
1055 while (CONSP (hare
))
1062 tortoise
= XCDR (tortoise
);
1064 if (EQ (hare
, tortoise
))
1071 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1075 /* Return true if LIST is a non-nil atom or
1076 a list containing one of CONDITIONS. */
1079 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1086 while (CONSP (conditions
))
1088 Lisp_Object
this, tail
;
1089 this = XCAR (conditions
);
1090 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1091 if (EQ (XCAR (tail
), this))
1093 conditions
= XCDR (conditions
);
1098 /* Return true if an error with condition-symbols CONDITIONS,
1099 and described by SIGNAL-DATA, should skip the debugger
1100 according to debugger-ignored-errors. */
1103 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1106 bool first_string
= 1;
1107 Lisp_Object error_message
;
1109 error_message
= Qnil
;
1110 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1112 if (STRINGP (XCAR (tail
)))
1116 error_message
= Ferror_message_string (data
);
1120 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1125 Lisp_Object contail
;
1127 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1128 if (EQ (XCAR (tail
), XCAR (contail
)))
1136 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1137 SIG and DATA describe the signal. There are two ways to pass them:
1138 = SIG is the error symbol, and DATA is the rest of the data.
1139 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1140 This is for memory-full errors only. */
1142 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1144 Lisp_Object combined_data
;
1146 combined_data
= Fcons (sig
, data
);
1149 /* Don't try to run the debugger with interrupts blocked.
1150 The editing loop would return anyway. */
1151 ! input_blocked_p ()
1152 && NILP (Vinhibit_debugger
)
1153 /* Does user want to enter debugger for this kind of error? */
1156 : wants_debugger (Vdebug_on_error
, conditions
))
1157 && ! skip_debugger (conditions
, combined_data
)
1158 /* RMS: What's this for? */
1159 && when_entered_debugger
< num_nonmacro_input_events
)
1161 call_debugger (list2 (Qerror
, combined_data
));
1169 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
)
1171 register Lisp_Object h
;
1173 /* t is used by handlers for all conditions, set up by C code. */
1174 if (EQ (handlers
, Qt
))
1177 /* error is used similarly, but means print an error message
1178 and run the debugger if that is enabled. */
1179 if (EQ (handlers
, Qerror
))
1182 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1184 Lisp_Object handler
= XCAR (h
);
1185 if (!NILP (Fmemq (handler
, conditions
)))
1193 /* Dump an error message; called like vprintf. */
1195 verror (const char *m
, va_list ap
)
1198 ptrdiff_t size
= sizeof buf
;
1199 ptrdiff_t size_max
= STRING_BYTES_BOUND
+ 1;
1204 used
= evxprintf (&buffer
, &size
, buf
, size_max
, m
, ap
);
1205 string
= make_string (buffer
, used
);
1209 xsignal1 (Qerror
, string
);
1213 /* Dump an error message; called like printf. */
1217 error (const char *m
, ...)
1224 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1225 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1226 This means it contains a description for how to read arguments to give it.
1227 The value is nil for an invalid function or a symbol with no function
1230 Interactively callable functions include strings and vectors (treated
1231 as keyboard macros), lambda-expressions that contain a top-level call
1232 to `interactive', autoload definitions made by `autoload' with non-nil
1233 fourth argument, and some of the built-in functions of Lisp.
1235 Also, a symbol satisfies `commandp' if its function definition does so.
1237 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1238 then strings and vectors are not accepted. */)
1239 (Lisp_Object function
, Lisp_Object for_call_interactively
)
1241 register Lisp_Object fun
;
1242 register Lisp_Object funcar
;
1243 Lisp_Object if_prop
= Qnil
;
1247 fun
= indirect_function (fun
); /* Check cycles. */
1251 /* Check an `interactive-form' property if present, analogous to the
1252 function-documentation property. */
1254 while (SYMBOLP (fun
))
1256 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
1259 fun
= Fsymbol_function (fun
);
1262 if (scm_is_true (scm_procedure_p (fun
)))
1263 return (scm_is_pair (scm_assq (Qinteractive_form
,
1264 scm_procedure_properties (fun
)))
1266 /* Bytecode objects are interactive if they are long enough to
1267 have an element whose index is COMPILED_INTERACTIVE, which is
1268 where the interactive spec is stored. */
1269 else if (COMPILEDP (fun
))
1270 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1273 /* Strings and vectors are keyboard macros. */
1274 if (STRINGP (fun
) || VECTORP (fun
))
1275 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
1277 /* Lists may represent commands. */
1280 funcar
= XCAR (fun
);
1281 if (EQ (funcar
, Qclosure
))
1282 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
1284 else if (EQ (funcar
, Qlambda
))
1285 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
1286 else if (EQ (funcar
, Qautoload
))
1287 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
1292 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1293 doc
: /* Define FUNCTION to autoload from FILE.
1294 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1295 Third arg DOCSTRING is documentation for the function.
1296 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1297 Fifth arg TYPE indicates the type of the object:
1298 nil or omitted says FUNCTION is a function,
1299 `keymap' says FUNCTION is really a keymap, and
1300 `macro' or t says FUNCTION is really a macro.
1301 Third through fifth args give info about the real definition.
1302 They default to nil.
1303 If FUNCTION is already defined other than as an autoload,
1304 this does nothing and returns nil. */)
1305 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
1307 CHECK_SYMBOL (function
);
1308 CHECK_STRING (file
);
1310 /* If function is defined and not as an autoload, don't override. */
1311 if (!NILP (SYMBOL_FUNCTION (function
))
1312 && !AUTOLOADP (SYMBOL_FUNCTION (function
)))
1315 return Fdefalias (function
,
1316 list5 (Qautoload
, file
, docstring
, interactive
, type
),
1321 un_autoload (Lisp_Object oldqueue
)
1323 Lisp_Object queue
, first
, second
;
1325 /* Queue to unwind is current value of Vautoload_queue.
1326 oldqueue is the shadowed value to leave in Vautoload_queue. */
1327 queue
= Vautoload_queue
;
1328 Vautoload_queue
= oldqueue
;
1329 while (CONSP (queue
))
1331 first
= XCAR (queue
);
1332 second
= Fcdr (first
);
1333 first
= Fcar (first
);
1334 if (EQ (first
, make_number (0)))
1337 Ffset (first
, second
);
1338 queue
= XCDR (queue
);
1342 /* Load an autoloaded function.
1343 FUNNAME is the symbol which is the function's name.
1344 FUNDEF is the autoload definition (a list). */
1346 DEFUN ("autoload-do-load", Fautoload_do_load
, Sautoload_do_load
, 1, 3, 0,
1347 doc
: /* Load FUNDEF which should be an autoload.
1348 If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
1349 in which case the function returns the new autoloaded function value.
1350 If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
1351 it is defines a macro. */)
1352 (Lisp_Object fundef
, Lisp_Object funname
, Lisp_Object macro_only
)
1355 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1357 if (!CONSP (fundef
) || !EQ (Qautoload
, XCAR (fundef
))) {
1362 if (EQ (macro_only
, Qmacro
))
1364 Lisp_Object kind
= Fnth (make_number (4), fundef
);
1365 if (! (EQ (kind
, Qt
) || EQ (kind
, Qmacro
))) {
1371 /* This is to make sure that loadup.el gives a clear picture
1372 of what files are preloaded and when. */
1373 /*if (! NILP (Vpurify_flag))
1374 error ("Attempt to autoload %s while preparing to dump",
1375 SDATA (SYMBOL_NAME (funname)));*/
1377 CHECK_SYMBOL (funname
);
1378 GCPRO3 (funname
, fundef
, macro_only
);
1380 /* Preserve the match data. */
1381 record_unwind_save_match_data ();
1383 /* If autoloading gets an error (which includes the error of failing
1384 to define the function being called), we use Vautoload_queue
1385 to undo function definitions and `provide' calls made by
1386 the function. We do this in the specific case of autoloading
1387 because autoloading is not an explicit request "load this file",
1388 but rather a request to "call this function".
1390 The value saved here is to be restored into Vautoload_queue. */
1391 record_unwind_protect (un_autoload
, Vautoload_queue
);
1392 Vautoload_queue
= Qt
;
1393 /* If `macro_only', assume this autoload to be a "best-effort",
1394 so don't signal an error if autoloading fails. */
1395 Fload (Fcar (Fcdr (fundef
)), macro_only
, Qt
, Qnil
, Qt
);
1397 /* Once loading finishes, don't undo it. */
1398 Vautoload_queue
= Qt
;
1407 Lisp_Object fun
= Findirect_function (funname
, Qnil
);
1409 if (!NILP (Fequal (fun
, fundef
)))
1410 error ("Autoloading failed to define function %s",
1411 SDATA (SYMBOL_NAME (funname
)));
1418 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
1419 doc
: /* Evaluate FORM and return its value.
1420 If LEXICAL is t, evaluate using lexical scoping.
1421 LEXICAL can also be an actual lexical environment, in the form of an
1422 alist mapping symbols to their value. */)
1423 (Lisp_Object form
, Lisp_Object lexical
)
1426 specbind (Qinternal_interpreter_environment
,
1427 CONSP (lexical
) || NILP (lexical
) ? lexical
: list1 (Qt
));
1428 Lisp_Object tem0
= eval_sub (form
);
1433 /* Grow the specpdl stack by one entry.
1434 The caller should have already initialized the entry.
1435 Signal an error on stack overflow.
1437 Make sure that there is always one unused entry past the top of the
1438 stack, so that the just-initialized entry is safely unwound if
1439 memory exhausted and an error is signaled here. Also, allocate a
1440 never-used entry just before the bottom of the stack; sometimes its
1441 address is taken. */
1448 if (specpdl_ptr
== specpdl
+ specpdl_size
)
1450 ptrdiff_t count
= SPECPDL_INDEX ();
1451 ptrdiff_t max_size
= min (max_specpdl_size
, PTRDIFF_MAX
- 1000);
1452 union specbinding
*pdlvec
= specpdl
- 1;
1453 ptrdiff_t pdlvecsize
= specpdl_size
+ 1;
1454 if (max_size
<= specpdl_size
)
1456 if (max_specpdl_size
< 400)
1457 max_size
= max_specpdl_size
= 400;
1458 if (max_size
<= specpdl_size
)
1459 signal_error ("Variable binding depth exceeds max-specpdl-size",
1462 pdlvec
= xpalloc (pdlvec
, &pdlvecsize
, 1, max_size
+ 1, sizeof *specpdl
);
1463 specpdl
= pdlvec
+ 1;
1464 specpdl_size
= pdlvecsize
- 1;
1465 specpdl_ptr
= specpdl
+ count
;
1470 set_lisp_eval_depth (void *data
)
1472 EMACS_INT n
= (EMACS_INT
) data
;
1473 lisp_eval_depth
= n
;
1476 /* Eval a sub-expression of the current expression (i.e. in the same
1479 eval_sub_1 (Lisp_Object form
)
1482 return scm_call_1 (eval_fn
, form
);
1486 eval_sub (Lisp_Object form
)
1488 return scm_c_value_ref (eval_sub_1 (form
), 0);
1492 values_to_list (Lisp_Object values
)
1494 Lisp_Object list
= Qnil
;
1495 for (int i
= scm_c_nvalues (values
) - 1; i
>= 0; i
--)
1496 list
= Fcons (scm_c_value_ref (values
, i
), list
);
1500 DEFUN ("multiple-value-call", Fmultiple_value_call
, Smultiple_value_call
,
1502 doc
: /* Call with multiple values.
1503 usage: (multiple-value-call FUNCTION-FORM FORM) */)
1506 Lisp_Object function_form
= eval_sub (XCAR (args
));
1507 Lisp_Object values
= Qnil
;
1508 while (CONSP (args
= XCDR (args
)))
1509 values
= nconc2 (Fnreverse (values_to_list (eval_sub_1 (XCAR (args
)))),
1511 return apply1 (function_form
, Fnreverse (values
));
1514 DEFUN ("values", Fvalues
, Svalues
, 0, MANY
, 0,
1515 doc
: /* Return multiple values. */)
1516 (ptrdiff_t nargs
, Lisp_Object
*args
)
1518 return scm_c_values (args
, nargs
);
1522 Fapply (ptrdiff_t nargs
, Lisp_Object
*args
)
1526 register Lisp_Object spread_arg
;
1527 register Lisp_Object
*funcall_args
;
1528 Lisp_Object fun
, retval
;
1529 struct gcpro gcpro1
;
1534 spread_arg
= args
[nargs
- 1];
1535 CHECK_LIST (spread_arg
);
1537 numargs
= XINT (Flength (spread_arg
));
1540 return Ffuncall (nargs
- 1, args
);
1541 else if (numargs
== 1)
1543 args
[nargs
- 1] = XCAR (spread_arg
);
1544 return Ffuncall (nargs
, args
);
1547 numargs
+= nargs
- 2;
1549 /* Optimize for no indirection. */
1550 if (SYMBOLP (fun
) && !NILP (fun
)
1551 && (fun
= SYMBOL_FUNCTION (fun
), SYMBOLP (fun
)))
1552 fun
= indirect_function (fun
);
1555 /* Let funcall get the error. */
1559 /* We add 1 to numargs because funcall_args includes the
1560 function itself as well as its arguments. */
1563 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
1564 GCPRO1 (*funcall_args
);
1565 gcpro1
.nvars
= 1 + numargs
;
1568 memcpy (funcall_args
, args
, nargs
* word_size
);
1569 /* Spread the last arg we got. Its first element goes in
1570 the slot that it used to occupy, hence this value of I. */
1572 while (!NILP (spread_arg
))
1574 funcall_args
[i
++] = XCAR (spread_arg
);
1575 spread_arg
= XCDR (spread_arg
);
1578 /* By convention, the caller needs to gcpro Ffuncall's args. */
1579 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
1586 /* Run hook variables in various ways. */
1589 funcall_nil (ptrdiff_t nargs
, Lisp_Object
*args
)
1591 Ffuncall (nargs
, args
);
1595 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
1596 doc
: /* Run each hook in HOOKS.
1597 Each argument should be a symbol, a hook variable.
1598 These symbols are processed in the order specified.
1599 If a hook symbol has a non-nil value, that value may be a function
1600 or a list of functions to be called to run the hook.
1601 If the value is a function, it is called with no arguments.
1602 If it is a list, the elements are called, in order, with no arguments.
1604 Major modes should not use this function directly to run their mode
1605 hook; they should use `run-mode-hooks' instead.
1607 Do not use `make-local-variable' to make a hook variable buffer-local.
1608 Instead, use `add-hook' and specify t for the LOCAL argument.
1609 usage: (run-hooks &rest HOOKS) */)
1610 (ptrdiff_t nargs
, Lisp_Object
*args
)
1612 Lisp_Object hook
[1];
1615 for (i
= 0; i
< nargs
; i
++)
1618 run_hook_with_args (1, hook
, funcall_nil
);
1624 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
1625 Srun_hook_with_args
, 1, MANY
, 0,
1626 doc
: /* Run HOOK with the specified arguments ARGS.
1627 HOOK should be a symbol, a hook variable. The value of HOOK
1628 may be nil, a function, or a list of functions. Call each
1629 function in order with arguments ARGS. The final return value
1632 Do not use `make-local-variable' to make a hook variable buffer-local.
1633 Instead, use `add-hook' and specify t for the LOCAL argument.
1634 usage: (run-hook-with-args HOOK &rest ARGS) */)
1635 (ptrdiff_t nargs
, Lisp_Object
*args
)
1637 return run_hook_with_args (nargs
, args
, funcall_nil
);
1640 /* NB this one still documents a specific non-nil return value.
1641 (As did run-hook-with-args and run-hook-with-args-until-failure
1642 until they were changed in 24.1.) */
1643 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
1644 Srun_hook_with_args_until_success
, 1, MANY
, 0,
1645 doc
: /* Run HOOK with the specified arguments ARGS.
1646 HOOK should be a symbol, a hook variable. The value of HOOK
1647 may be nil, a function, or a list of functions. Call each
1648 function in order with arguments ARGS, stopping at the first
1649 one that returns non-nil, and return that value. Otherwise (if
1650 all functions return nil, or if there are no functions to call),
1653 Do not use `make-local-variable' to make a hook variable buffer-local.
1654 Instead, use `add-hook' and specify t for the LOCAL argument.
1655 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
1656 (ptrdiff_t nargs
, Lisp_Object
*args
)
1658 return run_hook_with_args (nargs
, args
, Ffuncall
);
1662 funcall_not (ptrdiff_t nargs
, Lisp_Object
*args
)
1664 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
1667 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
1668 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
1669 doc
: /* Run HOOK with the specified arguments ARGS.
1670 HOOK should be a symbol, a hook variable. The value of HOOK
1671 may be nil, a function, or a list of functions. Call each
1672 function in order with arguments ARGS, stopping at the first
1673 one that returns nil, and return nil. Otherwise (if all functions
1674 return non-nil, or if there are no functions to call), return non-nil
1675 \(do not rely on the precise return value in this case).
1677 Do not use `make-local-variable' to make a hook variable buffer-local.
1678 Instead, use `add-hook' and specify t for the LOCAL argument.
1679 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
1680 (ptrdiff_t nargs
, Lisp_Object
*args
)
1682 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
1686 run_hook_wrapped_funcall (ptrdiff_t nargs
, Lisp_Object
*args
)
1688 Lisp_Object tmp
= args
[0], ret
;
1691 ret
= Ffuncall (nargs
, args
);
1697 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
1698 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
1699 I.e. instead of calling each function FUN directly with arguments ARGS,
1700 it calls WRAP-FUNCTION with arguments FUN and ARGS.
1701 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
1702 aborts and returns that value.
1703 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
1704 (ptrdiff_t nargs
, Lisp_Object
*args
)
1706 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
1709 /* ARGS[0] should be a hook symbol.
1710 Call each of the functions in the hook value, passing each of them
1711 as arguments all the rest of ARGS (all NARGS - 1 elements).
1712 FUNCALL specifies how to call each function on the hook.
1713 The caller (or its caller, etc) must gcpro all of ARGS,
1714 except that it isn't necessary to gcpro ARGS[0]. */
1717 run_hook_with_args (ptrdiff_t nargs
, Lisp_Object
*args
,
1718 Lisp_Object (*funcall
) (ptrdiff_t nargs
, Lisp_Object
*args
))
1720 Lisp_Object sym
, val
, ret
= Qnil
;
1721 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1723 /* If we are dying or still initializing,
1724 don't do anything--it would probably crash if we tried. */
1725 if (NILP (Vrun_hooks
))
1729 val
= find_symbol_value (sym
);
1731 if (EQ (val
, Qunbound
) || NILP (val
))
1733 else if (!CONSP (val
) || FUNCTIONP (val
))
1736 return funcall (nargs
, args
);
1740 Lisp_Object global_vals
= Qnil
;
1741 GCPRO3 (sym
, val
, global_vals
);
1744 CONSP (val
) && NILP (ret
);
1747 if (EQ (XCAR (val
), Qt
))
1749 /* t indicates this hook has a local binding;
1750 it means to run the global binding too. */
1751 global_vals
= Fdefault_value (sym
);
1752 if (NILP (global_vals
)) continue;
1754 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
1756 args
[0] = global_vals
;
1757 ret
= funcall (nargs
, args
);
1762 CONSP (global_vals
) && NILP (ret
);
1763 global_vals
= XCDR (global_vals
))
1765 args
[0] = XCAR (global_vals
);
1766 /* In a global value, t should not occur. If it does, we
1767 must ignore it to avoid an endless loop. */
1768 if (!EQ (args
[0], Qt
))
1769 ret
= funcall (nargs
, args
);
1775 args
[0] = XCAR (val
);
1776 ret
= funcall (nargs
, args
);
1785 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
1788 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
1790 Lisp_Object temp
[3];
1795 Frun_hook_with_args (3, temp
);
1798 /* Apply fn to arg. */
1800 apply1 (Lisp_Object fn
, Lisp_Object arg
)
1802 struct gcpro gcpro1
;
1806 return Ffuncall (1, &fn
);
1809 Lisp_Object args
[2];
1813 return Fapply (2, args
);
1817 /* Call function fn on no arguments. */
1819 call0 (Lisp_Object fn
)
1821 struct gcpro gcpro1
;
1824 return Ffuncall (1, &fn
);
1827 /* Call function fn with 1 argument arg1. */
1830 call1 (Lisp_Object fn
, Lisp_Object arg1
)
1832 struct gcpro gcpro1
;
1833 Lisp_Object args
[2];
1839 return Ffuncall (2, args
);
1842 /* Call function fn with 2 arguments arg1, arg2. */
1845 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
1847 struct gcpro gcpro1
;
1848 Lisp_Object args
[3];
1854 return Ffuncall (3, args
);
1857 /* Call function fn with 3 arguments arg1, arg2, arg3. */
1860 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1862 struct gcpro gcpro1
;
1863 Lisp_Object args
[4];
1870 return Ffuncall (4, args
);
1873 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
1876 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1879 struct gcpro gcpro1
;
1880 Lisp_Object args
[5];
1888 return Ffuncall (5, args
);
1891 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
1894 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1895 Lisp_Object arg4
, Lisp_Object arg5
)
1897 struct gcpro gcpro1
;
1898 Lisp_Object args
[6];
1907 return Ffuncall (6, args
);
1910 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
1913 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1914 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
1916 struct gcpro gcpro1
;
1917 Lisp_Object args
[7];
1927 return Ffuncall (7, args
);
1930 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
1933 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1934 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
1936 struct gcpro gcpro1
;
1937 Lisp_Object args
[8];
1948 return Ffuncall (8, args
);
1951 /* The caller should GCPRO all the elements of ARGS. */
1953 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
1954 doc
: /* Non-nil if OBJECT is a function. */)
1955 (Lisp_Object object
)
1957 if (FUNCTIONP (object
))
1963 Ffuncall1 (ptrdiff_t nargs
, Lisp_Object
*args
)
1965 return scm_call_n (funcall_fn
, args
, nargs
);
1969 Ffuncall (ptrdiff_t nargs
, Lisp_Object
*args
)
1971 return scm_c_value_ref (Ffuncall1 (nargs
, args
), 0);
1975 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
1977 Lisp_Object args_left
;
1980 register Lisp_Object
*arg_vector
;
1981 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1982 register Lisp_Object tem
;
1985 numargs
= XFASTINT (Flength (args
));
1986 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
1989 GCPRO3 (*arg_vector
, args_left
, fun
);
1992 for (i
= 0; i
< numargs
; )
1994 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
1995 arg_vector
[i
++] = tem
;
2001 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
2007 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2008 and return the result of evaluation.
2009 FUN must be either a lambda-expression or a compiled-code object. */
2012 funcall_lambda (Lisp_Object fun
, ptrdiff_t nargs
,
2013 register Lisp_Object
*arg_vector
)
2015 Lisp_Object val
, syms_left
, next
, lexenv
;
2018 bool optional
, rest
;
2022 if (EQ (XCAR (fun
), Qclosure
))
2024 fun
= XCDR (fun
); /* Drop `closure'. */
2025 lexenv
= XCAR (fun
);
2026 CHECK_LIST_CONS (fun
, fun
);
2030 syms_left
= XCDR (fun
);
2031 if (CONSP (syms_left
))
2032 syms_left
= XCAR (syms_left
);
2034 xsignal1 (Qinvalid_function
, fun
);
2039 i
= optional
= rest
= 0;
2040 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2044 next
= XCAR (syms_left
);
2045 if (!SYMBOLP (next
))
2046 xsignal1 (Qinvalid_function
, fun
);
2048 if (EQ (next
, Qand_rest
))
2050 else if (EQ (next
, Qand_optional
))
2057 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
2061 arg
= arg_vector
[i
++];
2063 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
2067 /* Bind the argument. */
2068 if (!NILP (lexenv
) && SYMBOLP (next
))
2069 /* Lexically bind NEXT by adding it to the lexenv alist. */
2070 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
2072 /* Dynamically bind NEXT. */
2073 specbind (next
, arg
);
2077 if (!NILP (syms_left
))
2078 xsignal1 (Qinvalid_function
, fun
);
2080 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
2082 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
2083 /* Instantiate a new lexical environment. */
2084 specbind (Qinternal_interpreter_environment
, lexenv
);
2086 val
= Fprogn (XCDR (XCDR (fun
)));
2092 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2094 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2095 (Lisp_Object object
)
2099 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2101 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2104 tem
= AREF (object
, COMPILED_BYTECODE
);
2105 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2106 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2108 error ("Invalid byte code");
2110 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
2111 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
2116 /* Return true if SYMBOL currently has a let-binding
2117 which was made in the buffer that is now current. */
2120 let_shadows_buffer_binding_p (sym_t symbol
)
2122 union specbinding
*p
;
2123 Lisp_Object buf
= Fcurrent_buffer ();
2125 for (p
= specpdl_ptr
; p
> specpdl
; )
2126 if ((--p
)->kind
> SPECPDL_LET
)
2128 sym_t let_bound_symbol
= XSYMBOL (specpdl_symbol (p
));
2129 eassert (SYMBOL_REDIRECT (let_bound_symbol
) != SYMBOL_VARALIAS
);
2130 if (symbol
== let_bound_symbol
2131 && EQ (specpdl_where (p
), buf
))
2139 let_shadows_global_binding_p (Lisp_Object symbol
)
2141 union specbinding
*p
;
2143 for (p
= specpdl_ptr
; p
> specpdl
; )
2144 if ((--p
)->kind
>= SPECPDL_LET
&& EQ (specpdl_symbol (p
), symbol
))
2150 /* `specpdl_ptr' describes which variable is
2151 let-bound, so it can be properly undone when we unbind_to.
2152 It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT.
2153 - SYMBOL is the variable being bound. Note that it should not be
2154 aliased (i.e. when let-binding V1 that's aliased to V2, we want
2156 - WHERE tells us in which buffer the binding took place.
2157 This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a
2158 buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings,
2159 i.e. bindings to the default value of a variable which can be
2163 specbind (Lisp_Object symbol
, Lisp_Object value
)
2167 CHECK_SYMBOL (symbol
);
2168 sym
= XSYMBOL (symbol
);
2171 switch (SYMBOL_REDIRECT (sym
))
2173 case SYMBOL_VARALIAS
:
2174 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
2175 case SYMBOL_PLAINVAL
:
2176 /* The most common case is that of a non-constant symbol with a
2177 trivial value. Make that as fast as we can. */
2178 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
2179 specpdl_ptr
->let
.symbol
= symbol
;
2180 specpdl_ptr
->let
.old_value
= SYMBOL_VAL (sym
);
2182 if (! SYMBOL_CONSTANT (sym
))
2183 SET_SYMBOL_VAL (sym
, value
);
2185 set_internal (symbol
, value
, Qnil
, 1);
2187 case SYMBOL_LOCALIZED
:
2188 if (SYMBOL_BLV (sym
)->frame_local
)
2189 error ("Frame-local vars cannot be let-bound");
2190 case SYMBOL_FORWARDED
:
2192 Lisp_Object ovalue
= find_symbol_value (symbol
);
2193 specpdl_ptr
->let
.kind
= SPECPDL_LET_LOCAL
;
2194 specpdl_ptr
->let
.symbol
= symbol
;
2195 specpdl_ptr
->let
.old_value
= ovalue
;
2196 specpdl_ptr
->let
.where
= Fcurrent_buffer ();
2198 eassert (SYMBOL_REDIRECT (sym
) != SYMBOL_LOCALIZED
2199 || (EQ (SYMBOL_BLV (sym
)->where
, Fcurrent_buffer ())));
2201 if (SYMBOL_REDIRECT (sym
) == SYMBOL_LOCALIZED
)
2203 if (!blv_found (SYMBOL_BLV (sym
)))
2204 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
2206 else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
2208 /* If SYMBOL is a per-buffer variable which doesn't have a
2209 buffer-local value here, make the `let' change the global
2210 value by changing the value of SYMBOL in all buffers not
2211 having their own value. This is consistent with what
2212 happens with other buffer-local variables. */
2213 if (NILP (Flocal_variable_p (symbol
, Qnil
)))
2215 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
2217 Fset_default (symbol
, value
);
2222 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
2225 set_internal (symbol
, value
, Qnil
, 1);
2228 default: emacs_abort ();
2232 scm_dynwind_unwind_handler (unbind_once
, NULL
, SCM_F_WIND_EXPLICITLY
);
2235 /* Push unwind-protect entries of various types. */
2238 record_unwind_protect_1 (void (*function
) (Lisp_Object
), Lisp_Object arg
,
2239 bool wind_explicitly
)
2241 record_unwind_protect_ptr_1 (function
, arg
, wind_explicitly
);
2245 record_unwind_protect (void (*function
) (Lisp_Object
), Lisp_Object arg
)
2247 record_unwind_protect_1 (function
, arg
, true);
2251 record_unwind_protect_ptr_1 (void (*function
) (void *), void *arg
,
2252 bool wind_explicitly
)
2254 scm_dynwind_unwind_handler (function
,
2257 ? SCM_F_WIND_EXPLICITLY
2262 record_unwind_protect_ptr (void (*function
) (void *), void *arg
)
2264 record_unwind_protect_ptr_1 (function
, arg
, true);
2268 record_unwind_protect_int_1 (void (*function
) (int), int arg
,
2269 bool wind_explicitly
)
2271 record_unwind_protect_ptr_1 (function
, arg
, wind_explicitly
);
2275 record_unwind_protect_int (void (*function
) (int), int arg
)
2277 record_unwind_protect_int_1 (function
, arg
, true);
2281 call_void (void *data
)
2283 ((void (*) (void)) data
) ();
2287 record_unwind_protect_void_1 (void (*function
) (void),
2288 bool wind_explicitly
)
2290 record_unwind_protect_ptr_1 (call_void
, function
, wind_explicitly
);
2294 record_unwind_protect_void (void (*function
) (void))
2296 record_unwind_protect_void_1 (function
, true);
2300 unbind_once (void *ignore
)
2302 /* Decrement specpdl_ptr before we do the work to unbind it, so
2303 that an error in unbinding won't try to unbind the same entry
2304 again. Take care to copy any parts of the binding needed
2305 before invoking any code that can make more bindings. */
2309 switch (specpdl_ptr
->kind
)
2312 { /* If variable has a trivial value (no forwarding), we can
2313 just set it. No need to check for constant symbols here,
2314 since that was already done by specbind. */
2315 sym_t sym
= XSYMBOL (specpdl_symbol (specpdl_ptr
));
2316 if (SYMBOL_REDIRECT (sym
) == SYMBOL_PLAINVAL
)
2318 SET_SYMBOL_VAL (sym
, specpdl_old_value (specpdl_ptr
));
2323 NOTE: we only ever come here if make_local_foo was used for
2324 the first time on this var within this let. */
2327 case SPECPDL_LET_DEFAULT
:
2328 Fset_default (specpdl_symbol (specpdl_ptr
),
2329 specpdl_old_value (specpdl_ptr
));
2331 case SPECPDL_LET_LOCAL
:
2333 Lisp_Object symbol
= specpdl_symbol (specpdl_ptr
);
2334 Lisp_Object where
= specpdl_where (specpdl_ptr
);
2335 Lisp_Object old_value
= specpdl_old_value (specpdl_ptr
);
2336 eassert (BUFFERP (where
));
2338 /* If this was a local binding, reset the value in the appropriate
2339 buffer, but only if that buffer's binding still exists. */
2340 if (!NILP (Flocal_variable_p (symbol
, where
)))
2341 set_internal (symbol
, old_value
, where
, 1);
2348 dynwind_begin (void)
2350 scm_dynwind_begin (0);
2359 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
2360 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
2361 A special variable is one that will be bound dynamically, even in a
2362 context where binding is lexical by default. */)
2363 (Lisp_Object symbol
)
2365 CHECK_SYMBOL (symbol
);
2366 return SYMBOL_DECLARED_SPECIAL (XSYMBOL (symbol
)) ? Qt
: Qnil
;
2370 abort_to_prompt (SCM tag
, SCM arglst
)
2372 static SCM var
= SCM_UNDEFINED
;
2373 if (SCM_UNBNDP (var
))
2374 var
= scm_c_public_lookup ("guile", "abort-to-prompt");
2376 scm_apply_1 (scm_variable_ref (var
), tag
, arglst
);
2381 call_with_prompt (SCM tag
, SCM thunk
, SCM handler
)
2383 static SCM var
= SCM_UNDEFINED
;
2384 if (SCM_UNBNDP (var
))
2385 var
= scm_c_public_lookup ("guile", "call-with-prompt");
2387 return scm_call_3 (scm_variable_ref (var
), tag
, thunk
, handler
);
2391 make_prompt_tag (void)
2393 static SCM var
= SCM_UNDEFINED
;
2394 if (SCM_UNBNDP (var
))
2395 var
= scm_c_public_lookup ("guile", "make-prompt-tag");
2397 return scm_call_0 (scm_variable_ref (var
));
2405 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
2406 doc
: /* Limit on number of Lisp variable bindings and `unwind-protect's.
2407 If Lisp code tries to increase the total number past this amount,
2408 an error is signaled.
2409 You can safely use a value considerably larger than the default value,
2410 if that proves inconveniently small. However, if you increase it too far,
2411 Emacs could run out of memory trying to make the stack bigger.
2412 Note that this limit may be silently increased by the debugger
2413 if `debug-on-error' or `debug-on-quit' is set. */);
2415 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
2416 doc
: /* Limit on depth in `eval', `apply' and `funcall' before error.
2418 This limit serves to catch infinite recursions for you before they cause
2419 actual stack overflow in C, which would be fatal for Emacs.
2420 You can safely make it considerably larger than its default value,
2421 if that proves inconveniently small. However, if you increase it too far,
2422 Emacs could overflow the real C stack, and crash. */);
2424 DEFVAR_LISP ("quit-flag", Vquit_flag
,
2425 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
2426 If the value is t, that means do an ordinary quit.
2427 If the value equals `throw-on-input', that means quit by throwing
2428 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
2429 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
2430 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
2433 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
2434 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
2435 Note that `quit-flag' will still be set by typing C-g,
2436 so a quit will be signaled as soon as `inhibit-quit' is nil.
2437 To prevent this happening, set `quit-flag' to nil
2438 before making `inhibit-quit' nil. */);
2439 Vinhibit_quit
= Qnil
;
2441 DEFSYM (Qinhibit_quit
, "inhibit-quit");
2442 DEFSYM (Qautoload
, "autoload");
2443 DEFSYM (Qinhibit_debugger
, "inhibit-debugger");
2444 DEFSYM (Qmacro
, "macro");
2445 DEFSYM (Qdeclare
, "declare");
2447 /* Note that the process handling also uses Qexit, but we don't want
2448 to staticpro it twice, so we just do it here. */
2449 DEFSYM (Qexit
, "exit");
2451 DEFSYM (Qinteractive
, "interactive");
2452 DEFSYM (Qcommandp
, "commandp");
2453 DEFSYM (Qand_rest
, "&rest");
2454 DEFSYM (Qand_optional
, "&optional");
2455 DEFSYM (Qclosure
, "closure");
2456 DEFSYM (Qdebug
, "debug");
2458 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger
,
2459 doc
: /* Non-nil means never enter the debugger.
2460 Normally set while the debugger is already active, to avoid recursive
2462 Vinhibit_debugger
= Qnil
;
2464 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
2465 doc
: /* Non-nil means enter debugger if an error is signaled.
2466 Does not apply to errors handled by `condition-case' or those
2467 matched by `debug-ignored-errors'.
2468 If the value is a list, an error only means to enter the debugger
2469 if one of its condition symbols appears in the list.
2470 When you evaluate an expression interactively, this variable
2471 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
2472 The command `toggle-debug-on-error' toggles this.
2473 See also the variable `debug-on-quit' and `inhibit-debugger'. */);
2474 Vdebug_on_error
= Qnil
;
2476 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
2477 doc
: /* List of errors for which the debugger should not be called.
2478 Each element may be a condition-name or a regexp that matches error messages.
2479 If any element applies to a given error, that error skips the debugger
2480 and just returns to top level.
2481 This overrides the variable `debug-on-error'.
2482 It does not apply to errors handled by `condition-case'. */);
2483 Vdebug_ignored_errors
= Qnil
;
2485 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
2486 doc
: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
2487 Does not apply if quit is handled by a `condition-case'. */);
2490 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
2491 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
2493 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
2494 doc
: /* Non-nil means debugger may continue execution.
2495 This is nil when the debugger is called under circumstances where it
2496 might not be safe to continue. */);
2497 debugger_may_continue
= 1;
2499 DEFVAR_LISP ("debugger", Vdebugger
,
2500 doc
: /* Function to call to invoke debugger.
2501 If due to frame exit, args are `exit' and the value being returned;
2502 this function's value will be returned instead of that.
2503 If due to error, args are `error' and a list of the args to `signal'.
2504 If due to `apply' or `funcall' entry, one arg, `lambda'.
2505 If due to `eval' entry, one arg, t. */);
2508 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
2509 doc
: /* If non-nil, this is a function for `signal' to call.
2510 It receives the same arguments that `signal' was given.
2511 The Edebug package uses this to regain control. */);
2512 Vsignal_hook_function
= Qnil
;
2514 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
2515 doc
: /* Non-nil means call the debugger regardless of condition handlers.
2516 Note that `debug-on-error', `debug-on-quit' and friends
2517 still determine whether to handle the particular condition. */);
2518 Vdebug_on_signal
= Qnil
;
2520 /* When lexical binding is being used,
2521 Vinternal_interpreter_environment is non-nil, and contains an alist
2522 of lexically-bound variable, or (t), indicating an empty
2523 environment. The lisp name of this variable would be
2524 `internal-interpreter-environment' if it weren't hidden.
2525 Every element of this list can be either a cons (VAR . VAL)
2526 specifying a lexical binding, or a single symbol VAR indicating
2527 that this variable should use dynamic scoping. */
2528 DEFSYM (Qinternal_interpreter_environment
,
2529 "internal-interpreter-environment");
2530 DEFVAR_LISP ("internal-interpreter-environment",
2531 Vinternal_interpreter_environment
,
2532 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
2533 When lexical binding is not being used, this variable is nil.
2534 A value of `(t)' indicates an empty environment, otherwise it is an
2535 alist of active lexical bindings. */);
2536 Vinternal_interpreter_environment
= Qnil
;
2537 /* Don't export this variable to Elisp, so no one can mess with it
2538 (Just imagine if someone makes it buffer-local). */
2539 //Funintern (Qinternal_interpreter_environment, Qnil);
2541 DEFSYM (Vrun_hooks
, "run-hooks");
2543 staticpro (&Vautoload_queue
);
2544 Vautoload_queue
= Qnil
;
2545 staticpro (&Vsignaling_function
);
2546 Vsignaling_function
= Qnil
;
2548 inhibit_lisp_code
= Qnil
;