1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include "blockinput.h"
28 #include "dispextern.h"
29 #include "frame.h" /* For XFRAME. */
35 /* This definition is duplicated in alloc.c and keyboard.c */
36 /* Putting it in lisp.h makes cc bomb out! */
40 struct backtrace
*next
;
41 Lisp_Object
*function
;
42 Lisp_Object
*args
; /* Points to vector of args. */
43 int nargs
; /* Length of vector.
44 If nargs is UNEVALLED, args points to slot holding
45 list of unevalled args */
47 /* Nonzero means call value of debugger when done with this operation. */
51 struct backtrace
*backtrace_list
;
53 struct catchtag
*catchlist
;
56 /* Count levels of GCPRO to detect failure to UNGCPRO. */
60 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
61 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
62 Lisp_Object Qand_rest
, Qand_optional
;
63 Lisp_Object Qdebug_on_error
;
65 Lisp_Object Qcurry
, Qunevalled
;
66 Lisp_Object Qinternal_interpreter_environment
, Qclosure
;
69 extern Lisp_Object Qinteractive_form
;
71 /* This holds either the symbol `run-hooks' or nil.
72 It is nil at an early stage of startup, and when Emacs
75 Lisp_Object Vrun_hooks
;
77 /* Non-nil means record all fset's and provide's, to be undone
78 if the file being autoloaded is not fully loaded.
79 They are recorded by being consed onto the front of Vautoload_queue:
80 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
82 Lisp_Object Vautoload_queue
;
84 /* When lexical binding is being used, this is non-nil, and contains an
85 alist of lexically-bound variable, or t, indicating an empty
86 environment. The lisp name of this variable is
87 `internal-interpreter-lexical-environment'. */
89 Lisp_Object Vinternal_interpreter_environment
;
91 /* Current number of specbindings allocated in specpdl. */
95 /* Pointer to beginning of specpdl. */
97 struct specbinding
*specpdl
;
99 /* Pointer to first unused element in specpdl. */
101 struct specbinding
*specpdl_ptr
;
103 /* Maximum size allowed for specpdl allocation */
105 EMACS_INT max_specpdl_size
;
107 /* Depth in Lisp evaluations and function calls. */
111 /* Maximum allowed depth in Lisp evaluations and function calls. */
113 EMACS_INT max_lisp_eval_depth
;
115 /* Nonzero means enter debugger before next function call */
117 int debug_on_next_call
;
119 /* Non-zero means debugger may continue. This is zero when the
120 debugger is called during redisplay, where it might not be safe to
121 continue the interrupted redisplay. */
123 int debugger_may_continue
;
125 /* List of conditions (non-nil atom means all) which cause a backtrace
126 if an error is handled by the command loop's error handler. */
128 Lisp_Object Vstack_trace_on_error
;
130 /* List of conditions (non-nil atom means all) which enter the debugger
131 if an error is handled by the command loop's error handler. */
133 Lisp_Object Vdebug_on_error
;
135 /* List of conditions and regexps specifying error messages which
136 do not enter the debugger even if Vdebug_on_error says they should. */
138 Lisp_Object Vdebug_ignored_errors
;
140 /* Non-nil means call the debugger even if the error will be handled. */
142 Lisp_Object Vdebug_on_signal
;
144 /* Hook for edebug to use. */
146 Lisp_Object Vsignal_hook_function
;
148 /* Nonzero means enter debugger if a quit signal
149 is handled by the command loop's error handler. */
153 /* The value of num_nonmacro_input_events as of the last time we
154 started to enter the debugger. If we decide to enter the debugger
155 again when this is still equal to num_nonmacro_input_events, then we
156 know that the debugger itself has an error, and we should just
157 signal the error instead of entering an infinite loop of debugger
160 int when_entered_debugger
;
162 Lisp_Object Vdebugger
;
164 /* The function from which the last `signal' was called. Set in
167 Lisp_Object Vsignaling_function
;
169 /* Set to non-zero while processing X events. Checked in Feval to
170 make sure the Lisp interpreter isn't called from a signal handler,
171 which is unsafe because the interpreter isn't reentrant. */
175 /* Function to process declarations in defmacro forms. */
177 Lisp_Object Vmacro_declaration_function
;
179 extern Lisp_Object Qrisky_local_variable
;
180 extern Lisp_Object Qfunction
;
182 static Lisp_Object funcall_lambda
P_ ((Lisp_Object
, int, Lisp_Object
*,
185 static void unwind_to_catch
P_ ((struct catchtag
*, Lisp_Object
)) NO_RETURN
;
188 /* "gcc -O3" enables automatic function inlining, which optimizes out
189 the arguments for the invocations of these functions, whereas they
190 expect these values on the stack. */
191 Lisp_Object
apply1 () __attribute__((noinline
));
192 Lisp_Object
call2 () __attribute__((noinline
));
199 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
200 specpdl_ptr
= specpdl
;
201 /* Don't forget to update docs (lispref node "Local Variables"). */
202 max_specpdl_size
= 1000;
203 max_lisp_eval_depth
= 500;
211 specpdl_ptr
= specpdl
;
216 debug_on_next_call
= 0;
221 /* This is less than the initial value of num_nonmacro_input_events. */
222 when_entered_debugger
= -1;
225 /* unwind-protect function used by call_debugger. */
228 restore_stack_limits (data
)
231 max_specpdl_size
= XINT (XCAR (data
));
232 max_lisp_eval_depth
= XINT (XCDR (data
));
236 /* Call the Lisp debugger, giving it argument ARG. */
242 int debug_while_redisplaying
;
243 int count
= SPECPDL_INDEX ();
245 int old_max
= max_specpdl_size
;
247 /* Temporarily bump up the stack limits,
248 so the debugger won't run out of stack. */
250 max_specpdl_size
+= 1;
251 record_unwind_protect (restore_stack_limits
,
252 Fcons (make_number (old_max
),
253 make_number (max_lisp_eval_depth
)));
254 max_specpdl_size
= old_max
;
256 if (lisp_eval_depth
+ 40 > max_lisp_eval_depth
)
257 max_lisp_eval_depth
= lisp_eval_depth
+ 40;
259 if (SPECPDL_INDEX () + 100 > max_specpdl_size
)
260 max_specpdl_size
= SPECPDL_INDEX () + 100;
262 #ifdef HAVE_WINDOW_SYSTEM
263 if (display_hourglass_p
)
267 debug_on_next_call
= 0;
268 when_entered_debugger
= num_nonmacro_input_events
;
270 /* Resetting redisplaying_p to 0 makes sure that debug output is
271 displayed if the debugger is invoked during redisplay. */
272 debug_while_redisplaying
= redisplaying_p
;
274 specbind (intern ("debugger-may-continue"),
275 debug_while_redisplaying
? Qnil
: Qt
);
276 specbind (Qinhibit_redisplay
, Qnil
);
277 specbind (Qdebug_on_error
, Qnil
);
279 #if 0 /* Binding this prevents execution of Lisp code during
280 redisplay, which necessarily leads to display problems. */
281 specbind (Qinhibit_eval_during_redisplay
, Qt
);
284 val
= apply1 (Vdebugger
, arg
);
286 /* Interrupting redisplay and resuming it later is not safe under
287 all circumstances. So, when the debugger returns, abort the
288 interrupted redisplay by going back to the top-level. */
289 if (debug_while_redisplaying
)
292 return unbind_to (count
, val
);
296 do_debug_on_call (code
)
299 debug_on_next_call
= 0;
300 backtrace_list
->debug_on_exit
= 1;
301 call_debugger (Fcons (code
, Qnil
));
304 /* NOTE!!! Every function that can call EVAL must protect its args
305 and temporaries from garbage collection while it needs them.
306 The definition of `For' shows what you have to do. */
308 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
309 doc
: /* Eval args until one of them yields non-nil, then return that value.
310 The remaining args are not evalled at all.
311 If all args return nil, return nil.
312 usage: (or CONDITIONS...) */)
316 register Lisp_Object val
= Qnil
;
323 val
= Feval (XCAR (args
));
333 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
334 doc
: /* Eval args until one of them yields nil, then return nil.
335 The remaining args are not evalled at all.
336 If no arg yields nil, return the last arg's value.
337 usage: (and CONDITIONS...) */)
341 register Lisp_Object val
= Qt
;
348 val
= Feval (XCAR (args
));
358 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
359 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
360 Returns the value of THEN or the value of the last of the ELSE's.
361 THEN must be one expression, but ELSE... can be zero or more expressions.
362 If COND yields nil, and there are no ELSE's, the value is nil.
363 usage: (if COND THEN ELSE...) */)
367 register Lisp_Object cond
;
371 cond
= Feval (Fcar (args
));
375 return Feval (Fcar (Fcdr (args
)));
376 return Fprogn (Fcdr (Fcdr (args
)));
379 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
380 doc
: /* Try each clause until one succeeds.
381 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
382 and, if the value is non-nil, this clause succeeds:
383 then the expressions in BODY are evaluated and the last one's
384 value is the value of the cond-form.
385 If no clause succeeds, cond returns nil.
386 If a clause has one element, as in (CONDITION),
387 CONDITION's value if non-nil is returned from the cond-form.
388 usage: (cond CLAUSES...) */)
392 register Lisp_Object clause
, val
;
399 clause
= Fcar (args
);
400 val
= Feval (Fcar (clause
));
403 if (!EQ (XCDR (clause
), Qnil
))
404 val
= Fprogn (XCDR (clause
));
414 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
415 doc
: /* Eval BODY forms sequentially and return value of last one.
416 usage: (progn BODY...) */)
420 register Lisp_Object val
= Qnil
;
427 val
= Feval (XCAR (args
));
435 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
436 doc
: /* Eval FIRST and BODY sequentially; return value from FIRST.
437 The value of FIRST is saved during the evaluation of the remaining args,
438 whose values are discarded.
439 usage: (prog1 FIRST BODY...) */)
444 register Lisp_Object args_left
;
445 struct gcpro gcpro1
, gcpro2
;
446 register int argnum
= 0;
458 val
= Feval (Fcar (args_left
));
460 Feval (Fcar (args_left
));
461 args_left
= Fcdr (args_left
);
463 while (!NILP(args_left
));
469 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
470 doc
: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
471 The value of FORM2 is saved during the evaluation of the
472 remaining args, whose values are discarded.
473 usage: (prog2 FORM1 FORM2 BODY...) */)
478 register Lisp_Object args_left
;
479 struct gcpro gcpro1
, gcpro2
;
480 register int argnum
= -1;
494 val
= Feval (Fcar (args_left
));
496 Feval (Fcar (args_left
));
497 args_left
= Fcdr (args_left
);
499 while (!NILP (args_left
));
505 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
506 doc
: /* Set each SYM to the value of its VAL.
507 The symbols SYM are variables; they are literal (not evaluated).
508 The values VAL are expressions; they are evaluated.
509 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
510 The second VAL is not computed until after the first SYM is set, and so on;
511 each VAL can use the new value of variables set earlier in the `setq'.
512 The return value of the `setq' form is the value of the last VAL.
513 usage: (setq [SYM VAL]...) */)
517 register Lisp_Object args_left
;
518 register Lisp_Object val
, sym
, lex_binding
;
529 val
= Feval (Fcar (Fcdr (args_left
)));
530 sym
= Fcar (args_left
);
532 if (!NILP (Vinternal_interpreter_environment
)
534 && !XSYMBOL (sym
)->declared_special
535 && !NILP (lex_binding
= Fassq (sym
, Vinternal_interpreter_environment
)))
536 XSETCDR (lex_binding
, val
); /* SYM is lexically bound. */
538 Fset (sym
, val
); /* SYM is dynamically bound. */
540 args_left
= Fcdr (Fcdr (args_left
));
542 while (!NILP(args_left
));
548 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
549 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
550 usage: (quote ARG) */)
554 if (!NILP (Fcdr (args
)))
555 xsignal2 (Qwrong_number_of_arguments
, Qquote
, Flength (args
));
559 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
560 doc
: /* Like `quote', but preferred for objects which are functions.
561 In byte compilation, `function' causes its argument to be compiled.
562 `quote' cannot do that.
563 usage: (function ARG) */)
567 Lisp_Object quoted
= XCAR (args
);
569 if (!NILP (Fcdr (args
)))
570 xsignal2 (Qwrong_number_of_arguments
, Qfunction
, Flength (args
));
572 if (!NILP (Vinternal_interpreter_environment
)
574 && EQ (XCAR (quoted
), Qlambda
))
575 /* This is a lambda expression within a lexical environment;
576 return an interpreted closure instead of a simple lambda. */
577 return Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
, quoted
));
579 /* Simply quote the argument. */
584 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
585 doc
: /* Return t if the containing function was run directly by user input.
586 This means that the function was called with `call-interactively'
587 \(which includes being called as the binding of a key)
588 and input is currently coming from the keyboard (not a keyboard macro),
589 and Emacs is not running in batch mode (`noninteractive' is nil).
591 The only known proper use of `interactive-p' is in deciding whether to
592 display a helpful message, or how to display it. If you're thinking
593 of using it for any other purpose, it is quite likely that you're
594 making a mistake. Think: what do you want to do when the command is
595 called from a keyboard macro?
597 To test whether your function was called with `call-interactively',
598 either (i) add an extra optional argument and give it an `interactive'
599 spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
600 use `called-interactively-p'. */)
603 return interactive_p (1) ? Qt
: Qnil
;
607 DEFUN ("called-interactively-p", Fcalled_interactively_p
, Scalled_interactively_p
, 0, 1, 0,
608 doc
: /* Return t if the containing function was called by `call-interactively'.
609 If KIND is `interactive', then only return t if the call was made
610 interactively by the user, i.e. not in `noninteractive' mode nor
611 when `executing-kbd-macro'.
612 If KIND is `any', on the other hand, it will return t for any kind of
613 interactive call, including being called as the binding of a key, or
614 from a keyboard macro, or in `noninteractive' mode.
616 The only known proper use of `interactive' for KIND is in deciding
617 whether to display a helpful message, or how to display it. If you're
618 thinking of using it for any other purpose, it is quite likely that
619 you're making a mistake. Think: what do you want to do when the
620 command is called from a keyboard macro?
622 This function is meant for implementing advice and other
623 function-modifying features. Instead of using this, it is sometimes
624 cleaner to give your function an extra optional argument whose
625 `interactive' spec specifies non-nil unconditionally (\"p\" is a good
626 way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
630 return ((INTERACTIVE
|| !EQ (kind
, intern ("interactive")))
631 && interactive_p (1)) ? Qt
: Qnil
;
635 /* Return 1 if function in which this appears was called using
638 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
639 called is a built-in. */
642 interactive_p (exclude_subrs_p
)
645 struct backtrace
*btp
;
648 btp
= backtrace_list
;
650 /* If this isn't a byte-compiled function, there may be a frame at
651 the top for Finteractive_p. If so, skip it. */
652 fun
= Findirect_function (*btp
->function
, Qnil
);
653 if (SUBRP (fun
) && (XSUBR (fun
) == &Sinteractive_p
654 || XSUBR (fun
) == &Scalled_interactively_p
))
657 /* If we're running an Emacs 18-style byte-compiled function, there
658 may be a frame for Fbytecode at the top level. In any version of
659 Emacs there can be Fbytecode frames for subexpressions evaluated
660 inside catch and condition-case. Skip past them.
662 If this isn't a byte-compiled function, then we may now be
663 looking at several frames for special forms. Skip past them. */
665 && (EQ (*btp
->function
, Qbytecode
)
666 || btp
->nargs
== UNEVALLED
))
669 /* btp now points at the frame of the innermost function that isn't
670 a special form, ignoring frames for Finteractive_p and/or
671 Fbytecode at the top. If this frame is for a built-in function
672 (such as load or eval-region) return nil. */
673 fun
= Findirect_function (*btp
->function
, Qnil
);
674 if (exclude_subrs_p
&& SUBRP (fun
))
677 /* btp points to the frame of a Lisp function that called interactive-p.
678 Return t if that function was called interactively. */
679 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
685 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
686 doc
: /* Define NAME as a function.
687 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
688 See also the function `interactive'.
689 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
693 register Lisp_Object fn_name
;
694 register Lisp_Object defn
;
696 fn_name
= Fcar (args
);
697 CHECK_SYMBOL (fn_name
);
698 defn
= Fcons (Qlambda
, Fcdr (args
));
699 if (! NILP (Vinternal_interpreter_environment
))
700 defn
= Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
, defn
));
701 if (!NILP (Vpurify_flag
))
702 defn
= Fpurecopy (defn
);
703 if (CONSP (XSYMBOL (fn_name
)->function
)
704 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
705 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
706 Ffset (fn_name
, defn
);
707 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
711 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
712 doc
: /* Define NAME as a macro.
713 The actual definition looks like
714 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
715 When the macro is called, as in (NAME ARGS...),
716 the function (lambda ARGLIST BODY...) is applied to
717 the list ARGS... as it appears in the expression,
718 and the result should be a form to be evaluated instead of the original.
720 DECL is a declaration, optional, which can specify how to indent
721 calls to this macro, how Edebug should handle it, and which argument
722 should be treated as documentation. It looks like this:
724 The elements can look like this:
726 Set NAME's `lisp-indent-function' property to INDENT.
729 Set NAME's `edebug-form-spec' property to DEBUG. (This is
730 equivalent to writing a `def-edebug-spec' for the macro.)
733 Set NAME's `doc-string-elt' property to ELT.
735 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
739 register Lisp_Object fn_name
;
740 register Lisp_Object defn
;
741 Lisp_Object lambda_list
, doc
, tail
;
743 fn_name
= Fcar (args
);
744 CHECK_SYMBOL (fn_name
);
745 lambda_list
= Fcar (Fcdr (args
));
746 tail
= Fcdr (Fcdr (args
));
749 if (STRINGP (Fcar (tail
)))
755 while (CONSP (Fcar (tail
))
756 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
758 if (!NILP (Vmacro_declaration_function
))
762 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
770 tail
= Fcons (lambda_list
, tail
);
772 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
774 defn
= Fcons (Qlambda
, tail
);
775 if (! NILP (Vinternal_interpreter_environment
))
776 defn
= Fcons (Qclosure
, Fcons (Vinternal_interpreter_environment
, defn
));
777 defn
= Fcons (Qmacro
, defn
);
779 if (!NILP (Vpurify_flag
))
780 defn
= Fpurecopy (defn
);
781 if (CONSP (XSYMBOL (fn_name
)->function
)
782 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
783 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
784 Ffset (fn_name
, defn
);
785 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
790 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
791 doc
: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
792 Aliased variables always have the same value; setting one sets the other.
793 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
794 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
795 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
796 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
797 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
798 The return value is BASE-VARIABLE. */)
799 (new_alias
, base_variable
, docstring
)
800 Lisp_Object new_alias
, base_variable
, docstring
;
802 struct Lisp_Symbol
*sym
;
804 CHECK_SYMBOL (new_alias
);
805 CHECK_SYMBOL (base_variable
);
807 sym
= XSYMBOL (new_alias
);
810 /* Not sure why, but why not? */
811 error ("Cannot make a constant an alias");
813 switch (sym
->redirect
)
815 case SYMBOL_FORWARDED
:
816 error ("Cannot make an internal variable an alias");
817 case SYMBOL_LOCALIZED
:
818 error ("Don't know how to make a localized variable an alias");
821 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
822 If n_a is bound, but b_v is not, set the value of b_v to n_a,
823 so that old-code that affects n_a before the aliasing is setup
825 if (NILP (Fboundp (base_variable
)))
826 set_internal (base_variable
, find_symbol_value (new_alias
), Qnil
, 1);
829 struct specbinding
*p
;
831 for (p
= specpdl_ptr
- 1; p
>= specpdl
; p
--)
834 CONSP (p
->symbol
) ? XCAR (p
->symbol
) : p
->symbol
)))
835 error ("Don't know how to make a let-bound variable an alias");
838 sym
->declared_special
= 1;
839 sym
->redirect
= SYMBOL_VARALIAS
;
840 SET_SYMBOL_ALIAS (sym
, XSYMBOL (base_variable
));
841 sym
->constant
= SYMBOL_CONSTANT_P (base_variable
);
842 LOADHIST_ATTACH (new_alias
);
843 /* Even if docstring is nil: remove old docstring. */
844 Fput (new_alias
, Qvariable_documentation
, docstring
);
846 return base_variable
;
850 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
851 doc
: /* Define SYMBOL as a variable, and return SYMBOL.
852 You are not required to define a variable in order to use it,
853 but the definition can supply documentation and an initial value
854 in a way that tags can recognize.
856 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
857 If SYMBOL is buffer-local, its default value is what is set;
858 buffer-local values are not affected.
859 INITVALUE and DOCSTRING are optional.
860 If DOCSTRING starts with *, this variable is identified as a user option.
861 This means that M-x set-variable recognizes it.
862 See also `user-variable-p'.
863 If INITVALUE is missing, SYMBOL's value is not set.
865 If SYMBOL has a local binding, then this form affects the local
866 binding. This is usually not what you want. Thus, if you need to
867 load a file defining variables, with this form or with `defconst' or
868 `defcustom', you should always load that file _outside_ any bindings
869 for these variables. \(`defconst' and `defcustom' behave similarly in
871 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
875 register Lisp_Object sym
, tem
, tail
;
879 if (!NILP (Fcdr (Fcdr (tail
))))
880 error ("Too many arguments");
882 tem
= Fdefault_boundp (sym
);
885 if (SYMBOL_CONSTANT_P (sym
))
887 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
888 Lisp_Object tem
= Fcar (tail
);
890 && EQ (XCAR (tem
), Qquote
)
891 && CONSP (XCDR (tem
))
892 && EQ (XCAR (XCDR (tem
)), sym
)))
893 error ("Constant symbol `%s' specified in defvar",
894 SDATA (SYMBOL_NAME (sym
)));
898 Fset_default (sym
, Feval (Fcar (tail
)));
900 { /* Check if there is really a global binding rather than just a let
901 binding that shadows the global unboundness of the var. */
902 volatile struct specbinding
*pdl
= specpdl_ptr
;
903 while (--pdl
>= specpdl
)
905 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
906 && EQ (pdl
->old_value
, Qunbound
))
908 message_with_string ("Warning: defvar ignored because %s is let-bound",
909 SYMBOL_NAME (sym
), 1);
918 if (!NILP (Vpurify_flag
))
919 tem
= Fpurecopy (tem
);
920 Fput (sym
, Qvariable_documentation
, tem
);
922 LOADHIST_ATTACH (sym
);
925 /* Simple (defvar <var>) should not count as a definition at all.
926 It could get in the way of other definitions, and unloading this
927 package could try to make the variable unbound. */
931 XSYMBOL (sym
)->declared_special
= 1;
936 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
937 doc
: /* Define SYMBOL as a constant variable.
938 The intent is that neither programs nor users should ever change this value.
939 Always sets the value of SYMBOL to the result of evalling INITVALUE.
940 If SYMBOL is buffer-local, its default value is what is set;
941 buffer-local values are not affected.
942 DOCSTRING is optional.
944 If SYMBOL has a local binding, then this form sets the local binding's
945 value. However, you should normally not make local bindings for
946 variables defined with this form.
947 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
951 register Lisp_Object sym
, tem
;
954 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
955 error ("Too many arguments");
957 tem
= Feval (Fcar (Fcdr (args
)));
958 if (!NILP (Vpurify_flag
))
959 tem
= Fpurecopy (tem
);
960 Fset_default (sym
, tem
);
961 XSYMBOL (sym
)->declared_special
= 1;
962 tem
= Fcar (Fcdr (Fcdr (args
)));
965 if (!NILP (Vpurify_flag
))
966 tem
= Fpurecopy (tem
);
967 Fput (sym
, Qvariable_documentation
, tem
);
969 Fput (sym
, Qrisky_local_variable
, Qt
);
970 LOADHIST_ATTACH (sym
);
974 /* Error handler used in Fuser_variable_p. */
976 user_variable_p_eh (ignore
)
983 lisp_indirect_variable (Lisp_Object sym
)
985 XSETSYMBOL (sym
, indirect_variable (XSYMBOL (sym
)));
989 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
990 doc
: /* Return t if VARIABLE is intended to be set and modified by users.
991 \(The alternative is a variable used internally in a Lisp program.)
992 A variable is a user variable if
993 \(1) the first character of its documentation is `*', or
994 \(2) it is customizable (its property list contains a non-nil value
995 of `standard-value' or `custom-autoload'), or
996 \(3) it is an alias for another user variable.
997 Return nil if VARIABLE is an alias and there is a loop in the
998 chain of symbols. */)
1000 Lisp_Object variable
;
1002 Lisp_Object documentation
;
1004 if (!SYMBOLP (variable
))
1007 /* If indirect and there's an alias loop, don't check anything else. */
1008 if (XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
1009 && NILP (internal_condition_case_1 (lisp_indirect_variable
, variable
,
1010 Qt
, user_variable_p_eh
)))
1015 documentation
= Fget (variable
, Qvariable_documentation
);
1016 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
1018 if (STRINGP (documentation
)
1019 && ((unsigned char) SREF (documentation
, 0) == '*'))
1021 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
1022 if (CONSP (documentation
)
1023 && STRINGP (XCAR (documentation
))
1024 && INTEGERP (XCDR (documentation
))
1025 && XINT (XCDR (documentation
)) < 0)
1027 /* Customizable? See `custom-variable-p'. */
1028 if ((!NILP (Fget (variable
, intern ("standard-value"))))
1029 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
1032 if (!(XSYMBOL (variable
)->redirect
== SYMBOL_VARALIAS
))
1035 /* An indirect variable? Let's follow the chain. */
1036 XSETSYMBOL (variable
, SYMBOL_ALIAS (XSYMBOL (variable
)));
1040 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
1041 doc
: /* Bind variables according to VARLIST then eval BODY.
1042 The value of the last form in BODY is returned.
1043 Each element of VARLIST is a symbol (which is bound to nil)
1044 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1045 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
1046 usage: (let* VARLIST BODY...) */)
1050 Lisp_Object varlist
, var
, val
, elt
, lexenv
;
1051 int count
= SPECPDL_INDEX ();
1052 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1054 GCPRO3 (args
, elt
, varlist
);
1056 lexenv
= Vinternal_interpreter_environment
;
1058 varlist
= Fcar (args
);
1059 while (CONSP (varlist
))
1063 elt
= XCAR (varlist
);
1069 else if (! NILP (Fcdr (Fcdr (elt
))))
1070 signal_error ("`let' bindings can have only one value-form", elt
);
1074 val
= Feval (Fcar (Fcdr (elt
)));
1077 if (!NILP (lexenv
) && SYMBOLP (var
) && !XSYMBOL (var
)->declared_special
)
1078 /* Lexically bind VAR by adding it to the interpreter's binding
1081 lexenv
= Fcons (Fcons (var
, val
), lexenv
);
1082 specbind (Qinternal_interpreter_environment
, lexenv
);
1085 specbind (var
, val
);
1087 varlist
= XCDR (varlist
);
1092 val
= Fprogn (Fcdr (args
));
1094 return unbind_to (count
, val
);
1097 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
1098 doc
: /* Bind variables according to VARLIST then eval BODY.
1099 The value of the last form in BODY is returned.
1100 Each element of VARLIST is a symbol (which is bound to nil)
1101 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1102 All the VALUEFORMs are evalled before any symbols are bound.
1103 usage: (let VARLIST BODY...) */)
1107 Lisp_Object
*temps
, tem
, lexenv
;
1108 register Lisp_Object elt
, varlist
;
1109 int count
= SPECPDL_INDEX ();
1110 register int argnum
;
1111 struct gcpro gcpro1
, gcpro2
;
1113 varlist
= Fcar (args
);
1115 /* Make space to hold the values to give the bound variables */
1116 elt
= Flength (varlist
);
1117 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
1119 /* Compute the values and store them in `temps' */
1121 GCPRO2 (args
, *temps
);
1124 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1127 elt
= XCAR (varlist
);
1129 temps
[argnum
++] = Qnil
;
1130 else if (! NILP (Fcdr (Fcdr (elt
))))
1131 signal_error ("`let' bindings can have only one value-form", elt
);
1133 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
1134 gcpro2
.nvars
= argnum
;
1138 lexenv
= Vinternal_interpreter_environment
;
1140 varlist
= Fcar (args
);
1141 for (argnum
= 0; CONSP (varlist
); varlist
= XCDR (varlist
))
1145 elt
= XCAR (varlist
);
1146 var
= SYMBOLP (elt
) ? elt
: Fcar (elt
);
1147 tem
= temps
[argnum
++];
1149 if (!NILP (lexenv
) && SYMBOLP (var
) && !XSYMBOL (var
)->declared_special
)
1150 /* Lexically bind VAR by adding it to the lexenv alist. */
1151 lexenv
= Fcons (Fcons (var
, tem
), lexenv
);
1153 /* Dynamically bind VAR. */
1154 specbind (var
, tem
);
1157 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
1158 /* Instantiate a new lexical environment. */
1159 specbind (Qinternal_interpreter_environment
, lexenv
);
1161 elt
= Fprogn (Fcdr (args
));
1163 return unbind_to (count
, elt
);
1166 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
1167 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
1168 The order of execution is thus TEST, BODY, TEST, BODY and so on
1169 until TEST returns nil.
1170 usage: (while TEST BODY...) */)
1174 Lisp_Object test
, body
;
1175 struct gcpro gcpro1
, gcpro2
;
1177 GCPRO2 (test
, body
);
1181 while (!NILP (Feval (test
)))
1191 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1192 doc
: /* Return result of expanding macros at top level of FORM.
1193 If FORM is not a macro call, it is returned unchanged.
1194 Otherwise, the macro is expanded and the expansion is considered
1195 in place of FORM. When a non-macro-call results, it is returned.
1197 The second optional arg ENVIRONMENT specifies an environment of macro
1198 definitions to shadow the loaded ones for use in file byte-compilation. */)
1201 Lisp_Object environment
;
1203 /* With cleanups from Hallvard Furuseth. */
1204 register Lisp_Object expander
, sym
, def
, tem
;
1208 /* Come back here each time we expand a macro call,
1209 in case it expands into another macro call. */
1212 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1213 def
= sym
= XCAR (form
);
1215 /* Trace symbols aliases to other symbols
1216 until we get a symbol that is not an alias. */
1217 while (SYMBOLP (def
))
1221 tem
= Fassq (sym
, environment
);
1224 def
= XSYMBOL (sym
)->function
;
1225 if (!EQ (def
, Qunbound
))
1230 /* Right now TEM is the result from SYM in ENVIRONMENT,
1231 and if TEM is nil then DEF is SYM's function definition. */
1234 /* SYM is not mentioned in ENVIRONMENT.
1235 Look at its function definition. */
1236 if (EQ (def
, Qunbound
) || !CONSP (def
))
1237 /* Not defined or definition not suitable */
1239 if (EQ (XCAR (def
), Qautoload
))
1241 /* Autoloading function: will it be a macro when loaded? */
1242 tem
= Fnth (make_number (4), def
);
1243 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1244 /* Yes, load it and try again. */
1246 struct gcpro gcpro1
;
1248 do_autoload (def
, sym
);
1255 else if (!EQ (XCAR (def
), Qmacro
))
1257 else expander
= XCDR (def
);
1261 expander
= XCDR (tem
);
1262 if (NILP (expander
))
1265 form
= apply1 (expander
, XCDR (form
));
1270 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1271 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1272 TAG is evalled to get the tag to use; it must not be nil.
1274 Then the BODY is executed.
1275 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1276 If no throw happens, `catch' returns the value of the last BODY form.
1277 If a throw happens, it specifies the value to return from `catch'.
1278 usage: (catch TAG BODY...) */)
1282 register Lisp_Object tag
;
1283 struct gcpro gcpro1
;
1286 tag
= Feval (Fcar (args
));
1288 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1291 /* Set up a catch, then call C function FUNC on argument ARG.
1292 FUNC should return a Lisp_Object.
1293 This is how catches are done from within C code. */
1296 internal_catch (tag
, func
, arg
)
1298 Lisp_Object (*func
) ();
1301 /* This structure is made part of the chain `catchlist'. */
1304 /* Fill in the components of c, and put it on the list. */
1308 c
.backlist
= backtrace_list
;
1309 c
.handlerlist
= handlerlist
;
1310 c
.lisp_eval_depth
= lisp_eval_depth
;
1311 c
.pdlcount
= SPECPDL_INDEX ();
1312 c
.poll_suppress_count
= poll_suppress_count
;
1313 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1314 c
.gcpro
= gcprolist
;
1315 c
.byte_stack
= byte_stack_list
;
1319 if (! _setjmp (c
.jmp
))
1320 c
.val
= (*func
) (arg
);
1322 /* Throw works by a longjmp that comes right here. */
1327 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1328 jump to that CATCH, returning VALUE as the value of that catch.
1330 This is the guts Fthrow and Fsignal; they differ only in the way
1331 they choose the catch tag to throw to. A catch tag for a
1332 condition-case form has a TAG of Qnil.
1334 Before each catch is discarded, unbind all special bindings and
1335 execute all unwind-protect clauses made above that catch. Unwind
1336 the handler stack as we go, so that the proper handlers are in
1337 effect for each unwind-protect clause we run. At the end, restore
1338 some static info saved in CATCH, and longjmp to the location
1341 This is used for correct unwinding in Fthrow and Fsignal. */
1344 unwind_to_catch (catch, value
)
1345 struct catchtag
*catch;
1348 register int last_time
;
1350 /* Save the value in the tag. */
1353 /* Restore certain special C variables. */
1354 set_poll_suppress_count (catch->poll_suppress_count
);
1355 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1356 handling_signal
= 0;
1361 last_time
= catchlist
== catch;
1363 /* Unwind the specpdl stack, and then restore the proper set of
1365 unbind_to (catchlist
->pdlcount
, Qnil
);
1366 handlerlist
= catchlist
->handlerlist
;
1367 catchlist
= catchlist
->next
;
1369 while (! last_time
);
1372 /* If x_catch_errors was done, turn it off now.
1373 (First we give unbind_to a chance to do that.) */
1374 #if 0 /* This would disable x_catch_errors after x_connection_closed.
1375 * The catch must remain in effect during that delicate
1376 * state. --lorentey */
1377 x_fully_uncatch_errors ();
1381 byte_stack_list
= catch->byte_stack
;
1382 gcprolist
= catch->gcpro
;
1385 gcpro_level
= gcprolist
->level
+ 1;
1389 backtrace_list
= catch->backlist
;
1390 lisp_eval_depth
= catch->lisp_eval_depth
;
1392 _longjmp (catch->jmp
, 1);
1395 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1396 doc
: /* Throw to the catch for TAG and return VALUE from it.
1397 Both TAG and VALUE are evalled. */)
1399 register Lisp_Object tag
, value
;
1401 register struct catchtag
*c
;
1404 for (c
= catchlist
; c
; c
= c
->next
)
1406 if (EQ (c
->tag
, tag
))
1407 unwind_to_catch (c
, value
);
1409 xsignal2 (Qno_catch
, tag
, value
);
1413 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1414 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1415 If BODYFORM completes normally, its value is returned
1416 after executing the UNWINDFORMS.
1417 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1418 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1423 int count
= SPECPDL_INDEX ();
1425 record_unwind_protect (Fprogn
, Fcdr (args
));
1426 val
= Feval (Fcar (args
));
1427 return unbind_to (count
, val
);
1430 /* Chain of condition handlers currently in effect.
1431 The elements of this chain are contained in the stack frames
1432 of Fcondition_case and internal_condition_case.
1433 When an error is signaled (by calling Fsignal, below),
1434 this chain is searched for an element that applies. */
1436 struct handler
*handlerlist
;
1438 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1439 doc
: /* Regain control when an error is signaled.
1440 Executes BODYFORM and returns its value if no error happens.
1441 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1442 where the BODY is made of Lisp expressions.
1444 A handler is applicable to an error
1445 if CONDITION-NAME is one of the error's condition names.
1446 If an error happens, the first applicable handler is run.
1448 The car of a handler may be a list of condition names
1449 instead of a single condition name. Then it handles all of them.
1451 When a handler handles an error, control returns to the `condition-case'
1452 and it executes the handler's BODY...
1453 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1454 (If VAR is nil, the handler can't access that information.)
1455 Then the value of the last BODY form is returned from the `condition-case'
1458 See also the function `signal' for more info.
1459 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1463 register Lisp_Object bodyform
, handlers
;
1464 volatile Lisp_Object var
;
1467 bodyform
= Fcar (Fcdr (args
));
1468 handlers
= Fcdr (Fcdr (args
));
1470 return internal_lisp_condition_case (var
, bodyform
, handlers
);
1473 /* Like Fcondition_case, but the args are separate
1474 rather than passed in a list. Used by Fbyte_code. */
1477 internal_lisp_condition_case (var
, bodyform
, handlers
)
1478 volatile Lisp_Object var
;
1479 Lisp_Object bodyform
, handlers
;
1487 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1493 && (SYMBOLP (XCAR (tem
))
1494 || CONSP (XCAR (tem
))))))
1495 error ("Invalid condition handler", tem
);
1500 c
.backlist
= backtrace_list
;
1501 c
.handlerlist
= handlerlist
;
1502 c
.lisp_eval_depth
= lisp_eval_depth
;
1503 c
.pdlcount
= SPECPDL_INDEX ();
1504 c
.poll_suppress_count
= poll_suppress_count
;
1505 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1506 c
.gcpro
= gcprolist
;
1507 c
.byte_stack
= byte_stack_list
;
1508 if (_setjmp (c
.jmp
))
1511 specbind (h
.var
, c
.val
);
1512 val
= Fprogn (Fcdr (h
.chosen_clause
));
1514 /* Note that this just undoes the binding of h.var; whoever
1515 longjumped to us unwound the stack to c.pdlcount before
1517 unbind_to (c
.pdlcount
, Qnil
);
1524 h
.handler
= handlers
;
1525 h
.next
= handlerlist
;
1529 val
= Feval (bodyform
);
1531 handlerlist
= h
.next
;
1535 /* Call the function BFUN with no arguments, catching errors within it
1536 according to HANDLERS. If there is an error, call HFUN with
1537 one argument which is the data that describes the error:
1540 HANDLERS can be a list of conditions to catch.
1541 If HANDLERS is Qt, catch all errors.
1542 If HANDLERS is Qerror, catch all errors
1543 but allow the debugger to run if that is enabled. */
1546 internal_condition_case (bfun
, handlers
, hfun
)
1547 Lisp_Object (*bfun
) ();
1548 Lisp_Object handlers
;
1549 Lisp_Object (*hfun
) ();
1555 /* Since Fsignal will close off all calls to x_catch_errors,
1556 we will get the wrong results if some are not closed now. */
1558 if (x_catching_errors ())
1564 c
.backlist
= backtrace_list
;
1565 c
.handlerlist
= handlerlist
;
1566 c
.lisp_eval_depth
= lisp_eval_depth
;
1567 c
.pdlcount
= SPECPDL_INDEX ();
1568 c
.poll_suppress_count
= poll_suppress_count
;
1569 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1570 c
.gcpro
= gcprolist
;
1571 c
.byte_stack
= byte_stack_list
;
1572 if (_setjmp (c
.jmp
))
1574 return (*hfun
) (c
.val
);
1578 h
.handler
= handlers
;
1580 h
.next
= handlerlist
;
1586 handlerlist
= h
.next
;
1590 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1593 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1594 Lisp_Object (*bfun
) ();
1596 Lisp_Object handlers
;
1597 Lisp_Object (*hfun
) ();
1603 /* Since Fsignal will close off all calls to x_catch_errors,
1604 we will get the wrong results if some are not closed now. */
1606 if (x_catching_errors ())
1612 c
.backlist
= backtrace_list
;
1613 c
.handlerlist
= handlerlist
;
1614 c
.lisp_eval_depth
= lisp_eval_depth
;
1615 c
.pdlcount
= SPECPDL_INDEX ();
1616 c
.poll_suppress_count
= poll_suppress_count
;
1617 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1618 c
.gcpro
= gcprolist
;
1619 c
.byte_stack
= byte_stack_list
;
1620 if (_setjmp (c
.jmp
))
1622 return (*hfun
) (c
.val
);
1626 h
.handler
= handlers
;
1628 h
.next
= handlerlist
;
1632 val
= (*bfun
) (arg
);
1634 handlerlist
= h
.next
;
1638 /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
1642 internal_condition_case_2 (Lisp_Object (*bfun
) (Lisp_Object
, Lisp_Object
),
1645 Lisp_Object handlers
,
1646 Lisp_Object (*hfun
) (Lisp_Object
))
1652 /* Since Fsignal will close off all calls to x_catch_errors,
1653 we will get the wrong results if some are not closed now. */
1655 if (x_catching_errors ())
1661 c
.backlist
= backtrace_list
;
1662 c
.handlerlist
= handlerlist
;
1663 c
.lisp_eval_depth
= lisp_eval_depth
;
1664 c
.pdlcount
= SPECPDL_INDEX ();
1665 c
.poll_suppress_count
= poll_suppress_count
;
1666 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1667 c
.gcpro
= gcprolist
;
1668 c
.byte_stack
= byte_stack_list
;
1669 if (_setjmp (c
.jmp
))
1671 return (*hfun
) (c
.val
);
1675 h
.handler
= handlers
;
1677 h
.next
= handlerlist
;
1681 val
= (*bfun
) (arg1
, arg2
);
1683 handlerlist
= h
.next
;
1687 /* Like internal_condition_case but call BFUN with NARGS as first,
1688 and ARGS as second argument. */
1691 internal_condition_case_n (Lisp_Object (*bfun
) (int, Lisp_Object
*),
1694 Lisp_Object handlers
,
1695 Lisp_Object (*hfun
) (Lisp_Object
))
1701 /* Since Fsignal will close off all calls to x_catch_errors,
1702 we will get the wrong results if some are not closed now. */
1704 if (x_catching_errors ())
1710 c
.backlist
= backtrace_list
;
1711 c
.handlerlist
= handlerlist
;
1712 c
.lisp_eval_depth
= lisp_eval_depth
;
1713 c
.pdlcount
= SPECPDL_INDEX ();
1714 c
.poll_suppress_count
= poll_suppress_count
;
1715 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1716 c
.gcpro
= gcprolist
;
1717 c
.byte_stack
= byte_stack_list
;
1718 if (_setjmp (c
.jmp
))
1720 return (*hfun
) (c
.val
);
1724 h
.handler
= handlers
;
1726 h
.next
= handlerlist
;
1730 val
= (*bfun
) (nargs
, args
);
1732 handlerlist
= h
.next
;
1737 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1738 Lisp_Object
, Lisp_Object
));
1740 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1741 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1742 This function does not return.
1744 An error symbol is a symbol with an `error-conditions' property
1745 that is a list of condition names.
1746 A handler for any of those names will get to handle this signal.
1747 The symbol `error' should normally be one of them.
1749 DATA should be a list. Its elements are printed as part of the error message.
1750 See Info anchor `(elisp)Definition of signal' for some details on how this
1751 error message is constructed.
1752 If the signal is handled, DATA is made available to the handler.
1753 See also the function `condition-case'. */)
1754 (error_symbol
, data
)
1755 Lisp_Object error_symbol
, data
;
1757 /* When memory is full, ERROR-SYMBOL is nil,
1758 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1759 That is a special case--don't do this in other situations. */
1760 register struct handler
*allhandlers
= handlerlist
;
1761 Lisp_Object conditions
;
1762 extern int gc_in_progress
;
1763 extern int waiting_for_input
;
1765 Lisp_Object real_error_symbol
;
1766 struct backtrace
*bp
;
1768 immediate_quit
= handling_signal
= 0;
1770 if (gc_in_progress
|| waiting_for_input
)
1773 if (NILP (error_symbol
))
1774 real_error_symbol
= Fcar (data
);
1776 real_error_symbol
= error_symbol
;
1778 #if 0 /* rms: I don't know why this was here,
1779 but it is surely wrong for an error that is handled. */
1780 #ifdef HAVE_WINDOW_SYSTEM
1781 if (display_hourglass_p
)
1782 cancel_hourglass ();
1786 /* This hook is used by edebug. */
1787 if (! NILP (Vsignal_hook_function
)
1788 && ! NILP (error_symbol
))
1790 /* Edebug takes care of restoring these variables when it exits. */
1791 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1792 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1794 if (SPECPDL_INDEX () + 40 > max_specpdl_size
)
1795 max_specpdl_size
= SPECPDL_INDEX () + 40;
1797 call2 (Vsignal_hook_function
, error_symbol
, data
);
1800 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1802 /* Remember from where signal was called. Skip over the frame for
1803 `signal' itself. If a frame for `error' follows, skip that,
1804 too. Don't do this when ERROR_SYMBOL is nil, because that
1805 is a memory-full error. */
1806 Vsignaling_function
= Qnil
;
1807 if (backtrace_list
&& !NILP (error_symbol
))
1809 bp
= backtrace_list
->next
;
1810 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1812 if (bp
&& bp
->function
)
1813 Vsignaling_function
= *bp
->function
;
1816 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1818 register Lisp_Object clause
;
1820 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1821 error_symbol
, data
);
1823 if (EQ (clause
, Qlambda
))
1825 /* We can't return values to code which signaled an error, but we
1826 can continue code which has signaled a quit. */
1827 if (EQ (real_error_symbol
, Qquit
))
1830 error ("Cannot return from the debugger in an error");
1835 Lisp_Object unwind_data
;
1836 struct handler
*h
= handlerlist
;
1838 handlerlist
= allhandlers
;
1840 if (NILP (error_symbol
))
1843 unwind_data
= Fcons (error_symbol
, data
);
1844 h
->chosen_clause
= clause
;
1845 unwind_to_catch (h
->tag
, unwind_data
);
1849 handlerlist
= allhandlers
;
1850 /* If no handler is present now, try to run the debugger,
1851 and if that fails, throw to top level. */
1852 find_handler_clause (Qerror
, conditions
, error_symbol
, data
);
1854 Fthrow (Qtop_level
, Qt
);
1856 if (! NILP (error_symbol
))
1857 data
= Fcons (error_symbol
, data
);
1859 string
= Ferror_message_string (data
);
1860 fatal ("%s", SDATA (string
), 0);
1863 /* Internal version of Fsignal that never returns.
1864 Used for anything but Qquit (which can return from Fsignal). */
1867 xsignal (error_symbol
, data
)
1868 Lisp_Object error_symbol
, data
;
1870 Fsignal (error_symbol
, data
);
1874 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1877 xsignal0 (error_symbol
)
1878 Lisp_Object error_symbol
;
1880 xsignal (error_symbol
, Qnil
);
1884 xsignal1 (error_symbol
, arg
)
1885 Lisp_Object error_symbol
, arg
;
1887 xsignal (error_symbol
, list1 (arg
));
1891 xsignal2 (error_symbol
, arg1
, arg2
)
1892 Lisp_Object error_symbol
, arg1
, arg2
;
1894 xsignal (error_symbol
, list2 (arg1
, arg2
));
1898 xsignal3 (error_symbol
, arg1
, arg2
, arg3
)
1899 Lisp_Object error_symbol
, arg1
, arg2
, arg3
;
1901 xsignal (error_symbol
, list3 (arg1
, arg2
, arg3
));
1904 /* Signal `error' with message S, and additional arg ARG.
1905 If ARG is not a genuine list, make it a one-element list. */
1908 signal_error (s
, arg
)
1912 Lisp_Object tortoise
, hare
;
1914 hare
= tortoise
= arg
;
1915 while (CONSP (hare
))
1922 tortoise
= XCDR (tortoise
);
1924 if (EQ (hare
, tortoise
))
1929 arg
= Fcons (arg
, Qnil
); /* Make it a list. */
1931 xsignal (Qerror
, Fcons (build_string (s
), arg
));
1935 /* Return nonzero if LIST is a non-nil atom or
1936 a list containing one of CONDITIONS. */
1939 wants_debugger (list
, conditions
)
1940 Lisp_Object list
, conditions
;
1947 while (CONSP (conditions
))
1949 Lisp_Object
this, tail
;
1950 this = XCAR (conditions
);
1951 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1952 if (EQ (XCAR (tail
), this))
1954 conditions
= XCDR (conditions
);
1959 /* Return 1 if an error with condition-symbols CONDITIONS,
1960 and described by SIGNAL-DATA, should skip the debugger
1961 according to debugger-ignored-errors. */
1964 skip_debugger (conditions
, data
)
1965 Lisp_Object conditions
, data
;
1968 int first_string
= 1;
1969 Lisp_Object error_message
;
1971 error_message
= Qnil
;
1972 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1974 if (STRINGP (XCAR (tail
)))
1978 error_message
= Ferror_message_string (data
);
1982 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1987 Lisp_Object contail
;
1989 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1990 if (EQ (XCAR (tail
), XCAR (contail
)))
1998 /* Call the debugger if calling it is currently enabled for CONDITIONS.
1999 SIG and DATA describe the signal, as in find_handler_clause. */
2002 maybe_call_debugger (conditions
, sig
, data
)
2003 Lisp_Object conditions
, sig
, data
;
2005 Lisp_Object combined_data
;
2007 combined_data
= Fcons (sig
, data
);
2010 /* Don't try to run the debugger with interrupts blocked.
2011 The editing loop would return anyway. */
2013 /* Does user want to enter debugger for this kind of error? */
2016 : wants_debugger (Vdebug_on_error
, conditions
))
2017 && ! skip_debugger (conditions
, combined_data
)
2018 /* rms: what's this for? */
2019 && when_entered_debugger
< num_nonmacro_input_events
)
2021 call_debugger (Fcons (Qerror
, Fcons (combined_data
, Qnil
)));
2028 /* Value of Qlambda means we have called debugger and user has continued.
2029 There are two ways to pass SIG and DATA:
2030 = SIG is the error symbol, and DATA is the rest of the data.
2031 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
2032 This is for memory-full errors only.
2034 We need to increase max_specpdl_size temporarily around
2035 anything we do that can push on the specpdl, so as not to get
2036 a second error here in case we're handling specpdl overflow. */
2039 find_handler_clause (handlers
, conditions
, sig
, data
)
2040 Lisp_Object handlers
, conditions
, sig
, data
;
2042 register Lisp_Object h
;
2043 register Lisp_Object tem
;
2044 int debugger_called
= 0;
2045 int debugger_considered
= 0;
2047 /* t is used by handlers for all conditions, set up by C code. */
2048 if (EQ (handlers
, Qt
))
2051 /* Don't run the debugger for a memory-full error.
2052 (There is no room in memory to do that!) */
2054 debugger_considered
= 1;
2056 /* error is used similarly, but means print an error message
2057 and run the debugger if that is enabled. */
2058 if (EQ (handlers
, Qerror
)
2059 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
2060 there is a handler. */
2062 if (!NILP (sig
) && wants_debugger (Vstack_trace_on_error
, conditions
))
2064 max_lisp_eval_depth
+= 15;
2069 internal_with_output_to_temp_buffer
2071 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
2074 max_lisp_eval_depth
-= 15;
2077 if (!debugger_considered
)
2079 debugger_considered
= 1;
2080 debugger_called
= maybe_call_debugger (conditions
, sig
, data
);
2083 /* If there is no handler, return saying whether we ran the debugger. */
2084 if (EQ (handlers
, Qerror
))
2086 if (debugger_called
)
2092 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
2094 Lisp_Object handler
, condit
;
2097 if (!CONSP (handler
))
2099 condit
= Fcar (handler
);
2100 /* Handle a single condition name in handler HANDLER. */
2101 if (SYMBOLP (condit
))
2103 tem
= Fmemq (Fcar (handler
), conditions
);
2107 /* Handle a list of condition names in handler HANDLER. */
2108 else if (CONSP (condit
))
2111 for (tail
= condit
; CONSP (tail
); tail
= XCDR (tail
))
2113 tem
= Fmemq (Fcar (tail
), conditions
);
2116 /* This handler is going to apply.
2117 Does it allow the debugger to run first? */
2118 if (! debugger_considered
&& !NILP (Fmemq (Qdebug
, condit
)))
2119 maybe_call_debugger (conditions
, sig
, data
);
2129 /* dump an error message; called like printf */
2133 error (m
, a1
, a2
, a3
)
2153 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
2158 buffer
= (char *) xrealloc (buffer
, size
);
2161 buffer
= (char *) xmalloc (size
);
2166 string
= build_string (buffer
);
2170 xsignal1 (Qerror
, string
);
2173 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
2174 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
2175 This means it contains a description for how to read arguments to give it.
2176 The value is nil for an invalid function or a symbol with no function
2179 Interactively callable functions include strings and vectors (treated
2180 as keyboard macros), lambda-expressions that contain a top-level call
2181 to `interactive', autoload definitions made by `autoload' with non-nil
2182 fourth argument, and some of the built-in functions of Lisp.
2184 Also, a symbol satisfies `commandp' if its function definition does so.
2186 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
2187 then strings and vectors are not accepted. */)
2188 (function
, for_call_interactively
)
2189 Lisp_Object function
, for_call_interactively
;
2191 register Lisp_Object fun
;
2192 register Lisp_Object funcar
;
2193 Lisp_Object if_prop
= Qnil
;
2197 fun
= indirect_function (fun
); /* Check cycles. */
2198 if (NILP (fun
) || EQ (fun
, Qunbound
))
2201 /* Check an `interactive-form' property if present, analogous to the
2202 function-documentation property. */
2204 while (SYMBOLP (fun
))
2206 Lisp_Object tmp
= Fget (fun
, Qinteractive_form
);
2209 fun
= Fsymbol_function (fun
);
2212 /* Emacs primitives are interactive if their DEFUN specifies an
2213 interactive spec. */
2215 return XSUBR (fun
)->intspec
? Qt
: if_prop
;
2217 /* Bytecode objects are interactive if they are long enough to
2218 have an element whose index is COMPILED_INTERACTIVE, which is
2219 where the interactive spec is stored. */
2220 else if (COMPILEDP (fun
))
2221 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
2224 /* Strings and vectors are keyboard macros. */
2225 if (STRINGP (fun
) || VECTORP (fun
))
2226 return (NILP (for_call_interactively
) ? Qt
: Qnil
);
2228 /* Lists may represent commands. */
2231 funcar
= XCAR (fun
);
2232 if (EQ (funcar
, Qlambda
))
2233 return !NILP (Fassq (Qinteractive
, Fcdr (XCDR (fun
)))) ? Qt
: if_prop
;
2234 if (EQ (funcar
, Qautoload
))
2235 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun
))))) ? Qt
: if_prop
;
2240 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
2241 doc
: /* Define FUNCTION to autoload from FILE.
2242 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
2243 Third arg DOCSTRING is documentation for the function.
2244 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
2245 Fifth arg TYPE indicates the type of the object:
2246 nil or omitted says FUNCTION is a function,
2247 `keymap' says FUNCTION is really a keymap, and
2248 `macro' or t says FUNCTION is really a macro.
2249 Third through fifth args give info about the real definition.
2250 They default to nil.
2251 If FUNCTION is already defined other than as an autoload,
2252 this does nothing and returns nil. */)
2253 (function
, file
, docstring
, interactive
, type
)
2254 Lisp_Object function
, file
, docstring
, interactive
, type
;
2256 CHECK_SYMBOL (function
);
2257 CHECK_STRING (file
);
2259 /* If function is defined and not as an autoload, don't override */
2260 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
2261 && !(CONSP (XSYMBOL (function
)->function
)
2262 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
2265 if (NILP (Vpurify_flag
))
2266 /* Only add entries after dumping, because the ones before are
2267 not useful and else we get loads of them from the loaddefs.el. */
2268 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
2270 /* We don't want the docstring in purespace (instead,
2271 Snarf-documentation should (hopefully) overwrite it).
2272 We used to use 0 here, but that leads to accidental sharing in
2273 purecopy's hash-consing, so we use a (hopefully) unique integer
2275 docstring
= make_number (XHASH (function
));
2276 return Ffset (function
,
2277 Fpurecopy (list5 (Qautoload
, file
, docstring
,
2278 interactive
, type
)));
2282 un_autoload (oldqueue
)
2283 Lisp_Object oldqueue
;
2285 register Lisp_Object queue
, first
, second
;
2287 /* Queue to unwind is current value of Vautoload_queue.
2288 oldqueue is the shadowed value to leave in Vautoload_queue. */
2289 queue
= Vautoload_queue
;
2290 Vautoload_queue
= oldqueue
;
2291 while (CONSP (queue
))
2293 first
= XCAR (queue
);
2294 second
= Fcdr (first
);
2295 first
= Fcar (first
);
2296 if (EQ (first
, make_number (0)))
2299 Ffset (first
, second
);
2300 queue
= XCDR (queue
);
2305 /* Load an autoloaded function.
2306 FUNNAME is the symbol which is the function's name.
2307 FUNDEF is the autoload definition (a list). */
2310 do_autoload (fundef
, funname
)
2311 Lisp_Object fundef
, funname
;
2313 int count
= SPECPDL_INDEX ();
2315 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2317 /* This is to make sure that loadup.el gives a clear picture
2318 of what files are preloaded and when. */
2319 if (! NILP (Vpurify_flag
))
2320 error ("Attempt to autoload %s while preparing to dump",
2321 SDATA (SYMBOL_NAME (funname
)));
2324 CHECK_SYMBOL (funname
);
2325 GCPRO3 (fun
, funname
, fundef
);
2327 /* Preserve the match data. */
2328 record_unwind_save_match_data ();
2330 /* If autoloading gets an error (which includes the error of failing
2331 to define the function being called), we use Vautoload_queue
2332 to undo function definitions and `provide' calls made by
2333 the function. We do this in the specific case of autoloading
2334 because autoloading is not an explicit request "load this file",
2335 but rather a request to "call this function".
2337 The value saved here is to be restored into Vautoload_queue. */
2338 record_unwind_protect (un_autoload
, Vautoload_queue
);
2339 Vautoload_queue
= Qt
;
2340 Fload (Fcar (Fcdr (fundef
)), Qnil
, Qt
, Qnil
, Qt
);
2342 /* Once loading finishes, don't undo it. */
2343 Vautoload_queue
= Qt
;
2344 unbind_to (count
, Qnil
);
2346 fun
= Findirect_function (fun
, Qnil
);
2348 if (!NILP (Fequal (fun
, fundef
)))
2349 error ("Autoloading failed to define function %s",
2350 SDATA (SYMBOL_NAME (funname
)));
2355 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
2356 doc
: /* Evaluate FORM and return its value. */)
2360 Lisp_Object fun
, val
, original_fun
, original_args
;
2362 struct backtrace backtrace
;
2363 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2365 if (handling_signal
)
2370 /* If there's an active lexical environment, and the variable
2371 isn't declared special, look up its binding in the lexical
2373 if (!NILP (Vinternal_interpreter_environment
)
2374 && !XSYMBOL (form
)->declared_special
)
2376 Lisp_Object lex_binding
2377 = Fassq (form
, Vinternal_interpreter_environment
);
2379 /* If we found a lexical binding for FORM, return the value.
2380 Otherwise, we just drop through and look for a dynamic
2381 binding -- the variable isn't declared special, but there's
2382 not much else we can do, and Fsymbol_value will take care
2383 of signaling an error if there is no binding at all. */
2384 if (CONSP (lex_binding
))
2385 return XCDR (lex_binding
);
2388 return Fsymbol_value (form
);
2395 if ((consing_since_gc
> gc_cons_threshold
2396 && consing_since_gc
> gc_relative_threshold
)
2398 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
2401 Fgarbage_collect ();
2405 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2407 if (max_lisp_eval_depth
< 100)
2408 max_lisp_eval_depth
= 100;
2409 if (lisp_eval_depth
> max_lisp_eval_depth
)
2410 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2413 original_fun
= Fcar (form
);
2414 original_args
= Fcdr (form
);
2416 backtrace
.next
= backtrace_list
;
2417 backtrace_list
= &backtrace
;
2418 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2419 backtrace
.args
= &original_args
;
2420 backtrace
.nargs
= UNEVALLED
;
2421 backtrace
.evalargs
= 1;
2422 backtrace
.debug_on_exit
= 0;
2424 if (debug_on_next_call
)
2425 do_debug_on_call (Qt
);
2427 /* At this point, only original_fun and original_args
2428 have values that will be used below */
2431 /* Optimize for no indirection. */
2433 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2434 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2435 fun
= indirect_function (fun
);
2439 Lisp_Object numargs
;
2440 Lisp_Object argvals
[8];
2441 Lisp_Object args_left
;
2442 register int i
, maxargs
;
2444 args_left
= original_args
;
2445 numargs
= Flength (args_left
);
2449 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2450 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2451 xsignal2 (Qwrong_number_of_arguments
, original_fun
, numargs
);
2453 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2455 backtrace
.evalargs
= 0;
2456 val
= (*XSUBR (fun
)->function
) (args_left
);
2460 if (XSUBR (fun
)->max_args
== MANY
)
2462 /* Pass a vector of evaluated arguments */
2464 register int argnum
= 0;
2466 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2468 GCPRO3 (args_left
, fun
, fun
);
2472 while (!NILP (args_left
))
2474 vals
[argnum
++] = Feval (Fcar (args_left
));
2475 args_left
= Fcdr (args_left
);
2476 gcpro3
.nvars
= argnum
;
2479 backtrace
.args
= vals
;
2480 backtrace
.nargs
= XINT (numargs
);
2482 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2487 GCPRO3 (args_left
, fun
, fun
);
2488 gcpro3
.var
= argvals
;
2491 maxargs
= XSUBR (fun
)->max_args
;
2492 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2494 argvals
[i
] = Feval (Fcar (args_left
));
2500 backtrace
.args
= argvals
;
2501 backtrace
.nargs
= XINT (numargs
);
2506 val
= (*XSUBR (fun
)->function
) ();
2509 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2512 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2515 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2519 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2520 argvals
[2], argvals
[3]);
2523 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2524 argvals
[3], argvals
[4]);
2527 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2528 argvals
[3], argvals
[4], argvals
[5]);
2531 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2532 argvals
[3], argvals
[4], argvals
[5],
2537 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2538 argvals
[3], argvals
[4], argvals
[5],
2539 argvals
[6], argvals
[7]);
2543 /* Someone has created a subr that takes more arguments than
2544 is supported by this code. We need to either rewrite the
2545 subr to use a different argument protocol, or add more
2546 cases to this switch. */
2551 val
= apply_lambda (fun
, original_args
, 1, Qnil
);
2554 if (EQ (fun
, Qunbound
))
2555 xsignal1 (Qvoid_function
, original_fun
);
2557 xsignal1 (Qinvalid_function
, original_fun
);
2558 funcar
= XCAR (fun
);
2559 if (!SYMBOLP (funcar
))
2560 xsignal1 (Qinvalid_function
, original_fun
);
2561 if (EQ (funcar
, Qautoload
))
2563 do_autoload (fun
, original_fun
);
2566 if (EQ (funcar
, Qmacro
))
2567 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2568 else if (EQ (funcar
, Qlambda
))
2569 val
= apply_lambda (fun
, original_args
, 1,
2570 /* Only pass down the current lexical environment
2571 if FUN is lexically embedded in FORM. */
2572 (CONSP (original_fun
)
2573 ? Vinternal_interpreter_environment
2575 else if (EQ (funcar
, Qclosure
)
2576 && CONSP (XCDR (fun
))
2577 && CONSP (XCDR (XCDR (fun
)))
2578 && EQ (XCAR (XCDR (XCDR (fun
))), Qlambda
))
2579 val
= apply_lambda (XCDR (XCDR (fun
)), original_args
, 1,
2582 xsignal1 (Qinvalid_function
, original_fun
);
2588 if (backtrace
.debug_on_exit
)
2589 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2590 backtrace_list
= backtrace
.next
;
2595 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2596 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2597 Then return the value FUNCTION returns.
2598 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2599 usage: (apply FUNCTION &rest ARGUMENTS) */)
2604 register int i
, numargs
;
2605 register Lisp_Object spread_arg
;
2606 register Lisp_Object
*funcall_args
;
2608 struct gcpro gcpro1
;
2612 spread_arg
= args
[nargs
- 1];
2613 CHECK_LIST (spread_arg
);
2615 numargs
= XINT (Flength (spread_arg
));
2618 return Ffuncall (nargs
- 1, args
);
2619 else if (numargs
== 1)
2621 args
[nargs
- 1] = XCAR (spread_arg
);
2622 return Ffuncall (nargs
, args
);
2625 numargs
+= nargs
- 2;
2627 /* Optimize for no indirection. */
2628 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
2629 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
2630 fun
= indirect_function (fun
);
2631 if (EQ (fun
, Qunbound
))
2633 /* Let funcall get the error */
2640 if (numargs
< XSUBR (fun
)->min_args
2641 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2642 goto funcall
; /* Let funcall get the error */
2643 else if (XSUBR (fun
)->max_args
> numargs
)
2645 /* Avoid making funcall cons up a yet another new vector of arguments
2646 by explicitly supplying nil's for optional values */
2647 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2648 * sizeof (Lisp_Object
));
2649 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2650 funcall_args
[++i
] = Qnil
;
2651 GCPRO1 (*funcall_args
);
2652 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2656 /* We add 1 to numargs because funcall_args includes the
2657 function itself as well as its arguments. */
2660 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2661 * sizeof (Lisp_Object
));
2662 GCPRO1 (*funcall_args
);
2663 gcpro1
.nvars
= 1 + numargs
;
2666 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2667 /* Spread the last arg we got. Its first element goes in
2668 the slot that it used to occupy, hence this value of I. */
2670 while (!NILP (spread_arg
))
2672 funcall_args
[i
++] = XCAR (spread_arg
);
2673 spread_arg
= XCDR (spread_arg
);
2676 /* By convention, the caller needs to gcpro Ffuncall's args. */
2677 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2680 /* Run hook variables in various ways. */
2682 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2683 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2684 enum run_hooks_condition
));
2686 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2687 doc
: /* Run each hook in HOOKS.
2688 Each argument should be a symbol, a hook variable.
2689 These symbols are processed in the order specified.
2690 If a hook symbol has a non-nil value, that value may be a function
2691 or a list of functions to be called to run the hook.
2692 If the value is a function, it is called with no arguments.
2693 If it is a list, the elements are called, in order, with no arguments.
2695 Major modes should not use this function directly to run their mode
2696 hook; they should use `run-mode-hooks' instead.
2698 Do not use `make-local-variable' to make a hook variable buffer-local.
2699 Instead, use `add-hook' and specify t for the LOCAL argument.
2700 usage: (run-hooks &rest HOOKS) */)
2705 Lisp_Object hook
[1];
2708 for (i
= 0; i
< nargs
; i
++)
2711 run_hook_with_args (1, hook
, to_completion
);
2717 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2718 Srun_hook_with_args
, 1, MANY
, 0,
2719 doc
: /* Run HOOK with the specified arguments ARGS.
2720 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2721 value, that value may be a function or a list of functions to be
2722 called to run the hook. If the value is a function, it is called with
2723 the given arguments and its return value is returned. If it is a list
2724 of functions, those functions are called, in order,
2725 with the given arguments ARGS.
2726 It is best not to depend on the value returned by `run-hook-with-args',
2729 Do not use `make-local-variable' to make a hook variable buffer-local.
2730 Instead, use `add-hook' and specify t for the LOCAL argument.
2731 usage: (run-hook-with-args HOOK &rest ARGS) */)
2736 return run_hook_with_args (nargs
, args
, to_completion
);
2739 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2740 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2741 doc
: /* Run HOOK with the specified arguments ARGS.
2742 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2743 value, that value may be a function or a list of functions to be
2744 called to run the hook. If the value is a function, it is called with
2745 the given arguments and its return value is returned.
2746 If it is a list of functions, those functions are called, in order,
2747 with the given arguments ARGS, until one of them
2748 returns a non-nil value. Then we return that value.
2749 However, if they all return nil, we return nil.
2751 Do not use `make-local-variable' to make a hook variable buffer-local.
2752 Instead, use `add-hook' and specify t for the LOCAL argument.
2753 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2758 return run_hook_with_args (nargs
, args
, until_success
);
2761 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2762 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2763 doc
: /* Run HOOK with the specified arguments ARGS.
2764 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2765 value, that value may be a function or a list of functions to be
2766 called to run the hook. If the value is a function, it is called with
2767 the given arguments and its return value is returned.
2768 If it is a list of functions, those functions are called, in order,
2769 with the given arguments ARGS, until one of them returns nil.
2770 Then we return nil. However, if they all return non-nil, we return non-nil.
2772 Do not use `make-local-variable' to make a hook variable buffer-local.
2773 Instead, use `add-hook' and specify t for the LOCAL argument.
2774 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2779 return run_hook_with_args (nargs
, args
, until_failure
);
2782 /* ARGS[0] should be a hook symbol.
2783 Call each of the functions in the hook value, passing each of them
2784 as arguments all the rest of ARGS (all NARGS - 1 elements).
2785 COND specifies a condition to test after each call
2786 to decide whether to stop.
2787 The caller (or its caller, etc) must gcpro all of ARGS,
2788 except that it isn't necessary to gcpro ARGS[0]. */
2791 run_hook_with_args (nargs
, args
, cond
)
2794 enum run_hooks_condition cond
;
2796 Lisp_Object sym
, val
, ret
;
2797 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2799 /* If we are dying or still initializing,
2800 don't do anything--it would probably crash if we tried. */
2801 if (NILP (Vrun_hooks
))
2805 val
= find_symbol_value (sym
);
2806 ret
= (cond
== until_failure
? Qt
: Qnil
);
2808 if (EQ (val
, Qunbound
) || NILP (val
))
2810 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2813 return Ffuncall (nargs
, args
);
2817 Lisp_Object globals
= Qnil
;
2818 GCPRO3 (sym
, val
, globals
);
2821 CONSP (val
) && ((cond
== to_completion
)
2822 || (cond
== until_success
? NILP (ret
)
2826 if (EQ (XCAR (val
), Qt
))
2828 /* t indicates this hook has a local binding;
2829 it means to run the global binding too. */
2830 globals
= Fdefault_value (sym
);
2831 if (NILP (globals
)) continue;
2833 if (!CONSP (globals
) || EQ (XCAR (globals
), Qlambda
))
2836 ret
= Ffuncall (nargs
, args
);
2841 CONSP (globals
) && ((cond
== to_completion
)
2842 || (cond
== until_success
? NILP (ret
)
2844 globals
= XCDR (globals
))
2846 args
[0] = XCAR (globals
);
2847 /* In a global value, t should not occur. If it does, we
2848 must ignore it to avoid an endless loop. */
2849 if (!EQ (args
[0], Qt
))
2850 ret
= Ffuncall (nargs
, args
);
2856 args
[0] = XCAR (val
);
2857 ret
= Ffuncall (nargs
, args
);
2866 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2867 present value of that symbol.
2868 Call each element of FUNLIST,
2869 passing each of them the rest of ARGS.
2870 The caller (or its caller, etc) must gcpro all of ARGS,
2871 except that it isn't necessary to gcpro ARGS[0]. */
2874 run_hook_list_with_args (funlist
, nargs
, args
)
2875 Lisp_Object funlist
;
2881 Lisp_Object globals
;
2882 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2886 GCPRO3 (sym
, val
, globals
);
2888 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2890 if (EQ (XCAR (val
), Qt
))
2892 /* t indicates this hook has a local binding;
2893 it means to run the global binding too. */
2895 for (globals
= Fdefault_value (sym
);
2897 globals
= XCDR (globals
))
2899 args
[0] = XCAR (globals
);
2900 /* In a global value, t should not occur. If it does, we
2901 must ignore it to avoid an endless loop. */
2902 if (!EQ (args
[0], Qt
))
2903 Ffuncall (nargs
, args
);
2908 args
[0] = XCAR (val
);
2909 Ffuncall (nargs
, args
);
2916 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2919 run_hook_with_args_2 (hook
, arg1
, arg2
)
2920 Lisp_Object hook
, arg1
, arg2
;
2922 Lisp_Object temp
[3];
2927 Frun_hook_with_args (3, temp
);
2930 /* Apply fn to arg */
2933 Lisp_Object fn
, arg
;
2935 struct gcpro gcpro1
;
2939 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2942 Lisp_Object args
[2];
2946 RETURN_UNGCPRO (Fapply (2, args
));
2950 /* Call function fn on no arguments */
2955 struct gcpro gcpro1
;
2958 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2961 /* Call function fn with 1 argument arg1 */
2965 Lisp_Object fn
, arg1
;
2967 struct gcpro gcpro1
;
2968 Lisp_Object args
[2];
2974 RETURN_UNGCPRO (Ffuncall (2, args
));
2977 /* Call function fn with 2 arguments arg1, arg2 */
2980 call2 (fn
, arg1
, arg2
)
2981 Lisp_Object fn
, arg1
, arg2
;
2983 struct gcpro gcpro1
;
2984 Lisp_Object args
[3];
2990 RETURN_UNGCPRO (Ffuncall (3, args
));
2993 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2996 call3 (fn
, arg1
, arg2
, arg3
)
2997 Lisp_Object fn
, arg1
, arg2
, arg3
;
2999 struct gcpro gcpro1
;
3000 Lisp_Object args
[4];
3007 RETURN_UNGCPRO (Ffuncall (4, args
));
3010 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
3013 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
3014 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
3016 struct gcpro gcpro1
;
3017 Lisp_Object args
[5];
3025 RETURN_UNGCPRO (Ffuncall (5, args
));
3028 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
3031 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
3032 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
3034 struct gcpro gcpro1
;
3035 Lisp_Object args
[6];
3044 RETURN_UNGCPRO (Ffuncall (6, args
));
3047 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
3050 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
3051 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
3053 struct gcpro gcpro1
;
3054 Lisp_Object args
[7];
3064 RETURN_UNGCPRO (Ffuncall (7, args
));
3067 /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
3070 call7 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
, arg7
)
3071 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
, arg7
;
3073 struct gcpro gcpro1
;
3074 Lisp_Object args
[8];
3085 RETURN_UNGCPRO (Ffuncall (8, args
));
3088 /* The caller should GCPRO all the elements of ARGS. */
3090 DEFUN ("functionp", Ffunctionp
, Sfunctionp
, 1, 1, 0,
3091 doc
: /* Return non-nil if OBJECT is a type of object that can be called as a function. */)
3095 if (SYMBOLP (object
) && !NILP (Ffboundp (object
)))
3097 object
= Findirect_function (object
, Qnil
);
3099 if (CONSP (object
) && EQ (XCAR (object
), Qautoload
))
3101 /* Autoloaded symbols are functions, except if they load
3102 macros or keymaps. */
3104 for (i
= 0; i
< 4 && CONSP (object
); i
++)
3105 object
= XCDR (object
);
3107 return (CONSP (object
) && !NILP (XCAR (object
))) ? Qnil
: Qt
;
3112 return (XSUBR (object
)->max_args
!= Qunevalled
) ? Qt
: Qnil
;
3113 else if (FUNVECP (object
))
3115 else if (CONSP (object
))
3117 Lisp_Object car
= XCAR (object
);
3118 return (EQ (car
, Qlambda
) || EQ (car
, Qclosure
)) ? Qt
: Qnil
;
3124 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
3125 doc
: /* Call first argument as a function, passing remaining arguments to it.
3126 Return the value that function returns.
3127 Thus, (funcall 'cons 'x 'y) returns (x . y).
3128 usage: (funcall FUNCTION &rest ARGUMENTS) */)
3133 Lisp_Object fun
, original_fun
;
3135 int numargs
= nargs
- 1;
3136 Lisp_Object lisp_numargs
;
3138 struct backtrace backtrace
;
3139 register Lisp_Object
*internal_args
;
3143 if ((consing_since_gc
> gc_cons_threshold
3144 && consing_since_gc
> gc_relative_threshold
)
3146 (!NILP (Vmemory_full
) && consing_since_gc
> memory_full_cons_threshold
))
3147 Fgarbage_collect ();
3149 if (++lisp_eval_depth
> max_lisp_eval_depth
)
3151 if (max_lisp_eval_depth
< 100)
3152 max_lisp_eval_depth
= 100;
3153 if (lisp_eval_depth
> max_lisp_eval_depth
)
3154 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
3157 backtrace
.next
= backtrace_list
;
3158 backtrace_list
= &backtrace
;
3159 backtrace
.function
= &args
[0];
3160 backtrace
.args
= &args
[1];
3161 backtrace
.nargs
= nargs
- 1;
3162 backtrace
.evalargs
= 0;
3163 backtrace
.debug_on_exit
= 0;
3165 if (debug_on_next_call
)
3166 do_debug_on_call (Qlambda
);
3170 original_fun
= args
[0];
3174 /* Optimize for no indirection. */
3176 if (SYMBOLP (fun
) && !EQ (fun
, Qunbound
)
3177 && (fun
= XSYMBOL (fun
)->function
, SYMBOLP (fun
)))
3178 fun
= indirect_function (fun
);
3182 if (numargs
< XSUBR (fun
)->min_args
3183 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
3185 XSETFASTINT (lisp_numargs
, numargs
);
3186 xsignal2 (Qwrong_number_of_arguments
, original_fun
, lisp_numargs
);
3189 if (XSUBR (fun
)->max_args
== UNEVALLED
)
3190 xsignal1 (Qinvalid_function
, original_fun
);
3192 if (XSUBR (fun
)->max_args
== MANY
)
3194 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
3198 if (XSUBR (fun
)->max_args
> numargs
)
3200 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
3201 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
3202 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
3203 internal_args
[i
] = Qnil
;
3206 internal_args
= args
+ 1;
3207 switch (XSUBR (fun
)->max_args
)
3210 val
= (*XSUBR (fun
)->function
) ();
3213 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
3216 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1]);
3219 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
3223 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
3224 internal_args
[2], internal_args
[3]);
3227 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
3228 internal_args
[2], internal_args
[3],
3232 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
3233 internal_args
[2], internal_args
[3],
3234 internal_args
[4], internal_args
[5]);
3237 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
3238 internal_args
[2], internal_args
[3],
3239 internal_args
[4], internal_args
[5],
3244 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
3245 internal_args
[2], internal_args
[3],
3246 internal_args
[4], internal_args
[5],
3247 internal_args
[6], internal_args
[7]);
3252 /* If a subr takes more than 8 arguments without using MANY
3253 or UNEVALLED, we need to extend this function to support it.
3254 Until this is done, there is no way to call the function. */
3260 val
= funcall_lambda (fun
, numargs
, args
+ 1, Qnil
);
3263 if (EQ (fun
, Qunbound
))
3264 xsignal1 (Qvoid_function
, original_fun
);
3266 xsignal1 (Qinvalid_function
, original_fun
);
3267 funcar
= XCAR (fun
);
3268 if (!SYMBOLP (funcar
))
3269 xsignal1 (Qinvalid_function
, original_fun
);
3270 if (EQ (funcar
, Qlambda
))
3271 val
= funcall_lambda (fun
, numargs
, args
+ 1, Qnil
);
3272 else if (EQ (funcar
, Qclosure
)
3273 && CONSP (XCDR (fun
))
3274 && CONSP (XCDR (XCDR (fun
)))
3275 && EQ (XCAR (XCDR (XCDR (fun
))), Qlambda
))
3276 val
= funcall_lambda (XCDR (XCDR (fun
)), numargs
, args
+ 1,
3278 else if (EQ (funcar
, Qautoload
))
3280 do_autoload (fun
, original_fun
);
3285 xsignal1 (Qinvalid_function
, original_fun
);
3290 if (backtrace
.debug_on_exit
)
3291 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
3292 backtrace_list
= backtrace
.next
;
3297 apply_lambda (fun
, args
, eval_flag
, lexenv
)
3298 Lisp_Object fun
, args
;
3302 Lisp_Object args_left
;
3303 Lisp_Object numargs
;
3304 register Lisp_Object
*arg_vector
;
3305 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3307 register Lisp_Object tem
;
3309 numargs
= Flength (args
);
3310 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
3313 GCPRO3 (*arg_vector
, args_left
, fun
);
3316 for (i
= 0; i
< XINT (numargs
);)
3318 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
3319 if (eval_flag
) tem
= Feval (tem
);
3320 arg_vector
[i
++] = tem
;
3328 backtrace_list
->args
= arg_vector
;
3329 backtrace_list
->nargs
= i
;
3331 backtrace_list
->evalargs
= 0;
3332 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
, lexenv
);
3334 /* Do the debug-on-exit now, while arg_vector still exists. */
3335 if (backtrace_list
->debug_on_exit
)
3336 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
3337 /* Don't do it again when we return to eval. */
3338 backtrace_list
->debug_on_exit
= 0;
3343 /* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
3347 funcall_funvec (fun
, nargs
, args
)
3352 int size
= FUNVEC_SIZE (fun
);
3353 Lisp_Object tag
= (size
> 0 ? AREF (fun
, 0) : Qnil
);
3355 if (EQ (tag
, Qcurry
))
3357 /* A curried function is a way to attach arguments to a another
3358 function. The first element of the vector is the identifier
3359 `curry', the second is the wrapped function, and remaining
3360 elements are the attached arguments. */
3361 int num_curried_args
= size
- 2;
3362 /* Offset of the curried and user args in the final arglist. Curried
3363 args are first in the new arg vector, after the function. User
3365 int curried_args_offs
= 1;
3366 int user_args_offs
= curried_args_offs
+ num_curried_args
;
3367 /* The curried function and arguments. */
3368 Lisp_Object
*curry_params
= XVECTOR (fun
)->contents
+ 1;
3369 /* The arguments in the curry vector. */
3370 Lisp_Object
*curried_args
= curry_params
+ 1;
3371 /* The number of arguments with which we'll call funcall, and the
3372 arguments themselves. */
3373 int num_funcall_args
= 1 + num_curried_args
+ nargs
;
3374 Lisp_Object
*funcall_args
3375 = (Lisp_Object
*) alloca (num_funcall_args
* sizeof (Lisp_Object
));
3377 /* First comes the real function. */
3378 funcall_args
[0] = curry_params
[0];
3380 /* Then the arguments in the appropriate order. */
3381 bcopy (curried_args
, funcall_args
+ curried_args_offs
,
3382 num_curried_args
* sizeof (Lisp_Object
));
3383 bcopy (args
, funcall_args
+ user_args_offs
,
3384 nargs
* sizeof (Lisp_Object
));
3386 return Ffuncall (num_funcall_args
, funcall_args
);
3389 xsignal1 (Qinvalid_function
, fun
);
3393 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
3394 and return the result of evaluation.
3395 FUN must be either a lambda-expression or a compiled-code object. */
3398 funcall_lambda (fun
, nargs
, arg_vector
, lexenv
)
3401 register Lisp_Object
*arg_vector
;
3404 Lisp_Object val
, syms_left
, next
;
3405 int count
= SPECPDL_INDEX ();
3406 int i
, optional
, rest
;
3409 && FUNVEC_SIZE (fun
) > COMPILED_PUSH_ARGS
3410 && ! NILP (XVECTOR (fun
)->contents
[COMPILED_PUSH_ARGS
]))
3411 /* A byte-code object with a non-nil `push args' slot means we
3412 shouldn't bind any arguments, instead just call the byte-code
3413 interpreter directly; it will push arguments as necessary.
3415 Byte-code objects with either a non-existant, or a nil value for
3416 the `push args' slot (the default), have dynamically-bound
3417 arguments, and use the argument-binding code below instead (as do
3418 all interpreted functions, even lexically bound ones). */
3420 /* If we have not actually read the bytecode string
3421 and constants vector yet, fetch them from the file. */
3422 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3423 Ffetch_bytecode (fun
);
3424 return exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3425 AREF (fun
, COMPILED_CONSTANTS
),
3426 AREF (fun
, COMPILED_STACK_DEPTH
),
3427 AREF (fun
, COMPILED_ARGLIST
),
3431 if (FUNVECP (fun
) && !FUNVEC_COMPILED_P (fun
))
3432 /* Byte-compiled functions are handled directly below, but we
3433 call other funvec types via funcall_funvec. */
3434 return funcall_funvec (fun
, nargs
, arg_vector
);
3438 syms_left
= XCDR (fun
);
3439 if (CONSP (syms_left
))
3440 syms_left
= XCAR (syms_left
);
3442 xsignal1 (Qinvalid_function
, fun
);
3444 else if (COMPILEDP (fun
))
3445 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
3449 i
= optional
= rest
= 0;
3450 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
3454 next
= XCAR (syms_left
);
3455 if (!SYMBOLP (next
))
3456 xsignal1 (Qinvalid_function
, fun
);
3458 if (EQ (next
, Qand_rest
))
3460 else if (EQ (next
, Qand_optional
))
3464 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
3471 /* Get the argument's actual value. */
3473 val
= arg_vector
[i
++];
3475 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3479 /* Bind the argument. */
3481 && SYMBOLP (next
) && !XSYMBOL (next
)->declared_special
)
3482 /* Lexically bind NEXT by adding it to the lexenv alist. */
3483 lexenv
= Fcons (Fcons (next
, val
), lexenv
);
3485 /* Dynamically bind NEXT. */
3486 specbind (next
, val
);
3490 if (!NILP (syms_left
))
3491 xsignal1 (Qinvalid_function
, fun
);
3493 xsignal2 (Qwrong_number_of_arguments
, fun
, make_number (nargs
));
3495 if (!EQ (lexenv
, Vinternal_interpreter_environment
))
3496 /* Instantiate a new lexical environment. */
3497 specbind (Qinternal_interpreter_environment
, lexenv
);
3500 val
= Fprogn (XCDR (XCDR (fun
)));
3503 /* If we have not actually read the bytecode string
3504 and constants vector yet, fetch them from the file. */
3505 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
3506 Ffetch_bytecode (fun
);
3507 val
= exec_byte_code (AREF (fun
, COMPILED_BYTECODE
),
3508 AREF (fun
, COMPILED_CONSTANTS
),
3509 AREF (fun
, COMPILED_STACK_DEPTH
),
3513 return unbind_to (count
, val
);
3516 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
3518 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3524 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
3526 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
3529 tem
= AREF (object
, COMPILED_BYTECODE
);
3530 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
3531 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
3533 error ("Invalid byte code");
3535 ASET (object
, COMPILED_BYTECODE
, XCAR (tem
));
3536 ASET (object
, COMPILED_CONSTANTS
, XCDR (tem
));
3544 register int count
= SPECPDL_INDEX ();
3545 if (specpdl_size
>= max_specpdl_size
)
3547 if (max_specpdl_size
< 400)
3548 max_specpdl_size
= 400;
3549 if (specpdl_size
>= max_specpdl_size
)
3550 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil
);
3553 if (specpdl_size
> max_specpdl_size
)
3554 specpdl_size
= max_specpdl_size
;
3555 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3556 specpdl_ptr
= specpdl
+ count
;
3559 /* specpdl_ptr->symbol is a field which describes which variable is
3560 let-bound, so it can be properly undone when we unbind_to.
3561 It can have the following two shapes:
3562 - SYMBOL : if it's a plain symbol, it means that we have let-bound
3563 a symbol that is not buffer-local (at least at the time
3564 the let binding started). Note also that it should not be
3565 aliased (i.e. when let-binding V1 that's aliased to V2, we want
3567 - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
3568 variable SYMBOL which can be buffer-local. WHERE tells us
3569 which buffer is affected (or nil if the let-binding affects the
3570 global value of the variable) and BUFFER tells us which buffer was
3571 current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
3572 BUFFER did not yet have a buffer-local value). */
3575 specbind (symbol
, value
)
3576 Lisp_Object symbol
, value
;
3578 struct Lisp_Symbol
*sym
;
3580 eassert (!handling_signal
);
3582 CHECK_SYMBOL (symbol
);
3583 sym
= XSYMBOL (symbol
);
3584 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3588 switch (sym
->redirect
)
3590 case SYMBOL_VARALIAS
:
3591 sym
= indirect_variable (sym
); XSETSYMBOL (symbol
, sym
); goto start
;
3592 case SYMBOL_PLAINVAL
:
3593 { /* The most common case is that of a non-constant symbol with a
3594 trivial value. Make that as fast as we can. */
3595 specpdl_ptr
->symbol
= symbol
;
3596 specpdl_ptr
->old_value
= SYMBOL_VAL (sym
);
3597 specpdl_ptr
->func
= NULL
;
3600 SET_SYMBOL_VAL (sym
, value
);
3602 set_internal (symbol
, value
, Qnil
, 1);
3605 case SYMBOL_LOCALIZED
:
3606 if (SYMBOL_BLV (sym
)->frame_local
)
3607 error ("Frame-local vars cannot be let-bound");
3608 case SYMBOL_FORWARDED
:
3610 Lisp_Object ovalue
= find_symbol_value (symbol
);
3611 specpdl_ptr
->func
= 0;
3612 specpdl_ptr
->old_value
= ovalue
;
3614 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3615 || (EQ (SYMBOL_BLV (sym
)->where
,
3616 SYMBOL_BLV (sym
)->frame_local
?
3617 Fselected_frame () : Fcurrent_buffer ())));
3619 if (sym
->redirect
== SYMBOL_LOCALIZED
3620 || BUFFER_OBJFWDP (SYMBOL_FWD (sym
)))
3622 Lisp_Object where
, cur_buf
= Fcurrent_buffer ();
3624 /* For a local variable, record both the symbol and which
3625 buffer's or frame's value we are saving. */
3626 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3628 eassert (sym
->redirect
!= SYMBOL_LOCALIZED
3629 || (BLV_FOUND (SYMBOL_BLV (sym
))
3630 && EQ (cur_buf
, SYMBOL_BLV (sym
)->where
)));
3633 else if (sym
->redirect
== SYMBOL_LOCALIZED
3634 && BLV_FOUND (SYMBOL_BLV (sym
)))
3635 where
= SYMBOL_BLV (sym
)->where
;
3639 /* We're not using the `unused' slot in the specbinding
3640 structure because this would mean we have to do more
3641 work for simple variables. */
3642 /* FIXME: The third value `current_buffer' is only used in
3643 let_shadows_buffer_binding_p which is itself only used
3644 in set_internal for local_if_set. */
3645 eassert (NILP (where
) || EQ (where
, cur_buf
));
3646 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, cur_buf
));
3648 /* If SYMBOL is a per-buffer variable which doesn't have a
3649 buffer-local value here, make the `let' change the global
3650 value by changing the value of SYMBOL in all buffers not
3651 having their own value. This is consistent with what
3652 happens with other buffer-local variables. */
3654 && sym
->redirect
== SYMBOL_FORWARDED
)
3656 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym
)));
3658 Fset_default (symbol
, value
);
3663 specpdl_ptr
->symbol
= symbol
;
3666 set_internal (symbol
, value
, Qnil
, 1);
3674 record_unwind_protect (function
, arg
)
3675 Lisp_Object (*function
) P_ ((Lisp_Object
));
3678 eassert (!handling_signal
);
3680 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3682 specpdl_ptr
->func
= function
;
3683 specpdl_ptr
->symbol
= Qnil
;
3684 specpdl_ptr
->old_value
= arg
;
3689 unbind_to (count
, value
)
3693 Lisp_Object quitf
= Vquit_flag
;
3694 struct gcpro gcpro1
, gcpro2
;
3696 GCPRO2 (value
, quitf
);
3699 while (specpdl_ptr
!= specpdl
+ count
)
3701 /* Copy the binding, and decrement specpdl_ptr, before we do
3702 the work to unbind it. We decrement first
3703 so that an error in unbinding won't try to unbind
3704 the same entry again, and we copy the binding first
3705 in case more bindings are made during some of the code we run. */
3707 struct specbinding this_binding
;
3708 this_binding
= *--specpdl_ptr
;
3710 if (this_binding
.func
!= 0)
3711 (*this_binding
.func
) (this_binding
.old_value
);
3712 /* If the symbol is a list, it is really (SYMBOL WHERE
3713 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3714 frame. If WHERE is a buffer or frame, this indicates we
3715 bound a variable that had a buffer-local or frame-local
3716 binding. WHERE nil means that the variable had the default
3717 value when it was bound. CURRENT-BUFFER is the buffer that
3718 was current when the variable was bound. */
3719 else if (CONSP (this_binding
.symbol
))
3721 Lisp_Object symbol
, where
;
3723 symbol
= XCAR (this_binding
.symbol
);
3724 where
= XCAR (XCDR (this_binding
.symbol
));
3727 Fset_default (symbol
, this_binding
.old_value
);
3728 /* If `where' is non-nil, reset the value in the appropriate
3729 local binding, but only if that binding still exists. */
3730 else if (BUFFERP (where
)
3731 ? !NILP (Flocal_variable_p (symbol
, where
))
3732 : !NILP (Fassq (symbol
, XFRAME (where
)->param_alist
)))
3733 set_internal (symbol
, this_binding
.old_value
, where
, 1);
3735 /* If variable has a trivial value (no forwarding), we can
3736 just set it. No need to check for constant symbols here,
3737 since that was already done by specbind. */
3738 else if (XSYMBOL (this_binding
.symbol
)->redirect
== SYMBOL_PLAINVAL
)
3739 SET_SYMBOL_VAL (XSYMBOL (this_binding
.symbol
),
3740 this_binding
.old_value
);
3742 /* NOTE: we only ever come here if make_local_foo was used for
3743 the first time on this var within this let. */
3744 Fset_default (this_binding
.symbol
, this_binding
.old_value
);
3747 if (NILP (Vquit_flag
) && !NILP (quitf
))
3756 DEFUN ("specialp", Fspecialp
, Sspecialp
, 1, 1, 0,
3757 doc
: /* Return non-nil if SYMBOL's global binding has been declared special.
3758 A special variable is one that will be bound dynamically, even in a
3759 context where binding is lexical by default. */)
3763 CHECK_SYMBOL (symbol
);
3764 return XSYMBOL (symbol
)->declared_special
? Qt
: Qnil
;
3769 DEFUN ("curry", Fcurry
, Scurry
, 1, MANY
, 0,
3770 doc
: /* Return FUN curried with ARGS.
3771 The result is a function-like object that will append any arguments it
3772 is called with to ARGS, and call FUN with the resulting list of arguments.
3775 (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2)
3777 (mapcar (curry 'concat "The ") '("a" "b" "c"))
3778 => ("The a" "The b" "The c")
3780 usage: (curry FUN &rest ARGS) */)
3785 return make_funvec (Qcurry
, 0, nargs
, args
);
3789 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3790 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3791 The debugger is entered when that frame exits, if the flag is non-nil. */)
3793 Lisp_Object level
, flag
;
3795 register struct backtrace
*backlist
= backtrace_list
;
3798 CHECK_NUMBER (level
);
3800 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3802 backlist
= backlist
->next
;
3806 backlist
->debug_on_exit
= !NILP (flag
);
3811 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3812 doc
: /* Print a trace of Lisp function calls currently active.
3813 Output stream used is value of `standard-output'. */)
3816 register struct backtrace
*backlist
= backtrace_list
;
3820 extern Lisp_Object Vprint_level
;
3821 struct gcpro gcpro1
;
3823 XSETFASTINT (Vprint_level
, 3);
3830 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3831 if (backlist
->nargs
== UNEVALLED
)
3833 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3834 write_string ("\n", -1);
3838 tem
= *backlist
->function
;
3839 Fprin1 (tem
, Qnil
); /* This can QUIT */
3840 write_string ("(", -1);
3841 if (backlist
->nargs
== MANY
)
3843 for (tail
= *backlist
->args
, i
= 0;
3845 tail
= Fcdr (tail
), i
++)
3847 if (i
) write_string (" ", -1);
3848 Fprin1 (Fcar (tail
), Qnil
);
3853 for (i
= 0; i
< backlist
->nargs
; i
++)
3855 if (i
) write_string (" ", -1);
3856 Fprin1 (backlist
->args
[i
], Qnil
);
3859 write_string (")\n", -1);
3861 backlist
= backlist
->next
;
3864 Vprint_level
= Qnil
;
3869 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3870 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3871 If that frame has not evaluated the arguments yet (or is a special form),
3872 the value is (nil FUNCTION ARG-FORMS...).
3873 If that frame has evaluated its arguments and called its function already,
3874 the value is (t FUNCTION ARG-VALUES...).
3875 A &rest arg is represented as the tail of the list ARG-VALUES.
3876 FUNCTION is whatever was supplied as car of evaluated list,
3877 or a lambda expression for macro calls.
3878 If NFRAMES is more than the number of frames, the value is nil. */)
3880 Lisp_Object nframes
;
3882 register struct backtrace
*backlist
= backtrace_list
;
3886 CHECK_NATNUM (nframes
);
3888 /* Find the frame requested. */
3889 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3890 backlist
= backlist
->next
;
3894 if (backlist
->nargs
== UNEVALLED
)
3895 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3898 if (backlist
->nargs
== MANY
)
3899 tem
= *backlist
->args
;
3901 tem
= Flist (backlist
->nargs
, backlist
->args
);
3903 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3911 register struct backtrace
*backlist
;
3914 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3916 mark_object (*backlist
->function
);
3918 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
3921 i
= backlist
->nargs
- 1;
3923 mark_object (backlist
->args
[i
]);
3930 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3931 doc
: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3932 If Lisp code tries to increase the total number past this amount,
3933 an error is signaled.
3934 You can safely use a value considerably larger than the default value,
3935 if that proves inconveniently small. However, if you increase it too far,
3936 Emacs could run out of memory trying to make the stack bigger. */);
3938 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3939 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3941 This limit serves to catch infinite recursions for you before they cause
3942 actual stack overflow in C, which would be fatal for Emacs.
3943 You can safely make it considerably larger than its default value,
3944 if that proves inconveniently small. However, if you increase it too far,
3945 Emacs could overflow the real C stack, and crash. */);
3947 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3948 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3949 If the value is t, that means do an ordinary quit.
3950 If the value equals `throw-on-input', that means quit by throwing
3951 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3952 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3953 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3956 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3957 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3958 Note that `quit-flag' will still be set by typing C-g,
3959 so a quit will be signaled as soon as `inhibit-quit' is nil.
3960 To prevent this happening, set `quit-flag' to nil
3961 before making `inhibit-quit' nil. */);
3962 Vinhibit_quit
= Qnil
;
3964 Qinhibit_quit
= intern_c_string ("inhibit-quit");
3965 staticpro (&Qinhibit_quit
);
3967 Qautoload
= intern_c_string ("autoload");
3968 staticpro (&Qautoload
);
3970 Qdebug_on_error
= intern_c_string ("debug-on-error");
3971 staticpro (&Qdebug_on_error
);
3973 Qmacro
= intern_c_string ("macro");
3974 staticpro (&Qmacro
);
3976 Qdeclare
= intern_c_string ("declare");
3977 staticpro (&Qdeclare
);
3979 /* Note that the process handling also uses Qexit, but we don't want
3980 to staticpro it twice, so we just do it here. */
3981 Qexit
= intern_c_string ("exit");
3984 Qinteractive
= intern_c_string ("interactive");
3985 staticpro (&Qinteractive
);
3987 Qcommandp
= intern_c_string ("commandp");
3988 staticpro (&Qcommandp
);
3990 Qdefun
= intern_c_string ("defun");
3991 staticpro (&Qdefun
);
3993 Qand_rest
= intern_c_string ("&rest");
3994 staticpro (&Qand_rest
);
3996 Qand_optional
= intern_c_string ("&optional");
3997 staticpro (&Qand_optional
);
3999 Qclosure
= intern_c_string ("closure");
4000 staticpro (&Qclosure
);
4002 Qcurry
= intern_c_string ("curry");
4003 staticpro (&Qcurry
);
4005 Qunevalled
= intern_c_string ("unevalled");
4006 staticpro (&Qunevalled
);
4008 Qdebug
= intern_c_string ("debug");
4009 staticpro (&Qdebug
);
4011 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
4012 doc
: /* *Non-nil means errors display a backtrace buffer.
4013 More precisely, this happens for any error that is handled
4014 by the editor command loop.
4015 If the value is a list, an error only means to display a backtrace
4016 if one of its condition symbols appears in the list. */);
4017 Vstack_trace_on_error
= Qnil
;
4019 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
4020 doc
: /* *Non-nil means enter debugger if an error is signaled.
4021 Does not apply to errors handled by `condition-case' or those
4022 matched by `debug-ignored-errors'.
4023 If the value is a list, an error only means to enter the debugger
4024 if one of its condition symbols appears in the list.
4025 When you evaluate an expression interactively, this variable
4026 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
4027 The command `toggle-debug-on-error' toggles this.
4028 See also the variable `debug-on-quit'. */);
4029 Vdebug_on_error
= Qnil
;
4031 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
4032 doc
: /* *List of errors for which the debugger should not be called.
4033 Each element may be a condition-name or a regexp that matches error messages.
4034 If any element applies to a given error, that error skips the debugger
4035 and just returns to top level.
4036 This overrides the variable `debug-on-error'.
4037 It does not apply to errors handled by `condition-case'. */);
4038 Vdebug_ignored_errors
= Qnil
;
4040 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
4041 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
4042 Does not apply if quit is handled by a `condition-case'. */);
4045 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
4046 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
4048 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
4049 doc
: /* Non-nil means debugger may continue execution.
4050 This is nil when the debugger is called under circumstances where it
4051 might not be safe to continue. */);
4052 debugger_may_continue
= 1;
4054 DEFVAR_LISP ("debugger", &Vdebugger
,
4055 doc
: /* Function to call to invoke debugger.
4056 If due to frame exit, args are `exit' and the value being returned;
4057 this function's value will be returned instead of that.
4058 If due to error, args are `error' and a list of the args to `signal'.
4059 If due to `apply' or `funcall' entry, one arg, `lambda'.
4060 If due to `eval' entry, one arg, t. */);
4063 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
4064 doc
: /* If non-nil, this is a function for `signal' to call.
4065 It receives the same arguments that `signal' was given.
4066 The Edebug package uses this to regain control. */);
4067 Vsignal_hook_function
= Qnil
;
4069 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
4070 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
4071 Note that `debug-on-error', `debug-on-quit' and friends
4072 still determine whether to handle the particular condition. */);
4073 Vdebug_on_signal
= Qnil
;
4075 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
4076 doc
: /* Function to process declarations in a macro definition.
4077 The function will be called with two args MACRO and DECL.
4078 MACRO is the name of the macro being defined.
4079 DECL is a list `(declare ...)' containing the declarations.
4080 The value the function returns is not used. */);
4081 Vmacro_declaration_function
= Qnil
;
4083 Qinternal_interpreter_environment
4084 = intern_c_string ("internal-interpreter-environment");
4085 staticpro (&Qinternal_interpreter_environment
);
4086 DEFVAR_LISP ("internal-interpreter-environment",
4087 &Vinternal_interpreter_environment
,
4088 doc
: /* If non-nil, the current lexical environment of the lisp interpreter.
4089 When lexical binding is not being used, this variable is nil.
4090 A value of `(t)' indicates an empty environment, otherwise it is an
4091 alist of active lexical bindings. */);
4092 Vinternal_interpreter_environment
= Qnil
;
4094 Vrun_hooks
= intern_c_string ("run-hooks");
4095 staticpro (&Vrun_hooks
);
4097 staticpro (&Vautoload_queue
);
4098 Vautoload_queue
= Qnil
;
4099 staticpro (&Vsignaling_function
);
4100 Vsignaling_function
= Qnil
;
4111 defsubr (&Sfunction
);
4113 defsubr (&Sdefmacro
);
4115 defsubr (&Sdefvaralias
);
4116 defsubr (&Sdefconst
);
4117 defsubr (&Suser_variable_p
);
4121 defsubr (&Smacroexpand
);
4124 defsubr (&Sunwind_protect
);
4125 defsubr (&Scondition_case
);
4127 defsubr (&Sinteractive_p
);
4128 defsubr (&Scalled_interactively_p
);
4129 defsubr (&Scommandp
);
4130 defsubr (&Sautoload
);
4133 defsubr (&Sfuncall
);
4134 defsubr (&Srun_hooks
);
4135 defsubr (&Srun_hook_with_args
);
4136 defsubr (&Srun_hook_with_args_until_success
);
4137 defsubr (&Srun_hook_with_args_until_failure
);
4138 defsubr (&Sfetch_bytecode
);
4140 defsubr (&Sbacktrace_debug
);
4141 defsubr (&Sbacktrace
);
4142 defsubr (&Sbacktrace_frame
);
4144 defsubr (&Sspecialp
);
4145 defsubr (&Sfunctionp
);
4148 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
4149 (do not change this comment) */