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 the dummy entry before the specpdl. */
78 union specbinding
*specpdl_base
;
80 /* Pointer to first unused element in specpdl. */
82 union specbinding
*specpdl_ptr
;
84 /* Depth in Lisp evaluations and function calls. */
86 EMACS_INT lisp_eval_depth
;
88 /* The value of num_nonmacro_input_events as of the last time we
89 started to enter the debugger. If we decide to enter the debugger
90 again when this is still equal to num_nonmacro_input_events, then we
91 know that the debugger itself has an error, and we should just
92 signal the error instead of entering an infinite loop of debugger
95 static EMACS_INT when_entered_debugger
;
97 /* The function from which the last `signal' was called. Set in
99 /* FIXME: We should probably get rid of this! */
100 Lisp_Object Vsignaling_function
;
102 /* If non-nil, Lisp code must not be run since some part of Emacs is
103 in an inconsistent state. Currently, x-create-frame uses this to
104 avoid triggering window-configuration-change-hook while the new
105 frame is half-initialized. */
106 Lisp_Object inhibit_lisp_code
;
108 static Lisp_Object
funcall_lambda (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
109 static Lisp_Object
apply_lambda (Lisp_Object fun
, Lisp_Object args
);
112 specpdl_symbol (union specbinding
*pdl
)
114 eassert (pdl
->kind
>= SPECPDL_LET
);
115 return pdl
->let
.symbol
;
119 specpdl_old_value (union specbinding
*pdl
)
121 eassert (pdl
->kind
>= SPECPDL_LET
);
122 return pdl
->let
.old_value
;
126 set_specpdl_old_value (union specbinding
*pdl
, Lisp_Object val
)
128 eassert (pdl
->kind
>= SPECPDL_LET
);
129 pdl
->let
.old_value
= val
;
133 specpdl_where (union specbinding
*pdl
)
135 eassert (pdl
->kind
> SPECPDL_LET
);
136 return pdl
->let
.where
;
140 make_catch_handler (Lisp_Object tag
)
142 struct handler
*c
= xmalloc (sizeof (*c
));
148 c
->next
= handlerlist
;
149 c
->lisp_eval_depth
= lisp_eval_depth
;
150 c
->interrupt_input_blocked
= interrupt_input_blocked
;
151 c
->ptag
= make_prompt_tag ();
156 make_condition_handler (Lisp_Object tag
)
158 struct handler
*c
= xmalloc (sizeof (*c
));
159 c
->type
= CONDITION_CASE
;
164 c
->next
= handlerlist
;
165 c
->lisp_eval_depth
= lisp_eval_depth
;
166 c
->interrupt_input_blocked
= interrupt_input_blocked
;
167 c
->ptag
= make_prompt_tag ();
171 static Lisp_Object eval_fn
;
172 static Lisp_Object funcall_fn
;
175 init_eval_once (void)
178 union specbinding
*pdlvec
= xmalloc ((size
+ 1) * sizeof *specpdl
);
179 specpdl_base
= pdlvec
;
181 specpdl
= specpdl_ptr
= pdlvec
+ 1;
182 /* Don't forget to update docs (lispref node "Local Variables"). */
183 max_specpdl_size
= 10000; /* 1000 is not enough for CEDET's c-by.el. */
184 max_lisp_eval_depth
= 10000;
188 eval_fn
= scm_c_public_ref ("language elisp runtime", "eval-elisp");
189 funcall_fn
= scm_c_public_ref ("elisp-functions", "funcall");
191 //scm_set_smob_apply (lisp_vectorlike_tag, apply_lambda, 0, 0, 1);
194 static struct handler
*handlerlist_sentinel
;
199 specpdl_ptr
= specpdl
;
200 handlerlist_sentinel
= make_catch_handler (Qunbound
);
201 handlerlist
= handlerlist_sentinel
;
203 debug_on_next_call
= 0;
208 /* This is less than the initial value of num_nonmacro_input_events. */
209 when_entered_debugger
= -1;
212 /* Unwind-protect function used by call_debugger. */
215 restore_stack_limits (Lisp_Object data
)
217 max_specpdl_size
= XINT (XCAR (data
));
218 max_lisp_eval_depth
= XINT (XCDR (data
));
221 static void grow_specpdl (void);
223 /* Call the Lisp debugger, giving it argument ARG. */
226 call_debugger (Lisp_Object arg
)
228 bool debug_while_redisplaying
;
231 EMACS_INT old_depth
= max_lisp_eval_depth
;
232 /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
233 EMACS_INT old_max
= max_specpdl_size
;
235 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
236 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
238 /* Restore limits after leaving the debugger. */
239 record_unwind_protect (restore_stack_limits
,
240 Fcons (make_number (old_max
),
241 make_number (old_depth
)));
243 #ifdef HAVE_WINDOW_SYSTEM
244 if (display_hourglass_p
)
248 debug_on_next_call
= 0;
249 when_entered_debugger
= num_nonmacro_input_events
;
251 /* Resetting redisplaying_p to 0 makes sure that debug output is
252 displayed if the debugger is invoked during redisplay. */
253 debug_while_redisplaying
= redisplaying_p
;
255 specbind (intern ("debugger-may-continue"),
256 debug_while_redisplaying
? Qnil
: Qt
);
257 specbind (Qinhibit_redisplay
, Qnil
);
258 specbind (Qinhibit_debugger
, Qt
);
260 #if 0 /* Binding this prevents execution of Lisp code during
261 redisplay, which necessarily leads to display problems. */
262 specbind (Qinhibit_eval_during_redisplay
, Qt
);
265 val
= apply1 (Vdebugger
, arg
);
267 /* Interrupting redisplay and resuming it later is not safe under
268 all circumstances. So, when the debugger returns, abort the
269 interrupted redisplay by going back to the top-level. */
270 if (debug_while_redisplaying
)
278 Fprogn (Lisp_Object body
)
280 Lisp_Object val
= Qnil
;
287 val
= eval_sub (XCAR (body
));
295 /* Evaluate BODY sequentially, discarding its value. Suitable for
296 record_unwind_protect. */
299 unwind_body (Lisp_Object body
)
305 Ffunction (Lisp_Object args
)
307 Lisp_Object quoted
= XCAR (args
);
309 if (CONSP (XCDR (args
)))
310 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
312 if (!NILP (Vinternal_interpreter_environment
)
314 && EQ (XCAR (quoted
), Qlambda
))
315 /* This is a lambda expression within a lexical environment;
316 return an interpreted closure instead of a simple lambda. */
317 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
,
320 /* Simply quote the argument. */
324 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
325 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
326 Aliased variables always have the same value; setting one sets the other.
327 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
328 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
329 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
330 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
331 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
332 The return value is BASE-VARIABLE. */)
333 (Lisp_Object new_alias
, Lisp_Object base_variable
, Lisp_Object docstring
)
337 CHECK_SYMBOL (new_alias
);
338 CHECK_SYMBOL (base_variable
);
340 sym
= XSYMBOL (new_alias
);
342 if (SYMBOL_CONSTANT (sym
))
343 /* Not sure why, but why not? */
344 error ("Cannot make a constant an alias");
346 switch (SYMBOL_REDIRECT (sym
))
348 case SYMBOL_FORWARDED
:
349 error ("Cannot make an internal variable an alias");
350 case SYMBOL_LOCALIZED
:
351 error ("Don't know how to make a localized variable an alias");
354 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
355 If n_a is bound, but b_v is not, set the value of b_v to n_a,
356 so that old-code that affects n_a before the aliasing is setup
358 if (NILP (Fboundp (base_variable
)))
359 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
362 union specbinding
*p
;
364 for (p
= specpdl_ptr
; p
> specpdl
; )
365 if ((--p
)->kind
>= SPECPDL_LET
366 && (EQ (new_alias
, specpdl_symbol (p
))))
367 error ("Don't know how to make a let-bound variable an alias");
370 SET_SYMBOL_DECLARED_SPECIAL (sym
, 1);
371 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (base_variable
), 1);
372 SET_SYMBOL_REDIRECT (sym
, SYMBOL_VARALIAS
);
373 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
374 SET_SYMBOL_CONSTANT (sym
, SYMBOL_CONSTANT_P (base_variable
));
375 LOADHIST_ATTACH (new_alias
);
376 /* Even if docstring is nil: remove old docstring. */
377 Fput (new_alias
, Qvariable_documentation
, docstring
);
379 return base_variable
;
382 static union specbinding
*
383 default_toplevel_binding (Lisp_Object symbol
)
385 union specbinding
*binding
= NULL
;
386 union specbinding
*pdl
= specpdl_ptr
;
387 while (pdl
> specpdl
)
389 switch ((--pdl
)->kind
)
391 case SPECPDL_LET_DEFAULT
:
393 if (EQ (specpdl_symbol (pdl
), symbol
))
401 DEFUN ("default-toplevel-value", Fdefault_toplevel_value
, Sdefault_toplevel_value
, 1, 1, 0,
402 doc
: /* Return SYMBOL's toplevel default value.
403 "Toplevel" means outside of any let binding. */)
406 union specbinding
*binding
= default_toplevel_binding (symbol
);
408 = binding
? specpdl_old_value (binding
) : Fdefault_value (symbol
);
409 if (!EQ (value
, Qunbound
))
411 xsignal1 (Qvoid_variable
, symbol
);
414 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value
,
415 Sset_default_toplevel_value
, 2, 2, 0,
416 doc
: /* Set SYMBOL's toplevel default value to VALUE.
417 "Toplevel" means outside of any let binding. */)
418 (Lisp_Object symbol
, Lisp_Object value
)
420 union specbinding
*binding
= default_toplevel_binding (symbol
);
422 set_specpdl_old_value (binding
, value
);
424 Fset_default (symbol
, value
);
428 /* Make SYMBOL lexically scoped. */
429 DEFUN ("internal-make-var-non-special", Fmake_var_non_special
,
430 Smake_var_non_special
, 1, 1, 0,
431 doc
: /* Internal function. */)
434 CHECK_SYMBOL (symbol
);
435 SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (symbol
), 0);
440 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
441 doc
: /* Return result of expanding macros at top level of FORM.
442 If FORM is not a macro call, it is returned unchanged.
443 Otherwise, the macro is expanded and the expansion is considered
444 in place of FORM. When a non-macro-call results, it is returned.
446 The second optional arg ENVIRONMENT specifies an environment of macro
447 definitions to shadow the loaded ones for use in file byte-compilation. */)
448 (Lisp_Object form
, Lisp_Object environment
)
450 /* With cleanups from Hallvard Furuseth. */
451 register Lisp_Object expander
, sym
, def
, tem
;
455 /* Come back here each time we expand a macro call,
456 in case it expands into another macro call. */
459 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
460 def
= sym
= XCAR (form
);
462 /* Trace symbols aliases to other symbols
463 until we get a symbol that is not an alias. */
464 while (SYMBOLP (def
))
468 tem
= Fassq (sym
, environment
);
471 def
= SYMBOL_FUNCTION (sym
);
477 /* Right now TEM is the result from SYM in ENVIRONMENT,
478 and if TEM is nil then DEF is SYM's function definition. */
481 /* SYM is not mentioned in ENVIRONMENT.
482 Look at its function definition. */
485 def
= Fautoload_do_load (def
, sym
, Qmacro
);
488 /* Not defined or definition not suitable. */
490 if (!EQ (XCAR (def
), Qmacro
))
492 else expander
= XCDR (def
);
496 expander
= XCDR (tem
);
501 Lisp_Object newform
= apply1 (expander
, XCDR (form
));
502 if (EQ (form
, newform
))
511 DEFUN ("call-with-catch", Fcatch
, Scatch
, 2, 2, 0,
512 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
513 TAG is evalled to get the tag to use; it must not be nil.
515 Then the BODY is executed.
516 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
517 If no throw happens, `catch' returns the value of the last BODY form.
518 If a throw happens, it specifies the value to return from `catch'.
519 usage: (catch TAG BODY...) */)
520 (Lisp_Object tag
, Lisp_Object thunk
)
522 return internal_catch (tag
, call0
, thunk
);
525 /* Assert that E is true, as a comment only. Use this instead of
526 eassert (E) when E contains variables that might be clobbered by a
529 #define clobbered_eassert(E) ((void) 0)
532 set_handlerlist (void *data
)
538 restore_handler (void *data
)
540 struct handler
*c
= data
;
541 unblock_input_to (c
->interrupt_input_blocked
);
547 enum { ICC_0
, ICC_1
, ICC_2
, ICC_3
, ICC_N
} type
;
550 Lisp_Object (*fun0
) (void);
551 Lisp_Object (*fun1
) (Lisp_Object
);
552 Lisp_Object (*fun2
) (Lisp_Object
, Lisp_Object
);
553 Lisp_Object (*fun3
) (Lisp_Object
, Lisp_Object
, Lisp_Object
);
554 Lisp_Object (*funn
) (ptrdiff_t, Lisp_Object
*);
574 icc_thunk (void *data
)
577 struct icc_thunk_env
*e
= data
;
578 scm_dynwind_begin (0);
579 scm_dynwind_unwind_handler (restore_handler
, e
->c
, 0);
580 scm_dynwind_unwind_handler (set_handlerlist
,
582 SCM_F_WIND_EXPLICITLY
);
590 tem
= e
->fun1 (e
->arg1
);
593 tem
= e
->fun2 (e
->arg1
, e
->arg2
);
596 tem
= e
->fun3 (e
->arg1
, e
->arg2
, e
->arg3
);
599 tem
= e
->funn (e
->nargs
, e
->args
);
609 icc_handler (void *data
, Lisp_Object k
, Lisp_Object v
)
611 Lisp_Object (*f
) (Lisp_Object
) = data
;
615 struct icc_handler_n_env
617 Lisp_Object (*fun
) (Lisp_Object
, ptrdiff_t, Lisp_Object
*);
623 icc_handler_n (void *data
, Lisp_Object k
, Lisp_Object v
)
625 struct icc_handler_n_env
*e
= data
;
626 return e
->fun (v
, e
->nargs
, e
->args
);
630 icc_lisp_handler (void *data
, Lisp_Object k
, Lisp_Object val
)
633 struct handler
*h
= data
;
634 Lisp_Object var
= h
->var
;
635 scm_dynwind_begin (0);
639 if (!NILP (Vinternal_interpreter_environment
))
640 specbind (Qinternal_interpreter_environment
,
641 Fcons (Fcons (var
, val
),
642 Vinternal_interpreter_environment
));
647 tem
= Fprogn (h
->body
);
652 /* Set up a catch, then call C function FUNC on argument ARG.
653 FUNC should return a Lisp_Object.
654 This is how catches are done from within C code. */
657 internal_catch (Lisp_Object tag
, Lisp_Object (*func
) (Lisp_Object
), Lisp_Object arg
)
659 struct handler
*c
= make_catch_handler (tag
);
660 struct icc_thunk_env env
= { .type
= ICC_1
,
664 return call_with_prompt (c
->ptag
,
665 make_c_closure (icc_thunk
, &env
, 0, 0),
666 make_c_closure (icc_handler
, Fidentity
, 2, 0));
669 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
670 jump to that CATCH, returning VALUE as the value of that catch.
672 This is the guts of Fthrow and Fsignal; they differ only in the way
673 they choose the catch tag to throw to. A catch tag for a
674 condition-case form has a TAG of Qnil.
676 Before each catch is discarded, unbind all special bindings and
677 execute all unwind-protect clauses made above that catch. Unwind
678 the handler stack as we go, so that the proper handlers are in
679 effect for each unwind-protect clause we run. At the end, restore
680 some static info saved in CATCH, and longjmp to the location
683 This is used for correct unwinding in Fthrow and Fsignal. */
685 static Lisp_Object
unbind_to_1 (ptrdiff_t, Lisp_Object
, bool);
687 static _Noreturn
void
688 unwind_to_catch (struct handler
*catch, Lisp_Object value
)
690 abort_to_prompt (catch->ptag
, scm_list_1 (value
));
693 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
694 doc
: /* Throw to the catch for TAG and return VALUE from it.
695 Both TAG and VALUE are evalled. */)
696 (register Lisp_Object tag
, Lisp_Object value
)
701 for (c
= handlerlist
; c
; c
= c
->next
)
703 if (c
->type
== CATCHER
&& EQ (c
->tag_or_ch
, tag
))
704 unwind_to_catch (c
, value
);
706 xsignal2 (Qno_catch
, tag
, value
);
709 DEFUN ("call-with-handler", Fcall_with_handler
, Scall_with_handler
, 4, 4, 0,
710 doc
: /* Regain control when an error is signaled.
711 Executes BODYFORM and returns its value if no error happens.
712 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
713 where the BODY is made of Lisp expressions.
715 A handler is applicable to an error
716 if CONDITION-NAME is one of the error's condition names.
717 If an error happens, the first applicable handler is run.
719 The car of a handler may be a list of condition names instead of a
720 single condition name; then it handles all of them. If the special
721 condition name `debug' is present in this list, it allows another
722 condition in the list to run the debugger if `debug-on-error' and the
723 other usual mechanisms says it should (otherwise, `condition-case'
724 suppresses the debugger).
726 When a handler handles an error, control returns to the `condition-case'
727 and it executes the handler's BODY...
728 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
729 \(If VAR is nil, the handler can't access that information.)
730 Then the value of the last BODY form is returned from the `condition-case'
733 See also the function `signal' for more info.
734 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
736 Lisp_Object conditions
,
740 return internal_lisp_condition_case (var
,
741 list2 (intern ("funcall"), thunk
),
742 list1 (list2 (conditions
, list2 (intern ("funcall"), hthunk
))));
746 ilcc1 (Lisp_Object var
, Lisp_Object bodyform
, Lisp_Object handlers
)
748 if (CONSP (handlers
))
750 Lisp_Object clause
= XCAR (handlers
);
751 Lisp_Object condition
= XCAR (clause
);
752 Lisp_Object body
= XCDR (clause
);
753 if (!CONSP (condition
))
754 condition
= Fcons (condition
, Qnil
);
755 struct handler
*c
= make_condition_handler (condition
);
758 struct icc_thunk_env env
= { .type
= ICC_3
,
762 .arg3
= XCDR (handlers
),
764 return call_with_prompt (c
->ptag
,
765 make_c_closure (icc_thunk
, &env
, 0, 0),
766 make_c_closure (icc_lisp_handler
, c
, 2, 0));
770 return eval_sub (bodyform
);
774 /* Like Fcondition_case, but the args are separate
775 rather than passed in a list. Used by Fbyte_code. */
778 internal_lisp_condition_case (volatile Lisp_Object var
, Lisp_Object bodyform
,
779 Lisp_Object handlers
)
783 struct handler
*oldhandlerlist
= handlerlist
;
787 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
789 Lisp_Object tem
= XCAR (val
);
792 && (SYMBOLP (XCAR (tem
))
793 || CONSP (XCAR (tem
))))))
794 error ("Invalid condition handler: %s",
795 SDATA (Fprin1_to_string (tem
, Qt
)));
798 return ilcc1 (var
, bodyform
, Freverse (handlers
));
801 /* Call the function BFUN with no arguments, catching errors within it
802 according to HANDLERS. If there is an error, call HFUN with
803 one argument which is the data that describes the error:
806 HANDLERS can be a list of conditions to catch.
807 If HANDLERS is Qt, catch all errors.
808 If HANDLERS is Qerror, catch all errors
809 but allow the debugger to run if that is enabled. */
812 internal_condition_case (Lisp_Object (*bfun
) (void), Lisp_Object handlers
,
813 Lisp_Object (*hfun
) (Lisp_Object
))
816 struct handler
*c
= make_condition_handler (handlers
);
818 struct icc_thunk_env env
= { .type
= ICC_0
, .fun0
= bfun
, .c
= c
};
819 return call_with_prompt (c
->ptag
,
820 make_c_closure (icc_thunk
, &env
, 0, 0),
821 make_c_closure (icc_handler
, hfun
, 2, 0));
824 /* Like internal_condition_case but call BFUN with ARG as its argument. */
827 internal_condition_case_1 (Lisp_Object (*bfun
) (Lisp_Object
), Lisp_Object arg
,
828 Lisp_Object handlers
, Lisp_Object (*hfun
) (Lisp_Object
))
831 struct handler
*c
= make_condition_handler (handlers
);
833 struct icc_thunk_env env
= { .type
= ICC_1
,
837 return call_with_prompt (c
->ptag
,
838 make_c_closure (icc_thunk
, &env
, 0, 0),
839 make_c_closure (icc_handler
, hfun
, 2, 0));
842 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
846 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
849 Lisp_Object handlers
,
850 Lisp_Object (*hfun
) (Lisp_Object
))
853 struct handler
*c
= make_condition_handler (handlers
);
854 struct icc_thunk_env env
= { .type
= ICC_2
,
859 return call_with_prompt (c
->ptag
,
860 make_c_closure (icc_thunk
, &env
, 0, 0),
861 make_c_closure (icc_handler
, hfun
, 2, 0));
864 /* Like internal_condition_case but call BFUN with NARGS as first,
865 and ARGS as second argument. */
868 internal_condition_case_n (Lisp_Object (*bfun
) (ptrdiff_t, Lisp_Object
*),
871 Lisp_Object handlers
,
872 Lisp_Object (*hfun
) (Lisp_Object err
,
877 struct handler
*c
= make_condition_handler (handlers
);
879 struct icc_thunk_env env
= { .type
= ICC_N
,
884 struct icc_handler_n_env henv
= { .fun
= hfun
, .nargs
= nargs
, .args
= args
};
885 return call_with_prompt (c
->ptag
,
886 make_c_closure (icc_thunk
, &env
, 0, 0),
887 make_c_closure (icc_handler_n
, &henv
, 2, 0));
891 static Lisp_Object
find_handler_clause (Lisp_Object
, Lisp_Object
);
892 static bool maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
,
896 process_quit_flag (void)
898 Lisp_Object flag
= Vquit_flag
;
900 if (EQ (flag
, Qkill_emacs
))
902 if (EQ (Vthrow_on_input
, flag
))
903 Fthrow (Vthrow_on_input
, Qt
);
904 Fsignal (Qquit
, Qnil
);
907 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
908 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
909 This function does not return.
911 An error symbol is a symbol with an `error-conditions' property
912 that is a list of condition names.
913 A handler for any of those names will get to handle this signal.
914 The symbol `error' should normally be one of them.
916 DATA should be a list. Its elements are printed as part of the error message.
917 See Info anchor `(elisp)Definition of signal' for some details on how this
918 error message is constructed.
919 If the signal is handled, DATA is made available to the handler.
920 See also the function `condition-case'. */)
921 (Lisp_Object error_symbol
, Lisp_Object data
)
923 /* When memory is full, ERROR-SYMBOL is nil,
924 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
925 That is a special case--don't do this in other situations. */
926 Lisp_Object conditions
;
928 Lisp_Object real_error_symbol
929 = (NILP (error_symbol
) ? Fcar (data
) : error_symbol
);
930 register Lisp_Object clause
= Qnil
;
934 if (waiting_for_input
)
937 #if 0 /* rms: I don't know why this was here,
938 but it is surely wrong for an error that is handled. */
939 #ifdef HAVE_WINDOW_SYSTEM
940 if (display_hourglass_p
)
945 /* This hook is used by edebug. */
946 if (! NILP (Vsignal_hook_function
)
947 && ! NILP (error_symbol
))
949 /* Edebug takes care of restoring these variables when it exits. */
950 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
951 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
953 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
954 max_specpdl_size
= SPECPDL_INDEX () + 40;
956 call2 (Vsignal_hook_function
, error_symbol
, data
);
959 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
961 for (h
= handlerlist
; h
; h
= h
->next
)
963 if (h
->type
!= CONDITION_CASE
)
965 clause
= find_handler_clause (h
->tag_or_ch
, conditions
);
970 if (/* Don't run the debugger for a memory-full error.
971 (There is no room in memory to do that!) */
973 && (!NILP (Vdebug_on_signal
)
974 /* If no handler is present now, try to run the debugger. */
976 /* A `debug' symbol in the handler list disables the normal
977 suppression of the debugger. */
978 || (CONSP (clause
) && CONSP (clause
)
979 && !NILP (Fmemq (Qdebug
, clause
)))
980 /* Special handler that means "print a message and run debugger
982 || EQ (h
->tag_or_ch
, Qerror
)))
985 = maybe_call_debugger (conditions
, error_symbol
, data
);
986 /* We can't return values to code which signaled an error, but we
987 can continue code which has signaled a quit. */
988 if (debugger_called
&& EQ (real_error_symbol
, Qquit
))
994 Lisp_Object unwind_data
995 = (NILP (error_symbol
) ? data
: Fcons (error_symbol
, data
));
997 unwind_to_catch (h
, unwind_data
);
1001 if (handlerlist
!= handlerlist_sentinel
)
1002 /* FIXME: This will come right back here if there's no `top-level'
1003 catcher. A better solution would be to abort here, and instead
1004 add a catch-all condition handler so we never come here. */
1005 Fthrow (Qtop_level
, Qt
);
1008 if (! NILP (error_symbol
))
1009 data
= Fcons (error_symbol
, data
);
1011 string
= Ferror_message_string (data
);
1012 fatal ("%s", SDATA (string
));
1015 /* Internal version of Fsignal that never returns.
1016 Used for anything but Qquit (which can return from Fsignal). */
1019 xsignal (Lisp_Object error_symbol
, Lisp_Object data
)
1021 Fsignal (error_symbol
, data
);
1025 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1028 xsignal0 (Lisp_Object error_symbol
)
1030 xsignal (error_symbol
, Qnil
);
1034 xsignal1 (Lisp_Object error_symbol
, Lisp_Object arg
)
1036 xsignal (error_symbol
, list1 (arg
));
1040 xsignal2 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
)
1042 xsignal (error_symbol
, list2 (arg1
, arg2
));
1046 xsignal3 (Lisp_Object error_symbol
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1048 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1051 /* Signal `error' with message S, and additional arg ARG.
1052 If ARG is not a genuine list, make it a one-element list. */
1055 signal_error (const char *s
, Lisp_Object arg
)
1057 Lisp_Object tortoise
, hare
;
1059 hare
= tortoise
= arg
;
1060 while (CONSP (hare
))
1067 tortoise
= XCDR (tortoise
);
1069 if (EQ (hare
, tortoise
))
1076 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1080 /* Return true if LIST is a non-nil atom or
1081 a list containing one of CONDITIONS. */
1084 wants_debugger (Lisp_Object list
, Lisp_Object conditions
)
1091 while (CONSP (conditions
))
1093 Lisp_Object
this, tail
;
1094 this = XCAR (conditions
);
1095 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1096 if (EQ (XCAR (tail
), this))
1098 conditions
= XCDR (conditions
);
1103 /* Return true if an error with condition-symbols CONDITIONS,
1104 and described by SIGNAL-DATA, should skip the debugger
1105 according to debugger-ignored-errors. */
1108 skip_debugger (Lisp_Object conditions
, Lisp_Object data
)
1111 bool first_string
= 1;
1112 Lisp_Object error_message
;
1114 error_message
= Qnil
;
1115 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1117 if (STRINGP (XCAR (tail
)))
1121 error_message
= Ferror_message_string (data
);
1125 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1130 Lisp_Object contail
;
1132 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1133 if (EQ (XCAR (tail
), XCAR (contail
)))
1141 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1142 SIG and DATA describe the signal. There are two ways to pass them:
1143 = SIG is the error symbol, and DATA is the rest of the data.
1144 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1145 This is for memory-full errors only. */
1147 maybe_call_debugger (Lisp_Object conditions
, Lisp_Object sig
, Lisp_Object data
)
1149 Lisp_Object combined_data
;
1151 combined_data
= Fcons (sig
, data
);
1154 /* Don't try to run the debugger with interrupts blocked.
1155 The editing loop would return anyway. */
1156 ! input_blocked_p ()
1157 && NILP (Vinhibit_debugger
)
1158 /* Does user want to enter debugger for this kind of error? */
1161 : wants_debugger (Vdebug_on_error
, conditions
))
1162 && ! skip_debugger (conditions
, combined_data
)
1163 /* RMS: What's this for? */
1164 && when_entered_debugger
< num_nonmacro_input_events
)
1166 call_debugger (list2 (Qerror
, combined_data
));
1174 find_handler_clause (Lisp_Object handlers
, Lisp_Object conditions
)
1176 register Lisp_Object h
;
1178 /* t is used by handlers for all conditions, set up by C code. */
1179 if (EQ (handlers
, Qt
))
1182 /* error is used similarly, but means print an error message
1183 and run the debugger if that is enabled. */
1184 if (EQ (handlers
, Qerror
))
1187 for (h
= handlers
; CONSP (h
); h
= XCDR (h
))
1189 Lisp_Object handler
= XCAR (h
);
1190 if (!NILP (Fmemq (handler
, conditions
)))
1198 /* Dump an error message; called like vprintf. */
1200 verror (const char *m
, va_list ap
)
1203 ptrdiff_t size
= sizeof buf
;
1204 ptrdiff_t size_max
= STRING_BYTES_BOUND
+ 1;
1209 used
= evxprintf (&buffer
, &size
, buf
, size_max
, m
, ap
);
1210 string
= make_string (buffer
, used
);
1214 xsignal1 (Qerror
, string
);
1218 /* Dump an error message; called like printf. */
1222 error (const char *m
, ...)
1229 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1230 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1231 This means it contains a description for how to read arguments to give it.
1232 The value is nil for an invalid function or a symbol with no function
1235 Interactively callable functions include strings and vectors (treated
1236 as keyboard macros), lambda-expressions that contain a top-level call
1237 to `interactive', autoload definitions made by `autoload' with non-nil
1238 fourth argument, and some of the built-in functions of Lisp.
1240 Also, a symbol satisfies `commandp' if its function definition does so.
1242 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1243 then strings and vectors are not accepted. */)
1244 (Lisp_Object function
, Lisp_Object for_call_interactively
)
1246 register Lisp_Object fun
;
1247 register Lisp_Object funcar
;
1248 Lisp_Object if_prop
= Qnil
;
1252 fun
= indirect_function (fun
); /* Check cycles. */
1256 /* Check an `interactive-form' property if present, analogous to the
1257 function-documentation property. */
1259 while (SYMBOLP (fun
))
1261 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
1264 fun
= Fsymbol_function (fun
);
1267 if (scm_is_true (scm_procedure_p (fun
)))
1268 return (scm_is_pair (scm_assq (Qinteractive_form
,
1269 scm_procedure_properties (fun
)))
1271 /* Bytecode objects are interactive if they are long enough to
1272 have an element whose index is COMPILED_INTERACTIVE, which is
1273 where the interactive spec is stored. */
1274 else if (COMPILEDP (fun
))
1275 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1278 /* Strings and vectors are keyboard macros. */
1279 if (STRINGP (fun
) || VECTORP (fun
))
1280 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
1282 /* Lists may represent commands. */
1285 funcar
= XCAR (fun
);
1286 if (EQ (funcar
, Qclosure
))
1287 return (!NILP (Fassq (Qinteractive
, Fcdr (Fcdr (XCDR (fun
)))))
1289 else if (EQ (funcar
, Qlambda
))
1290 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
1291 else if (EQ (funcar
, Qautoload
))
1292 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
1297 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1298 doc
: /* Define FUNCTION to autoload from FILE.
1299 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1300 Third arg DOCSTRING is documentation for the function.
1301 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1302 Fifth arg TYPE indicates the type of the object:
1303 nil or omitted says FUNCTION is a function,
1304 `keymap' says FUNCTION is really a keymap, and
1305 `macro' or t says FUNCTION is really a macro.
1306 Third through fifth args give info about the real definition.
1307 They default to nil.
1308 If FUNCTION is already defined other than as an autoload,
1309 this does nothing and returns nil. */)
1310 (Lisp_Object function
, Lisp_Object file
, Lisp_Object docstring
, Lisp_Object interactive
, Lisp_Object type
)
1312 CHECK_SYMBOL (function
);
1313 CHECK_STRING (file
);
1315 /* If function is defined and not as an autoload, don't override. */
1316 if (!NILP (SYMBOL_FUNCTION (function
))
1317 && !AUTOLOADP (SYMBOL_FUNCTION (function
)))
1320 return Fdefalias (function
,
1321 list5 (Qautoload
, file
, docstring
, interactive
, type
),
1326 un_autoload (Lisp_Object oldqueue
)
1328 Lisp_Object queue
, first
, second
;
1330 /* Queue to unwind is current value of Vautoload_queue.
1331 oldqueue is the shadowed value to leave in Vautoload_queue. */
1332 queue
= Vautoload_queue
;
1333 Vautoload_queue
= oldqueue
;
1334 while (CONSP (queue
))
1336 first
= XCAR (queue
);
1337 second
= Fcdr (first
);
1338 first
= Fcar (first
);
1339 if (EQ (first
, make_number (0)))
1342 Ffset (first
, second
);
1343 queue
= XCDR (queue
);
1347 /* Load an autoloaded function.
1348 FUNNAME is the symbol which is the function's name.
1349 FUNDEF is the autoload definition (a list). */
1351 DEFUN ("autoload-do-load", Fautoload_do_load
, Sautoload_do_load
, 1, 3, 0,
1352 doc
: /* Load FUNDEF which should be an autoload.
1353 If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
1354 in which case the function returns the new autoloaded function value.
1355 If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
1356 it is defines a macro. */)
1357 (Lisp_Object fundef
, Lisp_Object funname
, Lisp_Object macro_only
)
1360 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1362 if (!CONSP (fundef
) || !EQ (Qautoload
, XCAR (fundef
))) {
1367 if (EQ (macro_only
, Qmacro
))
1369 Lisp_Object kind
= Fnth (make_number (4), fundef
);
1370 if (! (EQ (kind
, Qt
) || EQ (kind
, Qmacro
))) {
1376 /* This is to make sure that loadup.el gives a clear picture
1377 of what files are preloaded and when. */
1378 /*if (! NILP (Vpurify_flag))
1379 error ("Attempt to autoload %s while preparing to dump",
1380 SDATA (SYMBOL_NAME (funname)));*/
1382 CHECK_SYMBOL (funname
);
1383 GCPRO3 (funname
, fundef
, macro_only
);
1385 /* Preserve the match data. */
1386 record_unwind_save_match_data ();
1388 /* If autoloading gets an error (which includes the error of failing
1389 to define the function being called), we use Vautoload_queue
1390 to undo function definitions and `provide' calls made by
1391 the function. We do this in the specific case of autoloading
1392 because autoloading is not an explicit request "load this file",
1393 but rather a request to "call this function".
1395 The value saved here is to be restored into Vautoload_queue. */
1396 record_unwind_protect (un_autoload
, Vautoload_queue
);
1397 Vautoload_queue
= Qt
;
1398 /* If `macro_only', assume this autoload to be a "best-effort",
1399 so don't signal an error if autoloading fails. */
1400 Fload (Fcar (Fcdr (fundef
)), macro_only
, Qt
, Qnil
, Qt
);
1402 /* Once loading finishes, don't undo it. */
1403 Vautoload_queue
= Qt
;
1412 Lisp_Object fun
= Findirect_function (funname
, Qnil
);
1414 if (!NILP (Fequal (fun
, fundef
)))
1415 error ("Autoloading failed to define function %s",
1416 SDATA (SYMBOL_NAME (funname
)));
1423 DEFUN ("eval", Feval
, Seval
, 1, 2, 0,
1424 doc
: /* Evaluate FORM and return its value.
1425 If LEXICAL is t, evaluate using lexical scoping.
1426 LEXICAL can also be an actual lexical environment, in the form of an
1427 alist mapping symbols to their value. */)
1428 (Lisp_Object form
, Lisp_Object lexical
)
1431 specbind (Qinternal_interpreter_environment
,
1432 CONSP (lexical
) || NILP (lexical
) ? lexical
: list1 (Qt
));
1433 Lisp_Object tem0
= eval_sub (form
);
1438 /* Grow the specpdl stack by one entry.
1439 The caller should have already initialized the entry.
1440 Signal an error on stack overflow.
1442 Make sure that there is always one unused entry past the top of the
1443 stack, so that the just-initialized entry is safely unwound if
1444 memory exhausted and an error is signaled here. Also, allocate a
1445 never-used entry just before the bottom of the stack; sometimes its
1446 address is taken. */
1453 if (specpdl_ptr
== specpdl
+ specpdl_size
)
1455 ptrdiff_t count
= SPECPDL_INDEX ();
1456 ptrdiff_t max_size
= min (max_specpdl_size
, PTRDIFF_MAX
- 1000);
1457 union specbinding
*pdlvec
= specpdl
- 1;
1458 ptrdiff_t pdlvecsize
= specpdl_size
+ 1;
1459 if (max_size
<= specpdl_size
)
1461 if (max_specpdl_size
< 400)
1462 max_size
= max_specpdl_size
= 400;
1463 if (max_size
<= specpdl_size
)
1464 signal_error ("Variable binding depth exceeds max-specpdl-size",
1467 pdlvec
= xpalloc (pdlvec
, &pdlvecsize
, 1, max_size
+ 1, sizeof *specpdl
);
1468 specpdl_base
= pdlvec
;
1469 specpdl
= pdlvec
+ 1;
1470 specpdl_size
= pdlvecsize
- 1;
1471 specpdl_ptr
= specpdl
+ count
;
1476 set_lisp_eval_depth (void *data
)
1478 EMACS_INT n
= (EMACS_INT
) data
;
1479 lisp_eval_depth
= n
;
1482 /* Eval a sub-expression of the current expression (i.e. in the same
1485 eval_sub_1 (Lisp_Object form
)
1488 return scm_call_1 (eval_fn
, form
);
1492 eval_sub (Lisp_Object form
)
1494 return scm_c_value_ref (eval_sub_1 (form
), 0);
1498 values_to_list (Lisp_Object values
)
1500 Lisp_Object list
= Qnil
;
1501 for (int i
= scm_c_nvalues (values
) - 1; i
>= 0; i
--)
1502 list
= Fcons (scm_c_value_ref (values
, i
), list
);
1506 DEFUN ("multiple-value-call", Fmultiple_value_call
, Smultiple_value_call
,
1508 doc
: /* Call with multiple values.
1509 usage: (multiple-value-call FUNCTION-FORM FORM) */)
1512 Lisp_Object function_form
= eval_sub (XCAR (args
));
1513 Lisp_Object values
= Qnil
;
1514 while (CONSP (args
= XCDR (args
)))
1515 values
= nconc2 (Fnreverse (values_to_list (eval_sub_1 (XCAR (args
)))),
1517 return apply1 (function_form
, Fnreverse (values
));
1520 DEFUN ("values", Fvalues
, Svalues
, 0, MANY
, 0,
1521 doc
: /* Return multiple values. */)
1522 (ptrdiff_t nargs
, Lisp_Object
*args
)
1524 return scm_c_values (args
, nargs
);
1528 Fapply (ptrdiff_t nargs
, Lisp_Object
*args
)
1532 register Lisp_Object spread_arg
;
1533 register Lisp_Object
*funcall_args
;
1534 Lisp_Object fun
, retval
;
1535 struct gcpro gcpro1
;
1540 spread_arg
= args
[nargs
- 1];
1541 CHECK_LIST (spread_arg
);
1543 numargs
= XINT (Flength (spread_arg
));
1546 return Ffuncall (nargs
- 1, args
);
1547 else if (numargs
== 1)
1549 args
[nargs
- 1] = XCAR (spread_arg
);
1550 return Ffuncall (nargs
, args
);
1553 numargs
+= nargs
- 2;
1555 /* Optimize for no indirection. */
1556 if (SYMBOLP (fun
) && !NILP (fun
)
1557 && (fun
= SYMBOL_FUNCTION (fun
), SYMBOLP (fun
)))
1558 fun
= indirect_function (fun
);
1561 /* Let funcall get the error. */
1565 /* We add 1 to numargs because funcall_args includes the
1566 function itself as well as its arguments. */
1569 SAFE_ALLOCA_LISP (funcall_args
, 1 + numargs
);
1570 GCPRO1 (*funcall_args
);
1571 gcpro1
.nvars
= 1 + numargs
;
1574 memcpy (funcall_args
, args
, nargs
* word_size
);
1575 /* Spread the last arg we got. Its first element goes in
1576 the slot that it used to occupy, hence this value of I. */
1578 while (!NILP (spread_arg
))
1580 funcall_args
[i
++] = XCAR (spread_arg
);
1581 spread_arg
= XCDR (spread_arg
);
1584 /* By convention, the caller needs to gcpro Ffuncall's args. */
1585 retval
= Ffuncall (gcpro1
.nvars
, funcall_args
);
1592 /* Run hook variables in various ways. */
1595 funcall_nil (ptrdiff_t nargs
, Lisp_Object
*args
)
1597 Ffuncall (nargs
, args
);
1601 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
1602 doc
: /* Run each hook in HOOKS.
1603 Each argument should be a symbol, a hook variable.
1604 These symbols are processed in the order specified.
1605 If a hook symbol has a non-nil value, that value may be a function
1606 or a list of functions to be called to run the hook.
1607 If the value is a function, it is called with no arguments.
1608 If it is a list, the elements are called, in order, with no arguments.
1610 Major modes should not use this function directly to run their mode
1611 hook; they should use `run-mode-hooks' instead.
1613 Do not use `make-local-variable' to make a hook variable buffer-local.
1614 Instead, use `add-hook' and specify t for the LOCAL argument.
1615 usage: (run-hooks &rest HOOKS) */)
1616 (ptrdiff_t nargs
, Lisp_Object
*args
)
1618 Lisp_Object hook
[1];
1621 for (i
= 0; i
< nargs
; i
++)
1624 run_hook_with_args (1, hook
, funcall_nil
);
1630 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
1631 Srun_hook_with_args
, 1, MANY
, 0,
1632 doc
: /* Run HOOK with the specified arguments ARGS.
1633 HOOK should be a symbol, a hook variable. The value of HOOK
1634 may be nil, a function, or a list of functions. Call each
1635 function in order with arguments ARGS. The final return value
1638 Do not use `make-local-variable' to make a hook variable buffer-local.
1639 Instead, use `add-hook' and specify t for the LOCAL argument.
1640 usage: (run-hook-with-args HOOK &rest ARGS) */)
1641 (ptrdiff_t nargs
, Lisp_Object
*args
)
1643 return run_hook_with_args (nargs
, args
, funcall_nil
);
1646 /* NB this one still documents a specific non-nil return value.
1647 (As did run-hook-with-args and run-hook-with-args-until-failure
1648 until they were changed in 24.1.) */
1649 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
1650 Srun_hook_with_args_until_success
, 1, MANY
, 0,
1651 doc
: /* Run HOOK with the specified arguments ARGS.
1652 HOOK should be a symbol, a hook variable. The value of HOOK
1653 may be nil, a function, or a list of functions. Call each
1654 function in order with arguments ARGS, stopping at the first
1655 one that returns non-nil, and return that value. Otherwise (if
1656 all functions return nil, or if there are no functions to call),
1659 Do not use `make-local-variable' to make a hook variable buffer-local.
1660 Instead, use `add-hook' and specify t for the LOCAL argument.
1661 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
1662 (ptrdiff_t nargs
, Lisp_Object
*args
)
1664 return run_hook_with_args (nargs
, args
, Ffuncall
);
1668 funcall_not (ptrdiff_t nargs
, Lisp_Object
*args
)
1670 return NILP (Ffuncall (nargs
, args
)) ? Qt
: Qnil
;
1673 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
1674 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
1675 doc
: /* Run HOOK with the specified arguments ARGS.
1676 HOOK should be a symbol, a hook variable. The value of HOOK
1677 may be nil, a function, or a list of functions. Call each
1678 function in order with arguments ARGS, stopping at the first
1679 one that returns nil, and return nil. Otherwise (if all functions
1680 return non-nil, or if there are no functions to call), return non-nil
1681 \(do not rely on the precise return value in this case).
1683 Do not use `make-local-variable' to make a hook variable buffer-local.
1684 Instead, use `add-hook' and specify t for the LOCAL argument.
1685 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
1686 (ptrdiff_t nargs
, Lisp_Object
*args
)
1688 return NILP (run_hook_with_args (nargs
, args
, funcall_not
)) ? Qt
: Qnil
;
1692 run_hook_wrapped_funcall (ptrdiff_t nargs
, Lisp_Object
*args
)
1694 Lisp_Object tmp
= args
[0], ret
;
1697 ret
= Ffuncall (nargs
, args
);
1703 DEFUN ("run-hook-wrapped", Frun_hook_wrapped
, Srun_hook_wrapped
, 2, MANY
, 0,
1704 doc
: /* Run HOOK, passing each function through WRAP-FUNCTION.
1705 I.e. instead of calling each function FUN directly with arguments ARGS,
1706 it calls WRAP-FUNCTION with arguments FUN and ARGS.
1707 As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
1708 aborts and returns that value.
1709 usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
1710 (ptrdiff_t nargs
, Lisp_Object
*args
)
1712 return run_hook_with_args (nargs
, args
, run_hook_wrapped_funcall
);
1715 /* ARGS[0] should be a hook symbol.
1716 Call each of the functions in the hook value, passing each of them
1717 as arguments all the rest of ARGS (all NARGS - 1 elements).
1718 FUNCALL specifies how to call each function on the hook.
1719 The caller (or its caller, etc) must gcpro all of ARGS,
1720 except that it isn't necessary to gcpro ARGS[0]. */
1723 run_hook_with_args (ptrdiff_t nargs
, Lisp_Object
*args
,
1724 Lisp_Object (*funcall
) (ptrdiff_t nargs
, Lisp_Object
*args
))
1726 Lisp_Object sym
, val
, ret
= Qnil
;
1727 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1729 /* If we are dying or still initializing,
1730 don't do anything--it would probably crash if we tried. */
1731 if (NILP (Vrun_hooks
))
1735 val
= find_symbol_value (sym
);
1737 if (EQ (val
, Qunbound
) || NILP (val
))
1739 else if (!CONSP (val
) || FUNCTIONP (val
))
1742 return funcall (nargs
, args
);
1746 Lisp_Object global_vals
= Qnil
;
1747 GCPRO3 (sym
, val
, global_vals
);
1750 CONSP (val
) && NILP (ret
);
1753 if (EQ (XCAR (val
), Qt
))
1755 /* t indicates this hook has a local binding;
1756 it means to run the global binding too. */
1757 global_vals
= Fdefault_value (sym
);
1758 if (NILP (global_vals
)) continue;
1760 if (!CONSP (global_vals
) || EQ (XCAR (global_vals
), Qlambda
))
1762 args
[0] = global_vals
;
1763 ret
= funcall (nargs
, args
);
1768 CONSP (global_vals
) && NILP (ret
);
1769 global_vals
= XCDR (global_vals
))
1771 args
[0] = XCAR (global_vals
);
1772 /* In a global value, t should not occur. If it does, we
1773 must ignore it to avoid an endless loop. */
1774 if (!EQ (args
[0], Qt
))
1775 ret
= funcall (nargs
, args
);
1781 args
[0] = XCAR (val
);
1782 ret
= funcall (nargs
, args
);
1791 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
1794 run_hook_with_args_2 (Lisp_Object hook
, Lisp_Object arg1
, Lisp_Object arg2
)
1796 Lisp_Object temp
[3];
1801 Frun_hook_with_args (3, temp
);
1804 /* Apply fn to arg. */
1806 apply1 (Lisp_Object fn
, Lisp_Object arg
)
1808 struct gcpro gcpro1
;
1812 return Ffuncall (1, &fn
);
1815 Lisp_Object args
[2];
1819 return Fapply (2, args
);
1823 /* Call function fn on no arguments. */
1825 call0 (Lisp_Object fn
)
1827 struct gcpro gcpro1
;
1830 return Ffuncall (1, &fn
);
1833 /* Call function fn with 1 argument arg1. */
1836 call1 (Lisp_Object fn
, Lisp_Object arg1
)
1838 struct gcpro gcpro1
;
1839 Lisp_Object args
[2];
1845 return Ffuncall (2, args
);
1848 /* Call function fn with 2 arguments arg1, arg2. */
1851 call2 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
)
1853 struct gcpro gcpro1
;
1854 Lisp_Object args
[3];
1860 return Ffuncall (3, args
);
1863 /* Call function fn with 3 arguments arg1, arg2, arg3. */
1866 call3 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
1868 struct gcpro gcpro1
;
1869 Lisp_Object args
[4];
1876 return Ffuncall (4, args
);
1879 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
1882 call4 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1885 struct gcpro gcpro1
;
1886 Lisp_Object args
[5];
1894 return Ffuncall (5, args
);
1897 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
1900 call5 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1901 Lisp_Object arg4
, Lisp_Object arg5
)
1903 struct gcpro gcpro1
;
1904 Lisp_Object args
[6];
1913 return Ffuncall (6, args
);
1916 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
1919 call6 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1920 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
)
1922 struct gcpro gcpro1
;
1923 Lisp_Object args
[7];
1933 return Ffuncall (7, args
);
1936 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
1939 call7 (Lisp_Object fn
, Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
,
1940 Lisp_Object arg4
, Lisp_Object arg5
, Lisp_Object arg6
, Lisp_Object arg7
)
1942 struct gcpro gcpro1
;
1943 Lisp_Object args
[8];
1954 return Ffuncall (8, args
);
1957 /* The caller should GCPRO all the elements of ARGS. */
1959 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
1960 doc
: /* Non-nil if OBJECT is a function. */)
1961 (Lisp_Object object
)
1963 if (FUNCTIONP (object
))
1969 Ffuncall1 (ptrdiff_t nargs
, Lisp_Object
*args
)
1971 return scm_call_n (funcall_fn
, args
, nargs
);
1975 Ffuncall (ptrdiff_t nargs
, Lisp_Object
*args
)
1977 return scm_c_value_ref (Ffuncall1 (nargs
, args
), 0);
1981 apply_lambda (Lisp_Object fun
, Lisp_Object args
)
1983 Lisp_Object args_left
;
1986 register Lisp_Object
*arg_vector
;
1987 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1988 register Lisp_Object tem
;
1991 numargs
= XFASTINT (Flength (args
));
1992 SAFE_ALLOCA_LISP (arg_vector
, numargs
);
1995 GCPRO3 (*arg_vector
, args_left
, fun
);
1998 for (i
= 0; i
< numargs
; )
2000 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2001 arg_vector
[i
++] = tem
;
2007 tem
= funcall_lambda (fun
, numargs
, arg_vector
);
2013 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2014 and return the result of evaluation.
2015 FUN must be either a lambda-expression or a compiled-code object. */
2018 funcall_lambda (Lisp_Object fun
, ptrdiff_t nargs
,
2019 register Lisp_Object
*arg_vector
)
2021 Lisp_Object val
, syms_left
, next
, lexenv
;
2024 bool optional
, rest
;
2028 if (EQ (XCAR (fun
), Qclosure
))
2030 fun
= XCDR (fun
); /* Drop `closure'. */
2031 lexenv
= XCAR (fun
);
2032 CHECK_LIST_CONS (fun
, fun
);
2036 syms_left
= XCDR (fun
);
2037 if (CONSP (syms_left
))
2038 syms_left
= XCAR (syms_left
);
2040 xsignal1 (Qinvalid_function
, fun
);
2045 i
= optional
= rest
= 0;
2046 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2050 next
= XCAR (syms_left
);
2051 if (!SYMBOLP (next
))
2052 xsignal1 (Qinvalid_function
, fun
);
2054 if (EQ (next
, Qand_rest
))
2056 else if (EQ (next
, Qand_optional
))
2063 arg
= Flist (nargs
- i
, &arg_vector
[i
]);
2067 arg
= arg_vector
[i
++];
2069 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
2073 /* Bind the argument. */
2074 if (!NILP (lexenv
) && SYMBOLP (next
))
2075 /* Lexically bind NEXT by adding it to the lexenv alist. */
2076 lexenv
= Fcons (Fcons (next
, arg
), lexenv
);
2078 /* Dynamically bind NEXT. */
2079 specbind (next
, arg
);
2083 if (!NILP (syms_left
))
2084 xsignal1 (Qinvalid_function
, fun
);
2086 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
2088 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
2089 /* Instantiate a new lexical environment. */
2090 specbind (Qinternal_interpreter_environment
, lexenv
);
2092 val
= Fprogn (XCDR (XCDR (fun
)));
2098 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2100 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2101 (Lisp_Object object
)
2105 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2107 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2110 tem
= AREF (object
, COMPILED_BYTECODE
);
2111 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2112 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2114 error ("Invalid byte code");
2116 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
2117 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
2122 /* Return true if SYMBOL currently has a let-binding
2123 which was made in the buffer that is now current. */
2126 let_shadows_buffer_binding_p (sym_t symbol
)
2128 union specbinding
*p
;
2129 Lisp_Object buf
= Fcurrent_buffer ();
2131 for (p
= specpdl_ptr
; p
> specpdl
; )
2132 if ((--p
)->kind
> SPECPDL_LET
)
2134 sym_t let_bound_symbol
= XSYMBOL (specpdl_symbol (p
));
2135 eassert (SYMBOL_REDIRECT (let_bound_symbol
) != SYMBOL_VARALIAS
);
2136 if (symbol
== let_bound_symbol
2137 && EQ (specpdl_where (p
), buf
))
2145 let_shadows_global_binding_p (Lisp_Object symbol
)
2147 union specbinding
*p
;
2149 for (p
= specpdl_ptr
; p
> specpdl
; )
2150 if ((--p
)->kind
>= SPECPDL_LET
&& EQ (specpdl_symbol (p
), symbol
))
2156 /* `specpdl_ptr' describes which variable is
2157 let-bound, so it can be properly undone when we unbind_to.
2158 It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT.
2159 - SYMBOL is the variable being bound. Note that it should not be
2160 aliased (i.e. when let-binding V1 that's aliased to V2, we want
2162 - WHERE tells us in which buffer the binding took place.
2163 This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a
2164 buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings,
2165 i.e. bindings to the default value of a variable which can be
2169 specbind (Lisp_Object symbol
, Lisp_Object value
)
2173 CHECK_SYMBOL (symbol
);
2174 sym
= XSYMBOL (symbol
);
2177 switch (SYMBOL_REDIRECT (sym
))
2179 case SYMBOL_VARALIAS
:
2180 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
2181 case SYMBOL_PLAINVAL
:
2182 /* The most common case is that of a non-constant symbol with a
2183 trivial value. Make that as fast as we can. */
2184 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
2185 specpdl_ptr
->let
.symbol
= symbol
;
2186 specpdl_ptr
->let
.old_value
= SYMBOL_VAL (sym
);
2188 if (! SYMBOL_CONSTANT (sym
))
2189 SET_SYMBOL_VAL (sym
, value
);
2191 set_internal (symbol
, value
, Qnil
, 1);
2193 case SYMBOL_LOCALIZED
:
2194 if (SYMBOL_BLV (sym
)->frame_local
)
2195 error ("Frame-local vars cannot be let-bound");
2196 case SYMBOL_FORWARDED
:
2198 Lisp_Object ovalue
= find_symbol_value (symbol
);
2199 specpdl_ptr
->let
.kind
= SPECPDL_LET_LOCAL
;
2200 specpdl_ptr
->let
.symbol
= symbol
;
2201 specpdl_ptr
->let
.old_value
= ovalue
;
2202 specpdl_ptr
->let
.where
= Fcurrent_buffer ();
2204 eassert (SYMBOL_REDIRECT (sym
) != SYMBOL_LOCALIZED
2205 || (EQ (SYMBOL_BLV (sym
)->where
, Fcurrent_buffer ())));
2207 if (SYMBOL_REDIRECT (sym
) == SYMBOL_LOCALIZED
)
2209 if (!blv_found (SYMBOL_BLV (sym
)))
2210 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
2212 else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
2214 /* If SYMBOL is a per-buffer variable which doesn't have a
2215 buffer-local value here, make the `let' change the global
2216 value by changing the value of SYMBOL in all buffers not
2217 having their own value. This is consistent with what
2218 happens with other buffer-local variables. */
2219 if (NILP (Flocal_variable_p (symbol
, Qnil
)))
2221 specpdl_ptr
->let
.kind
= SPECPDL_LET_DEFAULT
;
2223 Fset_default (symbol
, value
);
2228 specpdl_ptr
->let
.kind
= SPECPDL_LET
;
2231 set_internal (symbol
, value
, Qnil
, 1);
2234 default: emacs_abort ();
2238 scm_dynwind_unwind_handler (unbind_once
, NULL
, SCM_F_WIND_EXPLICITLY
);
2241 /* Push unwind-protect entries of various types. */
2244 record_unwind_protect_1 (void (*function
) (Lisp_Object
), Lisp_Object arg
,
2245 bool wind_explicitly
)
2247 record_unwind_protect_ptr_1 (function
, arg
, wind_explicitly
);
2251 record_unwind_protect (void (*function
) (Lisp_Object
), Lisp_Object arg
)
2253 record_unwind_protect_1 (function
, arg
, true);
2257 record_unwind_protect_ptr_1 (void (*function
) (void *), void *arg
,
2258 bool wind_explicitly
)
2260 scm_dynwind_unwind_handler (function
,
2263 ? SCM_F_WIND_EXPLICITLY
2268 record_unwind_protect_ptr (void (*function
) (void *), void *arg
)
2270 record_unwind_protect_ptr_1 (function
, arg
, true);
2274 record_unwind_protect_int_1 (void (*function
) (int), int arg
,
2275 bool wind_explicitly
)
2277 record_unwind_protect_ptr_1 (function
, arg
, wind_explicitly
);
2281 record_unwind_protect_int (void (*function
) (int), int arg
)
2283 record_unwind_protect_int_1 (function
, arg
, true);
2287 call_void (void *data
)
2289 ((void (*) (void)) data
) ();
2293 record_unwind_protect_void_1 (void (*function
) (void),
2294 bool wind_explicitly
)
2296 record_unwind_protect_ptr_1 (call_void
, function
, wind_explicitly
);
2300 record_unwind_protect_void (void (*function
) (void))
2302 record_unwind_protect_void_1 (function
, true);
2306 unbind_once (void *ignore
)
2308 /* Decrement specpdl_ptr before we do the work to unbind it, so
2309 that an error in unbinding won't try to unbind the same entry
2310 again. Take care to copy any parts of the binding needed
2311 before invoking any code that can make more bindings. */
2315 switch (specpdl_ptr
->kind
)
2318 { /* If variable has a trivial value (no forwarding), we can
2319 just set it. No need to check for constant symbols here,
2320 since that was already done by specbind. */
2321 sym_t sym
= XSYMBOL (specpdl_symbol (specpdl_ptr
));
2322 if (SYMBOL_REDIRECT (sym
) == SYMBOL_PLAINVAL
)
2324 SET_SYMBOL_VAL (sym
, specpdl_old_value (specpdl_ptr
));
2329 NOTE: we only ever come here if make_local_foo was used for
2330 the first time on this var within this let. */
2333 case SPECPDL_LET_DEFAULT
:
2334 Fset_default (specpdl_symbol (specpdl_ptr
),
2335 specpdl_old_value (specpdl_ptr
));
2337 case SPECPDL_LET_LOCAL
:
2339 Lisp_Object symbol
= specpdl_symbol (specpdl_ptr
);
2340 Lisp_Object where
= specpdl_where (specpdl_ptr
);
2341 Lisp_Object old_value
= specpdl_old_value (specpdl_ptr
);
2342 eassert (BUFFERP (where
));
2344 /* If this was a local binding, reset the value in the appropriate
2345 buffer, but only if that buffer's binding still exists. */
2346 if (!NILP (Flocal_variable_p (symbol
, where
)))
2347 set_internal (symbol
, old_value
, where
, 1);
2354 dynwind_begin (void)
2356 scm_dynwind_begin (0);
2365 DEFUN ("special-variable-p", Fspecial_variable_p
, Sspecial_variable_p
, 1, 1, 0,
2366 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
2367 A special variable is one that will be bound dynamically, even in a
2368 context where binding is lexical by default. */)
2369 (Lisp_Object symbol
)
2371 CHECK_SYMBOL (symbol
);
2372 return SYMBOL_DECLARED_SPECIAL (XSYMBOL (symbol
)) ? Qt
: Qnil
;
2376 abort_to_prompt (SCM tag
, SCM arglst
)
2378 static SCM var
= SCM_UNDEFINED
;
2379 if (SCM_UNBNDP (var
))
2380 var
= scm_c_public_lookup ("guile", "abort-to-prompt");
2382 scm_apply_1 (scm_variable_ref (var
), tag
, arglst
);
2387 call_with_prompt (SCM tag
, SCM thunk
, SCM handler
)
2389 static SCM var
= SCM_UNDEFINED
;
2390 if (SCM_UNBNDP (var
))
2391 var
= scm_c_public_lookup ("guile", "call-with-prompt");
2393 return scm_call_3 (scm_variable_ref (var
), tag
, thunk
, handler
);
2397 make_prompt_tag (void)
2399 static SCM var
= SCM_UNDEFINED
;
2400 if (SCM_UNBNDP (var
))
2401 var
= scm_c_public_lookup ("guile", "make-prompt-tag");
2403 return scm_call_0 (scm_variable_ref (var
));
2411 DEFVAR_INT ("max-specpdl-size", max_specpdl_size
,
2412 doc
: /* Limit on number of Lisp variable bindings and `unwind-protect's.
2413 If Lisp code tries to increase the total number past this amount,
2414 an error is signaled.
2415 You can safely use a value considerably larger than the default value,
2416 if that proves inconveniently small. However, if you increase it too far,
2417 Emacs could run out of memory trying to make the stack bigger.
2418 Note that this limit may be silently increased by the debugger
2419 if `debug-on-error' or `debug-on-quit' is set. */);
2421 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth
,
2422 doc
: /* Limit on depth in `eval', `apply' and `funcall' before error.
2424 This limit serves to catch infinite recursions for you before they cause
2425 actual stack overflow in C, which would be fatal for Emacs.
2426 You can safely make it considerably larger than its default value,
2427 if that proves inconveniently small. However, if you increase it too far,
2428 Emacs could overflow the real C stack, and crash. */);
2430 DEFVAR_LISP ("quit-flag", Vquit_flag
,
2431 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
2432 If the value is t, that means do an ordinary quit.
2433 If the value equals `throw-on-input', that means quit by throwing
2434 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
2435 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
2436 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
2439 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit
,
2440 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
2441 Note that `quit-flag' will still be set by typing C-g,
2442 so a quit will be signaled as soon as `inhibit-quit' is nil.
2443 To prevent this happening, set `quit-flag' to nil
2444 before making `inhibit-quit' nil. */);
2445 Vinhibit_quit
= Qnil
;
2447 DEFSYM (Qinhibit_quit
, "inhibit-quit");
2448 DEFSYM (Qautoload
, "autoload");
2449 DEFSYM (Qinhibit_debugger
, "inhibit-debugger");
2450 DEFSYM (Qmacro
, "macro");
2451 DEFSYM (Qdeclare
, "declare");
2453 /* Note that the process handling also uses Qexit, but we don't want
2454 to staticpro it twice, so we just do it here. */
2455 DEFSYM (Qexit
, "exit");
2457 DEFSYM (Qinteractive
, "interactive");
2458 DEFSYM (Qcommandp
, "commandp");
2459 DEFSYM (Qand_rest
, "&rest");
2460 DEFSYM (Qand_optional
, "&optional");
2461 DEFSYM (Qclosure
, "closure");
2462 DEFSYM (Qdebug
, "debug");
2464 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger
,
2465 doc
: /* Non-nil means never enter the debugger.
2466 Normally set while the debugger is already active, to avoid recursive
2468 Vinhibit_debugger
= Qnil
;
2470 DEFVAR_LISP ("debug-on-error", Vdebug_on_error
,
2471 doc
: /* Non-nil means enter debugger if an error is signaled.
2472 Does not apply to errors handled by `condition-case' or those
2473 matched by `debug-ignored-errors'.
2474 If the value is a list, an error only means to enter the debugger
2475 if one of its condition symbols appears in the list.
2476 When you evaluate an expression interactively, this variable
2477 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
2478 The command `toggle-debug-on-error' toggles this.
2479 See also the variable `debug-on-quit' and `inhibit-debugger'. */);
2480 Vdebug_on_error
= Qnil
;
2482 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors
,
2483 doc
: /* List of errors for which the debugger should not be called.
2484 Each element may be a condition-name or a regexp that matches error messages.
2485 If any element applies to a given error, that error skips the debugger
2486 and just returns to top level.
2487 This overrides the variable `debug-on-error'.
2488 It does not apply to errors handled by `condition-case'. */);
2489 Vdebug_ignored_errors
= Qnil
;
2491 DEFVAR_BOOL ("debug-on-quit", debug_on_quit
,
2492 doc
: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
2493 Does not apply if quit is handled by a `condition-case'. */);
2496 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call
,
2497 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
2499 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue
,
2500 doc
: /* Non-nil means debugger may continue execution.
2501 This is nil when the debugger is called under circumstances where it
2502 might not be safe to continue. */);
2503 debugger_may_continue
= 1;
2505 DEFVAR_LISP ("debugger", Vdebugger
,
2506 doc
: /* Function to call to invoke debugger.
2507 If due to frame exit, args are `exit' and the value being returned;
2508 this function's value will be returned instead of that.
2509 If due to error, args are `error' and a list of the args to `signal'.
2510 If due to `apply' or `funcall' entry, one arg, `lambda'.
2511 If due to `eval' entry, one arg, t. */);
2514 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function
,
2515 doc
: /* If non-nil, this is a function for `signal' to call.
2516 It receives the same arguments that `signal' was given.
2517 The Edebug package uses this to regain control. */);
2518 Vsignal_hook_function
= Qnil
;
2520 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal
,
2521 doc
: /* Non-nil means call the debugger regardless of condition handlers.
2522 Note that `debug-on-error', `debug-on-quit' and friends
2523 still determine whether to handle the particular condition. */);
2524 Vdebug_on_signal
= Qnil
;
2526 /* When lexical binding is being used,
2527 Vinternal_interpreter_environment is non-nil, and contains an alist
2528 of lexically-bound variable, or (t), indicating an empty
2529 environment. The lisp name of this variable would be
2530 `internal-interpreter-environment' if it weren't hidden.
2531 Every element of this list can be either a cons (VAR . VAL)
2532 specifying a lexical binding, or a single symbol VAR indicating
2533 that this variable should use dynamic scoping. */
2534 DEFSYM (Qinternal_interpreter_environment
,
2535 "internal-interpreter-environment");
2536 DEFVAR_LISP ("internal-interpreter-environment",
2537 Vinternal_interpreter_environment
,
2538 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
2539 When lexical binding is not being used, this variable is nil.
2540 A value of `(t)' indicates an empty environment, otherwise it is an
2541 alist of active lexical bindings. */);
2542 Vinternal_interpreter_environment
= Qnil
;
2543 /* Don't export this variable to Elisp, so no one can mess with it
2544 (Just imagine if someone makes it buffer-local). */
2545 //Funintern (Qinternal_interpreter_environment, Qnil);
2547 DEFSYM (Vrun_hooks
, "run-hooks");
2549 staticpro (&Vautoload_queue
);
2550 Vautoload_queue
= Qnil
;
2551 staticpro (&Vsignaling_function
);
2552 Vsignaling_function
= Qnil
;
2554 inhibit_lisp_code
= Qnil
;