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
, Qdefvar
;
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 (Fcons (Qdefvar
, 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 (Fcons (Qdefvar
, sym
));
783 /* Simple (defvar <var>) should not count as a definition at all.
784 It could get in the way of other definitions, and unloading this
785 package could try to make the variable unbound. */
790 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
791 doc
: /* Define SYMBOL as a constant variable.
792 The intent is that neither programs nor users should ever change this value.
793 Always sets the value of SYMBOL to the result of evalling INITVALUE.
794 If SYMBOL is buffer-local, its default value is what is set;
795 buffer-local values are not affected.
796 DOCSTRING is optional.
797 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
801 register Lisp_Object sym
, tem
;
804 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
805 error ("too many arguments");
807 tem
= Feval (Fcar (Fcdr (args
)));
808 if (!NILP (Vpurify_flag
))
809 tem
= Fpurecopy (tem
);
810 Fset_default (sym
, tem
);
811 tem
= Fcar (Fcdr (Fcdr (args
)));
814 if (!NILP (Vpurify_flag
))
815 tem
= Fpurecopy (tem
);
816 Fput (sym
, Qvariable_documentation
, tem
);
818 LOADHIST_ATTACH (Fcons (Qdefvar
, sym
));
822 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
823 doc
: /* Returns t if VARIABLE is intended to be set and modified by users.
824 \(The alternative is a variable used internally in a Lisp program.)
825 Determined by whether the first character of the documentation
826 for the variable is `*' or if the variable is customizable (has a non-nil
827 value of any of `custom-type', `custom-loads' or `standard-value'
828 on its property list). */)
830 Lisp_Object variable
;
832 Lisp_Object documentation
;
834 if (!SYMBOLP (variable
))
837 documentation
= Fget (variable
, Qvariable_documentation
);
838 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
840 if (STRINGP (documentation
)
841 && ((unsigned char) SREF (documentation
, 0) == '*'))
843 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
844 if (CONSP (documentation
)
845 && STRINGP (XCAR (documentation
))
846 && INTEGERP (XCDR (documentation
))
847 && XINT (XCDR (documentation
)) < 0)
850 if ((!NILP (Fget (variable
, intern ("custom-type"))))
851 || (!NILP (Fget (variable
, intern ("custom-loads"))))
852 || (!NILP (Fget (variable
, intern ("standard-value")))))
857 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
858 doc
: /* Bind variables according to VARLIST then eval BODY.
859 The value of the last form in BODY is returned.
860 Each element of VARLIST is a symbol (which is bound to nil)
861 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
862 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
863 usage: (let* VARLIST BODY...) */)
867 Lisp_Object varlist
, val
, elt
;
868 int count
= SPECPDL_INDEX ();
869 struct gcpro gcpro1
, gcpro2
, gcpro3
;
871 GCPRO3 (args
, elt
, varlist
);
873 varlist
= Fcar (args
);
874 while (!NILP (varlist
))
877 elt
= Fcar (varlist
);
879 specbind (elt
, Qnil
);
880 else if (! NILP (Fcdr (Fcdr (elt
))))
882 Fcons (build_string ("`let' bindings can have only one value-form"),
886 val
= Feval (Fcar (Fcdr (elt
)));
887 specbind (Fcar (elt
), val
);
889 varlist
= Fcdr (varlist
);
892 val
= Fprogn (Fcdr (args
));
893 return unbind_to (count
, val
);
896 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
897 doc
: /* Bind variables according to VARLIST then eval BODY.
898 The value of the last form in BODY is returned.
899 Each element of VARLIST is a symbol (which is bound to nil)
900 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
901 All the VALUEFORMs are evalled before any symbols are bound.
902 usage: (let VARLIST BODY...) */)
906 Lisp_Object
*temps
, tem
;
907 register Lisp_Object elt
, varlist
;
908 int count
= SPECPDL_INDEX ();
910 struct gcpro gcpro1
, gcpro2
;
912 varlist
= Fcar (args
);
914 /* Make space to hold the values to give the bound variables */
915 elt
= Flength (varlist
);
916 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
918 /* Compute the values and store them in `temps' */
920 GCPRO2 (args
, *temps
);
923 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
926 elt
= Fcar (varlist
);
928 temps
[argnum
++] = Qnil
;
929 else if (! NILP (Fcdr (Fcdr (elt
))))
931 Fcons (build_string ("`let' bindings can have only one value-form"),
934 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
935 gcpro2
.nvars
= argnum
;
939 varlist
= Fcar (args
);
940 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
942 elt
= Fcar (varlist
);
943 tem
= temps
[argnum
++];
947 specbind (Fcar (elt
), tem
);
950 elt
= Fprogn (Fcdr (args
));
951 return unbind_to (count
, elt
);
954 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
955 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
956 The order of execution is thus TEST, BODY, TEST, BODY and so on
957 until TEST returns nil.
958 usage: (while TEST BODY...) */)
962 Lisp_Object test
, body
;
963 struct gcpro gcpro1
, gcpro2
;
969 while (!NILP (Feval (test
)))
979 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
980 doc
: /* Return result of expanding macros at top level of FORM.
981 If FORM is not a macro call, it is returned unchanged.
982 Otherwise, the macro is expanded and the expansion is considered
983 in place of FORM. When a non-macro-call results, it is returned.
985 The second optional arg ENVIRONMENT specifies an environment of macro
986 definitions to shadow the loaded ones for use in file byte-compilation. */)
989 Lisp_Object environment
;
991 /* With cleanups from Hallvard Furuseth. */
992 register Lisp_Object expander
, sym
, def
, tem
;
996 /* Come back here each time we expand a macro call,
997 in case it expands into another macro call. */
1000 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1001 def
= sym
= XCAR (form
);
1003 /* Trace symbols aliases to other symbols
1004 until we get a symbol that is not an alias. */
1005 while (SYMBOLP (def
))
1009 tem
= Fassq (sym
, environment
);
1012 def
= XSYMBOL (sym
)->function
;
1013 if (!EQ (def
, Qunbound
))
1018 /* Right now TEM is the result from SYM in ENVIRONMENT,
1019 and if TEM is nil then DEF is SYM's function definition. */
1022 /* SYM is not mentioned in ENVIRONMENT.
1023 Look at its function definition. */
1024 if (EQ (def
, Qunbound
) || !CONSP (def
))
1025 /* Not defined or definition not suitable */
1027 if (EQ (XCAR (def
), Qautoload
))
1029 /* Autoloading function: will it be a macro when loaded? */
1030 tem
= Fnth (make_number (4), def
);
1031 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1032 /* Yes, load it and try again. */
1034 struct gcpro gcpro1
;
1036 do_autoload (def
, sym
);
1043 else if (!EQ (XCAR (def
), Qmacro
))
1045 else expander
= XCDR (def
);
1049 expander
= XCDR (tem
);
1050 if (NILP (expander
))
1053 form
= apply1 (expander
, XCDR (form
));
1058 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1059 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1060 TAG is evalled to get the tag to use; it must not be nil.
1062 Then the BODY is executed.
1063 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1064 If no throw happens, `catch' returns the value of the last BODY form.
1065 If a throw happens, it specifies the value to return from `catch'.
1066 usage: (catch TAG BODY...) */)
1070 register Lisp_Object tag
;
1071 struct gcpro gcpro1
;
1074 tag
= Feval (Fcar (args
));
1076 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1079 /* Set up a catch, then call C function FUNC on argument ARG.
1080 FUNC should return a Lisp_Object.
1081 This is how catches are done from within C code. */
1084 internal_catch (tag
, func
, arg
)
1086 Lisp_Object (*func
) ();
1089 /* This structure is made part of the chain `catchlist'. */
1092 /* Fill in the components of c, and put it on the list. */
1096 c
.backlist
= backtrace_list
;
1097 c
.handlerlist
= handlerlist
;
1098 c
.lisp_eval_depth
= lisp_eval_depth
;
1099 c
.pdlcount
= SPECPDL_INDEX ();
1100 c
.poll_suppress_count
= poll_suppress_count
;
1101 c
.gcpro
= gcprolist
;
1102 c
.byte_stack
= byte_stack_list
;
1106 if (! _setjmp (c
.jmp
))
1107 c
.val
= (*func
) (arg
);
1109 /* Throw works by a longjmp that comes right here. */
1114 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1115 jump to that CATCH, returning VALUE as the value of that catch.
1117 This is the guts Fthrow and Fsignal; they differ only in the way
1118 they choose the catch tag to throw to. A catch tag for a
1119 condition-case form has a TAG of Qnil.
1121 Before each catch is discarded, unbind all special bindings and
1122 execute all unwind-protect clauses made above that catch. Unwind
1123 the handler stack as we go, so that the proper handlers are in
1124 effect for each unwind-protect clause we run. At the end, restore
1125 some static info saved in CATCH, and longjmp to the location
1128 This is used for correct unwinding in Fthrow and Fsignal. */
1131 unwind_to_catch (catch, value
)
1132 struct catchtag
*catch;
1135 register int last_time
;
1137 /* Save the value in the tag. */
1140 /* Restore the polling-suppression count. */
1141 set_poll_suppress_count (catch->poll_suppress_count
);
1145 last_time
= catchlist
== catch;
1147 /* Unwind the specpdl stack, and then restore the proper set of
1149 unbind_to (catchlist
->pdlcount
, Qnil
);
1150 handlerlist
= catchlist
->handlerlist
;
1151 catchlist
= catchlist
->next
;
1153 while (! last_time
);
1155 byte_stack_list
= catch->byte_stack
;
1156 gcprolist
= catch->gcpro
;
1159 gcpro_level
= gcprolist
->level
+ 1;
1163 backtrace_list
= catch->backlist
;
1164 lisp_eval_depth
= catch->lisp_eval_depth
;
1166 _longjmp (catch->jmp
, 1);
1169 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1170 doc
: /* Throw to the catch for TAG and return VALUE from it.
1171 Both TAG and VALUE are evalled. */)
1173 register Lisp_Object tag
, value
;
1175 register struct catchtag
*c
;
1180 for (c
= catchlist
; c
; c
= c
->next
)
1182 if (EQ (c
->tag
, tag
))
1183 unwind_to_catch (c
, value
);
1185 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1190 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1191 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1192 If BODYFORM completes normally, its value is returned
1193 after executing the UNWINDFORMS.
1194 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1195 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1200 int count
= SPECPDL_INDEX ();
1202 record_unwind_protect (0, Fcdr (args
));
1203 val
= Feval (Fcar (args
));
1204 return unbind_to (count
, val
);
1207 /* Chain of condition handlers currently in effect.
1208 The elements of this chain are contained in the stack frames
1209 of Fcondition_case and internal_condition_case.
1210 When an error is signaled (by calling Fsignal, below),
1211 this chain is searched for an element that applies. */
1213 struct handler
*handlerlist
;
1215 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1216 doc
: /* Regain control when an error is signaled.
1217 Executes BODYFORM and returns its value if no error happens.
1218 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1219 where the BODY is made of Lisp expressions.
1221 A handler is applicable to an error
1222 if CONDITION-NAME is one of the error's condition names.
1223 If an error happens, the first applicable handler is run.
1225 The car of a handler may be a list of condition names
1226 instead of a single condition name.
1228 When a handler handles an error,
1229 control returns to the condition-case and the handler BODY... is executed
1230 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1231 VAR may be nil; then you do not get access to the signal information.
1233 The value of the last BODY form is returned from the condition-case.
1234 See also the function `signal' for more info.
1235 usage: (condition-case VAR BODYFORM HANDLERS...) */)
1242 register Lisp_Object bodyform
, handlers
;
1243 volatile Lisp_Object var
;
1246 bodyform
= Fcar (Fcdr (args
));
1247 handlers
= Fcdr (Fcdr (args
));
1250 for (val
= handlers
; ! NILP (val
); val
= Fcdr (val
))
1256 && (SYMBOLP (XCAR (tem
))
1257 || CONSP (XCAR (tem
))))))
1258 error ("Invalid condition handler", tem
);
1263 c
.backlist
= backtrace_list
;
1264 c
.handlerlist
= handlerlist
;
1265 c
.lisp_eval_depth
= lisp_eval_depth
;
1266 c
.pdlcount
= SPECPDL_INDEX ();
1267 c
.poll_suppress_count
= poll_suppress_count
;
1268 c
.gcpro
= gcprolist
;
1269 c
.byte_stack
= byte_stack_list
;
1270 if (_setjmp (c
.jmp
))
1273 specbind (h
.var
, c
.val
);
1274 val
= Fprogn (Fcdr (h
.chosen_clause
));
1276 /* Note that this just undoes the binding of h.var; whoever
1277 longjumped to us unwound the stack to c.pdlcount before
1279 unbind_to (c
.pdlcount
, Qnil
);
1286 h
.handler
= handlers
;
1287 h
.next
= handlerlist
;
1291 val
= Feval (bodyform
);
1293 handlerlist
= h
.next
;
1297 /* Call the function BFUN with no arguments, catching errors within it
1298 according to HANDLERS. If there is an error, call HFUN with
1299 one argument which is the data that describes the error:
1302 HANDLERS can be a list of conditions to catch.
1303 If HANDLERS is Qt, catch all errors.
1304 If HANDLERS is Qerror, catch all errors
1305 but allow the debugger to run if that is enabled. */
1308 internal_condition_case (bfun
, handlers
, hfun
)
1309 Lisp_Object (*bfun
) ();
1310 Lisp_Object handlers
;
1311 Lisp_Object (*hfun
) ();
1317 #if 0 /* Can't do this check anymore because realize_basic_faces has
1318 to BLOCK_INPUT, and can call Lisp. What's really needed is a
1319 flag indicating that we're currently handling a signal. */
1320 /* Since Fsignal resets this to 0, it had better be 0 now
1321 or else we have a potential bug. */
1322 if (interrupt_input_blocked
!= 0)
1328 c
.backlist
= backtrace_list
;
1329 c
.handlerlist
= handlerlist
;
1330 c
.lisp_eval_depth
= lisp_eval_depth
;
1331 c
.pdlcount
= SPECPDL_INDEX ();
1332 c
.poll_suppress_count
= poll_suppress_count
;
1333 c
.gcpro
= gcprolist
;
1334 c
.byte_stack
= byte_stack_list
;
1335 if (_setjmp (c
.jmp
))
1337 return (*hfun
) (c
.val
);
1341 h
.handler
= handlers
;
1343 h
.next
= handlerlist
;
1349 handlerlist
= h
.next
;
1353 /* Like internal_condition_case but call HFUN with ARG as its argument. */
1356 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1357 Lisp_Object (*bfun
) ();
1359 Lisp_Object handlers
;
1360 Lisp_Object (*hfun
) ();
1368 c
.backlist
= backtrace_list
;
1369 c
.handlerlist
= handlerlist
;
1370 c
.lisp_eval_depth
= lisp_eval_depth
;
1371 c
.pdlcount
= SPECPDL_INDEX ();
1372 c
.poll_suppress_count
= poll_suppress_count
;
1373 c
.gcpro
= gcprolist
;
1374 c
.byte_stack
= byte_stack_list
;
1375 if (_setjmp (c
.jmp
))
1377 return (*hfun
) (c
.val
);
1381 h
.handler
= handlers
;
1383 h
.next
= handlerlist
;
1387 val
= (*bfun
) (arg
);
1389 handlerlist
= h
.next
;
1394 /* Like internal_condition_case but call HFUN with NARGS as first,
1395 and ARGS as second argument. */
1398 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1399 Lisp_Object (*bfun
) ();
1402 Lisp_Object handlers
;
1403 Lisp_Object (*hfun
) ();
1411 c
.backlist
= backtrace_list
;
1412 c
.handlerlist
= handlerlist
;
1413 c
.lisp_eval_depth
= lisp_eval_depth
;
1414 c
.pdlcount
= SPECPDL_INDEX ();
1415 c
.poll_suppress_count
= poll_suppress_count
;
1416 c
.gcpro
= gcprolist
;
1417 c
.byte_stack
= byte_stack_list
;
1418 if (_setjmp (c
.jmp
))
1420 return (*hfun
) (c
.val
);
1424 h
.handler
= handlers
;
1426 h
.next
= handlerlist
;
1430 val
= (*bfun
) (nargs
, args
);
1432 handlerlist
= h
.next
;
1437 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1438 Lisp_Object
, Lisp_Object
,
1441 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1442 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1443 This function does not return.
1445 An error symbol is a symbol with an `error-conditions' property
1446 that is a list of condition names.
1447 A handler for any of those names will get to handle this signal.
1448 The symbol `error' should normally be one of them.
1450 DATA should be a list. Its elements are printed as part of the error message.
1451 If the signal is handled, DATA is made available to the handler.
1452 See also the function `condition-case'. */)
1453 (error_symbol
, data
)
1454 Lisp_Object error_symbol
, data
;
1456 /* When memory is full, ERROR-SYMBOL is nil,
1457 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1458 That is a special case--don't do this in other situations. */
1459 register struct handler
*allhandlers
= handlerlist
;
1460 Lisp_Object conditions
;
1461 extern int gc_in_progress
;
1462 extern int waiting_for_input
;
1463 Lisp_Object debugger_value
;
1465 Lisp_Object real_error_symbol
;
1466 struct backtrace
*bp
;
1468 immediate_quit
= handling_signal
= 0;
1469 if (gc_in_progress
|| waiting_for_input
)
1472 TOTALLY_UNBLOCK_INPUT
;
1474 if (NILP (error_symbol
))
1475 real_error_symbol
= Fcar (data
);
1477 real_error_symbol
= error_symbol
;
1479 #if 0 /* rms: I don't know why this was here,
1480 but it is surely wrong for an error that is handled. */
1481 #ifdef HAVE_X_WINDOWS
1482 if (display_hourglass_p
)
1483 cancel_hourglass ();
1487 /* This hook is used by edebug. */
1488 if (! NILP (Vsignal_hook_function
)
1489 && ! NILP (error_symbol
))
1490 call2 (Vsignal_hook_function
, error_symbol
, data
);
1492 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1494 /* Remember from where signal was called. Skip over the frame for
1495 `signal' itself. If a frame for `error' follows, skip that,
1496 too. Don't do this when ERROR_SYMBOL is nil, because that
1497 is a memory-full error. */
1498 Vsignaling_function
= Qnil
;
1499 if (backtrace_list
&& !NILP (error_symbol
))
1501 bp
= backtrace_list
->next
;
1502 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1504 if (bp
&& bp
->function
)
1505 Vsignaling_function
= *bp
->function
;
1508 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1510 register Lisp_Object clause
;
1512 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1513 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1515 if (specpdl_size
+ 40 > max_specpdl_size
)
1516 max_specpdl_size
= specpdl_size
+ 40;
1518 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1519 error_symbol
, data
, &debugger_value
);
1521 if (EQ (clause
, Qlambda
))
1523 /* We can't return values to code which signaled an error, but we
1524 can continue code which has signaled a quit. */
1525 if (EQ (real_error_symbol
, Qquit
))
1528 error ("Cannot return from the debugger in an error");
1533 Lisp_Object unwind_data
;
1534 struct handler
*h
= handlerlist
;
1536 handlerlist
= allhandlers
;
1538 if (NILP (error_symbol
))
1541 unwind_data
= Fcons (error_symbol
, data
);
1542 h
->chosen_clause
= clause
;
1543 unwind_to_catch (h
->tag
, unwind_data
);
1547 handlerlist
= allhandlers
;
1548 /* If no handler is present now, try to run the debugger,
1549 and if that fails, throw to top level. */
1550 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1552 Fthrow (Qtop_level
, Qt
);
1554 if (! NILP (error_symbol
))
1555 data
= Fcons (error_symbol
, data
);
1557 string
= Ferror_message_string (data
);
1558 fatal ("%s", SDATA (string
), 0);
1561 /* Return nonzero iff LIST is a non-nil atom or
1562 a list containing one of CONDITIONS. */
1565 wants_debugger (list
, conditions
)
1566 Lisp_Object list
, conditions
;
1573 while (CONSP (conditions
))
1575 Lisp_Object
this, tail
;
1576 this = XCAR (conditions
);
1577 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1578 if (EQ (XCAR (tail
), this))
1580 conditions
= XCDR (conditions
);
1585 /* Return 1 if an error with condition-symbols CONDITIONS,
1586 and described by SIGNAL-DATA, should skip the debugger
1587 according to debugger-ignored-errors. */
1590 skip_debugger (conditions
, data
)
1591 Lisp_Object conditions
, data
;
1594 int first_string
= 1;
1595 Lisp_Object error_message
;
1597 error_message
= Qnil
;
1598 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1600 if (STRINGP (XCAR (tail
)))
1604 error_message
= Ferror_message_string (data
);
1608 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1613 Lisp_Object contail
;
1615 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1616 if (EQ (XCAR (tail
), XCAR (contail
)))
1624 /* Value of Qlambda means we have called debugger and user has continued.
1625 There are two ways to pass SIG and DATA:
1626 = SIG is the error symbol, and DATA is the rest of the data.
1627 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1628 This is for memory-full errors only.
1630 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1633 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1634 Lisp_Object handlers
, conditions
, sig
, data
;
1635 Lisp_Object
*debugger_value_ptr
;
1637 register Lisp_Object h
;
1638 register Lisp_Object tem
;
1640 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1642 /* error is used similarly, but means print an error message
1643 and run the debugger if that is enabled. */
1644 if (EQ (handlers
, Qerror
)
1645 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1646 there is a handler. */
1648 int count
= SPECPDL_INDEX ();
1649 int debugger_called
= 0;
1650 Lisp_Object sig_symbol
, combined_data
;
1651 /* This is set to 1 if we are handling a memory-full error,
1652 because these must not run the debugger.
1653 (There is no room in memory to do that!) */
1654 int no_debugger
= 0;
1658 combined_data
= data
;
1659 sig_symbol
= Fcar (data
);
1664 combined_data
= Fcons (sig
, data
);
1668 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1671 internal_with_output_to_temp_buffer ("*Backtrace*",
1672 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1675 internal_with_output_to_temp_buffer ("*Backtrace*",
1680 && (EQ (sig_symbol
, Qquit
)
1682 : wants_debugger (Vdebug_on_error
, conditions
))
1683 && ! skip_debugger (conditions
, combined_data
)
1684 && when_entered_debugger
< num_nonmacro_input_events
)
1686 specbind (Qdebug_on_error
, Qnil
);
1688 = call_debugger (Fcons (Qerror
,
1689 Fcons (combined_data
, Qnil
)));
1690 debugger_called
= 1;
1692 /* If there is no handler, return saying whether we ran the debugger. */
1693 if (EQ (handlers
, Qerror
))
1695 if (debugger_called
)
1696 return unbind_to (count
, Qlambda
);
1700 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1702 Lisp_Object handler
, condit
;
1705 if (!CONSP (handler
))
1707 condit
= Fcar (handler
);
1708 /* Handle a single condition name in handler HANDLER. */
1709 if (SYMBOLP (condit
))
1711 tem
= Fmemq (Fcar (handler
), conditions
);
1715 /* Handle a list of condition names in handler HANDLER. */
1716 else if (CONSP (condit
))
1718 while (CONSP (condit
))
1720 tem
= Fmemq (Fcar (condit
), conditions
);
1723 condit
= XCDR (condit
);
1730 /* dump an error message; called like printf */
1734 error (m
, a1
, a2
, a3
)
1754 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1759 buffer
= (char *) xrealloc (buffer
, size
);
1762 buffer
= (char *) xmalloc (size
);
1767 string
= build_string (buffer
);
1771 Fsignal (Qerror
, Fcons (string
, Qnil
));
1775 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1776 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1777 This means it contains a description for how to read arguments to give it.
1778 The value is nil for an invalid function or a symbol with no function
1781 Interactively callable functions include strings and vectors (treated
1782 as keyboard macros), lambda-expressions that contain a top-level call
1783 to `interactive', autoload definitions made by `autoload' with non-nil
1784 fourth argument, and some of the built-in functions of Lisp.
1786 Also, a symbol satisfies `commandp' if its function definition does so.
1788 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1789 then strings and vectors are not accepted. */)
1790 (function
, for_call_interactively
)
1791 Lisp_Object function
, for_call_interactively
;
1793 register Lisp_Object fun
;
1794 register Lisp_Object funcar
;
1798 fun
= indirect_function (fun
);
1799 if (EQ (fun
, Qunbound
))
1802 /* Emacs primitives are interactive if their DEFUN specifies an
1803 interactive spec. */
1806 if (XSUBR (fun
)->prompt
)
1812 /* Bytecode objects are interactive if they are long enough to
1813 have an element whose index is COMPILED_INTERACTIVE, which is
1814 where the interactive spec is stored. */
1815 else if (COMPILEDP (fun
))
1816 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1819 /* Strings and vectors are keyboard macros. */
1820 if (NILP (for_call_interactively
) && (STRINGP (fun
) || VECTORP (fun
)))
1823 /* Lists may represent commands. */
1826 funcar
= Fcar (fun
);
1827 if (!SYMBOLP (funcar
))
1828 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
1829 if (EQ (funcar
, Qlambda
))
1830 return Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
1831 if (EQ (funcar
, Qautoload
))
1832 return Fcar (Fcdr (Fcdr (Fcdr (fun
))));
1838 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1839 doc
: /* Define FUNCTION to autoload from FILE.
1840 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1841 Third arg DOCSTRING is documentation for the function.
1842 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1843 Fifth arg TYPE indicates the type of the object:
1844 nil or omitted says FUNCTION is a function,
1845 `keymap' says FUNCTION is really a keymap, and
1846 `macro' or t says FUNCTION is really a macro.
1847 Third through fifth args give info about the real definition.
1848 They default to nil.
1849 If FUNCTION is already defined other than as an autoload,
1850 this does nothing and returns nil. */)
1851 (function
, file
, docstring
, interactive
, type
)
1852 Lisp_Object function
, file
, docstring
, interactive
, type
;
1855 Lisp_Object args
[4];
1858 CHECK_SYMBOL (function
);
1859 CHECK_STRING (file
);
1861 /* If function is defined and not as an autoload, don't override */
1862 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1863 && !(CONSP (XSYMBOL (function
)->function
)
1864 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1867 if (NILP (Vpurify_flag
))
1868 /* Only add entries after dumping, because the ones before are
1869 not useful and else we get loads of them from the loaddefs.el. */
1870 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1874 args
[1] = docstring
;
1875 args
[2] = interactive
;
1878 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1879 #else /* NO_ARG_ARRAY */
1880 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1881 #endif /* not NO_ARG_ARRAY */
1885 un_autoload (oldqueue
)
1886 Lisp_Object oldqueue
;
1888 register Lisp_Object queue
, first
, second
;
1890 /* Queue to unwind is current value of Vautoload_queue.
1891 oldqueue is the shadowed value to leave in Vautoload_queue. */
1892 queue
= Vautoload_queue
;
1893 Vautoload_queue
= oldqueue
;
1894 while (CONSP (queue
))
1896 first
= Fcar (queue
);
1897 second
= Fcdr (first
);
1898 first
= Fcar (first
);
1899 if (EQ (second
, Qnil
))
1902 Ffset (first
, second
);
1903 queue
= Fcdr (queue
);
1908 /* Load an autoloaded function.
1909 FUNNAME is the symbol which is the function's name.
1910 FUNDEF is the autoload definition (a list). */
1913 do_autoload (fundef
, funname
)
1914 Lisp_Object fundef
, funname
;
1916 int count
= SPECPDL_INDEX ();
1917 Lisp_Object fun
, queue
, first
, second
;
1918 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1920 /* This is to make sure that loadup.el gives a clear picture
1921 of what files are preloaded and when. */
1922 if (! NILP (Vpurify_flag
))
1923 error ("Attempt to autoload %s while preparing to dump",
1924 SDATA (SYMBOL_NAME (funname
)));
1927 CHECK_SYMBOL (funname
);
1928 GCPRO3 (fun
, funname
, fundef
);
1930 /* Preserve the match data. */
1931 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1933 /* Value saved here is to be restored into Vautoload_queue. */
1934 record_unwind_protect (un_autoload
, Vautoload_queue
);
1935 Vautoload_queue
= Qt
;
1936 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1938 /* Save the old autoloads, in case we ever do an unload. */
1939 queue
= Vautoload_queue
;
1940 while (CONSP (queue
))
1942 first
= Fcar (queue
);
1943 second
= Fcdr (first
);
1944 first
= Fcar (first
);
1946 /* Note: This test is subtle. The cdr of an autoload-queue entry
1947 may be an atom if the autoload entry was generated by a defalias
1950 Fput (first
, Qautoload
, (Fcdr (second
)));
1952 queue
= Fcdr (queue
);
1955 /* Once loading finishes, don't undo it. */
1956 Vautoload_queue
= Qt
;
1957 unbind_to (count
, Qnil
);
1959 fun
= Findirect_function (fun
);
1961 if (!NILP (Fequal (fun
, fundef
)))
1962 error ("Autoloading failed to define function %s",
1963 SDATA (SYMBOL_NAME (funname
)));
1968 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1969 doc
: /* Evaluate FORM and return its value. */)
1973 Lisp_Object fun
, val
, original_fun
, original_args
;
1975 struct backtrace backtrace
;
1976 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1978 if (handling_signal
)
1982 return Fsymbol_value (form
);
1987 if (consing_since_gc
> gc_cons_threshold
)
1990 Fgarbage_collect ();
1994 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1996 if (max_lisp_eval_depth
< 100)
1997 max_lisp_eval_depth
= 100;
1998 if (lisp_eval_depth
> max_lisp_eval_depth
)
1999 error ("Lisp nesting exceeds max-lisp-eval-depth");
2002 original_fun
= Fcar (form
);
2003 original_args
= Fcdr (form
);
2005 backtrace
.next
= backtrace_list
;
2006 backtrace_list
= &backtrace
;
2007 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2008 backtrace
.args
= &original_args
;
2009 backtrace
.nargs
= UNEVALLED
;
2010 backtrace
.evalargs
= 1;
2011 backtrace
.debug_on_exit
= 0;
2013 if (debug_on_next_call
)
2014 do_debug_on_call (Qt
);
2016 /* At this point, only original_fun and original_args
2017 have values that will be used below */
2019 fun
= Findirect_function (original_fun
);
2023 Lisp_Object numargs
;
2024 Lisp_Object argvals
[8];
2025 Lisp_Object args_left
;
2026 register int i
, maxargs
;
2028 args_left
= original_args
;
2029 numargs
= Flength (args_left
);
2031 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2032 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2033 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2035 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2037 backtrace
.evalargs
= 0;
2038 val
= (*XSUBR (fun
)->function
) (args_left
);
2042 if (XSUBR (fun
)->max_args
== MANY
)
2044 /* Pass a vector of evaluated arguments */
2046 register int argnum
= 0;
2048 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2050 GCPRO3 (args_left
, fun
, fun
);
2054 while (!NILP (args_left
))
2056 vals
[argnum
++] = Feval (Fcar (args_left
));
2057 args_left
= Fcdr (args_left
);
2058 gcpro3
.nvars
= argnum
;
2061 backtrace
.args
= vals
;
2062 backtrace
.nargs
= XINT (numargs
);
2064 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2069 GCPRO3 (args_left
, fun
, fun
);
2070 gcpro3
.var
= argvals
;
2073 maxargs
= XSUBR (fun
)->max_args
;
2074 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2076 argvals
[i
] = Feval (Fcar (args_left
));
2082 backtrace
.args
= argvals
;
2083 backtrace
.nargs
= XINT (numargs
);
2088 val
= (*XSUBR (fun
)->function
) ();
2091 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2094 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2097 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2101 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2102 argvals
[2], argvals
[3]);
2105 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2106 argvals
[3], argvals
[4]);
2109 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2110 argvals
[3], argvals
[4], argvals
[5]);
2113 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2114 argvals
[3], argvals
[4], argvals
[5],
2119 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2120 argvals
[3], argvals
[4], argvals
[5],
2121 argvals
[6], argvals
[7]);
2125 /* Someone has created a subr that takes more arguments than
2126 is supported by this code. We need to either rewrite the
2127 subr to use a different argument protocol, or add more
2128 cases to this switch. */
2132 if (COMPILEDP (fun
))
2133 val
= apply_lambda (fun
, original_args
, 1);
2137 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2138 funcar
= Fcar (fun
);
2139 if (!SYMBOLP (funcar
))
2140 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2141 if (EQ (funcar
, Qautoload
))
2143 do_autoload (fun
, original_fun
);
2146 if (EQ (funcar
, Qmacro
))
2147 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2148 else if (EQ (funcar
, Qlambda
))
2149 val
= apply_lambda (fun
, original_args
, 1);
2151 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2155 if (backtrace
.debug_on_exit
)
2156 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2157 backtrace_list
= backtrace
.next
;
2161 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2162 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2163 Then return the value FUNCTION returns.
2164 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2165 usage: (apply FUNCTION &rest ARGUMENTS) */)
2170 register int i
, numargs
;
2171 register Lisp_Object spread_arg
;
2172 register Lisp_Object
*funcall_args
;
2174 struct gcpro gcpro1
;
2178 spread_arg
= args
[nargs
- 1];
2179 CHECK_LIST (spread_arg
);
2181 numargs
= XINT (Flength (spread_arg
));
2184 return Ffuncall (nargs
- 1, args
);
2185 else if (numargs
== 1)
2187 args
[nargs
- 1] = XCAR (spread_arg
);
2188 return Ffuncall (nargs
, args
);
2191 numargs
+= nargs
- 2;
2193 fun
= indirect_function (fun
);
2194 if (EQ (fun
, Qunbound
))
2196 /* Let funcall get the error */
2203 if (numargs
< XSUBR (fun
)->min_args
2204 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2205 goto funcall
; /* Let funcall get the error */
2206 else if (XSUBR (fun
)->max_args
> numargs
)
2208 /* Avoid making funcall cons up a yet another new vector of arguments
2209 by explicitly supplying nil's for optional values */
2210 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2211 * sizeof (Lisp_Object
));
2212 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2213 funcall_args
[++i
] = Qnil
;
2214 GCPRO1 (*funcall_args
);
2215 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2219 /* We add 1 to numargs because funcall_args includes the
2220 function itself as well as its arguments. */
2223 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2224 * sizeof (Lisp_Object
));
2225 GCPRO1 (*funcall_args
);
2226 gcpro1
.nvars
= 1 + numargs
;
2229 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2230 /* Spread the last arg we got. Its first element goes in
2231 the slot that it used to occupy, hence this value of I. */
2233 while (!NILP (spread_arg
))
2235 funcall_args
[i
++] = XCAR (spread_arg
);
2236 spread_arg
= XCDR (spread_arg
);
2239 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2242 /* Run hook variables in various ways. */
2244 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2245 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2246 enum run_hooks_condition
));
2248 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2249 doc
: /* Run each hook in HOOKS. Major mode functions use this.
2250 Each argument should be a symbol, a hook variable.
2251 These symbols are processed in the order specified.
2252 If a hook symbol has a non-nil value, that value may be a function
2253 or a list of functions to be called to run the hook.
2254 If the value is a function, it is called with no arguments.
2255 If it is a list, the elements are called, in order, with no arguments.
2257 Do not use `make-local-variable' to make a hook variable buffer-local.
2258 Instead, use `add-hook' and specify t for the LOCAL argument.
2259 usage: (run-hooks &rest HOOKS) */)
2264 Lisp_Object hook
[1];
2267 for (i
= 0; i
< nargs
; i
++)
2270 run_hook_with_args (1, hook
, to_completion
);
2276 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2277 Srun_hook_with_args
, 1, MANY
, 0,
2278 doc
: /* Run HOOK with the specified arguments ARGS.
2279 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2280 value, that value may be a function or a list of functions to be
2281 called to run the hook. If the value is a function, it is called with
2282 the given arguments and its return value is returned. If it is a list
2283 of functions, those functions are called, in order,
2284 with the given arguments ARGS.
2285 It is best not to depend on the value return by `run-hook-with-args',
2288 Do not use `make-local-variable' to make a hook variable buffer-local.
2289 Instead, use `add-hook' and specify t for the LOCAL argument.
2290 usage: (run-hook-with-args HOOK &rest ARGS) */)
2295 return run_hook_with_args (nargs
, args
, to_completion
);
2298 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2299 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2300 doc
: /* Run HOOK with the specified arguments ARGS.
2301 HOOK should be a symbol, a hook variable. Its value should
2302 be a list of functions. We call those functions, one by one,
2303 passing arguments ARGS to each of them, until one of them
2304 returns a non-nil value. Then we return that value.
2305 If all the functions return nil, we return nil.
2307 Do not use `make-local-variable' to make a hook variable buffer-local.
2308 Instead, use `add-hook' and specify t for the LOCAL argument.
2309 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2314 return run_hook_with_args (nargs
, args
, until_success
);
2317 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2318 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2319 doc
: /* Run HOOK with the specified arguments ARGS.
2320 HOOK should be a symbol, a hook variable. Its value should
2321 be a list of functions. We call those functions, one by one,
2322 passing arguments ARGS to each of them, until one of them
2323 returns nil. Then we return nil.
2324 If all the functions return non-nil, we return non-nil.
2326 Do not use `make-local-variable' to make a hook variable buffer-local.
2327 Instead, use `add-hook' and specify t for the LOCAL argument.
2328 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2333 return run_hook_with_args (nargs
, args
, until_failure
);
2336 /* ARGS[0] should be a hook symbol.
2337 Call each of the functions in the hook value, passing each of them
2338 as arguments all the rest of ARGS (all NARGS - 1 elements).
2339 COND specifies a condition to test after each call
2340 to decide whether to stop.
2341 The caller (or its caller, etc) must gcpro all of ARGS,
2342 except that it isn't necessary to gcpro ARGS[0]. */
2345 run_hook_with_args (nargs
, args
, cond
)
2348 enum run_hooks_condition cond
;
2350 Lisp_Object sym
, val
, ret
;
2351 Lisp_Object globals
;
2352 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2354 /* If we are dying or still initializing,
2355 don't do anything--it would probably crash if we tried. */
2356 if (NILP (Vrun_hooks
))
2360 val
= find_symbol_value (sym
);
2361 ret
= (cond
== until_failure
? Qt
: Qnil
);
2363 if (EQ (val
, Qunbound
) || NILP (val
))
2365 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2368 return Ffuncall (nargs
, args
);
2373 GCPRO3 (sym
, val
, globals
);
2376 CONSP (val
) && ((cond
== to_completion
)
2377 || (cond
== until_success
? NILP (ret
)
2381 if (EQ (XCAR (val
), Qt
))
2383 /* t indicates this hook has a local binding;
2384 it means to run the global binding too. */
2386 for (globals
= Fdefault_value (sym
);
2387 CONSP (globals
) && ((cond
== to_completion
)
2388 || (cond
== until_success
? NILP (ret
)
2390 globals
= XCDR (globals
))
2392 args
[0] = XCAR (globals
);
2393 /* In a global value, t should not occur. If it does, we
2394 must ignore it to avoid an endless loop. */
2395 if (!EQ (args
[0], Qt
))
2396 ret
= Ffuncall (nargs
, args
);
2401 args
[0] = XCAR (val
);
2402 ret
= Ffuncall (nargs
, args
);
2411 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2412 present value of that symbol.
2413 Call each element of FUNLIST,
2414 passing each of them the rest of ARGS.
2415 The caller (or its caller, etc) must gcpro all of ARGS,
2416 except that it isn't necessary to gcpro ARGS[0]. */
2419 run_hook_list_with_args (funlist
, nargs
, args
)
2420 Lisp_Object funlist
;
2426 Lisp_Object globals
;
2427 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2431 GCPRO3 (sym
, val
, globals
);
2433 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2435 if (EQ (XCAR (val
), Qt
))
2437 /* t indicates this hook has a local binding;
2438 it means to run the global binding too. */
2440 for (globals
= Fdefault_value (sym
);
2442 globals
= XCDR (globals
))
2444 args
[0] = XCAR (globals
);
2445 /* In a global value, t should not occur. If it does, we
2446 must ignore it to avoid an endless loop. */
2447 if (!EQ (args
[0], Qt
))
2448 Ffuncall (nargs
, args
);
2453 args
[0] = XCAR (val
);
2454 Ffuncall (nargs
, args
);
2461 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2464 run_hook_with_args_2 (hook
, arg1
, arg2
)
2465 Lisp_Object hook
, arg1
, arg2
;
2467 Lisp_Object temp
[3];
2472 Frun_hook_with_args (3, temp
);
2475 /* Apply fn to arg */
2478 Lisp_Object fn
, arg
;
2480 struct gcpro gcpro1
;
2484 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2488 Lisp_Object args
[2];
2492 RETURN_UNGCPRO (Fapply (2, args
));
2494 #else /* not NO_ARG_ARRAY */
2495 RETURN_UNGCPRO (Fapply (2, &fn
));
2496 #endif /* not NO_ARG_ARRAY */
2499 /* Call function fn on no arguments */
2504 struct gcpro gcpro1
;
2507 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2510 /* Call function fn with 1 argument arg1 */
2514 Lisp_Object fn
, arg1
;
2516 struct gcpro gcpro1
;
2518 Lisp_Object args
[2];
2524 RETURN_UNGCPRO (Ffuncall (2, args
));
2525 #else /* not NO_ARG_ARRAY */
2528 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2529 #endif /* not NO_ARG_ARRAY */
2532 /* Call function fn with 2 arguments arg1, arg2 */
2535 call2 (fn
, arg1
, arg2
)
2536 Lisp_Object fn
, arg1
, arg2
;
2538 struct gcpro gcpro1
;
2540 Lisp_Object args
[3];
2546 RETURN_UNGCPRO (Ffuncall (3, args
));
2547 #else /* not NO_ARG_ARRAY */
2550 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2551 #endif /* not NO_ARG_ARRAY */
2554 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2557 call3 (fn
, arg1
, arg2
, arg3
)
2558 Lisp_Object fn
, arg1
, arg2
, arg3
;
2560 struct gcpro gcpro1
;
2562 Lisp_Object args
[4];
2569 RETURN_UNGCPRO (Ffuncall (4, args
));
2570 #else /* not NO_ARG_ARRAY */
2573 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2574 #endif /* not NO_ARG_ARRAY */
2577 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2580 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2581 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2583 struct gcpro gcpro1
;
2585 Lisp_Object args
[5];
2593 RETURN_UNGCPRO (Ffuncall (5, args
));
2594 #else /* not NO_ARG_ARRAY */
2597 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2598 #endif /* not NO_ARG_ARRAY */
2601 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2604 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2605 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2607 struct gcpro gcpro1
;
2609 Lisp_Object args
[6];
2618 RETURN_UNGCPRO (Ffuncall (6, args
));
2619 #else /* not NO_ARG_ARRAY */
2622 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2623 #endif /* not NO_ARG_ARRAY */
2626 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2629 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2630 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2632 struct gcpro gcpro1
;
2634 Lisp_Object args
[7];
2644 RETURN_UNGCPRO (Ffuncall (7, args
));
2645 #else /* not NO_ARG_ARRAY */
2648 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2649 #endif /* not NO_ARG_ARRAY */
2652 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2653 doc
: /* Call first argument as a function, passing remaining arguments to it.
2654 Return the value that function returns.
2655 Thus, (funcall 'cons 'x 'y) returns (x . y).
2656 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2663 int numargs
= nargs
- 1;
2664 Lisp_Object lisp_numargs
;
2666 struct backtrace backtrace
;
2667 register Lisp_Object
*internal_args
;
2671 if (consing_since_gc
> gc_cons_threshold
)
2672 Fgarbage_collect ();
2674 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2676 if (max_lisp_eval_depth
< 100)
2677 max_lisp_eval_depth
= 100;
2678 if (lisp_eval_depth
> max_lisp_eval_depth
)
2679 error ("Lisp nesting exceeds max-lisp-eval-depth");
2682 backtrace
.next
= backtrace_list
;
2683 backtrace_list
= &backtrace
;
2684 backtrace
.function
= &args
[0];
2685 backtrace
.args
= &args
[1];
2686 backtrace
.nargs
= nargs
- 1;
2687 backtrace
.evalargs
= 0;
2688 backtrace
.debug_on_exit
= 0;
2690 if (debug_on_next_call
)
2691 do_debug_on_call (Qlambda
);
2697 fun
= Findirect_function (fun
);
2701 if (numargs
< XSUBR (fun
)->min_args
2702 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2704 XSETFASTINT (lisp_numargs
, numargs
);
2705 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2708 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2709 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2711 if (XSUBR (fun
)->max_args
== MANY
)
2713 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2717 if (XSUBR (fun
)->max_args
> numargs
)
2719 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2720 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2721 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2722 internal_args
[i
] = Qnil
;
2725 internal_args
= args
+ 1;
2726 switch (XSUBR (fun
)->max_args
)
2729 val
= (*XSUBR (fun
)->function
) ();
2732 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2735 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2739 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2743 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2748 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2749 internal_args
[2], internal_args
[3],
2753 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2754 internal_args
[2], internal_args
[3],
2755 internal_args
[4], internal_args
[5]);
2758 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2759 internal_args
[2], internal_args
[3],
2760 internal_args
[4], internal_args
[5],
2765 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2766 internal_args
[2], internal_args
[3],
2767 internal_args
[4], internal_args
[5],
2768 internal_args
[6], internal_args
[7]);
2773 /* If a subr takes more than 8 arguments without using MANY
2774 or UNEVALLED, we need to extend this function to support it.
2775 Until this is done, there is no way to call the function. */
2779 if (COMPILEDP (fun
))
2780 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2784 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2785 funcar
= Fcar (fun
);
2786 if (!SYMBOLP (funcar
))
2787 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2788 if (EQ (funcar
, Qlambda
))
2789 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2790 else if (EQ (funcar
, Qautoload
))
2792 do_autoload (fun
, args
[0]);
2796 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2800 if (backtrace
.debug_on_exit
)
2801 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2802 backtrace_list
= backtrace
.next
;
2807 apply_lambda (fun
, args
, eval_flag
)
2808 Lisp_Object fun
, args
;
2811 Lisp_Object args_left
;
2812 Lisp_Object numargs
;
2813 register Lisp_Object
*arg_vector
;
2814 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2816 register Lisp_Object tem
;
2818 numargs
= Flength (args
);
2819 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2822 GCPRO3 (*arg_vector
, args_left
, fun
);
2825 for (i
= 0; i
< XINT (numargs
);)
2827 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2828 if (eval_flag
) tem
= Feval (tem
);
2829 arg_vector
[i
++] = tem
;
2837 backtrace_list
->args
= arg_vector
;
2838 backtrace_list
->nargs
= i
;
2840 backtrace_list
->evalargs
= 0;
2841 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2843 /* Do the debug-on-exit now, while arg_vector still exists. */
2844 if (backtrace_list
->debug_on_exit
)
2845 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2846 /* Don't do it again when we return to eval. */
2847 backtrace_list
->debug_on_exit
= 0;
2851 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2852 and return the result of evaluation.
2853 FUN must be either a lambda-expression or a compiled-code object. */
2856 funcall_lambda (fun
, nargs
, arg_vector
)
2859 register Lisp_Object
*arg_vector
;
2861 Lisp_Object val
, syms_left
, next
;
2862 int count
= SPECPDL_INDEX ();
2863 int i
, optional
, rest
;
2867 syms_left
= XCDR (fun
);
2868 if (CONSP (syms_left
))
2869 syms_left
= XCAR (syms_left
);
2871 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2873 else if (COMPILEDP (fun
))
2874 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2878 i
= optional
= rest
= 0;
2879 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2883 next
= XCAR (syms_left
);
2884 while (!SYMBOLP (next
))
2885 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2887 if (EQ (next
, Qand_rest
))
2889 else if (EQ (next
, Qand_optional
))
2893 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2897 specbind (next
, arg_vector
[i
++]);
2899 return Fsignal (Qwrong_number_of_arguments
,
2900 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2902 specbind (next
, Qnil
);
2905 if (!NILP (syms_left
))
2906 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2908 return Fsignal (Qwrong_number_of_arguments
,
2909 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2912 val
= Fprogn (XCDR (XCDR (fun
)));
2915 /* If we have not actually read the bytecode string
2916 and constants vector yet, fetch them from the file. */
2917 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2918 Ffetch_bytecode (fun
);
2919 val
= Fbyte_code (AREF (fun
, COMPILED_BYTECODE
),
2920 AREF (fun
, COMPILED_CONSTANTS
),
2921 AREF (fun
, COMPILED_STACK_DEPTH
));
2924 return unbind_to (count
, val
);
2927 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2929 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2935 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2937 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2940 tem
= AREF (object
, COMPILED_BYTECODE
);
2941 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2942 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2944 error ("Invalid byte code");
2946 AREF (object
, COMPILED_BYTECODE
) = XCAR (tem
);
2947 AREF (object
, COMPILED_CONSTANTS
) = XCDR (tem
);
2955 register int count
= SPECPDL_INDEX ();
2956 if (specpdl_size
>= max_specpdl_size
)
2958 if (max_specpdl_size
< 400)
2959 max_specpdl_size
= 400;
2960 if (specpdl_size
>= max_specpdl_size
)
2962 if (!NILP (Vdebug_on_error
))
2963 /* Leave room for some specpdl in the debugger. */
2964 max_specpdl_size
= specpdl_size
+ 100;
2966 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2970 if (specpdl_size
> max_specpdl_size
)
2971 specpdl_size
= max_specpdl_size
;
2972 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2973 specpdl_ptr
= specpdl
+ count
;
2977 specbind (symbol
, value
)
2978 Lisp_Object symbol
, value
;
2981 Lisp_Object valcontents
;
2983 CHECK_SYMBOL (symbol
);
2984 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2987 /* The most common case is that of a non-constant symbol with a
2988 trivial value. Make that as fast as we can. */
2989 valcontents
= SYMBOL_VALUE (symbol
);
2990 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
2992 specpdl_ptr
->symbol
= symbol
;
2993 specpdl_ptr
->old_value
= valcontents
;
2994 specpdl_ptr
->func
= NULL
;
2996 SET_SYMBOL_VALUE (symbol
, value
);
3000 Lisp_Object valcontents
;
3002 ovalue
= find_symbol_value (symbol
);
3003 specpdl_ptr
->func
= 0;
3004 specpdl_ptr
->old_value
= ovalue
;
3006 valcontents
= XSYMBOL (symbol
)->value
;
3008 if (BUFFER_LOCAL_VALUEP (valcontents
)
3009 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
3010 || BUFFER_OBJFWDP (valcontents
))
3012 Lisp_Object where
, current_buffer
;
3014 current_buffer
= Fcurrent_buffer ();
3016 /* For a local variable, record both the symbol and which
3017 buffer's or frame's value we are saving. */
3018 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3019 where
= current_buffer
;
3020 else if (!BUFFER_OBJFWDP (valcontents
)
3021 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3022 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3026 /* We're not using the `unused' slot in the specbinding
3027 structure because this would mean we have to do more
3028 work for simple variables. */
3029 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3031 /* If SYMBOL is a per-buffer variable which doesn't have a
3032 buffer-local value here, make the `let' change the global
3033 value by changing the value of SYMBOL in all buffers not
3034 having their own value. This is consistent with what
3035 happens with other buffer-local variables. */
3037 && BUFFER_OBJFWDP (valcontents
))
3040 Fset_default (symbol
, value
);
3045 specpdl_ptr
->symbol
= symbol
;
3048 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3049 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3051 set_internal (symbol
, value
, 0, 1);
3056 record_unwind_protect (function
, arg
)
3057 Lisp_Object (*function
) P_ ((Lisp_Object
));
3060 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3062 specpdl_ptr
->func
= function
;
3063 specpdl_ptr
->symbol
= Qnil
;
3064 specpdl_ptr
->old_value
= arg
;
3069 unbind_to (count
, value
)
3073 int quitf
= !NILP (Vquit_flag
);
3074 struct gcpro gcpro1
;
3079 while (specpdl_ptr
!= specpdl
+ count
)
3083 if (specpdl_ptr
->func
!= 0)
3084 (*specpdl_ptr
->func
) (specpdl_ptr
->old_value
);
3085 /* Note that a "binding" of nil is really an unwind protect,
3086 so in that case the "old value" is a list of forms to evaluate. */
3087 else if (NILP (specpdl_ptr
->symbol
))
3088 Fprogn (specpdl_ptr
->old_value
);
3089 /* If the symbol is a list, it is really (SYMBOL WHERE
3090 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3091 frame. If WHERE is a buffer or frame, this indicates we
3092 bound a variable that had a buffer-local or frame-local
3093 binding. WHERE nil means that the variable had the default
3094 value when it was bound. CURRENT-BUFFER is the buffer that
3095 was current when the variable was bound. */
3096 else if (CONSP (specpdl_ptr
->symbol
))
3098 Lisp_Object symbol
, where
;
3100 symbol
= XCAR (specpdl_ptr
->symbol
);
3101 where
= XCAR (XCDR (specpdl_ptr
->symbol
));
3104 Fset_default (symbol
, specpdl_ptr
->old_value
);
3105 else if (BUFFERP (where
))
3106 set_internal (symbol
, specpdl_ptr
->old_value
, XBUFFER (where
), 1);
3108 set_internal (symbol
, specpdl_ptr
->old_value
, NULL
, 1);
3112 /* If variable has a trivial value (no forwarding), we can
3113 just set it. No need to check for constant symbols here,
3114 since that was already done by specbind. */
3115 if (!MISCP (SYMBOL_VALUE (specpdl_ptr
->symbol
)))
3116 SET_SYMBOL_VALUE (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
);
3118 set_internal (specpdl_ptr
->symbol
, specpdl_ptr
->old_value
, 0, 1);
3122 if (NILP (Vquit_flag
) && quitf
)
3129 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3130 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3131 The debugger is entered when that frame exits, if the flag is non-nil. */)
3133 Lisp_Object level
, flag
;
3135 register struct backtrace
*backlist
= backtrace_list
;
3138 CHECK_NUMBER (level
);
3140 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3142 backlist
= backlist
->next
;
3146 backlist
->debug_on_exit
= !NILP (flag
);
3151 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3152 doc
: /* Print a trace of Lisp function calls currently active.
3153 Output stream used is value of `standard-output'. */)
3156 register struct backtrace
*backlist
= backtrace_list
;
3160 extern Lisp_Object Vprint_level
;
3161 struct gcpro gcpro1
;
3163 XSETFASTINT (Vprint_level
, 3);
3170 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3171 if (backlist
->nargs
== UNEVALLED
)
3173 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3174 write_string ("\n", -1);
3178 tem
= *backlist
->function
;
3179 Fprin1 (tem
, Qnil
); /* This can QUIT */
3180 write_string ("(", -1);
3181 if (backlist
->nargs
== MANY
)
3183 for (tail
= *backlist
->args
, i
= 0;
3185 tail
= Fcdr (tail
), i
++)
3187 if (i
) write_string (" ", -1);
3188 Fprin1 (Fcar (tail
), Qnil
);
3193 for (i
= 0; i
< backlist
->nargs
; i
++)
3195 if (i
) write_string (" ", -1);
3196 Fprin1 (backlist
->args
[i
], Qnil
);
3199 write_string (")\n", -1);
3201 backlist
= backlist
->next
;
3204 Vprint_level
= Qnil
;
3209 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3210 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3211 If that frame has not evaluated the arguments yet (or is a special form),
3212 the value is (nil FUNCTION ARG-FORMS...).
3213 If that frame has evaluated its arguments and called its function already,
3214 the value is (t FUNCTION ARG-VALUES...).
3215 A &rest arg is represented as the tail of the list ARG-VALUES.
3216 FUNCTION is whatever was supplied as car of evaluated list,
3217 or a lambda expression for macro calls.
3218 If NFRAMES is more than the number of frames, the value is nil. */)
3220 Lisp_Object nframes
;
3222 register struct backtrace
*backlist
= backtrace_list
;
3226 CHECK_NATNUM (nframes
);
3228 /* Find the frame requested. */
3229 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3230 backlist
= backlist
->next
;
3234 if (backlist
->nargs
== UNEVALLED
)
3235 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3238 if (backlist
->nargs
== MANY
)
3239 tem
= *backlist
->args
;
3241 tem
= Flist (backlist
->nargs
, backlist
->args
);
3243 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3251 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3252 doc
: /* *Limit on number of Lisp variable bindings & unwind-protects.
3253 If Lisp code tries to make more than this many at once,
3254 an error is signaled.
3255 You can safely use a value considerably larger than the default value,
3256 if that proves inconveniently small. However, if you increase it too far,
3257 Emacs could run out of memory trying to make the stack bigger. */);
3259 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3260 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3262 This limit serves to catch infinite recursions for you before they cause
3263 actual stack overflow in C, which would be fatal for Emacs.
3264 You can safely make it considerably larger than its default value,
3265 if that proves inconveniently small. However, if you increase it too far,
3266 Emacs could overflow the real C stack, and crash. */);
3268 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3269 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3270 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'. */);
3273 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3274 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3275 Note that `quit-flag' will still be set by typing C-g,
3276 so a quit will be signaled as soon as `inhibit-quit' is nil.
3277 To prevent this happening, set `quit-flag' to nil
3278 before making `inhibit-quit' nil. */);
3279 Vinhibit_quit
= Qnil
;
3281 Qinhibit_quit
= intern ("inhibit-quit");
3282 staticpro (&Qinhibit_quit
);
3284 Qautoload
= intern ("autoload");
3285 staticpro (&Qautoload
);
3287 Qdebug_on_error
= intern ("debug-on-error");
3288 staticpro (&Qdebug_on_error
);
3290 Qmacro
= intern ("macro");
3291 staticpro (&Qmacro
);
3293 Qdeclare
= intern ("declare");
3294 staticpro (&Qdeclare
);
3296 /* Note that the process handling also uses Qexit, but we don't want
3297 to staticpro it twice, so we just do it here. */
3298 Qexit
= intern ("exit");
3301 Qinteractive
= intern ("interactive");
3302 staticpro (&Qinteractive
);
3304 Qcommandp
= intern ("commandp");
3305 staticpro (&Qcommandp
);
3307 Qdefun
= intern ("defun");
3308 staticpro (&Qdefun
);
3310 Qdefvar
= intern ("defvar");
3311 staticpro (&Qdefvar
);
3313 Qand_rest
= intern ("&rest");
3314 staticpro (&Qand_rest
);
3316 Qand_optional
= intern ("&optional");
3317 staticpro (&Qand_optional
);
3319 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3320 doc
: /* *Non-nil means errors display a backtrace buffer.
3321 More precisely, this happens for any error that is handled
3322 by the editor command loop.
3323 If the value is a list, an error only means to display a backtrace
3324 if one of its condition symbols appears in the list. */);
3325 Vstack_trace_on_error
= Qnil
;
3327 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3328 doc
: /* *Non-nil means enter debugger if an error is signaled.
3329 Does not apply to errors handled by `condition-case' or those
3330 matched by `debug-ignored-errors'.
3331 If the value is a list, an error only means to enter the debugger
3332 if one of its condition symbols appears in the list.
3333 When you evaluate an expression interactively, this variable
3334 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3335 See also variable `debug-on-quit'. */);
3336 Vdebug_on_error
= Qnil
;
3338 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3339 doc
: /* *List of errors for which the debugger should not be called.
3340 Each element may be a condition-name or a regexp that matches error messages.
3341 If any element applies to a given error, that error skips the debugger
3342 and just returns to top level.
3343 This overrides the variable `debug-on-error'.
3344 It does not apply to errors handled by `condition-case'. */);
3345 Vdebug_ignored_errors
= Qnil
;
3347 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3348 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3349 Does not apply if quit is handled by a `condition-case'.
3350 When you evaluate an expression interactively, this variable
3351 is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil. */);
3354 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3355 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3357 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3358 doc
: /* Non-nil means debugger may continue execution.
3359 This is nil when the debugger is called under circumstances where it
3360 might not be safe to continue. */);
3361 debugger_may_continue
= 1;
3363 DEFVAR_LISP ("debugger", &Vdebugger
,
3364 doc
: /* Function to call to invoke debugger.
3365 If due to frame exit, args are `exit' and the value being returned;
3366 this function's value will be returned instead of that.
3367 If due to error, args are `error' and a list of the args to `signal'.
3368 If due to `apply' or `funcall' entry, one arg, `lambda'.
3369 If due to `eval' entry, one arg, t. */);
3372 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3373 doc
: /* If non-nil, this is a function for `signal' to call.
3374 It receives the same arguments that `signal' was given.
3375 The Edebug package uses this to regain control. */);
3376 Vsignal_hook_function
= Qnil
;
3378 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3379 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3380 Note that `debug-on-error', `debug-on-quit' and friends
3381 still determine whether to handle the particular condition. */);
3382 Vdebug_on_signal
= Qnil
;
3384 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3385 doc
: /* Function to process declarations in a macro definition.
3386 The function will be called with two args MACRO and DECL.
3387 MACRO is the name of the macro being defined.
3388 DECL is a list `(declare ...)' containing the declarations.
3389 The value the function returns is not used. */);
3390 Vmacro_declaration_function
= Qnil
;
3392 Vrun_hooks
= intern ("run-hooks");
3393 staticpro (&Vrun_hooks
);
3395 staticpro (&Vautoload_queue
);
3396 Vautoload_queue
= Qnil
;
3397 staticpro (&Vsignaling_function
);
3398 Vsignaling_function
= Qnil
;
3409 defsubr (&Sfunction
);
3411 defsubr (&Sdefmacro
);
3413 defsubr (&Sdefvaralias
);
3414 defsubr (&Sdefconst
);
3415 defsubr (&Suser_variable_p
);
3419 defsubr (&Smacroexpand
);
3422 defsubr (&Sunwind_protect
);
3423 defsubr (&Scondition_case
);
3425 defsubr (&Sinteractive_p
);
3426 defsubr (&Scommandp
);
3427 defsubr (&Sautoload
);
3430 defsubr (&Sfuncall
);
3431 defsubr (&Srun_hooks
);
3432 defsubr (&Srun_hook_with_args
);
3433 defsubr (&Srun_hook_with_args_until_success
);
3434 defsubr (&Srun_hook_with_args_until_failure
);
3435 defsubr (&Sfetch_bytecode
);
3436 defsubr (&Sbacktrace_debug
);
3437 defsubr (&Sbacktrace
);
3438 defsubr (&Sbacktrace_frame
);