1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include "blockinput.h"
28 #include "dispextern.h"
31 /* This definition is duplicated in alloc.c and keyboard.c */
32 /* Putting it in lisp.h makes cc bomb out! */
36 struct backtrace
*next
;
37 Lisp_Object
*function
;
38 Lisp_Object
*args
; /* Points to vector of args. */
39 int nargs
; /* Length of vector.
40 If nargs is UNEVALLED, args points to slot holding
41 list of unevalled args */
43 /* Nonzero means call value of debugger when done with this operation. */
47 struct backtrace
*backtrace_list
;
49 /* This structure helps implement the `catch' and `throw' control
50 structure. A struct catchtag contains all the information needed
51 to restore the state of the interpreter after a non-local jump.
53 Handlers for error conditions (represented by `struct handler'
54 structures) just point to a catch tag to do the cleanup required
57 catchtag structures are chained together in the C calling stack;
58 the `next' member points to the next outer catchtag.
60 A call like (throw TAG VAL) searches for a catchtag whose `tag'
61 member is TAG, and then unbinds to it. The `val' member is used to
62 hold VAL while the stack is unwound; `val' is returned as the value
65 All the other members are concerned with restoring the interpreter
72 struct catchtag
*next
;
75 struct backtrace
*backlist
;
76 struct handler
*handlerlist
;
79 int poll_suppress_count
;
80 struct byte_stack
*byte_stack
;
83 struct catchtag
*catchlist
;
86 /* Count levels of GCPRO to detect failure to UNGCPRO. */
90 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
;
91 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
92 Lisp_Object Qand_rest
, Qand_optional
;
93 Lisp_Object Qdebug_on_error
;
96 /* This holds either the symbol `run-hooks' or nil.
97 It is nil at an early stage of startup, and when Emacs
100 Lisp_Object Vrun_hooks
;
102 /* Non-nil means record all fset's and provide's, to be undone
103 if the file being autoloaded is not fully loaded.
104 They are recorded by being consed onto the front of Vautoload_queue:
105 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
107 Lisp_Object Vautoload_queue
;
109 /* Current number of specbindings allocated in specpdl. */
113 /* Pointer to beginning of specpdl. */
115 struct specbinding
*specpdl
;
117 /* Pointer to first unused element in specpdl. */
119 struct specbinding
*specpdl_ptr
;
121 /* Maximum size allowed for specpdl allocation */
123 EMACS_INT max_specpdl_size
;
125 /* Depth in Lisp evaluations and function calls. */
129 /* Maximum allowed depth in Lisp evaluations and function calls. */
131 EMACS_INT max_lisp_eval_depth
;
133 /* Nonzero means enter debugger before next function call */
135 int debug_on_next_call
;
137 /* Non-zero means debugger may continue. This is zero when the
138 debugger is called during redisplay, where it might not be safe to
139 continue the interrupted redisplay. */
141 int debugger_may_continue
;
143 /* List of conditions (non-nil atom means all) which cause a backtrace
144 if an error is handled by the command loop's error handler. */
146 Lisp_Object Vstack_trace_on_error
;
148 /* List of conditions (non-nil atom means all) which enter the debugger
149 if an error is handled by the command loop's error handler. */
151 Lisp_Object Vdebug_on_error
;
153 /* List of conditions and regexps specifying error messages which
154 do not enter the debugger even if Vdebug_on_error says they should. */
156 Lisp_Object Vdebug_ignored_errors
;
158 /* Non-nil means call the debugger even if the error will be handled. */
160 Lisp_Object Vdebug_on_signal
;
162 /* Hook for edebug to use. */
164 Lisp_Object Vsignal_hook_function
;
166 /* Nonzero means enter debugger if a quit signal
167 is handled by the command loop's error handler. */
171 /* The value of num_nonmacro_input_events as of the last time we
172 started to enter the debugger. If we decide to enter the debugger
173 again when this is still equal to num_nonmacro_input_events, then we
174 know that the debugger itself has an error, and we should just
175 signal the error instead of entering an infinite loop of debugger
178 int when_entered_debugger
;
180 Lisp_Object Vdebugger
;
182 /* The function from which the last `signal' was called. Set in
185 Lisp_Object Vsignaling_function
;
187 /* Set to non-zero while processing X events. Checked in Feval to
188 make sure the Lisp interpreter isn't called from a signal handler,
189 which is unsafe because the interpreter isn't reentrant. */
193 /* Function to process declarations in defmacro forms. */
195 Lisp_Object Vmacro_declaration_function
;
198 static Lisp_Object funcall_lambda
P_ ((Lisp_Object
, int, Lisp_Object
*));
204 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
205 specpdl_ptr
= specpdl
;
206 max_specpdl_size
= 600;
207 max_lisp_eval_depth
= 300;
215 specpdl_ptr
= specpdl
;
220 debug_on_next_call
= 0;
225 /* This is less than the initial value of num_nonmacro_input_events. */
226 when_entered_debugger
= -1;
233 int debug_while_redisplaying
;
234 int count
= SPECPDL_INDEX ();
237 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
238 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
240 if (specpdl_size
+ 40 > max_specpdl_size
)
241 max_specpdl_size
= specpdl_size
+ 40;
243 #ifdef HAVE_X_WINDOWS
244 if (display_hourglass_p
)
248 debug_on_next_call
= 0;
249 when_entered_debugger
= num_nonmacro_input_events
;
251 /* Resetting redisplaying_p to 0 makes sure that debug output is
252 displayed if the debugger is invoked during redisplay. */
253 debug_while_redisplaying
= redisplaying_p
;
255 specbind (intern ("debugger-may-continue"),
256 debug_while_redisplaying
? Qnil
: Qt
);
257 specbind (Qinhibit_redisplay
, Qnil
);
259 #if 0 /* Binding this prevents execution of Lisp code during
260 redisplay, which necessarily leads to display problems. */
261 specbind (Qinhibit_eval_during_redisplay
, Qt
);
264 val
= apply1 (Vdebugger
, arg
);
266 /* Interrupting redisplay and resuming it later is not safe under
267 all circumstances. So, when the debugger returns, abort the
268 interrupted redisplay by going back to the top-level. */
269 if (debug_while_redisplaying
)
272 return unbind_to (count
, val
);
276 do_debug_on_call (code
)
279 debug_on_next_call
= 0;
280 backtrace_list
->debug_on_exit
= 1;
281 call_debugger (Fcons (code
, Qnil
));
284 /* NOTE!!! Every function that can call EVAL must protect its args
285 and temporaries from garbage collection while it needs them.
286 The definition of `For' shows what you have to do. */
288 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
289 doc
: /* Eval args until one of them yields non-nil, then return that value.
290 The remaining args are not evalled at all.
291 If all args return nil, return nil.
292 usage: (or CONDITIONS ...) */)
296 register Lisp_Object val
;
297 Lisp_Object args_left
;
308 val
= Feval (Fcar (args_left
));
311 args_left
= Fcdr (args_left
);
313 while (!NILP(args_left
));
319 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
320 doc
: /* Eval args until one of them yields nil, then return nil.
321 The remaining args are not evalled at all.
322 If no arg yields nil, return the last arg's value.
323 usage: (and CONDITIONS ...) */)
327 register Lisp_Object val
;
328 Lisp_Object args_left
;
339 val
= Feval (Fcar (args_left
));
342 args_left
= Fcdr (args_left
);
344 while (!NILP(args_left
));
350 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
351 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
352 Returns the value of THEN or the value of the last of the ELSE's.
353 THEN must be one expression, but ELSE... can be zero or more expressions.
354 If COND yields nil, and there are no ELSE's, the value is nil.
355 usage: (if COND THEN ELSE...) */)
359 register Lisp_Object cond
;
363 cond
= Feval (Fcar (args
));
367 return Feval (Fcar (Fcdr (args
)));
368 return Fprogn (Fcdr (Fcdr (args
)));
371 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
372 doc
: /* Try each clause until one succeeds.
373 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
374 and, if the value is non-nil, this clause succeeds:
375 then the expressions in BODY are evaluated and the last one's
376 value is the value of the cond-form.
377 If no clause succeeds, cond returns nil.
378 If a clause has one element, as in (CONDITION),
379 CONDITION's value if non-nil is returned from the cond-form.
380 usage: (cond CLAUSES...) */)
384 register Lisp_Object clause
, val
;
391 clause
= Fcar (args
);
392 val
= Feval (Fcar (clause
));
395 if (!EQ (XCDR (clause
), Qnil
))
396 val
= Fprogn (XCDR (clause
));
406 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
407 doc
: /* Eval BODY forms sequentially and return value of last one.
408 usage: (progn BODY ...) */)
412 register Lisp_Object val
;
413 Lisp_Object args_left
;
424 val
= Feval (Fcar (args_left
));
425 args_left
= Fcdr (args_left
);
427 while (!NILP(args_left
));
433 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
434 doc
: /* Eval FIRST and BODY sequentially; value from FIRST.
435 The value of FIRST is saved during the evaluation of the remaining args,
436 whose values are discarded.
437 usage: (prog1 FIRST BODY...) */)
442 register Lisp_Object args_left
;
443 struct gcpro gcpro1
, gcpro2
;
444 register int argnum
= 0;
456 val
= Feval (Fcar (args_left
));
458 Feval (Fcar (args_left
));
459 args_left
= Fcdr (args_left
);
461 while (!NILP(args_left
));
467 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
468 doc
: /* Eval X, Y and BODY sequentially; value from Y.
469 The value of Y is saved during the evaluation of the remaining args,
470 whose values are discarded.
471 usage: (prog2 X Y BODY...) */)
476 register Lisp_Object args_left
;
477 struct gcpro gcpro1
, gcpro2
;
478 register int argnum
= -1;
492 val
= Feval (Fcar (args_left
));
494 Feval (Fcar (args_left
));
495 args_left
= Fcdr (args_left
);
497 while (!NILP (args_left
));
503 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
504 doc
: /* Set each SYM to the value of its VAL.
505 The symbols SYM are variables; they are literal (not evaluated).
506 The values VAL are expressions; they are evaluated.
507 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
508 The second VAL is not computed until after the first SYM is set, and so on;
509 each VAL can use the new value of variables set earlier in the `setq'.
510 The return value of the `setq' form is the value of the last VAL.
511 usage: (setq SYM VAL SYM VAL ...) */)
515 register Lisp_Object args_left
;
516 register Lisp_Object val
, sym
;
527 val
= Feval (Fcar (Fcdr (args_left
)));
528 sym
= Fcar (args_left
);
530 args_left
= Fcdr (Fcdr (args_left
));
532 while (!NILP(args_left
));
538 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
539 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
540 usage: (quote ARG) */)
547 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
548 doc
: /* Like `quote', but preferred for objects which are functions.
549 In byte compilation, `function' causes its argument to be compiled.
550 `quote' cannot do that.
551 usage: (function ARG) */)
559 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
560 doc
: /* Return t if function in which this appears was called interactively.
561 This means that the function was called with call-interactively (which
562 includes being called as the binding of a key)
563 and input is currently coming from the keyboard (not in keyboard macro). */)
566 return interactive_p (1) ? Qt
: Qnil
;
570 /* Return 1 if function in which this appears was called
571 interactively. This means that the function was called with
572 call-interactively (which includes being called as the binding of
573 a key) and input is currently coming from the keyboard (not in
576 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
577 called is a built-in. */
580 interactive_p (exclude_subrs_p
)
583 struct backtrace
*btp
;
589 btp
= backtrace_list
;
591 /* If this isn't a byte-compiled function, there may be a frame at
592 the top for Finteractive_p. If so, skip it. */
593 fun
= Findirect_function (*btp
->function
);
594 if (SUBRP (fun
) && XSUBR (fun
) == &Sinteractive_p
)
597 /* If we're running an Emacs 18-style byte-compiled function, there
598 may be a frame for Fbytecode. Now, given the strictest
599 definition, this function isn't really being called
600 interactively, but because that's the way Emacs 18 always builds
601 byte-compiled functions, we'll accept it for now. */
602 if (EQ (*btp
->function
, Qbytecode
))
605 /* If this isn't a byte-compiled function, then we may now be
606 looking at several frames for special forms. Skip past them. */
608 btp
->nargs
== UNEVALLED
)
611 /* btp now points at the frame of the innermost function that isn't
612 a special form, ignoring frames for Finteractive_p and/or
613 Fbytecode at the top. If this frame is for a built-in function
614 (such as load or eval-region) return nil. */
615 fun
= Findirect_function (*btp
->function
);
616 if (exclude_subrs_p
&& SUBRP (fun
))
619 /* btp points to the frame of a Lisp function that called interactive-p.
620 Return t if that function was called interactively. */
621 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
627 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
628 doc
: /* Define NAME as a function.
629 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
630 See also the function `interactive'.
631 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
635 register Lisp_Object fn_name
;
636 register Lisp_Object defn
;
638 fn_name
= Fcar (args
);
639 defn
= Fcons (Qlambda
, Fcdr (args
));
640 if (!NILP (Vpurify_flag
))
641 defn
= Fpurecopy (defn
);
642 Ffset (fn_name
, defn
);
643 LOADHIST_ATTACH (fn_name
);
647 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
648 doc
: /* Define NAME as a macro.
649 The actual definition looks like
650 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
651 When the macro is called, as in (NAME ARGS...),
652 the function (lambda ARGLIST BODY...) is applied to
653 the list ARGS... as it appears in the expression,
654 and the result should be a form to be evaluated instead of the original.
656 DECL is a declaration, optional, which can specify how to indent
657 calls to this macro and how Edebug should handle it. It looks like this:
659 The elements can look like this:
661 Set NAME's `lisp-indent-function' property to INDENT.
664 Set NAME's `edebug-form-spec' property to DEBUG. (This is
665 equivalent to writing a `def-edebug-spec' for the macro.
666 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
670 register Lisp_Object fn_name
;
671 register Lisp_Object defn
;
672 Lisp_Object lambda_list
, doc
, tail
;
674 fn_name
= Fcar (args
);
675 lambda_list
= Fcar (Fcdr (args
));
676 tail
= Fcdr (Fcdr (args
));
679 if (STRINGP (Fcar (tail
)))
685 while (CONSP (Fcar (tail
))
686 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
688 if (!NILP (Vmacro_declaration_function
))
692 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
700 tail
= Fcons (lambda_list
, tail
);
702 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
703 defn
= Fcons (Qmacro
, Fcons (Qlambda
, tail
));
705 if (!NILP (Vpurify_flag
))
706 defn
= Fpurecopy (defn
);
707 Ffset (fn_name
, defn
);
708 LOADHIST_ATTACH (fn_name
);
713 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
714 doc
: /* Make SYMBOL a variable alias for symbol ALIASED.
715 Setting the value of SYMBOL will subsequently set the value of ALIASED,
716 and getting the value of SYMBOL will return the value ALIASED has.
717 ALIASED nil means remove the alias; SYMBOL is unbound after that.
718 Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. */)
719 (symbol
, aliased
, docstring
)
720 Lisp_Object symbol
, aliased
, docstring
;
722 struct Lisp_Symbol
*sym
;
724 CHECK_SYMBOL (symbol
);
725 CHECK_SYMBOL (aliased
);
727 if (SYMBOL_CONSTANT_P (symbol
))
728 error ("Cannot make a constant an alias");
730 sym
= XSYMBOL (symbol
);
731 sym
->indirect_variable
= 1;
732 sym
->value
= aliased
;
733 sym
->constant
= SYMBOL_CONSTANT_P (aliased
);
734 LOADHIST_ATTACH (symbol
);
735 if (!NILP (docstring
))
736 Fput (symbol
, Qvariable_documentation
, docstring
);
742 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
743 doc
: /* Define SYMBOL as a variable.
744 You are not required to define a variable in order to use it,
745 but the definition can supply documentation and an initial value
746 in a way that tags can recognize.
748 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
749 If SYMBOL is buffer-local, its default value is what is set;
750 buffer-local values are not affected.
751 INITVALUE and DOCSTRING are optional.
752 If DOCSTRING starts with *, this variable is identified as a user option.
753 This means that M-x set-variable recognizes it.
754 See also `user-variable-p'.
755 If INITVALUE is missing, SYMBOL's value is not set.
756 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
760 register Lisp_Object sym
, tem
, tail
;
764 if (!NILP (Fcdr (Fcdr (tail
))))
765 error ("too many arguments");
767 tem
= Fdefault_boundp (sym
);
771 Fset_default (sym
, Feval (Fcar (tail
)));
773 if (!NILP (Fcar (tail
)))
776 if (!NILP (Vpurify_flag
))
777 tem
= Fpurecopy (tem
);
778 Fput (sym
, Qvariable_documentation
, tem
);
780 LOADHIST_ATTACH (sym
);
783 /* A (defvar <var>) should not take precedence in the load-history over
784 an earlier (defvar <var> <val>), so only add to history if the default
785 value is still unbound. */
787 LOADHIST_ATTACH (sym
);
792 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
793 doc
: /* Define SYMBOL as a constant variable.
794 The intent is that neither programs nor users should ever change this value.
795 Always sets the value of SYMBOL to the result of evalling INITVALUE.
796 If SYMBOL is buffer-local, its default value is what is set;
797 buffer-local values are not affected.
798 DOCSTRING is optional.
799 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
803 register Lisp_Object sym
, tem
;
806 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
807 error ("too many arguments");
809 tem
= Feval (Fcar (Fcdr (args
)));
810 if (!NILP (Vpurify_flag
))
811 tem
= Fpurecopy (tem
);
812 Fset_default (sym
, tem
);
813 tem
= Fcar (Fcdr (Fcdr (args
)));
816 if (!NILP (Vpurify_flag
))
817 tem
= Fpurecopy (tem
);
818 Fput (sym
, Qvariable_documentation
, tem
);
820 LOADHIST_ATTACH (sym
);
824 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
825 doc
: /* Returns t if VARIABLE is intended to be set and modified by users.
826 \(The alternative is a variable used internally in a Lisp program.)
827 Determined by whether the first character of the documentation
828 for the variable is `*' or if the variable is customizable (has a non-nil
829 value of any of `custom-type', `custom-loads' or `standard-value'
830 on its property list). */)
832 Lisp_Object variable
;
834 Lisp_Object documentation
;
836 if (!SYMBOLP (variable
))
839 documentation
= Fget (variable
, Qvariable_documentation
);
840 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
842 if (STRINGP (documentation
)
843 && ((unsigned char) SREF (documentation
, 0) == '*'))
845 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
846 if (CONSP (documentation
)
847 && STRINGP (XCAR (documentation
))
848 && INTEGERP (XCDR (documentation
))
849 && XINT (XCDR (documentation
)) < 0)
852 if ((!NILP (Fget (variable
, intern ("custom-type"))))
853 || (!NILP (Fget (variable
, intern ("custom-loads"))))
854 || (!NILP (Fget (variable
, intern ("standard-value")))))
859 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
860 doc
: /* Bind variables according to VARLIST then eval BODY.
861 The value of the last form in BODY is returned.
862 Each element of VARLIST is a symbol (which is bound to nil)
863 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
864 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
865 usage: (let* VARLIST BODY...) */)
869 Lisp_Object varlist
, val
, elt
;
870 int count
= SPECPDL_INDEX ();
871 struct gcpro gcpro1
, gcpro2
, gcpro3
;
873 GCPRO3 (args
, elt
, varlist
);
875 varlist
= Fcar (args
);
876 while (!NILP (varlist
))
879 elt
= Fcar (varlist
);
881 specbind (elt
, Qnil
);
882 else if (! NILP (Fcdr (Fcdr (elt
))))
884 Fcons (build_string ("`let' bindings can have only one value-form"),
888 val
= Feval (Fcar (Fcdr (elt
)));
889 specbind (Fcar (elt
), val
);
891 varlist
= Fcdr (varlist
);
894 val
= Fprogn (Fcdr (args
));
895 return unbind_to (count
, val
);
898 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
899 doc
: /* Bind variables according to VARLIST then eval BODY.
900 The value of the last form in BODY is returned.
901 Each element of VARLIST is a symbol (which is bound to nil)
902 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
903 All the VALUEFORMs are evalled before any symbols are bound.
904 usage: (let VARLIST BODY...) */)
908 Lisp_Object
*temps
, tem
;
909 register Lisp_Object elt
, varlist
;
910 int count
= SPECPDL_INDEX ();
912 struct gcpro gcpro1
, gcpro2
;
914 varlist
= Fcar (args
);
916 /* Make space to hold the values to give the bound variables */
917 elt
= Flength (varlist
);
918 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
920 /* Compute the values and store them in `temps' */
922 GCPRO2 (args
, *temps
);
925 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
928 elt
= Fcar (varlist
);
930 temps
[argnum
++] = Qnil
;
931 else if (! NILP (Fcdr (Fcdr (elt
))))
933 Fcons (build_string ("`let' bindings can have only one value-form"),
936 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
937 gcpro2
.nvars
= argnum
;
941 varlist
= Fcar (args
);
942 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
944 elt
= Fcar (varlist
);
945 tem
= temps
[argnum
++];
949 specbind (Fcar (elt
), tem
);
952 elt
= Fprogn (Fcdr (args
));
953 return unbind_to (count
, elt
);
956 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
957 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
958 The order of execution is thus TEST, BODY, TEST, BODY and so on
959 until TEST returns nil.
960 usage: (while TEST BODY...) */)
964 Lisp_Object test
, body
;
965 struct gcpro gcpro1
, gcpro2
;
971 while (!NILP (Feval (test
)))
981 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
982 doc
: /* Return result of expanding macros at top level of FORM.
983 If FORM is not a macro call, it is returned unchanged.
984 Otherwise, the macro is expanded and the expansion is considered
985 in place of FORM. When a non-macro-call results, it is returned.
987 The second optional arg ENVIRONMENT specifies an environment of macro
988 definitions to shadow the loaded ones for use in file byte-compilation. */)
991 Lisp_Object environment
;
993 /* With cleanups from Hallvard Furuseth. */
994 register Lisp_Object expander
, sym
, def
, tem
;
998 /* Come back here each time we expand a macro call,
999 in case it expands into another macro call. */
1002 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1003 def
= sym
= XCAR (form
);
1005 /* Trace symbols aliases to other symbols
1006 until we get a symbol that is not an alias. */
1007 while (SYMBOLP (def
))
1011 tem
= Fassq (sym
, environment
);
1014 def
= XSYMBOL (sym
)->function
;
1015 if (!EQ (def
, Qunbound
))
1020 /* Right now TEM is the result from SYM in ENVIRONMENT,
1021 and if TEM is nil then DEF is SYM's function definition. */
1024 /* SYM is not mentioned in ENVIRONMENT.
1025 Look at its function definition. */
1026 if (EQ (def
, Qunbound
) || !CONSP (def
))
1027 /* Not defined or definition not suitable */
1029 if (EQ (XCAR (def
), Qautoload
))
1031 /* Autoloading function: will it be a macro when loaded? */
1032 tem
= Fnth (make_number (4), def
);
1033 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1034 /* Yes, load it and try again. */
1036 struct gcpro gcpro1
;
1038 do_autoload (def
, sym
);
1045 else if (!EQ (XCAR (def
), Qmacro
))
1047 else expander
= XCDR (def
);
1051 expander
= XCDR (tem
);
1052 if (NILP (expander
))
1055 form
= apply1 (expander
, XCDR (form
));
1060 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1061 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1062 TAG is evalled to get the tag to use; it must not be nil.
1064 Then the BODY is executed.
1065 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1066 If no throw happens, `catch' returns the value of the last BODY form.
1067 If a throw happens, it specifies the value to return from `catch'.
1068 usage: (catch TAG BODY...) */)
1072 register Lisp_Object tag
;
1073 struct gcpro gcpro1
;
1076 tag
= Feval (Fcar (args
));
1078 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1081 /* Set up a catch, then call C function FUNC on argument ARG.
1082 FUNC should return a Lisp_Object.
1083 This is how catches are done from within C code. */
1086 internal_catch (tag
, func
, arg
)
1088 Lisp_Object (*func
) ();
1091 /* This structure is made part of the chain `catchlist'. */
1094 /* Fill in the components of c, and put it on the list. */
1098 c
.backlist
= backtrace_list
;
1099 c
.handlerlist
= handlerlist
;
1100 c
.lisp_eval_depth
= lisp_eval_depth
;
1101 c
.pdlcount
= SPECPDL_INDEX ();
1102 c
.poll_suppress_count
= poll_suppress_count
;
1103 c
.gcpro
= gcprolist
;
1104 c
.byte_stack
= byte_stack_list
;
1108 if (! _setjmp (c
.jmp
))
1109 c
.val
= (*func
) (arg
);
1111 /* Throw works by a longjmp that comes right here. */
1116 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1117 jump to that CATCH, returning VALUE as the value of that catch.
1119 This is the guts Fthrow and Fsignal; they differ only in the way
1120 they choose the catch tag to throw to. A catch tag for a
1121 condition-case form has a TAG of Qnil.
1123 Before each catch is discarded, unbind all special bindings and
1124 execute all unwind-protect clauses made above that catch. Unwind
1125 the handler stack as we go, so that the proper handlers are in
1126 effect for each unwind-protect clause we run. At the end, restore
1127 some static info saved in CATCH, and longjmp to the location
1130 This is used for correct unwinding in Fthrow and Fsignal. */
1133 unwind_to_catch (catch, value
)
1134 struct catchtag
*catch;
1137 register int last_time
;
1139 /* Save the value in the tag. */
1142 /* Restore the polling-suppression count. */
1143 set_poll_suppress_count (catch->poll_suppress_count
);
1147 last_time
= catchlist
== catch;
1149 /* Unwind the specpdl stack, and then restore the proper set of
1151 unbind_to (catchlist
->pdlcount
, Qnil
);
1152 handlerlist
= catchlist
->handlerlist
;
1153 catchlist
= catchlist
->next
;
1155 while (! last_time
);
1157 byte_stack_list
= catch->byte_stack
;
1158 gcprolist
= catch->gcpro
;
1161 gcpro_level
= gcprolist
->level
+ 1;
1165 backtrace_list
= catch->backlist
;
1166 lisp_eval_depth
= catch->lisp_eval_depth
;
1168 _longjmp (catch->jmp
, 1);
1171 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1172 doc
: /* Throw to the catch for TAG and return VALUE from it.
1173 Both TAG and VALUE are evalled. */)
1175 register Lisp_Object tag
, value
;
1177 register struct catchtag
*c
;
1182 for (c
= catchlist
; c
; c
= c
->next
)
1184 if (EQ (c
->tag
, tag
))
1185 unwind_to_catch (c
, value
);
1187 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1192 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1193 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1194 If BODYFORM completes normally, its value is returned
1195 after executing the UNWINDFORMS.
1196 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1197 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1202 int count
= SPECPDL_INDEX ();
1204 record_unwind_protect (0, Fcdr (args
));
1205 val
= Feval (Fcar (args
));
1206 return unbind_to (count
, val
);
1209 /* Chain of condition handlers currently in effect.
1210 The elements of this chain are contained in the stack frames
1211 of Fcondition_case and internal_condition_case.
1212 When an error is signaled (by calling Fsignal, below),
1213 this chain is searched for an element that applies. */
1215 struct handler
*handlerlist
;
1217 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1218 doc
: /* Regain control when an error is signaled.
1219 Executes BODYFORM and returns its value if no error happens.
1220 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1221 where the BODY is made of Lisp expressions.
1223 A handler is applicable to an error
1224 if CONDITION-NAME is one of the error's condition names.
1225 If an error happens, the first applicable handler is run.
1227 The car of a handler may be a list of condition names
1228 instead of a single condition name.
1230 When a handler handles an error,
1231 control returns to the condition-case and the handler BODY... is executed
1232 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1233 VAR may be nil; then you do not get access to the signal information.
1235 The value of the last BODY form is returned from the condition-case.
1236 See also the function `signal' for more info.
1237 usage: (condition-case VAR BODYFORM HANDLERS...) */)
1244 register Lisp_Object bodyform
, handlers
;
1245 volatile Lisp_Object var
;
1248 bodyform
= Fcar (Fcdr (args
));
1249 handlers
= Fcdr (Fcdr (args
));
1252 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1258 && (SYMBOLP (XCAR (tem
))
1259 || CONSP (XCAR (tem
))))))
1260 error ("Invalid condition handler", tem
);
1265 c
.backlist
= backtrace_list
;
1266 c
.handlerlist
= handlerlist
;
1267 c
.lisp_eval_depth
= lisp_eval_depth
;
1268 c
.pdlcount
= SPECPDL_INDEX ();
1269 c
.poll_suppress_count
= poll_suppress_count
;
1270 c
.gcpro
= gcprolist
;
1271 c
.byte_stack
= byte_stack_list
;
1272 if (_setjmp (c
.jmp
))
1275 specbind (h
.var
, c
.val
);
1276 val
= Fprogn (Fcdr (h
.chosen_clause
));
1278 /* Note that this just undoes the binding of h.var; whoever
1279 longjumped to us unwound the stack to c.pdlcount before
1281 unbind_to (c
.pdlcount
, Qnil
);
1288 h
.handler
= handlers
;
1289 h
.next
= handlerlist
;
1293 val
= Feval (bodyform
);
1295 handlerlist
= h
.next
;
1299 /* Call the function BFUN with no arguments, catching errors within it
1300 according to HANDLERS. If there is an error, call HFUN with
1301 one argument which is the data that describes the error:
1304 HANDLERS can be a list of conditions to catch.
1305 If HANDLERS is Qt, catch all errors.
1306 If HANDLERS is Qerror, catch all errors
1307 but allow the debugger to run if that is enabled. */
1310 internal_condition_case (bfun
, handlers
, hfun
)
1311 Lisp_Object (*bfun
) ();
1312 Lisp_Object handlers
;
1313 Lisp_Object (*hfun
) ();
1319 #if 0 /* Can't do this check anymore because realize_basic_faces has
1320 to BLOCK_INPUT, and can call Lisp. What's really needed is a
1321 flag indicating that we're currently handling a signal. */
1322 /* Since Fsignal resets this to 0, it had better be 0 now
1323 or else we have a potential bug. */
1324 if (interrupt_input_blocked
!= 0)
1330 c
.backlist
= backtrace_list
;
1331 c
.handlerlist
= handlerlist
;
1332 c
.lisp_eval_depth
= lisp_eval_depth
;
1333 c
.pdlcount
= SPECPDL_INDEX ();
1334 c
.poll_suppress_count
= poll_suppress_count
;
1335 c
.gcpro
= gcprolist
;
1336 c
.byte_stack
= byte_stack_list
;
1337 if (_setjmp (c
.jmp
))
1339 return (*hfun
) (c
.val
);
1343 h
.handler
= handlers
;
1345 h
.next
= handlerlist
;
1351 handlerlist
= h
.next
;
1355 /* Like internal_condition_case but call HFUN with ARG as its argument. */
1358 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1359 Lisp_Object (*bfun
) ();
1361 Lisp_Object handlers
;
1362 Lisp_Object (*hfun
) ();
1370 c
.backlist
= backtrace_list
;
1371 c
.handlerlist
= handlerlist
;
1372 c
.lisp_eval_depth
= lisp_eval_depth
;
1373 c
.pdlcount
= SPECPDL_INDEX ();
1374 c
.poll_suppress_count
= poll_suppress_count
;
1375 c
.gcpro
= gcprolist
;
1376 c
.byte_stack
= byte_stack_list
;
1377 if (_setjmp (c
.jmp
))
1379 return (*hfun
) (c
.val
);
1383 h
.handler
= handlers
;
1385 h
.next
= handlerlist
;
1389 val
= (*bfun
) (arg
);
1391 handlerlist
= h
.next
;
1396 /* Like internal_condition_case but call HFUN with NARGS as first,
1397 and ARGS as second argument. */
1400 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1401 Lisp_Object (*bfun
) ();
1404 Lisp_Object handlers
;
1405 Lisp_Object (*hfun
) ();
1413 c
.backlist
= backtrace_list
;
1414 c
.handlerlist
= handlerlist
;
1415 c
.lisp_eval_depth
= lisp_eval_depth
;
1416 c
.pdlcount
= SPECPDL_INDEX ();
1417 c
.poll_suppress_count
= poll_suppress_count
;
1418 c
.gcpro
= gcprolist
;
1419 c
.byte_stack
= byte_stack_list
;
1420 if (_setjmp (c
.jmp
))
1422 return (*hfun
) (c
.val
);
1426 h
.handler
= handlers
;
1428 h
.next
= handlerlist
;
1432 val
= (*bfun
) (nargs
, args
);
1434 handlerlist
= h
.next
;
1439 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1440 Lisp_Object
, Lisp_Object
,
1443 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1444 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1445 This function does not return.
1447 An error symbol is a symbol with an `error-conditions' property
1448 that is a list of condition names.
1449 A handler for any of those names will get to handle this signal.
1450 The symbol `error' should normally be one of them.
1452 DATA should be a list. Its elements are printed as part of the error message.
1453 If the signal is handled, DATA is made available to the handler.
1454 See also the function `condition-case'. */)
1455 (error_symbol
, data
)
1456 Lisp_Object error_symbol
, data
;
1458 /* When memory is full, ERROR-SYMBOL is nil,
1459 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1460 That is a special case--don't do this in other situations. */
1461 register struct handler
*allhandlers
= handlerlist
;
1462 Lisp_Object conditions
;
1463 extern int gc_in_progress
;
1464 extern int waiting_for_input
;
1465 Lisp_Object debugger_value
;
1467 Lisp_Object real_error_symbol
;
1468 struct backtrace
*bp
;
1470 immediate_quit
= handling_signal
= 0;
1471 if (gc_in_progress
|| waiting_for_input
)
1474 TOTALLY_UNBLOCK_INPUT
;
1476 if (NILP (error_symbol
))
1477 real_error_symbol
= Fcar (data
);
1479 real_error_symbol
= error_symbol
;
1481 #if 0 /* rms: I don't know why this was here,
1482 but it is surely wrong for an error that is handled. */
1483 #ifdef HAVE_X_WINDOWS
1484 if (display_hourglass_p
)
1485 cancel_hourglass ();
1489 /* This hook is used by edebug. */
1490 if (! NILP (Vsignal_hook_function
)
1491 && ! NILP (error_symbol
))
1492 call2 (Vsignal_hook_function
, error_symbol
, data
);
1494 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1496 /* Remember from where signal was called. Skip over the frame for
1497 `signal' itself. If a frame for `error' follows, skip that,
1498 too. Don't do this when ERROR_SYMBOL is nil, because that
1499 is a memory-full error. */
1500 Vsignaling_function
= Qnil
;
1501 if (backtrace_list
&& !NILP (error_symbol
))
1503 bp
= backtrace_list
->next
;
1504 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1506 if (bp
&& bp
->function
)
1507 Vsignaling_function
= *bp
->function
;
1510 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1512 register Lisp_Object clause
;
1514 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1515 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1517 if (specpdl_size
+ 40 > max_specpdl_size
)
1518 max_specpdl_size
= specpdl_size
+ 40;
1520 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1521 error_symbol
, data
, &debugger_value
);
1523 if (EQ (clause
, Qlambda
))
1525 /* We can't return values to code which signaled an error, but we
1526 can continue code which has signaled a quit. */
1527 if (EQ (real_error_symbol
, Qquit
))
1530 error ("Cannot return from the debugger in an error");
1535 Lisp_Object unwind_data
;
1536 struct handler
*h
= handlerlist
;
1538 handlerlist
= allhandlers
;
1540 if (NILP (error_symbol
))
1543 unwind_data
= Fcons (error_symbol
, data
);
1544 h
->chosen_clause
= clause
;
1545 unwind_to_catch (h
->tag
, unwind_data
);
1549 handlerlist
= allhandlers
;
1550 /* If no handler is present now, try to run the debugger,
1551 and if that fails, throw to top level. */
1552 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1554 Fthrow (Qtop_level
, Qt
);
1556 if (! NILP (error_symbol
))
1557 data
= Fcons (error_symbol
, data
);
1559 string
= Ferror_message_string (data
);
1560 fatal ("%s", SDATA (string
), 0);
1563 /* Return nonzero iff LIST is a non-nil atom or
1564 a list containing one of CONDITIONS. */
1567 wants_debugger (list
, conditions
)
1568 Lisp_Object list
, conditions
;
1575 while (CONSP (conditions
))
1577 Lisp_Object
this, tail
;
1578 this = XCAR (conditions
);
1579 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1580 if (EQ (XCAR (tail
), this))
1582 conditions
= XCDR (conditions
);
1587 /* Return 1 if an error with condition-symbols CONDITIONS,
1588 and described by SIGNAL-DATA, should skip the debugger
1589 according to debugger-ignored-errors. */
1592 skip_debugger (conditions
, data
)
1593 Lisp_Object conditions
, data
;
1596 int first_string
= 1;
1597 Lisp_Object error_message
;
1599 error_message
= Qnil
;
1600 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1602 if (STRINGP (XCAR (tail
)))
1606 error_message
= Ferror_message_string (data
);
1610 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1615 Lisp_Object contail
;
1617 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1618 if (EQ (XCAR (tail
), XCAR (contail
)))
1626 /* Value of Qlambda means we have called debugger and user has continued.
1627 There are two ways to pass SIG and DATA:
1628 = SIG is the error symbol, and DATA is the rest of the data.
1629 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1630 This is for memory-full errors only.
1632 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1635 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1636 Lisp_Object handlers
, conditions
, sig
, data
;
1637 Lisp_Object
*debugger_value_ptr
;
1639 register Lisp_Object h
;
1640 register Lisp_Object tem
;
1642 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1644 /* error is used similarly, but means print an error message
1645 and run the debugger if that is enabled. */
1646 if (EQ (handlers
, Qerror
)
1647 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1648 there is a handler. */
1650 int count
= SPECPDL_INDEX ();
1651 int debugger_called
= 0;
1652 Lisp_Object sig_symbol
, combined_data
;
1653 /* This is set to 1 if we are handling a memory-full error,
1654 because these must not run the debugger.
1655 (There is no room in memory to do that!) */
1656 int no_debugger
= 0;
1660 combined_data
= data
;
1661 sig_symbol
= Fcar (data
);
1666 combined_data
= Fcons (sig
, data
);
1670 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1673 internal_with_output_to_temp_buffer ("*Backtrace*",
1674 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1677 internal_with_output_to_temp_buffer ("*Backtrace*",
1682 && (EQ (sig_symbol
, Qquit
)
1684 : wants_debugger (Vdebug_on_error
, conditions
))
1685 && ! skip_debugger (conditions
, combined_data
)
1686 && when_entered_debugger
< num_nonmacro_input_events
)
1688 specbind (Qdebug_on_error
, Qnil
);
1690 = call_debugger (Fcons (Qerror
,
1691 Fcons (combined_data
, Qnil
)));
1692 debugger_called
= 1;
1694 /* If there is no handler, return saying whether we ran the debugger. */
1695 if (EQ (handlers
, Qerror
))
1697 if (debugger_called
)
1698 return unbind_to (count
, Qlambda
);
1702 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1704 Lisp_Object handler
, condit
;
1707 if (!CONSP (handler
))
1709 condit
= Fcar (handler
);
1710 /* Handle a single condition name in handler HANDLER. */
1711 if (SYMBOLP (condit
))
1713 tem
= Fmemq (Fcar (handler
), conditions
);
1717 /* Handle a list of condition names in handler HANDLER. */
1718 else if (CONSP (condit
))
1720 while (CONSP (condit
))
1722 tem
= Fmemq (Fcar (condit
), conditions
);
1725 condit
= XCDR (condit
);
1732 /* dump an error message; called like printf */
1736 error (m
, a1
, a2
, a3
)
1756 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1761 buffer
= (char *) xrealloc (buffer
, size
);
1764 buffer
= (char *) xmalloc (size
);
1769 string
= build_string (buffer
);
1773 Fsignal (Qerror
, Fcons (string
, Qnil
));
1777 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1778 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1779 This means it contains a description for how to read arguments to give it.
1780 The value is nil for an invalid function or a symbol with no function
1783 Interactively callable functions include strings and vectors (treated
1784 as keyboard macros), lambda-expressions that contain a top-level call
1785 to `interactive', autoload definitions made by `autoload' with non-nil
1786 fourth argument, and some of the built-in functions of Lisp.
1788 Also, a symbol satisfies `commandp' if its function definition does so.
1790 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1791 then strings and vectors are not accepted. */)
1792 (function
, for_call_interactively
)
1793 Lisp_Object function
, for_call_interactively
;
1795 register Lisp_Object fun
;
1796 register Lisp_Object funcar
;
1800 fun
= indirect_function (fun
);
1801 if (EQ (fun
, Qunbound
))
1804 /* Emacs primitives are interactive if their DEFUN specifies an
1805 interactive spec. */
1808 if (XSUBR (fun
)->prompt
)
1814 /* Bytecode objects are interactive if they are long enough to
1815 have an element whose index is COMPILED_INTERACTIVE, which is
1816 where the interactive spec is stored. */
1817 else if (COMPILEDP (fun
))
1818 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1821 /* Strings and vectors are keyboard macros. */
1822 if (NILP (for_call_interactively
) && (STRINGP (fun
) || VECTORP (fun
)))
1825 /* Lists may represent commands. */
1828 funcar
= Fcar (fun
);
1829 if (!SYMBOLP (funcar
))
1830 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1831 if (EQ (funcar
, Qlambda
))
1832 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1833 if (EQ (funcar
, Qautoload
))
1834 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1840 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1841 doc
: /* Define FUNCTION to autoload from FILE.
1842 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1843 Third arg DOCSTRING is documentation for the function.
1844 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1845 Fifth arg TYPE indicates the type of the object:
1846 nil or omitted says FUNCTION is a function,
1847 `keymap' says FUNCTION is really a keymap, and
1848 `macro' or t says FUNCTION is really a macro.
1849 Third through fifth args give info about the real definition.
1850 They default to nil.
1851 If FUNCTION is already defined other than as an autoload,
1852 this does nothing and returns nil. */)
1853 (function
, file
, docstring
, interactive
, type
)
1854 Lisp_Object function
, file
, docstring
, interactive
, type
;
1857 Lisp_Object args
[4];
1860 CHECK_SYMBOL (function
);
1861 CHECK_STRING (file
);
1863 /* If function is defined and not as an autoload, don't override */
1864 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1865 && !(CONSP (XSYMBOL (function
)->function
)
1866 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1869 if (NILP (Vpurify_flag
))
1870 /* Only add entries after dumping, because the ones before are
1871 not useful and else we get loads of them from the loaddefs.el. */
1872 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1876 args
[1] = docstring
;
1877 args
[2] = interactive
;
1880 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1881 #else /* NO_ARG_ARRAY */
1882 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1883 #endif /* not NO_ARG_ARRAY */
1887 un_autoload (oldqueue
)
1888 Lisp_Object oldqueue
;
1890 register Lisp_Object queue
, first
, second
;
1892 /* Queue to unwind is current value of Vautoload_queue.
1893 oldqueue is the shadowed value to leave in Vautoload_queue. */
1894 queue
= Vautoload_queue
;
1895 Vautoload_queue
= oldqueue
;
1896 while (CONSP (queue
))
1898 first
= Fcar (queue
);
1899 second
= Fcdr (first
);
1900 first
= Fcar (first
);
1901 if (EQ (second
, Qnil
))
1904 Ffset (first
, second
);
1905 queue
= Fcdr (queue
);
1910 /* Load an autoloaded function.
1911 FUNNAME is the symbol which is the function's name.
1912 FUNDEF is the autoload definition (a list). */
1915 do_autoload (fundef
, funname
)
1916 Lisp_Object fundef
, funname
;
1918 int count
= SPECPDL_INDEX ();
1919 Lisp_Object fun
, queue
, first
, second
;
1920 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1922 /* This is to make sure that loadup.el gives a clear picture
1923 of what files are preloaded and when. */
1924 if (! NILP (Vpurify_flag
))
1925 error ("Attempt to autoload %s while preparing to dump",
1926 SDATA (SYMBOL_NAME (funname
)));
1929 CHECK_SYMBOL (funname
);
1930 GCPRO3 (fun
, funname
, fundef
);
1932 /* Preserve the match data. */
1933 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1935 /* Value saved here is to be restored into Vautoload_queue. */
1936 record_unwind_protect (un_autoload
, Vautoload_queue
);
1937 Vautoload_queue
= Qt
;
1938 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1940 /* Save the old autoloads, in case we ever do an unload. */
1941 queue
= Vautoload_queue
;
1942 while (CONSP (queue
))
1944 first
= Fcar (queue
);
1945 second
= Fcdr (first
);
1946 first
= Fcar (first
);
1948 /* Note: This test is subtle. The cdr of an autoload-queue entry
1949 may be an atom if the autoload entry was generated by a defalias
1952 Fput (first
, Qautoload
, (Fcdr (second
)));
1954 queue
= Fcdr (queue
);
1957 /* Once loading finishes, don't undo it. */
1958 Vautoload_queue
= Qt
;
1959 unbind_to (count
, Qnil
);
1961 fun
= Findirect_function (fun
);
1963 if (!NILP (Fequal (fun
, fundef
)))
1964 error ("Autoloading failed to define function %s",
1965 SDATA (SYMBOL_NAME (funname
)));
1970 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1971 doc
: /* Evaluate FORM and return its value. */)
1975 Lisp_Object fun
, val
, original_fun
, original_args
;
1977 struct backtrace backtrace
;
1978 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1980 if (handling_signal
)
1984 return Fsymbol_value (form
);
1989 if (consing_since_gc
> gc_cons_threshold
)
1992 Fgarbage_collect ();
1996 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1998 if (max_lisp_eval_depth
< 100)
1999 max_lisp_eval_depth
= 100;
2000 if (lisp_eval_depth
> max_lisp_eval_depth
)
2001 error ("Lisp nesting exceeds max-lisp-eval-depth");
2004 original_fun
= Fcar (form
);
2005 original_args
= Fcdr (form
);
2007 backtrace
.next
= backtrace_list
;
2008 backtrace_list
= &backtrace
;
2009 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2010 backtrace
.args
= &original_args
;
2011 backtrace
.nargs
= UNEVALLED
;
2012 backtrace
.evalargs
= 1;
2013 backtrace
.debug_on_exit
= 0;
2015 if (debug_on_next_call
)
2016 do_debug_on_call (Qt
);
2018 /* At this point, only original_fun and original_args
2019 have values that will be used below */
2021 fun
= Findirect_function (original_fun
);
2025 Lisp_Object numargs
;
2026 Lisp_Object argvals
[8];
2027 Lisp_Object args_left
;
2028 register int i
, maxargs
;
2030 args_left
= original_args
;
2031 numargs
= Flength (args_left
);
2033 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2034 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2035 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2037 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2039 backtrace
.evalargs
= 0;
2040 val
= (*XSUBR (fun
)->function
) (args_left
);
2044 if (XSUBR (fun
)->max_args
== MANY
)
2046 /* Pass a vector of evaluated arguments */
2048 register int argnum
= 0;
2050 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2052 GCPRO3 (args_left
, fun
, fun
);
2056 while (!NILP (args_left
))
2058 vals
[argnum
++] = Feval (Fcar (args_left
));
2059 args_left
= Fcdr (args_left
);
2060 gcpro3
.nvars
= argnum
;
2063 backtrace
.args
= vals
;
2064 backtrace
.nargs
= XINT (numargs
);
2066 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2071 GCPRO3 (args_left
, fun
, fun
);
2072 gcpro3
.var
= argvals
;
2075 maxargs
= XSUBR (fun
)->max_args
;
2076 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2078 argvals
[i
] = Feval (Fcar (args_left
));
2084 backtrace
.args
= argvals
;
2085 backtrace
.nargs
= XINT (numargs
);
2090 val
= (*XSUBR (fun
)->function
) ();
2093 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2096 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2099 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2103 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2104 argvals
[2], argvals
[3]);
2107 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2108 argvals
[3], argvals
[4]);
2111 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2112 argvals
[3], argvals
[4], argvals
[5]);
2115 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2116 argvals
[3], argvals
[4], argvals
[5],
2121 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2122 argvals
[3], argvals
[4], argvals
[5],
2123 argvals
[6], argvals
[7]);
2127 /* Someone has created a subr that takes more arguments than
2128 is supported by this code. We need to either rewrite the
2129 subr to use a different argument protocol, or add more
2130 cases to this switch. */
2134 if (COMPILEDP (fun
))
2135 val
= apply_lambda (fun
, original_args
, 1);
2139 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2140 funcar
= Fcar (fun
);
2141 if (!SYMBOLP (funcar
))
2142 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2143 if (EQ (funcar
, Qautoload
))
2145 do_autoload (fun
, original_fun
);
2148 if (EQ (funcar
, Qmacro
))
2149 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2150 else if (EQ (funcar
, Qlambda
))
2151 val
= apply_lambda (fun
, original_args
, 1);
2153 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2157 if (backtrace
.debug_on_exit
)
2158 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2159 backtrace_list
= backtrace
.next
;
2163 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2164 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2165 Then return the value FUNCTION returns.
2166 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2167 usage: (apply FUNCTION &rest ARGUMENTS) */)
2172 register int i
, numargs
;
2173 register Lisp_Object spread_arg
;
2174 register Lisp_Object
*funcall_args
;
2176 struct gcpro gcpro1
;
2180 spread_arg
= args
[nargs
- 1];
2181 CHECK_LIST (spread_arg
);
2183 numargs
= XINT (Flength (spread_arg
));
2186 return Ffuncall (nargs
- 1, args
);
2187 else if (numargs
== 1)
2189 args
[nargs
- 1] = XCAR (spread_arg
);
2190 return Ffuncall (nargs
, args
);
2193 numargs
+= nargs
- 2;
2195 fun
= indirect_function (fun
);
2196 if (EQ (fun
, Qunbound
))
2198 /* Let funcall get the error */
2205 if (numargs
< XSUBR (fun
)->min_args
2206 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2207 goto funcall
; /* Let funcall get the error */
2208 else if (XSUBR (fun
)->max_args
> numargs
)
2210 /* Avoid making funcall cons up a yet another new vector of arguments
2211 by explicitly supplying nil's for optional values */
2212 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2213 * sizeof (Lisp_Object
));
2214 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2215 funcall_args
[++i
] = Qnil
;
2216 GCPRO1 (*funcall_args
);
2217 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2221 /* We add 1 to numargs because funcall_args includes the
2222 function itself as well as its arguments. */
2225 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2226 * sizeof (Lisp_Object
));
2227 GCPRO1 (*funcall_args
);
2228 gcpro1
.nvars
= 1 + numargs
;
2231 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2232 /* Spread the last arg we got. Its first element goes in
2233 the slot that it used to occupy, hence this value of I. */
2235 while (!NILP (spread_arg
))
2237 funcall_args
[i
++] = XCAR (spread_arg
);
2238 spread_arg
= XCDR (spread_arg
);
2241 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2244 /* Run hook variables in various ways. */
2246 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2247 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2248 enum run_hooks_condition
));
2250 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2251 doc
: /* Run each hook in HOOKS. Major mode functions use this.
2252 Each argument should be a symbol, a hook variable.
2253 These symbols are processed in the order specified.
2254 If a hook symbol has a non-nil value, that value may be a function
2255 or a list of functions to be called to run the hook.
2256 If the value is a function, it is called with no arguments.
2257 If it is a list, the elements are called, in order, with no arguments.
2259 Do not use `make-local-variable' to make a hook variable buffer-local.
2260 Instead, use `add-hook' and specify t for the LOCAL argument.
2261 usage: (run-hooks &rest HOOKS) */)
2266 Lisp_Object hook
[1];
2269 for (i
= 0; i
< nargs
; i
++)
2272 run_hook_with_args (1, hook
, to_completion
);
2278 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2279 Srun_hook_with_args
, 1, MANY
, 0,
2280 doc
: /* Run HOOK with the specified arguments ARGS.
2281 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2282 value, that value may be a function or a list of functions to be
2283 called to run the hook. If the value is a function, it is called with
2284 the given arguments and its return value is returned. If it is a list
2285 of functions, those functions are called, in order,
2286 with the given arguments ARGS.
2287 It is best not to depend on the value return by `run-hook-with-args',
2290 Do not use `make-local-variable' to make a hook variable buffer-local.
2291 Instead, use `add-hook' and specify t for the LOCAL argument.
2292 usage: (run-hook-with-args HOOK &rest ARGS) */)
2297 return run_hook_with_args (nargs
, args
, to_completion
);
2300 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2301 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2302 doc
: /* Run HOOK with the specified arguments ARGS.
2303 HOOK should be a symbol, a hook variable. Its value should
2304 be a list of functions. We call those functions, one by one,
2305 passing arguments ARGS to each of them, until one of them
2306 returns a non-nil value. Then we return that value.
2307 If all the functions return nil, we return nil.
2309 Do not use `make-local-variable' to make a hook variable buffer-local.
2310 Instead, use `add-hook' and specify t for the LOCAL argument.
2311 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2316 return run_hook_with_args (nargs
, args
, until_success
);
2319 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2320 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2321 doc
: /* Run HOOK with the specified arguments ARGS.
2322 HOOK should be a symbol, a hook variable. Its value should
2323 be a list of functions. We call those functions, one by one,
2324 passing arguments ARGS to each of them, until one of them
2325 returns nil. Then we return nil.
2326 If all the functions return non-nil, we return non-nil.
2328 Do not use `make-local-variable' to make a hook variable buffer-local.
2329 Instead, use `add-hook' and specify t for the LOCAL argument.
2330 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2335 return run_hook_with_args (nargs
, args
, until_failure
);
2338 /* ARGS[0] should be a hook symbol.
2339 Call each of the functions in the hook value, passing each of them
2340 as arguments all the rest of ARGS (all NARGS - 1 elements).
2341 COND specifies a condition to test after each call
2342 to decide whether to stop.
2343 The caller (or its caller, etc) must gcpro all of ARGS,
2344 except that it isn't necessary to gcpro ARGS[0]. */
2347 run_hook_with_args (nargs
, args
, cond
)
2350 enum run_hooks_condition cond
;
2352 Lisp_Object sym
, val
, ret
;
2353 Lisp_Object globals
;
2354 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2356 /* If we are dying or still initializing,
2357 don't do anything--it would probably crash if we tried. */
2358 if (NILP (Vrun_hooks
))
2362 val
= find_symbol_value (sym
);
2363 ret
= (cond
== until_failure
? Qt
: Qnil
);
2365 if (EQ (val
, Qunbound
) || NILP (val
))
2367 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2370 return Ffuncall (nargs
, args
);
2375 GCPRO3 (sym
, val
, globals
);
2378 CONSP (val
) && ((cond
== to_completion
)
2379 || (cond
== until_success
? NILP (ret
)
2383 if (EQ (XCAR (val
), Qt
))
2385 /* t indicates this hook has a local binding;
2386 it means to run the global binding too. */
2388 for (globals
= Fdefault_value (sym
);
2389 CONSP (globals
) && ((cond
== to_completion
)
2390 || (cond
== until_success
? NILP (ret
)
2392 globals
= XCDR (globals
))
2394 args
[0] = XCAR (globals
);
2395 /* In a global value, t should not occur. If it does, we
2396 must ignore it to avoid an endless loop. */
2397 if (!EQ (args
[0], Qt
))
2398 ret
= Ffuncall (nargs
, args
);
2403 args
[0] = XCAR (val
);
2404 ret
= Ffuncall (nargs
, args
);
2413 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2414 present value of that symbol.
2415 Call each element of FUNLIST,
2416 passing each of them the rest of ARGS.
2417 The caller (or its caller, etc) must gcpro all of ARGS,
2418 except that it isn't necessary to gcpro ARGS[0]. */
2421 run_hook_list_with_args (funlist
, nargs
, args
)
2422 Lisp_Object funlist
;
2428 Lisp_Object globals
;
2429 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2433 GCPRO3 (sym
, val
, globals
);
2435 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2437 if (EQ (XCAR (val
), Qt
))
2439 /* t indicates this hook has a local binding;
2440 it means to run the global binding too. */
2442 for (globals
= Fdefault_value (sym
);
2444 globals
= XCDR (globals
))
2446 args
[0] = XCAR (globals
);
2447 /* In a global value, t should not occur. If it does, we
2448 must ignore it to avoid an endless loop. */
2449 if (!EQ (args
[0], Qt
))
2450 Ffuncall (nargs
, args
);
2455 args
[0] = XCAR (val
);
2456 Ffuncall (nargs
, args
);
2463 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2466 run_hook_with_args_2 (hook
, arg1
, arg2
)
2467 Lisp_Object hook
, arg1
, arg2
;
2469 Lisp_Object temp
[3];
2474 Frun_hook_with_args (3, temp
);
2477 /* Apply fn to arg */
2480 Lisp_Object fn
, arg
;
2482 struct gcpro gcpro1
;
2486 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2490 Lisp_Object args
[2];
2494 RETURN_UNGCPRO (Fapply (2, args
));
2496 #else /* not NO_ARG_ARRAY */
2497 RETURN_UNGCPRO (Fapply (2, &fn
));
2498 #endif /* not NO_ARG_ARRAY */
2501 /* Call function fn on no arguments */
2506 struct gcpro gcpro1
;
2509 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2512 /* Call function fn with 1 argument arg1 */
2516 Lisp_Object fn
, arg1
;
2518 struct gcpro gcpro1
;
2520 Lisp_Object args
[2];
2526 RETURN_UNGCPRO (Ffuncall (2, args
));
2527 #else /* not NO_ARG_ARRAY */
2530 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2531 #endif /* not NO_ARG_ARRAY */
2534 /* Call function fn with 2 arguments arg1, arg2 */
2537 call2 (fn
, arg1
, arg2
)
2538 Lisp_Object fn
, arg1
, arg2
;
2540 struct gcpro gcpro1
;
2542 Lisp_Object args
[3];
2548 RETURN_UNGCPRO (Ffuncall (3, args
));
2549 #else /* not NO_ARG_ARRAY */
2552 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2553 #endif /* not NO_ARG_ARRAY */
2556 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2559 call3 (fn
, arg1
, arg2
, arg3
)
2560 Lisp_Object fn
, arg1
, arg2
, arg3
;
2562 struct gcpro gcpro1
;
2564 Lisp_Object args
[4];
2571 RETURN_UNGCPRO (Ffuncall (4, args
));
2572 #else /* not NO_ARG_ARRAY */
2575 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2576 #endif /* not NO_ARG_ARRAY */
2579 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2582 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2583 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2585 struct gcpro gcpro1
;
2587 Lisp_Object args
[5];
2595 RETURN_UNGCPRO (Ffuncall (5, args
));
2596 #else /* not NO_ARG_ARRAY */
2599 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2600 #endif /* not NO_ARG_ARRAY */
2603 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2606 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2607 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2609 struct gcpro gcpro1
;
2611 Lisp_Object args
[6];
2620 RETURN_UNGCPRO (Ffuncall (6, args
));
2621 #else /* not NO_ARG_ARRAY */
2624 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2625 #endif /* not NO_ARG_ARRAY */
2628 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2631 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2632 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2634 struct gcpro gcpro1
;
2636 Lisp_Object args
[7];
2646 RETURN_UNGCPRO (Ffuncall (7, args
));
2647 #else /* not NO_ARG_ARRAY */
2650 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2651 #endif /* not NO_ARG_ARRAY */
2654 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2655 doc
: /* Call first argument as a function, passing remaining arguments to it.
2656 Return the value that function returns.
2657 Thus, (funcall 'cons 'x 'y) returns (x . y).
2658 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2665 int numargs
= nargs
- 1;
2666 Lisp_Object lisp_numargs
;
2668 struct backtrace backtrace
;
2669 register Lisp_Object
*internal_args
;
2673 if (consing_since_gc
> gc_cons_threshold
)
2674 Fgarbage_collect ();
2676 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2678 if (max_lisp_eval_depth
< 100)
2679 max_lisp_eval_depth
= 100;
2680 if (lisp_eval_depth
> max_lisp_eval_depth
)
2681 error ("Lisp nesting exceeds max-lisp-eval-depth");
2684 backtrace
.next
= backtrace_list
;
2685 backtrace_list
= &backtrace
;
2686 backtrace
.function
= &args
[0];
2687 backtrace
.args
= &args
[1];
2688 backtrace
.nargs
= nargs
- 1;
2689 backtrace
.evalargs
= 0;
2690 backtrace
.debug_on_exit
= 0;
2692 if (debug_on_next_call
)
2693 do_debug_on_call (Qlambda
);
2699 fun
= Findirect_function (fun
);
2703 if (numargs
< XSUBR (fun
)->min_args
2704 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2706 XSETFASTINT (lisp_numargs
, numargs
);
2707 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2710 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2711 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2713 if (XSUBR (fun
)->max_args
== MANY
)
2715 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2719 if (XSUBR (fun
)->max_args
> numargs
)
2721 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2722 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2723 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2724 internal_args
[i
] = Qnil
;
2727 internal_args
= args
+ 1;
2728 switch (XSUBR (fun
)->max_args
)
2731 val
= (*XSUBR (fun
)->function
) ();
2734 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2737 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2741 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2745 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2750 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2751 internal_args
[2], internal_args
[3],
2755 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2756 internal_args
[2], internal_args
[3],
2757 internal_args
[4], internal_args
[5]);
2760 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2761 internal_args
[2], internal_args
[3],
2762 internal_args
[4], internal_args
[5],
2767 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2768 internal_args
[2], internal_args
[3],
2769 internal_args
[4], internal_args
[5],
2770 internal_args
[6], internal_args
[7]);
2775 /* If a subr takes more than 8 arguments without using MANY
2776 or UNEVALLED, we need to extend this function to support it.
2777 Until this is done, there is no way to call the function. */
2781 if (COMPILEDP (fun
))
2782 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2786 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2787 funcar
= Fcar (fun
);
2788 if (!SYMBOLP (funcar
))
2789 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2790 if (EQ (funcar
, Qlambda
))
2791 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2792 else if (EQ (funcar
, Qautoload
))
2794 do_autoload (fun
, args
[0]);
2798 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2802 if (backtrace
.debug_on_exit
)
2803 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2804 backtrace_list
= backtrace
.next
;
2809 apply_lambda (fun
, args
, eval_flag
)
2810 Lisp_Object fun
, args
;
2813 Lisp_Object args_left
;
2814 Lisp_Object numargs
;
2815 register Lisp_Object
*arg_vector
;
2816 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2818 register Lisp_Object tem
;
2820 numargs
= Flength (args
);
2821 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2824 GCPRO3 (*arg_vector
, args_left
, fun
);
2827 for (i
= 0; i
< XINT (numargs
);)
2829 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2830 if (eval_flag
) tem
= Feval (tem
);
2831 arg_vector
[i
++] = tem
;
2839 backtrace_list
->args
= arg_vector
;
2840 backtrace_list
->nargs
= i
;
2842 backtrace_list
->evalargs
= 0;
2843 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2845 /* Do the debug-on-exit now, while arg_vector still exists. */
2846 if (backtrace_list
->debug_on_exit
)
2847 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2848 /* Don't do it again when we return to eval. */
2849 backtrace_list
->debug_on_exit
= 0;
2853 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2854 and return the result of evaluation.
2855 FUN must be either a lambda-expression or a compiled-code object. */
2858 funcall_lambda (fun
, nargs
, arg_vector
)
2861 register Lisp_Object
*arg_vector
;
2863 Lisp_Object val
, syms_left
, next
;
2864 int count
= SPECPDL_INDEX ();
2865 int i
, optional
, rest
;
2869 syms_left
= XCDR (fun
);
2870 if (CONSP (syms_left
))
2871 syms_left
= XCAR (syms_left
);
2873 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2875 else if (COMPILEDP (fun
))
2876 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2880 i
= optional
= rest
= 0;
2881 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2885 next
= XCAR (syms_left
);
2886 while (!SYMBOLP (next
))
2887 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2889 if (EQ (next
, Qand_rest
))
2891 else if (EQ (next
, Qand_optional
))
2895 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2899 specbind (next
, arg_vector
[i
++]);
2901 return Fsignal (Qwrong_number_of_arguments
,
2902 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2904 specbind (next
, Qnil
);
2907 if (!NILP (syms_left
))
2908 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2910 return Fsignal (Qwrong_number_of_arguments
,
2911 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2914 val
= Fprogn (XCDR (XCDR (fun
)));
2917 /* If we have not actually read the bytecode string
2918 and constants vector yet, fetch them from the file. */
2919 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2920 Ffetch_bytecode (fun
);
2921 val
= Fbyte_code (AREF (fun
, COMPILED_BYTECODE
),
2922 AREF (fun
, COMPILED_CONSTANTS
),
2923 AREF (fun
, COMPILED_STACK_DEPTH
));
2926 return unbind_to (count
, val
);
2929 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2931 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2937 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2939 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2942 tem
= AREF (object
, COMPILED_BYTECODE
);
2943 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2944 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2946 error ("Invalid byte code");
2948 AREF (object
, COMPILED_BYTECODE
) = XCAR (tem
);
2949 AREF (object
, COMPILED_CONSTANTS
) = XCDR (tem
);
2957 register int count
= SPECPDL_INDEX ();
2958 if (specpdl_size
>= max_specpdl_size
)
2960 if (max_specpdl_size
< 400)
2961 max_specpdl_size
= 400;
2962 if (specpdl_size
>= max_specpdl_size
)
2964 if (!NILP (Vdebug_on_error
))
2965 /* Leave room for some specpdl in the debugger. */
2966 max_specpdl_size
= specpdl_size
+ 100;
2968 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2972 if (specpdl_size
> max_specpdl_size
)
2973 specpdl_size
= max_specpdl_size
;
2974 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2975 specpdl_ptr
= specpdl
+ count
;
2979 specbind (symbol
, value
)
2980 Lisp_Object symbol
, value
;
2983 Lisp_Object valcontents
;
2985 CHECK_SYMBOL (symbol
);
2986 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2989 /* The most common case is that of a non-constant symbol with a
2990 trivial value. Make that as fast as we can. */
2991 valcontents
= SYMBOL_VALUE (symbol
);
2992 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
2994 specpdl_ptr
->symbol
= symbol
;
2995 specpdl_ptr
->old_value
= valcontents
;
2996 specpdl_ptr
->func
= NULL
;
2998 SET_SYMBOL_VALUE (symbol
, value
);
3002 Lisp_Object valcontents
;
3004 ovalue
= find_symbol_value (symbol
);
3005 specpdl_ptr
->func
= 0;
3006 specpdl_ptr
->old_value
= ovalue
;
3008 valcontents
= XSYMBOL (symbol
)->value
;
3010 if (BUFFER_LOCAL_VALUEP (valcontents
)
3011 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
3012 || BUFFER_OBJFWDP (valcontents
))
3014 Lisp_Object where
, current_buffer
;
3016 current_buffer
= Fcurrent_buffer ();
3018 /* For a local variable, record both the symbol and which
3019 buffer's or frame's value we are saving. */
3020 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3021 where
= current_buffer
;
3022 else if (!BUFFER_OBJFWDP (valcontents
)
3023 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3024 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3028 /* We're not using the `unused' slot in the specbinding
3029 structure because this would mean we have to do more
3030 work for simple variables. */
3031 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3033 /* If SYMBOL is a per-buffer variable which doesn't have a
3034 buffer-local value here, make the `let' change the global
3035 value by changing the value of SYMBOL in all buffers not
3036 having their own value. This is consistent with what
3037 happens with other buffer-local variables. */
3039 && BUFFER_OBJFWDP (valcontents
))
3042 Fset_default (symbol
, value
);
3047 specpdl_ptr
->symbol
= symbol
;
3050 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3051 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3053 set_internal (symbol
, value
, 0, 1);
3058 record_unwind_protect (function
, arg
)
3059 Lisp_Object (*function
) P_ ((Lisp_Object
));
3062 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3064 specpdl_ptr
->func
= function
;
3065 specpdl_ptr
->symbol
= Qnil
;
3066 specpdl_ptr
->old_value
= arg
;
3071 unbind_to (count
, value
)
3075 int quitf
= !NILP (Vquit_flag
);
3076 struct gcpro gcpro1
;
3081 while (specpdl_ptr
!= specpdl
+ count
)
3085 if (specpdl_ptr
->func
!= 0)
3086 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
3087 /* Note that a "binding" of nil is really an unwind protect,
3088 so in that case the "old value" is a list of forms to evaluate. */
3089 else if (NILP (specpdl_ptr
->symbol
))
3090 Fprogn (specpdl_ptr
->old_value
);
3091 /* If the symbol is a list, it is really (SYMBOL WHERE
3092 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3093 frame. If WHERE is a buffer or frame, this indicates we
3094 bound a variable that had a buffer-local or frame-local
3095 binding. WHERE nil means that the variable had the default
3096 value when it was bound. CURRENT-BUFFER is the buffer that
3097 was current when the variable was bound. */
3098 else if (CONSP (specpdl_ptr
->symbol
))
3100 Lisp_Object symbol
, where
;
3102 symbol
= XCAR (specpdl_ptr
->symbol
);
3103 where
= XCAR (XCDR (specpdl_ptr
->symbol
));
3106 Fset_default (symbol
, specpdl_ptr
->old_value
);
3107 else if (BUFFERP (where
))
3108 set_internal (symbol
, specpdl_ptr
->old_value
, XBUFFER (where
), 1);
3110 set_internal (symbol
, specpdl_ptr
->old_value
, NULL
, 1);
3114 /* If variable has a trivial value (no forwarding), we can
3115 just set it. No need to check for constant symbols here,
3116 since that was already done by specbind. */
3117 if (!MISCP (SYMBOL_VALUE (specpdl_ptr
->symbol
)))
3118 SET_SYMBOL_VALUE (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
3120 set_internal (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
, 0, 1);
3124 if (NILP (Vquit_flag
) && quitf
)
3131 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3132 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3133 The debugger is entered when that frame exits, if the flag is non-nil. */)
3135 Lisp_Object level
, flag
;
3137 register struct backtrace
*backlist
= backtrace_list
;
3140 CHECK_NUMBER (level
);
3142 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3144 backlist
= backlist
->next
;
3148 backlist
->debug_on_exit
= !NILP (flag
);
3153 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3154 doc
: /* Print a trace of Lisp function calls currently active.
3155 Output stream used is value of `standard-output'. */)
3158 register struct backtrace
*backlist
= backtrace_list
;
3162 extern Lisp_Object Vprint_level
;
3163 struct gcpro gcpro1
;
3165 XSETFASTINT (Vprint_level
, 3);
3172 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3173 if (backlist
->nargs
== UNEVALLED
)
3175 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3176 write_string ("\n", -1);
3180 tem
= *backlist
->function
;
3181 Fprin1 (tem
, Qnil
); /* This can QUIT */
3182 write_string ("(", -1);
3183 if (backlist
->nargs
== MANY
)
3185 for (tail
= *backlist
->args
, i
= 0;
3187 tail
= Fcdr (tail
), i
++)
3189 if (i
) write_string (" ", -1);
3190 Fprin1 (Fcar (tail
), Qnil
);
3195 for (i
= 0; i
< backlist
->nargs
; i
++)
3197 if (i
) write_string (" ", -1);
3198 Fprin1 (backlist
->args
[i
], Qnil
);
3201 write_string (")\n", -1);
3203 backlist
= backlist
->next
;
3206 Vprint_level
= Qnil
;
3211 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3212 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3213 If that frame has not evaluated the arguments yet (or is a special form),
3214 the value is (nil FUNCTION ARG-FORMS...).
3215 If that frame has evaluated its arguments and called its function already,
3216 the value is (t FUNCTION ARG-VALUES...).
3217 A &rest arg is represented as the tail of the list ARG-VALUES.
3218 FUNCTION is whatever was supplied as car of evaluated list,
3219 or a lambda expression for macro calls.
3220 If NFRAMES is more than the number of frames, the value is nil. */)
3222 Lisp_Object nframes
;
3224 register struct backtrace
*backlist
= backtrace_list
;
3228 CHECK_NATNUM (nframes
);
3230 /* Find the frame requested. */
3231 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3232 backlist
= backlist
->next
;
3236 if (backlist
->nargs
== UNEVALLED
)
3237 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3240 if (backlist
->nargs
== MANY
)
3241 tem
= *backlist
->args
;
3243 tem
= Flist (backlist
->nargs
, backlist
->args
);
3245 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3253 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3254 doc
: /* *Limit on number of Lisp variable bindings & unwind-protects.
3255 If Lisp code tries to make more than this many at once,
3256 an error is signaled.
3257 You can safely use a value considerably larger than the default value,
3258 if that proves inconveniently small. However, if you increase it too far,
3259 Emacs could run out of memory trying to make the stack bigger. */);
3261 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3262 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3264 This limit serves to catch infinite recursions for you before they cause
3265 actual stack overflow in C, which would be fatal for Emacs.
3266 You can safely make it considerably larger than its default value,
3267 if that proves inconveniently small. However, if you increase it too far,
3268 Emacs could overflow the real C stack, and crash. */);
3270 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3271 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3272 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'. */);
3275 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3276 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3277 Note that `quit-flag' will still be set by typing C-g,
3278 so a quit will be signaled as soon as `inhibit-quit' is nil.
3279 To prevent this happening, set `quit-flag' to nil
3280 before making `inhibit-quit' nil. */);
3281 Vinhibit_quit
= Qnil
;
3283 Qinhibit_quit
= intern ("inhibit-quit");
3284 staticpro (&Qinhibit_quit
);
3286 Qautoload
= intern ("autoload");
3287 staticpro (&Qautoload
);
3289 Qdebug_on_error
= intern ("debug-on-error");
3290 staticpro (&Qdebug_on_error
);
3292 Qmacro
= intern ("macro");
3293 staticpro (&Qmacro
);
3295 Qdeclare
= intern ("declare");
3296 staticpro (&Qdeclare
);
3298 /* Note that the process handling also uses Qexit, but we don't want
3299 to staticpro it twice, so we just do it here. */
3300 Qexit
= intern ("exit");
3303 Qinteractive
= intern ("interactive");
3304 staticpro (&Qinteractive
);
3306 Qcommandp
= intern ("commandp");
3307 staticpro (&Qcommandp
);
3309 Qdefun
= intern ("defun");
3310 staticpro (&Qdefun
);
3312 Qand_rest
= intern ("&rest");
3313 staticpro (&Qand_rest
);
3315 Qand_optional
= intern ("&optional");
3316 staticpro (&Qand_optional
);
3318 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3319 doc
: /* *Non-nil means errors display a backtrace buffer.
3320 More precisely, this happens for any error that is handled
3321 by the editor command loop.
3322 If the value is a list, an error only means to display a backtrace
3323 if one of its condition symbols appears in the list. */);
3324 Vstack_trace_on_error
= Qnil
;
3326 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3327 doc
: /* *Non-nil means enter debugger if an error is signaled.
3328 Does not apply to errors handled by `condition-case' or those
3329 matched by `debug-ignored-errors'.
3330 If the value is a list, an error only means to enter the debugger
3331 if one of its condition symbols appears in the list.
3332 When you evaluate an expression interactively, this variable
3333 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3334 See also variable `debug-on-quit'. */);
3335 Vdebug_on_error
= Qnil
;
3337 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3338 doc
: /* *List of errors for which the debugger should not be called.
3339 Each element may be a condition-name or a regexp that matches error messages.
3340 If any element applies to a given error, that error skips the debugger
3341 and just returns to top level.
3342 This overrides the variable `debug-on-error'.
3343 It does not apply to errors handled by `condition-case'. */);
3344 Vdebug_ignored_errors
= Qnil
;
3346 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3347 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3348 Does not apply if quit is handled by a `condition-case'.
3349 When you evaluate an expression interactively, this variable
3350 is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil. */);
3353 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3354 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3356 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3357 doc
: /* Non-nil means debugger may continue execution.
3358 This is nil when the debugger is called under circumstances where it
3359 might not be safe to continue. */);
3360 debugger_may_continue
= 1;
3362 DEFVAR_LISP ("debugger", &Vdebugger
,
3363 doc
: /* Function to call to invoke debugger.
3364 If due to frame exit, args are `exit' and the value being returned;
3365 this function's value will be returned instead of that.
3366 If due to error, args are `error' and a list of the args to `signal'.
3367 If due to `apply' or `funcall' entry, one arg, `lambda'.
3368 If due to `eval' entry, one arg, t. */);
3371 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3372 doc
: /* If non-nil, this is a function for `signal' to call.
3373 It receives the same arguments that `signal' was given.
3374 The Edebug package uses this to regain control. */);
3375 Vsignal_hook_function
= Qnil
;
3377 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3378 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3379 Note that `debug-on-error', `debug-on-quit' and friends
3380 still determine whether to handle the particular condition. */);
3381 Vdebug_on_signal
= Qnil
;
3383 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3384 doc
: /* Function to process declarations in a macro definition.
3385 The function will be called with two args MACRO and DECL.
3386 MACRO is the name of the macro being defined.
3387 DECL is a list `(declare ...)' containing the declarations.
3388 The value the function returns is not used. */);
3389 Vmacro_declaration_function
= Qnil
;
3391 Vrun_hooks
= intern ("run-hooks");
3392 staticpro (&Vrun_hooks
);
3394 staticpro (&Vautoload_queue
);
3395 Vautoload_queue
= Qnil
;
3396 staticpro (&Vsignaling_function
);
3397 Vsignaling_function
= Qnil
;
3408 defsubr (&Sfunction
);
3410 defsubr (&Sdefmacro
);
3412 defsubr (&Sdefvaralias
);
3413 defsubr (&Sdefconst
);
3414 defsubr (&Suser_variable_p
);
3418 defsubr (&Smacroexpand
);
3421 defsubr (&Sunwind_protect
);
3422 defsubr (&Scondition_case
);
3424 defsubr (&Sinteractive_p
);
3425 defsubr (&Scommandp
);
3426 defsubr (&Sautoload
);
3429 defsubr (&Sfuncall
);
3430 defsubr (&Srun_hooks
);
3431 defsubr (&Srun_hook_with_args
);
3432 defsubr (&Srun_hook_with_args_until_success
);
3433 defsubr (&Srun_hook_with_args_until_failure
);
3434 defsubr (&Sfetch_bytecode
);
3435 defsubr (&Sbacktrace_debug
);
3436 defsubr (&Sbacktrace
);
3437 defsubr (&Sbacktrace_frame
);