1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 02, 2004
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 int interrupt_input_blocked
;
81 struct byte_stack
*byte_stack
;
84 struct catchtag
*catchlist
;
87 /* Count levels of GCPRO to detect failure to UNGCPRO. */
91 Lisp_Object Qautoload
, Qmacro
, Qexit
, Qinteractive
, Qcommandp
, Qdefun
, Qdefvar
;
92 Lisp_Object Qinhibit_quit
, Vinhibit_quit
, Vquit_flag
;
93 Lisp_Object Qand_rest
, Qand_optional
;
94 Lisp_Object Qdebug_on_error
;
97 /* This holds either the symbol `run-hooks' or nil.
98 It is nil at an early stage of startup, and when Emacs
101 Lisp_Object Vrun_hooks
;
103 /* Non-nil means record all fset's and provide's, to be undone
104 if the file being autoloaded is not fully loaded.
105 They are recorded by being consed onto the front of Vautoload_queue:
106 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
108 Lisp_Object Vautoload_queue
;
110 /* Current number of specbindings allocated in specpdl. */
114 /* Pointer to beginning of specpdl. */
116 struct specbinding
*specpdl
;
118 /* Pointer to first unused element in specpdl. */
120 volatile struct specbinding
*specpdl_ptr
;
122 /* Maximum size allowed for specpdl allocation */
124 EMACS_INT max_specpdl_size
;
126 /* Depth in Lisp evaluations and function calls. */
130 /* Maximum allowed depth in Lisp evaluations and function calls. */
132 EMACS_INT max_lisp_eval_depth
;
134 /* Nonzero means enter debugger before next function call */
136 int debug_on_next_call
;
138 /* Non-zero means debugger may continue. This is zero when the
139 debugger is called during redisplay, where it might not be safe to
140 continue the interrupted redisplay. */
142 int debugger_may_continue
;
144 /* List of conditions (non-nil atom means all) which cause a backtrace
145 if an error is handled by the command loop's error handler. */
147 Lisp_Object Vstack_trace_on_error
;
149 /* List of conditions (non-nil atom means all) which enter the debugger
150 if an error is handled by the command loop's error handler. */
152 Lisp_Object Vdebug_on_error
;
154 /* List of conditions and regexps specifying error messages which
155 do not enter the debugger even if Vdebug_on_error says they should. */
157 Lisp_Object Vdebug_ignored_errors
;
159 /* Non-nil means call the debugger even if the error will be handled. */
161 Lisp_Object Vdebug_on_signal
;
163 /* Hook for edebug to use. */
165 Lisp_Object Vsignal_hook_function
;
167 /* Nonzero means enter debugger if a quit signal
168 is handled by the command loop's error handler. */
172 /* The value of num_nonmacro_input_events as of the last time we
173 started to enter the debugger. If we decide to enter the debugger
174 again when this is still equal to num_nonmacro_input_events, then we
175 know that the debugger itself has an error, and we should just
176 signal the error instead of entering an infinite loop of debugger
179 int when_entered_debugger
;
181 Lisp_Object Vdebugger
;
183 /* The function from which the last `signal' was called. Set in
186 Lisp_Object Vsignaling_function
;
188 /* Set to non-zero while processing X events. Checked in Feval to
189 make sure the Lisp interpreter isn't called from a signal handler,
190 which is unsafe because the interpreter isn't reentrant. */
194 /* Function to process declarations in defmacro forms. */
196 Lisp_Object Vmacro_declaration_function
;
199 static Lisp_Object funcall_lambda
P_ ((Lisp_Object
, int, Lisp_Object
*));
205 specpdl
= (struct specbinding
*) xmalloc (specpdl_size
* sizeof (struct specbinding
));
206 specpdl_ptr
= specpdl
;
207 max_specpdl_size
= 600;
208 max_lisp_eval_depth
= 300;
216 specpdl_ptr
= specpdl
;
221 debug_on_next_call
= 0;
226 /* This is less than the initial value of num_nonmacro_input_events. */
227 when_entered_debugger
= -1;
234 int debug_while_redisplaying
;
235 int count
= SPECPDL_INDEX ();
238 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
239 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
241 if (specpdl_size
+ 40 > max_specpdl_size
)
242 max_specpdl_size
= specpdl_size
+ 40;
244 #ifdef HAVE_X_WINDOWS
245 if (display_hourglass_p
)
249 debug_on_next_call
= 0;
250 when_entered_debugger
= num_nonmacro_input_events
;
252 /* Resetting redisplaying_p to 0 makes sure that debug output is
253 displayed if the debugger is invoked during redisplay. */
254 debug_while_redisplaying
= redisplaying_p
;
256 specbind (intern ("debugger-may-continue"),
257 debug_while_redisplaying
? Qnil
: Qt
);
258 specbind (Qinhibit_redisplay
, Qnil
);
260 #if 0 /* Binding this prevents execution of Lisp code during
261 redisplay, which necessarily leads to display problems. */
262 specbind (Qinhibit_eval_during_redisplay
, Qt
);
265 val
= apply1 (Vdebugger
, arg
);
267 /* Interrupting redisplay and resuming it later is not safe under
268 all circumstances. So, when the debugger returns, abort the
269 interrupted redisplay by going back to the top-level. */
270 if (debug_while_redisplaying
)
273 return unbind_to (count
, val
);
277 do_debug_on_call (code
)
280 debug_on_next_call
= 0;
281 backtrace_list
->debug_on_exit
= 1;
282 call_debugger (Fcons (code
, Qnil
));
285 /* NOTE!!! Every function that can call EVAL must protect its args
286 and temporaries from garbage collection while it needs them.
287 The definition of `For' shows what you have to do. */
289 DEFUN ("or", For
, Sor
, 0, UNEVALLED
, 0,
290 doc
: /* Eval args until one of them yields non-nil, then return that value.
291 The remaining args are not evalled at all.
292 If all args return nil, return nil.
293 usage: (or CONDITIONS ...) */)
297 register Lisp_Object val
= Qnil
;
304 val
= Feval (XCAR (args
));
314 DEFUN ("and", Fand
, Sand
, 0, UNEVALLED
, 0,
315 doc
: /* Eval args until one of them yields nil, then return nil.
316 The remaining args are not evalled at all.
317 If no arg yields nil, return the last arg's value.
318 usage: (and CONDITIONS ...) */)
322 register Lisp_Object val
= Qt
;
329 val
= Feval (XCAR (args
));
339 DEFUN ("if", Fif
, Sif
, 2, UNEVALLED
, 0,
340 doc
: /* If COND yields non-nil, do THEN, else do ELSE...
341 Returns the value of THEN or the value of the last of the ELSE's.
342 THEN must be one expression, but ELSE... can be zero or more expressions.
343 If COND yields nil, and there are no ELSE's, the value is nil.
344 usage: (if COND THEN ELSE...) */)
348 register Lisp_Object cond
;
352 cond
= Feval (Fcar (args
));
356 return Feval (Fcar (Fcdr (args
)));
357 return Fprogn (Fcdr (Fcdr (args
)));
360 DEFUN ("cond", Fcond
, Scond
, 0, UNEVALLED
, 0,
361 doc
: /* Try each clause until one succeeds.
362 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
363 and, if the value is non-nil, this clause succeeds:
364 then the expressions in BODY are evaluated and the last one's
365 value is the value of the cond-form.
366 If no clause succeeds, cond returns nil.
367 If a clause has one element, as in (CONDITION),
368 CONDITION's value if non-nil is returned from the cond-form.
369 usage: (cond CLAUSES...) */)
373 register Lisp_Object clause
, val
;
380 clause
= Fcar (args
);
381 val
= Feval (Fcar (clause
));
384 if (!EQ (XCDR (clause
), Qnil
))
385 val
= Fprogn (XCDR (clause
));
395 DEFUN ("progn", Fprogn
, Sprogn
, 0, UNEVALLED
, 0,
396 doc
: /* Eval BODY forms sequentially and return value of last one.
397 usage: (progn BODY ...) */)
401 register Lisp_Object val
= Qnil
;
408 val
= Feval (XCAR (args
));
416 DEFUN ("prog1", Fprog1
, Sprog1
, 1, UNEVALLED
, 0,
417 doc
: /* Eval FIRST and BODY sequentially; value from FIRST.
418 The value of FIRST is saved during the evaluation of the remaining args,
419 whose values are discarded.
420 usage: (prog1 FIRST BODY...) */)
425 register Lisp_Object args_left
;
426 struct gcpro gcpro1
, gcpro2
;
427 register int argnum
= 0;
439 val
= Feval (Fcar (args_left
));
441 Feval (Fcar (args_left
));
442 args_left
= Fcdr (args_left
);
444 while (!NILP(args_left
));
450 DEFUN ("prog2", Fprog2
, Sprog2
, 2, UNEVALLED
, 0,
451 doc
: /* Eval X, Y and BODY sequentially; value from Y.
452 The value of Y is saved during the evaluation of the remaining args,
453 whose values are discarded.
454 usage: (prog2 X Y BODY...) */)
459 register Lisp_Object args_left
;
460 struct gcpro gcpro1
, gcpro2
;
461 register int argnum
= -1;
475 val
= Feval (Fcar (args_left
));
477 Feval (Fcar (args_left
));
478 args_left
= Fcdr (args_left
);
480 while (!NILP (args_left
));
486 DEFUN ("setq", Fsetq
, Ssetq
, 0, UNEVALLED
, 0,
487 doc
: /* Set each SYM to the value of its VAL.
488 The symbols SYM are variables; they are literal (not evaluated).
489 The values VAL are expressions; they are evaluated.
490 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
491 The second VAL is not computed until after the first SYM is set, and so on;
492 each VAL can use the new value of variables set earlier in the `setq'.
493 The return value of the `setq' form is the value of the last VAL.
494 usage: (setq SYM VAL SYM VAL ...) */)
498 register Lisp_Object args_left
;
499 register Lisp_Object val
, sym
;
510 val
= Feval (Fcar (Fcdr (args_left
)));
511 sym
= Fcar (args_left
);
513 args_left
= Fcdr (Fcdr (args_left
));
515 while (!NILP(args_left
));
521 DEFUN ("quote", Fquote
, Squote
, 1, UNEVALLED
, 0,
522 doc
: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
523 usage: (quote ARG) */)
530 DEFUN ("function", Ffunction
, Sfunction
, 1, UNEVALLED
, 0,
531 doc
: /* Like `quote', but preferred for objects which are functions.
532 In byte compilation, `function' causes its argument to be compiled.
533 `quote' cannot do that.
534 usage: (function ARG) */)
542 DEFUN ("interactive-p", Finteractive_p
, Sinteractive_p
, 0, 0, 0,
543 doc
: /* Return t if function in which this appears was called interactively.
544 This means that the function was called with call-interactively (which
545 includes being called as the binding of a key)
546 and input is currently coming from the keyboard (not in keyboard macro). */)
549 return interactive_p (1) ? Qt
: Qnil
;
553 /* Return 1 if function in which this appears was called
554 interactively. This means that the function was called with
555 call-interactively (which includes being called as the binding of
556 a key) and input is currently coming from the keyboard (not in
559 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
560 called is a built-in. */
563 interactive_p (exclude_subrs_p
)
566 struct backtrace
*btp
;
572 btp
= backtrace_list
;
574 /* If this isn't a byte-compiled function, there may be a frame at
575 the top for Finteractive_p. If so, skip it. */
576 fun
= Findirect_function (*btp
->function
);
577 if (SUBRP (fun
) && XSUBR (fun
) == &Sinteractive_p
)
580 /* If we're running an Emacs 18-style byte-compiled function, there
581 may be a frame for Fbytecode at the top level. In any version of
582 Emacs there can be Fbytecode frames for subexpressions evaluated
583 inside catch and condition-case. Skip past them.
585 If this isn't a byte-compiled function, then we may now be
586 looking at several frames for special forms. Skip past them. */
588 && (EQ (*btp
->function
, Qbytecode
)
589 || btp
->nargs
== UNEVALLED
))
592 /* btp now points at the frame of the innermost function that isn't
593 a special form, ignoring frames for Finteractive_p and/or
594 Fbytecode at the top. If this frame is for a built-in function
595 (such as load or eval-region) return nil. */
596 fun
= Findirect_function (*btp
->function
);
597 if (exclude_subrs_p
&& SUBRP (fun
))
600 /* btp points to the frame of a Lisp function that called interactive-p.
601 Return t if that function was called interactively. */
602 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
608 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
609 doc
: /* Define NAME as a function.
610 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
611 See also the function `interactive'.
612 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
616 register Lisp_Object fn_name
;
617 register Lisp_Object defn
;
619 fn_name
= Fcar (args
);
620 CHECK_SYMBOL (fn_name
);
621 defn
= Fcons (Qlambda
, Fcdr (args
));
622 if (!NILP (Vpurify_flag
))
623 defn
= Fpurecopy (defn
);
624 if (CONSP (XSYMBOL (fn_name
)->function
)
625 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
626 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
627 Ffset (fn_name
, defn
);
628 LOADHIST_ATTACH (fn_name
);
632 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
633 doc
: /* Define NAME as a macro.
634 The actual definition looks like
635 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
636 When the macro is called, as in (NAME ARGS...),
637 the function (lambda ARGLIST BODY...) is applied to
638 the list ARGS... as it appears in the expression,
639 and the result should be a form to be evaluated instead of the original.
641 DECL is a declaration, optional, which can specify how to indent
642 calls to this macro and how Edebug should handle it. It looks like this:
644 The elements can look like this:
646 Set NAME's `lisp-indent-function' property to INDENT.
649 Set NAME's `edebug-form-spec' property to DEBUG. (This is
650 equivalent to writing a `def-edebug-spec' for the macro.)
651 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
655 register Lisp_Object fn_name
;
656 register Lisp_Object defn
;
657 Lisp_Object lambda_list
, doc
, tail
;
659 fn_name
= Fcar (args
);
660 lambda_list
= Fcar (Fcdr (args
));
661 tail
= Fcdr (Fcdr (args
));
664 if (STRINGP (Fcar (tail
)))
670 while (CONSP (Fcar (tail
))
671 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
673 if (!NILP (Vmacro_declaration_function
))
677 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
685 tail
= Fcons (lambda_list
, tail
);
687 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
688 defn
= Fcons (Qmacro
, Fcons (Qlambda
, tail
));
690 if (!NILP (Vpurify_flag
))
691 defn
= Fpurecopy (defn
);
692 if (CONSP (XSYMBOL (fn_name
)->function
)
693 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
694 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
695 Ffset (fn_name
, defn
);
696 LOADHIST_ATTACH (fn_name
);
701 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
702 doc
: /* Make SYMBOL a variable alias for symbol ALIASED.
703 Setting the value of SYMBOL will subsequently set the value of ALIASED,
704 and getting the value of SYMBOL will return the value ALIASED has.
705 Third arg DOCSTRING, if non-nil, is documentation for SYMBOL.
706 The return value is ALIASED. */)
707 (symbol
, aliased
, docstring
)
708 Lisp_Object symbol
, aliased
, docstring
;
710 struct Lisp_Symbol
*sym
;
712 CHECK_SYMBOL (symbol
);
713 CHECK_SYMBOL (aliased
);
715 if (SYMBOL_CONSTANT_P (symbol
))
716 error ("Cannot make a constant an alias");
718 sym
= XSYMBOL (symbol
);
719 sym
->indirect_variable
= 1;
720 sym
->value
= aliased
;
721 sym
->constant
= SYMBOL_CONSTANT_P (aliased
);
722 LOADHIST_ATTACH (Fcons (Qdefvar
, symbol
));
723 if (!NILP (docstring
))
724 Fput (symbol
, Qvariable_documentation
, docstring
);
730 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
731 doc
: /* Define SYMBOL as a variable.
732 You are not required to define a variable in order to use it,
733 but the definition can supply documentation and an initial value
734 in a way that tags can recognize.
736 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
737 If SYMBOL is buffer-local, its default value is what is set;
738 buffer-local values are not affected.
739 INITVALUE and DOCSTRING are optional.
740 If DOCSTRING starts with *, this variable is identified as a user option.
741 This means that M-x set-variable recognizes it.
742 See also `user-variable-p'.
743 If INITVALUE is missing, SYMBOL's value is not set.
744 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
748 register Lisp_Object sym
, tem
, tail
;
752 if (!NILP (Fcdr (Fcdr (tail
))))
753 error ("too many arguments");
755 tem
= Fdefault_boundp (sym
);
759 Fset_default (sym
, Feval (Fcar (tail
)));
764 if (!NILP (Vpurify_flag
))
765 tem
= Fpurecopy (tem
);
766 Fput (sym
, Qvariable_documentation
, tem
);
768 LOADHIST_ATTACH (Fcons (Qdefvar
, sym
));
771 /* Simple (defvar <var>) should not count as a definition at all.
772 It could get in the way of other definitions, and unloading this
773 package could try to make the variable unbound. */
779 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
780 doc
: /* Define SYMBOL as a constant variable.
781 The intent is that neither programs nor users should ever change this value.
782 Always sets the value of SYMBOL to the result of evalling INITVALUE.
783 If SYMBOL is buffer-local, its default value is what is set;
784 buffer-local values are not affected.
785 DOCSTRING is optional.
786 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
790 register Lisp_Object sym
, tem
;
793 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
794 error ("too many arguments");
796 tem
= Feval (Fcar (Fcdr (args
)));
797 if (!NILP (Vpurify_flag
))
798 tem
= Fpurecopy (tem
);
799 Fset_default (sym
, tem
);
800 tem
= Fcar (Fcdr (Fcdr (args
)));
803 if (!NILP (Vpurify_flag
))
804 tem
= Fpurecopy (tem
);
805 Fput (sym
, Qvariable_documentation
, tem
);
807 LOADHIST_ATTACH (Fcons (Qdefvar
, sym
));
811 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
812 doc
: /* Returns t if VARIABLE is intended to be set and modified by users.
813 \(The alternative is a variable used internally in a Lisp program.)
814 Determined by whether the first character of the documentation
815 for the variable is `*' or if the variable is customizable (has a non-nil
816 value of `standard-value' or of `custom-autoload' on its property list). */)
818 Lisp_Object variable
;
820 Lisp_Object documentation
;
822 if (!SYMBOLP (variable
))
825 documentation
= Fget (variable
, Qvariable_documentation
);
826 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
828 if (STRINGP (documentation
)
829 && ((unsigned char) SREF (documentation
, 0) == '*'))
831 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
832 if (CONSP (documentation
)
833 && STRINGP (XCAR (documentation
))
834 && INTEGERP (XCDR (documentation
))
835 && XINT (XCDR (documentation
)) < 0)
837 /* Customizable? See `custom-variable-p'. */
838 if ((!NILP (Fget (variable
, intern ("standard-value"))))
839 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
844 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
845 doc
: /* Bind variables according to VARLIST then eval BODY.
846 The value of the last form in BODY is returned.
847 Each element of VARLIST is a symbol (which is bound to nil)
848 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
849 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
850 usage: (let* VARLIST BODY...) */)
854 Lisp_Object varlist
, val
, elt
;
855 int count
= SPECPDL_INDEX ();
856 struct gcpro gcpro1
, gcpro2
, gcpro3
;
858 GCPRO3 (args
, elt
, varlist
);
860 varlist
= Fcar (args
);
861 while (!NILP (varlist
))
864 elt
= Fcar (varlist
);
866 specbind (elt
, Qnil
);
867 else if (! NILP (Fcdr (Fcdr (elt
))))
869 Fcons (build_string ("`let' bindings can have only one value-form"),
873 val
= Feval (Fcar (Fcdr (elt
)));
874 specbind (Fcar (elt
), val
);
876 varlist
= Fcdr (varlist
);
879 val
= Fprogn (Fcdr (args
));
880 return unbind_to (count
, val
);
883 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
884 doc
: /* Bind variables according to VARLIST then eval BODY.
885 The value of the last form in BODY is returned.
886 Each element of VARLIST is a symbol (which is bound to nil)
887 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
888 All the VALUEFORMs are evalled before any symbols are bound.
889 usage: (let VARLIST BODY...) */)
893 Lisp_Object
*temps
, tem
;
894 register Lisp_Object elt
, varlist
;
895 int count
= SPECPDL_INDEX ();
897 struct gcpro gcpro1
, gcpro2
;
899 varlist
= Fcar (args
);
901 /* Make space to hold the values to give the bound variables */
902 elt
= Flength (varlist
);
903 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
905 /* Compute the values and store them in `temps' */
907 GCPRO2 (args
, *temps
);
910 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
913 elt
= Fcar (varlist
);
915 temps
[argnum
++] = Qnil
;
916 else if (! NILP (Fcdr (Fcdr (elt
))))
918 Fcons (build_string ("`let' bindings can have only one value-form"),
921 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
922 gcpro2
.nvars
= argnum
;
926 varlist
= Fcar (args
);
927 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
929 elt
= Fcar (varlist
);
930 tem
= temps
[argnum
++];
934 specbind (Fcar (elt
), tem
);
937 elt
= Fprogn (Fcdr (args
));
938 return unbind_to (count
, elt
);
941 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
942 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
943 The order of execution is thus TEST, BODY, TEST, BODY and so on
944 until TEST returns nil.
945 usage: (while TEST BODY...) */)
949 Lisp_Object test
, body
;
950 struct gcpro gcpro1
, gcpro2
;
956 while (!NILP (Feval (test
)))
966 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
967 doc
: /* Return result of expanding macros at top level of FORM.
968 If FORM is not a macro call, it is returned unchanged.
969 Otherwise, the macro is expanded and the expansion is considered
970 in place of FORM. When a non-macro-call results, it is returned.
972 The second optional arg ENVIRONMENT specifies an environment of macro
973 definitions to shadow the loaded ones for use in file byte-compilation. */)
976 Lisp_Object environment
;
978 /* With cleanups from Hallvard Furuseth. */
979 register Lisp_Object expander
, sym
, def
, tem
;
983 /* Come back here each time we expand a macro call,
984 in case it expands into another macro call. */
987 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
988 def
= sym
= XCAR (form
);
990 /* Trace symbols aliases to other symbols
991 until we get a symbol that is not an alias. */
992 while (SYMBOLP (def
))
996 tem
= Fassq (sym
, environment
);
999 def
= XSYMBOL (sym
)->function
;
1000 if (!EQ (def
, Qunbound
))
1005 /* Right now TEM is the result from SYM in ENVIRONMENT,
1006 and if TEM is nil then DEF is SYM's function definition. */
1009 /* SYM is not mentioned in ENVIRONMENT.
1010 Look at its function definition. */
1011 if (EQ (def
, Qunbound
) || !CONSP (def
))
1012 /* Not defined or definition not suitable */
1014 if (EQ (XCAR (def
), Qautoload
))
1016 /* Autoloading function: will it be a macro when loaded? */
1017 tem
= Fnth (make_number (4), def
);
1018 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1019 /* Yes, load it and try again. */
1021 struct gcpro gcpro1
;
1023 do_autoload (def
, sym
);
1030 else if (!EQ (XCAR (def
), Qmacro
))
1032 else expander
= XCDR (def
);
1036 expander
= XCDR (tem
);
1037 if (NILP (expander
))
1040 form
= apply1 (expander
, XCDR (form
));
1045 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1046 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1047 TAG is evalled to get the tag to use; it must not be nil.
1049 Then the BODY is executed.
1050 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1051 If no throw happens, `catch' returns the value of the last BODY form.
1052 If a throw happens, it specifies the value to return from `catch'.
1053 usage: (catch TAG BODY...) */)
1057 register Lisp_Object tag
;
1058 struct gcpro gcpro1
;
1061 tag
= Feval (Fcar (args
));
1063 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1066 /* Set up a catch, then call C function FUNC on argument ARG.
1067 FUNC should return a Lisp_Object.
1068 This is how catches are done from within C code. */
1071 internal_catch (tag
, func
, arg
)
1073 Lisp_Object (*func
) ();
1076 /* This structure is made part of the chain `catchlist'. */
1079 /* Fill in the components of c, and put it on the list. */
1083 c
.backlist
= backtrace_list
;
1084 c
.handlerlist
= handlerlist
;
1085 c
.lisp_eval_depth
= lisp_eval_depth
;
1086 c
.pdlcount
= SPECPDL_INDEX ();
1087 c
.poll_suppress_count
= poll_suppress_count
;
1088 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1089 c
.gcpro
= gcprolist
;
1090 c
.byte_stack
= byte_stack_list
;
1094 if (! _setjmp (c
.jmp
))
1095 c
.val
= (*func
) (arg
);
1097 /* Throw works by a longjmp that comes right here. */
1102 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1103 jump to that CATCH, returning VALUE as the value of that catch.
1105 This is the guts Fthrow and Fsignal; they differ only in the way
1106 they choose the catch tag to throw to. A catch tag for a
1107 condition-case form has a TAG of Qnil.
1109 Before each catch is discarded, unbind all special bindings and
1110 execute all unwind-protect clauses made above that catch. Unwind
1111 the handler stack as we go, so that the proper handlers are in
1112 effect for each unwind-protect clause we run. At the end, restore
1113 some static info saved in CATCH, and longjmp to the location
1116 This is used for correct unwinding in Fthrow and Fsignal. */
1119 unwind_to_catch (catch, value
)
1120 struct catchtag
*catch;
1123 register int last_time
;
1125 /* Save the value in the tag. */
1128 /* Restore the polling-suppression count. */
1129 set_poll_suppress_count (catch->poll_suppress_count
);
1130 interrupt_input_blocked
= catch->interrupt_input_blocked
;
1134 last_time
= catchlist
== catch;
1136 /* Unwind the specpdl stack, and then restore the proper set of
1138 unbind_to (catchlist
->pdlcount
, Qnil
);
1139 handlerlist
= catchlist
->handlerlist
;
1140 catchlist
= catchlist
->next
;
1142 while (! last_time
);
1144 byte_stack_list
= catch->byte_stack
;
1145 gcprolist
= catch->gcpro
;
1148 gcpro_level
= gcprolist
->level
+ 1;
1152 backtrace_list
= catch->backlist
;
1153 lisp_eval_depth
= catch->lisp_eval_depth
;
1155 _longjmp (catch->jmp
, 1);
1158 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1159 doc
: /* Throw to the catch for TAG and return VALUE from it.
1160 Both TAG and VALUE are evalled. */)
1162 register Lisp_Object tag
, value
;
1164 register struct catchtag
*c
;
1169 for (c
= catchlist
; c
; c
= c
->next
)
1171 if (EQ (c
->tag
, tag
))
1172 unwind_to_catch (c
, value
);
1174 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1179 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1180 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1181 If BODYFORM completes normally, its value is returned
1182 after executing the UNWINDFORMS.
1183 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1184 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1189 int count
= SPECPDL_INDEX ();
1191 record_unwind_protect (Fprogn
, Fcdr (args
));
1192 val
= Feval (Fcar (args
));
1193 return unbind_to (count
, val
);
1196 /* Chain of condition handlers currently in effect.
1197 The elements of this chain are contained in the stack frames
1198 of Fcondition_case and internal_condition_case.
1199 When an error is signaled (by calling Fsignal, below),
1200 this chain is searched for an element that applies. */
1202 struct handler
*handlerlist
;
1204 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1205 doc
: /* Regain control when an error is signaled.
1206 Executes BODYFORM and returns its value if no error happens.
1207 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1208 where the BODY is made of Lisp expressions.
1210 A handler is applicable to an error
1211 if CONDITION-NAME is one of the error's condition names.
1212 If an error happens, the first applicable handler is run.
1214 The car of a handler may be a list of condition names
1215 instead of a single condition name.
1217 When a handler handles an error,
1218 control returns to the condition-case and the handler BODY... is executed
1219 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1220 VAR may be nil; then you do not get access to the signal information.
1222 The value of the last BODY form is returned from the condition-case.
1223 See also the function `signal' for more info.
1224 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1231 register Lisp_Object bodyform
, handlers
;
1232 volatile Lisp_Object var
;
1235 bodyform
= Fcar (Fcdr (args
));
1236 handlers
= Fcdr (Fcdr (args
));
1239 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1245 && (SYMBOLP (XCAR (tem
))
1246 || CONSP (XCAR (tem
))))))
1247 error ("Invalid condition handler", tem
);
1252 c
.backlist
= backtrace_list
;
1253 c
.handlerlist
= handlerlist
;
1254 c
.lisp_eval_depth
= lisp_eval_depth
;
1255 c
.pdlcount
= SPECPDL_INDEX ();
1256 c
.poll_suppress_count
= poll_suppress_count
;
1257 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1258 c
.gcpro
= gcprolist
;
1259 c
.byte_stack
= byte_stack_list
;
1260 if (_setjmp (c
.jmp
))
1263 specbind (h
.var
, c
.val
);
1264 val
= Fprogn (Fcdr (h
.chosen_clause
));
1266 /* Note that this just undoes the binding of h.var; whoever
1267 longjumped to us unwound the stack to c.pdlcount before
1269 unbind_to (c
.pdlcount
, Qnil
);
1276 h
.handler
= handlers
;
1277 h
.next
= handlerlist
;
1281 val
= Feval (bodyform
);
1283 handlerlist
= h
.next
;
1287 /* Call the function BFUN with no arguments, catching errors within it
1288 according to HANDLERS. If there is an error, call HFUN with
1289 one argument which is the data that describes the error:
1292 HANDLERS can be a list of conditions to catch.
1293 If HANDLERS is Qt, catch all errors.
1294 If HANDLERS is Qerror, catch all errors
1295 but allow the debugger to run if that is enabled. */
1298 internal_condition_case (bfun
, handlers
, hfun
)
1299 Lisp_Object (*bfun
) ();
1300 Lisp_Object handlers
;
1301 Lisp_Object (*hfun
) ();
1307 #if 0 /* We now handle interrupt_input_blocked properly.
1308 What we still do not handle is exiting a signal handler. */
1314 c
.backlist
= backtrace_list
;
1315 c
.handlerlist
= handlerlist
;
1316 c
.lisp_eval_depth
= lisp_eval_depth
;
1317 c
.pdlcount
= SPECPDL_INDEX ();
1318 c
.poll_suppress_count
= poll_suppress_count
;
1319 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1320 c
.gcpro
= gcprolist
;
1321 c
.byte_stack
= byte_stack_list
;
1322 if (_setjmp (c
.jmp
))
1324 return (*hfun
) (c
.val
);
1328 h
.handler
= handlers
;
1330 h
.next
= handlerlist
;
1336 handlerlist
= h
.next
;
1340 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1343 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1344 Lisp_Object (*bfun
) ();
1346 Lisp_Object handlers
;
1347 Lisp_Object (*hfun
) ();
1355 c
.backlist
= backtrace_list
;
1356 c
.handlerlist
= handlerlist
;
1357 c
.lisp_eval_depth
= lisp_eval_depth
;
1358 c
.pdlcount
= SPECPDL_INDEX ();
1359 c
.poll_suppress_count
= poll_suppress_count
;
1360 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1361 c
.gcpro
= gcprolist
;
1362 c
.byte_stack
= byte_stack_list
;
1363 if (_setjmp (c
.jmp
))
1365 return (*hfun
) (c
.val
);
1369 h
.handler
= handlers
;
1371 h
.next
= handlerlist
;
1375 val
= (*bfun
) (arg
);
1377 handlerlist
= h
.next
;
1382 /* Like internal_condition_case but call BFUN with NARGS as first,
1383 and ARGS as second argument. */
1386 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1387 Lisp_Object (*bfun
) ();
1390 Lisp_Object handlers
;
1391 Lisp_Object (*hfun
) ();
1399 c
.backlist
= backtrace_list
;
1400 c
.handlerlist
= handlerlist
;
1401 c
.lisp_eval_depth
= lisp_eval_depth
;
1402 c
.pdlcount
= SPECPDL_INDEX ();
1403 c
.poll_suppress_count
= poll_suppress_count
;
1404 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1405 c
.gcpro
= gcprolist
;
1406 c
.byte_stack
= byte_stack_list
;
1407 if (_setjmp (c
.jmp
))
1409 return (*hfun
) (c
.val
);
1413 h
.handler
= handlers
;
1415 h
.next
= handlerlist
;
1419 val
= (*bfun
) (nargs
, args
);
1421 handlerlist
= h
.next
;
1426 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1427 Lisp_Object
, Lisp_Object
,
1430 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1431 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1432 This function does not return.
1434 An error symbol is a symbol with an `error-conditions' property
1435 that is a list of condition names.
1436 A handler for any of those names will get to handle this signal.
1437 The symbol `error' should normally be one of them.
1439 DATA should be a list. Its elements are printed as part of the error message.
1440 See Info anchor `(elisp)Definition of signal' for some details on how this
1441 error message is constructed.
1442 If the signal is handled, DATA is made available to the handler.
1443 See also the function `condition-case'. */)
1444 (error_symbol
, data
)
1445 Lisp_Object error_symbol
, data
;
1447 /* When memory is full, ERROR-SYMBOL is nil,
1448 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1449 That is a special case--don't do this in other situations. */
1450 register struct handler
*allhandlers
= handlerlist
;
1451 Lisp_Object conditions
;
1452 extern int gc_in_progress
;
1453 extern int waiting_for_input
;
1454 Lisp_Object debugger_value
;
1456 Lisp_Object real_error_symbol
;
1457 struct backtrace
*bp
;
1459 immediate_quit
= handling_signal
= 0;
1461 if (gc_in_progress
|| waiting_for_input
)
1464 if (NILP (error_symbol
))
1465 real_error_symbol
= Fcar (data
);
1467 real_error_symbol
= error_symbol
;
1469 #if 0 /* rms: I don't know why this was here,
1470 but it is surely wrong for an error that is handled. */
1471 #ifdef HAVE_X_WINDOWS
1472 if (display_hourglass_p
)
1473 cancel_hourglass ();
1477 /* This hook is used by edebug. */
1478 if (! NILP (Vsignal_hook_function
)
1479 && ! NILP (error_symbol
))
1480 call2 (Vsignal_hook_function
, error_symbol
, data
);
1482 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1484 /* Remember from where signal was called. Skip over the frame for
1485 `signal' itself. If a frame for `error' follows, skip that,
1486 too. Don't do this when ERROR_SYMBOL is nil, because that
1487 is a memory-full error. */
1488 Vsignaling_function
= Qnil
;
1489 if (backtrace_list
&& !NILP (error_symbol
))
1491 bp
= backtrace_list
->next
;
1492 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1494 if (bp
&& bp
->function
)
1495 Vsignaling_function
= *bp
->function
;
1498 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1500 register Lisp_Object clause
;
1502 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1503 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1505 if (specpdl_size
+ 40 > max_specpdl_size
)
1506 max_specpdl_size
= specpdl_size
+ 40;
1508 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1509 error_symbol
, data
, &debugger_value
);
1511 if (EQ (clause
, Qlambda
))
1513 /* We can't return values to code which signaled an error, but we
1514 can continue code which has signaled a quit. */
1515 if (EQ (real_error_symbol
, Qquit
))
1518 error ("Cannot return from the debugger in an error");
1523 Lisp_Object unwind_data
;
1524 struct handler
*h
= handlerlist
;
1526 handlerlist
= allhandlers
;
1528 if (NILP (error_symbol
))
1531 unwind_data
= Fcons (error_symbol
, data
);
1532 h
->chosen_clause
= clause
;
1533 unwind_to_catch (h
->tag
, unwind_data
);
1537 handlerlist
= allhandlers
;
1538 /* If no handler is present now, try to run the debugger,
1539 and if that fails, throw to top level. */
1540 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1542 Fthrow (Qtop_level
, Qt
);
1544 if (! NILP (error_symbol
))
1545 data
= Fcons (error_symbol
, data
);
1547 string
= Ferror_message_string (data
);
1548 fatal ("%s", SDATA (string
), 0);
1551 /* Return nonzero iff LIST is a non-nil atom or
1552 a list containing one of CONDITIONS. */
1555 wants_debugger (list
, conditions
)
1556 Lisp_Object list
, conditions
;
1563 while (CONSP (conditions
))
1565 Lisp_Object
this, tail
;
1566 this = XCAR (conditions
);
1567 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1568 if (EQ (XCAR (tail
), this))
1570 conditions
= XCDR (conditions
);
1575 /* Return 1 if an error with condition-symbols CONDITIONS,
1576 and described by SIGNAL-DATA, should skip the debugger
1577 according to debugger-ignored-errors. */
1580 skip_debugger (conditions
, data
)
1581 Lisp_Object conditions
, data
;
1584 int first_string
= 1;
1585 Lisp_Object error_message
;
1587 error_message
= Qnil
;
1588 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1590 if (STRINGP (XCAR (tail
)))
1594 error_message
= Ferror_message_string (data
);
1598 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1603 Lisp_Object contail
;
1605 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1606 if (EQ (XCAR (tail
), XCAR (contail
)))
1614 /* Value of Qlambda means we have called debugger and user has continued.
1615 There are two ways to pass SIG and DATA:
1616 = SIG is the error symbol, and DATA is the rest of the data.
1617 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1618 This is for memory-full errors only.
1620 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1623 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1624 Lisp_Object handlers
, conditions
, sig
, data
;
1625 Lisp_Object
*debugger_value_ptr
;
1627 register Lisp_Object h
;
1628 register Lisp_Object tem
;
1630 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1632 /* error is used similarly, but means print an error message
1633 and run the debugger if that is enabled. */
1634 if (EQ (handlers
, Qerror
)
1635 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1636 there is a handler. */
1638 int count
= SPECPDL_INDEX ();
1639 int debugger_called
= 0;
1640 Lisp_Object sig_symbol
, combined_data
;
1641 /* This is set to 1 if we are handling a memory-full error,
1642 because these must not run the debugger.
1643 (There is no room in memory to do that!) */
1644 int no_debugger
= 0;
1648 combined_data
= data
;
1649 sig_symbol
= Fcar (data
);
1654 combined_data
= Fcons (sig
, data
);
1658 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1661 internal_with_output_to_temp_buffer ("*Backtrace*",
1662 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1665 internal_with_output_to_temp_buffer ("*Backtrace*",
1670 && (EQ (sig_symbol
, Qquit
)
1672 : wants_debugger (Vdebug_on_error
, conditions
))
1673 && ! skip_debugger (conditions
, combined_data
)
1674 && when_entered_debugger
< num_nonmacro_input_events
)
1676 specbind (Qdebug_on_error
, Qnil
);
1678 = call_debugger (Fcons (Qerror
,
1679 Fcons (combined_data
, Qnil
)));
1680 debugger_called
= 1;
1682 /* If there is no handler, return saying whether we ran the debugger. */
1683 if (EQ (handlers
, Qerror
))
1685 if (debugger_called
)
1686 return unbind_to (count
, Qlambda
);
1690 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1692 Lisp_Object handler
, condit
;
1695 if (!CONSP (handler
))
1697 condit
= Fcar (handler
);
1698 /* Handle a single condition name in handler HANDLER. */
1699 if (SYMBOLP (condit
))
1701 tem
= Fmemq (Fcar (handler
), conditions
);
1705 /* Handle a list of condition names in handler HANDLER. */
1706 else if (CONSP (condit
))
1708 while (CONSP (condit
))
1710 tem
= Fmemq (Fcar (condit
), conditions
);
1713 condit
= XCDR (condit
);
1720 /* dump an error message; called like printf */
1724 error (m
, a1
, a2
, a3
)
1744 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1749 buffer
= (char *) xrealloc (buffer
, size
);
1752 buffer
= (char *) xmalloc (size
);
1757 string
= build_string (buffer
);
1761 Fsignal (Qerror
, Fcons (string
, Qnil
));
1765 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1766 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1767 This means it contains a description for how to read arguments to give it.
1768 The value is nil for an invalid function or a symbol with no function
1771 Interactively callable functions include strings and vectors (treated
1772 as keyboard macros), lambda-expressions that contain a top-level call
1773 to `interactive', autoload definitions made by `autoload' with non-nil
1774 fourth argument, and some of the built-in functions of Lisp.
1776 Also, a symbol satisfies `commandp' if its function definition does so.
1778 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1779 then strings and vectors are not accepted. */)
1780 (function
, for_call_interactively
)
1781 Lisp_Object function
, for_call_interactively
;
1783 register Lisp_Object fun
;
1784 register Lisp_Object funcar
;
1788 fun
= indirect_function (fun
);
1789 if (EQ (fun
, Qunbound
))
1792 /* Emacs primitives are interactive if their DEFUN specifies an
1793 interactive spec. */
1796 if (XSUBR (fun
)->prompt
)
1802 /* Bytecode objects are interactive if they are long enough to
1803 have an element whose index is COMPILED_INTERACTIVE, which is
1804 where the interactive spec is stored. */
1805 else if (COMPILEDP (fun
))
1806 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1809 /* Strings and vectors are keyboard macros. */
1810 if (NILP (for_call_interactively
) && (STRINGP (fun
) || VECTORP (fun
)))
1813 /* Lists may represent commands. */
1816 funcar
= XCAR (fun
);
1817 if (EQ (funcar
, Qlambda
))
1818 return Fassq (Qinteractive
, Fcdr (XCDR (fun
)));
1819 if (EQ (funcar
, Qautoload
))
1820 return Fcar (Fcdr (Fcdr (XCDR (fun
))));
1826 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1827 doc
: /* Define FUNCTION to autoload from FILE.
1828 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1829 Third arg DOCSTRING is documentation for the function.
1830 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1831 Fifth arg TYPE indicates the type of the object:
1832 nil or omitted says FUNCTION is a function,
1833 `keymap' says FUNCTION is really a keymap, and
1834 `macro' or t says FUNCTION is really a macro.
1835 Third through fifth args give info about the real definition.
1836 They default to nil.
1837 If FUNCTION is already defined other than as an autoload,
1838 this does nothing and returns nil. */)
1839 (function
, file
, docstring
, interactive
, type
)
1840 Lisp_Object function
, file
, docstring
, interactive
, type
;
1843 Lisp_Object args
[4];
1846 CHECK_SYMBOL (function
);
1847 CHECK_STRING (file
);
1849 /* If function is defined and not as an autoload, don't override */
1850 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1851 && !(CONSP (XSYMBOL (function
)->function
)
1852 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1855 if (NILP (Vpurify_flag
))
1856 /* Only add entries after dumping, because the ones before are
1857 not useful and else we get loads of them from the loaddefs.el. */
1858 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1862 args
[1] = docstring
;
1863 args
[2] = interactive
;
1866 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1867 #else /* NO_ARG_ARRAY */
1868 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1869 #endif /* not NO_ARG_ARRAY */
1873 un_autoload (oldqueue
)
1874 Lisp_Object oldqueue
;
1876 register Lisp_Object queue
, first
, second
;
1878 /* Queue to unwind is current value of Vautoload_queue.
1879 oldqueue is the shadowed value to leave in Vautoload_queue. */
1880 queue
= Vautoload_queue
;
1881 Vautoload_queue
= oldqueue
;
1882 while (CONSP (queue
))
1884 first
= XCAR (queue
);
1885 second
= Fcdr (first
);
1886 first
= Fcar (first
);
1887 if (EQ (second
, Qnil
))
1890 Ffset (first
, second
);
1891 queue
= XCDR (queue
);
1896 /* Load an autoloaded function.
1897 FUNNAME is the symbol which is the function's name.
1898 FUNDEF is the autoload definition (a list). */
1901 do_autoload (fundef
, funname
)
1902 Lisp_Object fundef
, funname
;
1904 int count
= SPECPDL_INDEX ();
1905 Lisp_Object fun
, queue
, first
, second
;
1906 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1908 /* This is to make sure that loadup.el gives a clear picture
1909 of what files are preloaded and when. */
1910 if (! NILP (Vpurify_flag
))
1911 error ("Attempt to autoload %s while preparing to dump",
1912 SDATA (SYMBOL_NAME (funname
)));
1915 CHECK_SYMBOL (funname
);
1916 GCPRO3 (fun
, funname
, fundef
);
1918 /* Preserve the match data. */
1919 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1921 /* Value saved here is to be restored into Vautoload_queue. */
1922 record_unwind_protect (un_autoload
, Vautoload_queue
);
1923 Vautoload_queue
= Qt
;
1924 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1926 /* Save the old autoloads, in case we ever do an unload. */
1927 queue
= Vautoload_queue
;
1928 while (CONSP (queue
))
1930 first
= XCAR (queue
);
1931 second
= Fcdr (first
);
1932 first
= Fcar (first
);
1934 /* Note: This test is subtle. The cdr of an autoload-queue entry
1935 may be an atom if the autoload entry was generated by a defalias
1938 Fput (first
, Qautoload
, (XCDR (second
)));
1940 queue
= XCDR (queue
);
1943 /* Once loading finishes, don't undo it. */
1944 Vautoload_queue
= Qt
;
1945 unbind_to (count
, Qnil
);
1947 fun
= Findirect_function (fun
);
1949 if (!NILP (Fequal (fun
, fundef
)))
1950 error ("Autoloading failed to define function %s",
1951 SDATA (SYMBOL_NAME (funname
)));
1956 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
1957 doc
: /* Evaluate FORM and return its value. */)
1961 Lisp_Object fun
, val
, original_fun
, original_args
;
1963 struct backtrace backtrace
;
1964 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1966 if (handling_signal
)
1970 return Fsymbol_value (form
);
1975 if (consing_since_gc
> gc_cons_threshold
)
1978 Fgarbage_collect ();
1982 if (++lisp_eval_depth
> max_lisp_eval_depth
)
1984 if (max_lisp_eval_depth
< 100)
1985 max_lisp_eval_depth
= 100;
1986 if (lisp_eval_depth
> max_lisp_eval_depth
)
1987 error ("Lisp nesting exceeds max-lisp-eval-depth");
1990 original_fun
= Fcar (form
);
1991 original_args
= Fcdr (form
);
1993 backtrace
.next
= backtrace_list
;
1994 backtrace_list
= &backtrace
;
1995 backtrace
.function
= &original_fun
; /* This also protects them from gc */
1996 backtrace
.args
= &original_args
;
1997 backtrace
.nargs
= UNEVALLED
;
1998 backtrace
.evalargs
= 1;
1999 backtrace
.debug_on_exit
= 0;
2001 if (debug_on_next_call
)
2002 do_debug_on_call (Qt
);
2004 /* At this point, only original_fun and original_args
2005 have values that will be used below */
2007 fun
= Findirect_function (original_fun
);
2011 Lisp_Object numargs
;
2012 Lisp_Object argvals
[8];
2013 Lisp_Object args_left
;
2014 register int i
, maxargs
;
2016 args_left
= original_args
;
2017 numargs
= Flength (args_left
);
2019 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2020 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2021 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2023 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2025 backtrace
.evalargs
= 0;
2026 val
= (*XSUBR (fun
)->function
) (args_left
);
2030 if (XSUBR (fun
)->max_args
== MANY
)
2032 /* Pass a vector of evaluated arguments */
2034 register int argnum
= 0;
2036 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2038 GCPRO3 (args_left
, fun
, fun
);
2042 while (!NILP (args_left
))
2044 vals
[argnum
++] = Feval (Fcar (args_left
));
2045 args_left
= Fcdr (args_left
);
2046 gcpro3
.nvars
= argnum
;
2049 backtrace
.args
= vals
;
2050 backtrace
.nargs
= XINT (numargs
);
2052 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2057 GCPRO3 (args_left
, fun
, fun
);
2058 gcpro3
.var
= argvals
;
2061 maxargs
= XSUBR (fun
)->max_args
;
2062 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2064 argvals
[i
] = Feval (Fcar (args_left
));
2070 backtrace
.args
= argvals
;
2071 backtrace
.nargs
= XINT (numargs
);
2076 val
= (*XSUBR (fun
)->function
) ();
2079 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2082 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2085 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2089 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2090 argvals
[2], argvals
[3]);
2093 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2094 argvals
[3], argvals
[4]);
2097 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2098 argvals
[3], argvals
[4], argvals
[5]);
2101 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2102 argvals
[3], argvals
[4], argvals
[5],
2107 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2108 argvals
[3], argvals
[4], argvals
[5],
2109 argvals
[6], argvals
[7]);
2113 /* Someone has created a subr that takes more arguments than
2114 is supported by this code. We need to either rewrite the
2115 subr to use a different argument protocol, or add more
2116 cases to this switch. */
2120 if (COMPILEDP (fun
))
2121 val
= apply_lambda (fun
, original_args
, 1);
2125 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2126 funcar
= Fcar (fun
);
2127 if (!SYMBOLP (funcar
))
2128 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2129 if (EQ (funcar
, Qautoload
))
2131 do_autoload (fun
, original_fun
);
2134 if (EQ (funcar
, Qmacro
))
2135 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2136 else if (EQ (funcar
, Qlambda
))
2137 val
= apply_lambda (fun
, original_args
, 1);
2139 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2143 if (backtrace
.debug_on_exit
)
2144 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2145 backtrace_list
= backtrace
.next
;
2148 mac_check_for_quit_char();
2153 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2154 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2155 Then return the value FUNCTION returns.
2156 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2157 usage: (apply FUNCTION &rest ARGUMENTS) */)
2162 register int i
, numargs
;
2163 register Lisp_Object spread_arg
;
2164 register Lisp_Object
*funcall_args
;
2166 struct gcpro gcpro1
;
2170 spread_arg
= args
[nargs
- 1];
2171 CHECK_LIST (spread_arg
);
2173 numargs
= XINT (Flength (spread_arg
));
2176 return Ffuncall (nargs
- 1, args
);
2177 else if (numargs
== 1)
2179 args
[nargs
- 1] = XCAR (spread_arg
);
2180 return Ffuncall (nargs
, args
);
2183 numargs
+= nargs
- 2;
2185 fun
= indirect_function (fun
);
2186 if (EQ (fun
, Qunbound
))
2188 /* Let funcall get the error */
2195 if (numargs
< XSUBR (fun
)->min_args
2196 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2197 goto funcall
; /* Let funcall get the error */
2198 else if (XSUBR (fun
)->max_args
> numargs
)
2200 /* Avoid making funcall cons up a yet another new vector of arguments
2201 by explicitly supplying nil's for optional values */
2202 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2203 * sizeof (Lisp_Object
));
2204 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2205 funcall_args
[++i
] = Qnil
;
2206 GCPRO1 (*funcall_args
);
2207 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2211 /* We add 1 to numargs because funcall_args includes the
2212 function itself as well as its arguments. */
2215 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2216 * sizeof (Lisp_Object
));
2217 GCPRO1 (*funcall_args
);
2218 gcpro1
.nvars
= 1 + numargs
;
2221 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2222 /* Spread the last arg we got. Its first element goes in
2223 the slot that it used to occupy, hence this value of I. */
2225 while (!NILP (spread_arg
))
2227 funcall_args
[i
++] = XCAR (spread_arg
);
2228 spread_arg
= XCDR (spread_arg
);
2231 /* By convention, the caller needs to gcpro Ffuncall's args. */
2232 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2235 /* Run hook variables in various ways. */
2237 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2238 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2239 enum run_hooks_condition
));
2241 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2242 doc
: /* Run each hook in HOOKS. Major mode functions use this.
2243 Each argument should be a symbol, a hook variable.
2244 These symbols are processed in the order specified.
2245 If a hook symbol has a non-nil value, that value may be a function
2246 or a list of functions to be called to run the hook.
2247 If the value is a function, it is called with no arguments.
2248 If it is a list, the elements are called, in order, with no arguments.
2250 Do not use `make-local-variable' to make a hook variable buffer-local.
2251 Instead, use `add-hook' and specify t for the LOCAL argument.
2252 usage: (run-hooks &rest HOOKS) */)
2257 Lisp_Object hook
[1];
2260 for (i
= 0; i
< nargs
; i
++)
2263 run_hook_with_args (1, hook
, to_completion
);
2269 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2270 Srun_hook_with_args
, 1, MANY
, 0,
2271 doc
: /* Run HOOK with the specified arguments ARGS.
2272 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2273 value, that value may be a function or a list of functions to be
2274 called to run the hook. If the value is a function, it is called with
2275 the given arguments and its return value is returned. If it is a list
2276 of functions, those functions are called, in order,
2277 with the given arguments ARGS.
2278 It is best not to depend on the value return by `run-hook-with-args',
2281 Do not use `make-local-variable' to make a hook variable buffer-local.
2282 Instead, use `add-hook' and specify t for the LOCAL argument.
2283 usage: (run-hook-with-args HOOK &rest ARGS) */)
2288 return run_hook_with_args (nargs
, args
, to_completion
);
2291 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2292 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2293 doc
: /* Run HOOK with the specified arguments ARGS.
2294 HOOK should be a symbol, a hook variable. Its value should
2295 be a list of functions. We call those functions, one by one,
2296 passing arguments ARGS to each of them, until one of them
2297 returns a non-nil value. Then we return that value.
2298 If all the functions return nil, we return nil.
2300 Do not use `make-local-variable' to make a hook variable buffer-local.
2301 Instead, use `add-hook' and specify t for the LOCAL argument.
2302 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2307 return run_hook_with_args (nargs
, args
, until_success
);
2310 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2311 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2312 doc
: /* Run HOOK with the specified arguments ARGS.
2313 HOOK should be a symbol, a hook variable. Its value should
2314 be a list of functions. We call those functions, one by one,
2315 passing arguments ARGS to each of them, until one of them
2316 returns nil. Then we return nil.
2317 If all the functions return non-nil, we return non-nil.
2319 Do not use `make-local-variable' to make a hook variable buffer-local.
2320 Instead, use `add-hook' and specify t for the LOCAL argument.
2321 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2326 return run_hook_with_args (nargs
, args
, until_failure
);
2329 /* ARGS[0] should be a hook symbol.
2330 Call each of the functions in the hook value, passing each of them
2331 as arguments all the rest of ARGS (all NARGS - 1 elements).
2332 COND specifies a condition to test after each call
2333 to decide whether to stop.
2334 The caller (or its caller, etc) must gcpro all of ARGS,
2335 except that it isn't necessary to gcpro ARGS[0]. */
2338 run_hook_with_args (nargs
, args
, cond
)
2341 enum run_hooks_condition cond
;
2343 Lisp_Object sym
, val
, ret
;
2344 Lisp_Object globals
;
2345 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2347 /* If we are dying or still initializing,
2348 don't do anything--it would probably crash if we tried. */
2349 if (NILP (Vrun_hooks
))
2353 val
= find_symbol_value (sym
);
2354 ret
= (cond
== until_failure
? Qt
: Qnil
);
2356 if (EQ (val
, Qunbound
) || NILP (val
))
2358 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2361 return Ffuncall (nargs
, args
);
2366 GCPRO3 (sym
, val
, globals
);
2369 CONSP (val
) && ((cond
== to_completion
)
2370 || (cond
== until_success
? NILP (ret
)
2374 if (EQ (XCAR (val
), Qt
))
2376 /* t indicates this hook has a local binding;
2377 it means to run the global binding too. */
2379 for (globals
= Fdefault_value (sym
);
2380 CONSP (globals
) && ((cond
== to_completion
)
2381 || (cond
== until_success
? NILP (ret
)
2383 globals
= XCDR (globals
))
2385 args
[0] = XCAR (globals
);
2386 /* In a global value, t should not occur. If it does, we
2387 must ignore it to avoid an endless loop. */
2388 if (!EQ (args
[0], Qt
))
2389 ret
= Ffuncall (nargs
, args
);
2394 args
[0] = XCAR (val
);
2395 ret
= Ffuncall (nargs
, args
);
2404 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2405 present value of that symbol.
2406 Call each element of FUNLIST,
2407 passing each of them the rest of ARGS.
2408 The caller (or its caller, etc) must gcpro all of ARGS,
2409 except that it isn't necessary to gcpro ARGS[0]. */
2412 run_hook_list_with_args (funlist
, nargs
, args
)
2413 Lisp_Object funlist
;
2419 Lisp_Object globals
;
2420 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2424 GCPRO3 (sym
, val
, globals
);
2426 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2428 if (EQ (XCAR (val
), Qt
))
2430 /* t indicates this hook has a local binding;
2431 it means to run the global binding too. */
2433 for (globals
= Fdefault_value (sym
);
2435 globals
= XCDR (globals
))
2437 args
[0] = XCAR (globals
);
2438 /* In a global value, t should not occur. If it does, we
2439 must ignore it to avoid an endless loop. */
2440 if (!EQ (args
[0], Qt
))
2441 Ffuncall (nargs
, args
);
2446 args
[0] = XCAR (val
);
2447 Ffuncall (nargs
, args
);
2454 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2457 run_hook_with_args_2 (hook
, arg1
, arg2
)
2458 Lisp_Object hook
, arg1
, arg2
;
2460 Lisp_Object temp
[3];
2465 Frun_hook_with_args (3, temp
);
2468 /* Apply fn to arg */
2471 Lisp_Object fn
, arg
;
2473 struct gcpro gcpro1
;
2477 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2481 Lisp_Object args
[2];
2485 RETURN_UNGCPRO (Fapply (2, args
));
2487 #else /* not NO_ARG_ARRAY */
2488 RETURN_UNGCPRO (Fapply (2, &fn
));
2489 #endif /* not NO_ARG_ARRAY */
2492 /* Call function fn on no arguments */
2497 struct gcpro gcpro1
;
2500 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2503 /* Call function fn with 1 argument arg1 */
2507 Lisp_Object fn
, arg1
;
2509 struct gcpro gcpro1
;
2511 Lisp_Object args
[2];
2517 RETURN_UNGCPRO (Ffuncall (2, args
));
2518 #else /* not NO_ARG_ARRAY */
2521 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2522 #endif /* not NO_ARG_ARRAY */
2525 /* Call function fn with 2 arguments arg1, arg2 */
2528 call2 (fn
, arg1
, arg2
)
2529 Lisp_Object fn
, arg1
, arg2
;
2531 struct gcpro gcpro1
;
2533 Lisp_Object args
[3];
2539 RETURN_UNGCPRO (Ffuncall (3, args
));
2540 #else /* not NO_ARG_ARRAY */
2543 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2544 #endif /* not NO_ARG_ARRAY */
2547 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2550 call3 (fn
, arg1
, arg2
, arg3
)
2551 Lisp_Object fn
, arg1
, arg2
, arg3
;
2553 struct gcpro gcpro1
;
2555 Lisp_Object args
[4];
2562 RETURN_UNGCPRO (Ffuncall (4, args
));
2563 #else /* not NO_ARG_ARRAY */
2566 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2567 #endif /* not NO_ARG_ARRAY */
2570 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2573 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2574 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2576 struct gcpro gcpro1
;
2578 Lisp_Object args
[5];
2586 RETURN_UNGCPRO (Ffuncall (5, args
));
2587 #else /* not NO_ARG_ARRAY */
2590 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2591 #endif /* not NO_ARG_ARRAY */
2594 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2597 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2598 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2600 struct gcpro gcpro1
;
2602 Lisp_Object args
[6];
2611 RETURN_UNGCPRO (Ffuncall (6, args
));
2612 #else /* not NO_ARG_ARRAY */
2615 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2616 #endif /* not NO_ARG_ARRAY */
2619 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2622 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2623 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2625 struct gcpro gcpro1
;
2627 Lisp_Object args
[7];
2637 RETURN_UNGCPRO (Ffuncall (7, args
));
2638 #else /* not NO_ARG_ARRAY */
2641 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2642 #endif /* not NO_ARG_ARRAY */
2645 /* The caller should GCPRO all the elements of ARGS. */
2647 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2648 doc
: /* Call first argument as a function, passing remaining arguments to it.
2649 Return the value that function returns.
2650 Thus, (funcall 'cons 'x 'y) returns (x . y).
2651 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2658 int numargs
= nargs
- 1;
2659 Lisp_Object lisp_numargs
;
2661 struct backtrace backtrace
;
2662 register Lisp_Object
*internal_args
;
2666 if (consing_since_gc
> gc_cons_threshold
)
2667 Fgarbage_collect ();
2669 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2671 if (max_lisp_eval_depth
< 100)
2672 max_lisp_eval_depth
= 100;
2673 if (lisp_eval_depth
> max_lisp_eval_depth
)
2674 error ("Lisp nesting exceeds max-lisp-eval-depth");
2677 backtrace
.next
= backtrace_list
;
2678 backtrace_list
= &backtrace
;
2679 backtrace
.function
= &args
[0];
2680 backtrace
.args
= &args
[1];
2681 backtrace
.nargs
= nargs
- 1;
2682 backtrace
.evalargs
= 0;
2683 backtrace
.debug_on_exit
= 0;
2685 if (debug_on_next_call
)
2686 do_debug_on_call (Qlambda
);
2692 fun
= Findirect_function (fun
);
2696 if (numargs
< XSUBR (fun
)->min_args
2697 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2699 XSETFASTINT (lisp_numargs
, numargs
);
2700 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2703 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2704 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2706 if (XSUBR (fun
)->max_args
== MANY
)
2708 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2712 if (XSUBR (fun
)->max_args
> numargs
)
2714 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2715 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2716 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2717 internal_args
[i
] = Qnil
;
2720 internal_args
= args
+ 1;
2721 switch (XSUBR (fun
)->max_args
)
2724 val
= (*XSUBR (fun
)->function
) ();
2727 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2730 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2734 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2738 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2743 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2744 internal_args
[2], internal_args
[3],
2748 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2749 internal_args
[2], internal_args
[3],
2750 internal_args
[4], internal_args
[5]);
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],
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],
2763 internal_args
[6], internal_args
[7]);
2768 /* If a subr takes more than 8 arguments without using MANY
2769 or UNEVALLED, we need to extend this function to support it.
2770 Until this is done, there is no way to call the function. */
2774 if (COMPILEDP (fun
))
2775 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2779 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2780 funcar
= Fcar (fun
);
2781 if (!SYMBOLP (funcar
))
2782 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2783 if (EQ (funcar
, Qlambda
))
2784 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2785 else if (EQ (funcar
, Qautoload
))
2787 do_autoload (fun
, args
[0]);
2791 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2795 if (backtrace
.debug_on_exit
)
2796 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2797 backtrace_list
= backtrace
.next
;
2802 apply_lambda (fun
, args
, eval_flag
)
2803 Lisp_Object fun
, args
;
2806 Lisp_Object args_left
;
2807 Lisp_Object numargs
;
2808 register Lisp_Object
*arg_vector
;
2809 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2811 register Lisp_Object tem
;
2813 numargs
= Flength (args
);
2814 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2817 GCPRO3 (*arg_vector
, args_left
, fun
);
2820 for (i
= 0; i
< XINT (numargs
);)
2822 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2823 if (eval_flag
) tem
= Feval (tem
);
2824 arg_vector
[i
++] = tem
;
2832 backtrace_list
->args
= arg_vector
;
2833 backtrace_list
->nargs
= i
;
2835 backtrace_list
->evalargs
= 0;
2836 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2838 /* Do the debug-on-exit now, while arg_vector still exists. */
2839 if (backtrace_list
->debug_on_exit
)
2840 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2841 /* Don't do it again when we return to eval. */
2842 backtrace_list
->debug_on_exit
= 0;
2846 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2847 and return the result of evaluation.
2848 FUN must be either a lambda-expression or a compiled-code object. */
2851 funcall_lambda (fun
, nargs
, arg_vector
)
2854 register Lisp_Object
*arg_vector
;
2856 Lisp_Object val
, syms_left
, next
;
2857 int count
= SPECPDL_INDEX ();
2858 int i
, optional
, rest
;
2862 syms_left
= XCDR (fun
);
2863 if (CONSP (syms_left
))
2864 syms_left
= XCAR (syms_left
);
2866 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2868 else if (COMPILEDP (fun
))
2869 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2873 i
= optional
= rest
= 0;
2874 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2878 next
= XCAR (syms_left
);
2879 while (!SYMBOLP (next
))
2880 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2882 if (EQ (next
, Qand_rest
))
2884 else if (EQ (next
, Qand_optional
))
2888 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2892 specbind (next
, arg_vector
[i
++]);
2894 return Fsignal (Qwrong_number_of_arguments
,
2895 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2897 specbind (next
, Qnil
);
2900 if (!NILP (syms_left
))
2901 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2903 return Fsignal (Qwrong_number_of_arguments
,
2904 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2907 val
= Fprogn (XCDR (XCDR (fun
)));
2910 /* If we have not actually read the bytecode string
2911 and constants vector yet, fetch them from the file. */
2912 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2913 Ffetch_bytecode (fun
);
2914 val
= Fbyte_code (AREF (fun
, COMPILED_BYTECODE
),
2915 AREF (fun
, COMPILED_CONSTANTS
),
2916 AREF (fun
, COMPILED_STACK_DEPTH
));
2919 return unbind_to (count
, val
);
2922 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2924 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2930 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2932 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2935 tem
= AREF (object
, COMPILED_BYTECODE
);
2936 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2937 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2939 error ("Invalid byte code");
2941 AREF (object
, COMPILED_BYTECODE
) = XCAR (tem
);
2942 AREF (object
, COMPILED_CONSTANTS
) = XCDR (tem
);
2950 register int count
= SPECPDL_INDEX ();
2951 if (specpdl_size
>= max_specpdl_size
)
2953 if (max_specpdl_size
< 400)
2954 max_specpdl_size
= 400;
2955 if (specpdl_size
>= max_specpdl_size
)
2957 if (!NILP (Vdebug_on_error
))
2958 /* Leave room for some specpdl in the debugger. */
2959 max_specpdl_size
= specpdl_size
+ 100;
2961 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
2965 if (specpdl_size
> max_specpdl_size
)
2966 specpdl_size
= max_specpdl_size
;
2967 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
2968 specpdl_ptr
= specpdl
+ count
;
2972 specbind (symbol
, value
)
2973 Lisp_Object symbol
, value
;
2976 Lisp_Object valcontents
;
2978 CHECK_SYMBOL (symbol
);
2979 if (specpdl_ptr
== specpdl
+ specpdl_size
)
2982 /* The most common case is that of a non-constant symbol with a
2983 trivial value. Make that as fast as we can. */
2984 valcontents
= SYMBOL_VALUE (symbol
);
2985 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
2987 specpdl_ptr
->symbol
= symbol
;
2988 specpdl_ptr
->old_value
= valcontents
;
2989 specpdl_ptr
->func
= NULL
;
2991 SET_SYMBOL_VALUE (symbol
, value
);
2995 Lisp_Object valcontents
;
2997 ovalue
= find_symbol_value (symbol
);
2998 specpdl_ptr
->func
= 0;
2999 specpdl_ptr
->old_value
= ovalue
;
3001 valcontents
= XSYMBOL (symbol
)->value
;
3003 if (BUFFER_LOCAL_VALUEP (valcontents
)
3004 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
3005 || BUFFER_OBJFWDP (valcontents
))
3007 Lisp_Object where
, current_buffer
;
3009 current_buffer
= Fcurrent_buffer ();
3011 /* For a local variable, record both the symbol and which
3012 buffer's or frame's value we are saving. */
3013 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3014 where
= current_buffer
;
3015 else if (!BUFFER_OBJFWDP (valcontents
)
3016 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3017 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3021 /* We're not using the `unused' slot in the specbinding
3022 structure because this would mean we have to do more
3023 work for simple variables. */
3024 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3026 /* If SYMBOL is a per-buffer variable which doesn't have a
3027 buffer-local value here, make the `let' change the global
3028 value by changing the value of SYMBOL in all buffers not
3029 having their own value. This is consistent with what
3030 happens with other buffer-local variables. */
3032 && BUFFER_OBJFWDP (valcontents
))
3035 Fset_default (symbol
, value
);
3040 specpdl_ptr
->symbol
= symbol
;
3043 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3044 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3046 set_internal (symbol
, value
, 0, 1);
3051 record_unwind_protect (function
, arg
)
3052 Lisp_Object (*function
) P_ ((Lisp_Object
));
3055 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3057 specpdl_ptr
->func
= function
;
3058 specpdl_ptr
->symbol
= Qnil
;
3059 specpdl_ptr
->old_value
= arg
;
3064 unbind_to (count
, value
)
3068 int quitf
= !NILP (Vquit_flag
);
3069 struct gcpro gcpro1
;
3074 while (specpdl_ptr
!= specpdl
+ count
)
3076 /* Copy the binding, and decrement specpdl_ptr, before we do
3077 the work to unbind it. We decrement first
3078 so that an error in unbinding won't try to unbind
3079 the same entry again, and we copy the binding first
3080 in case more bindings are made during some of the code we run. */
3082 struct specbinding this_binding
;
3083 this_binding
= *--specpdl_ptr
;
3085 if (this_binding
.func
!= 0)
3086 (*this_binding
.func
) (this_binding
.old_value
);
3087 /* If the symbol is a list, it is really (SYMBOL WHERE
3088 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3089 frame. If WHERE is a buffer or frame, this indicates we
3090 bound a variable that had a buffer-local or frame-local
3091 binding. WHERE nil means that the variable had the default
3092 value when it was bound. CURRENT-BUFFER is the buffer that
3093 was current when the variable was bound. */
3094 else if (CONSP (this_binding
.symbol
))
3096 Lisp_Object symbol
, where
;
3098 symbol
= XCAR (this_binding
.symbol
);
3099 where
= XCAR (XCDR (this_binding
.symbol
));
3102 Fset_default (symbol
, this_binding
.old_value
);
3103 else if (BUFFERP (where
))
3104 set_internal (symbol
, this_binding
.old_value
, XBUFFER (where
), 1);
3106 set_internal (symbol
, this_binding
.old_value
, NULL
, 1);
3110 /* If variable has a trivial value (no forwarding), we can
3111 just set it. No need to check for constant symbols here,
3112 since that was already done by specbind. */
3113 if (!MISCP (SYMBOL_VALUE (this_binding
.symbol
)))
3114 SET_SYMBOL_VALUE (this_binding
.symbol
, this_binding
.old_value
);
3116 set_internal (this_binding
.symbol
, this_binding
.old_value
, 0, 1);
3120 if (NILP (Vquit_flag
) && quitf
)
3127 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3128 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3129 The debugger is entered when that frame exits, if the flag is non-nil. */)
3131 Lisp_Object level
, flag
;
3133 register struct backtrace
*backlist
= backtrace_list
;
3136 CHECK_NUMBER (level
);
3138 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3140 backlist
= backlist
->next
;
3144 backlist
->debug_on_exit
= !NILP (flag
);
3149 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3150 doc
: /* Print a trace of Lisp function calls currently active.
3151 Output stream used is value of `standard-output'. */)
3154 register struct backtrace
*backlist
= backtrace_list
;
3158 extern Lisp_Object Vprint_level
;
3159 struct gcpro gcpro1
;
3161 XSETFASTINT (Vprint_level
, 3);
3168 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3169 if (backlist
->nargs
== UNEVALLED
)
3171 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3172 write_string ("\n", -1);
3176 tem
= *backlist
->function
;
3177 Fprin1 (tem
, Qnil
); /* This can QUIT */
3178 write_string ("(", -1);
3179 if (backlist
->nargs
== MANY
)
3181 for (tail
= *backlist
->args
, i
= 0;
3183 tail
= Fcdr (tail
), i
++)
3185 if (i
) write_string (" ", -1);
3186 Fprin1 (Fcar (tail
), Qnil
);
3191 for (i
= 0; i
< backlist
->nargs
; i
++)
3193 if (i
) write_string (" ", -1);
3194 Fprin1 (backlist
->args
[i
], Qnil
);
3197 write_string (")\n", -1);
3199 backlist
= backlist
->next
;
3202 Vprint_level
= Qnil
;
3207 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3208 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3209 If that frame has not evaluated the arguments yet (or is a special form),
3210 the value is (nil FUNCTION ARG-FORMS...).
3211 If that frame has evaluated its arguments and called its function already,
3212 the value is (t FUNCTION ARG-VALUES...).
3213 A &rest arg is represented as the tail of the list ARG-VALUES.
3214 FUNCTION is whatever was supplied as car of evaluated list,
3215 or a lambda expression for macro calls.
3216 If NFRAMES is more than the number of frames, the value is nil. */)
3218 Lisp_Object nframes
;
3220 register struct backtrace
*backlist
= backtrace_list
;
3224 CHECK_NATNUM (nframes
);
3226 /* Find the frame requested. */
3227 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3228 backlist
= backlist
->next
;
3232 if (backlist
->nargs
== UNEVALLED
)
3233 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3236 if (backlist
->nargs
== MANY
)
3237 tem
= *backlist
->args
;
3239 tem
= Flist (backlist
->nargs
, backlist
->args
);
3241 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3249 register struct backtrace
*backlist
;
3252 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3254 mark_object (*backlist
->function
);
3256 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
3259 i
= backlist
->nargs
- 1;
3261 mark_object (backlist
->args
[i
]);
3268 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3269 doc
: /* *Limit on number of Lisp variable bindings & unwind-protects.
3270 If Lisp code tries to make more than this many at once,
3271 an error is signaled.
3272 You can safely use a value considerably larger than the default value,
3273 if that proves inconveniently small. However, if you increase it too far,
3274 Emacs could run out of memory trying to make the stack bigger. */);
3276 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3277 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3279 This limit serves to catch infinite recursions for you before they cause
3280 actual stack overflow in C, which would be fatal for Emacs.
3281 You can safely make it considerably larger than its default value,
3282 if that proves inconveniently small. However, if you increase it too far,
3283 Emacs could overflow the real C stack, and crash. */);
3285 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3286 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3287 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'. */);
3290 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3291 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3292 Note that `quit-flag' will still be set by typing C-g,
3293 so a quit will be signaled as soon as `inhibit-quit' is nil.
3294 To prevent this happening, set `quit-flag' to nil
3295 before making `inhibit-quit' nil. */);
3296 Vinhibit_quit
= Qnil
;
3298 Qinhibit_quit
= intern ("inhibit-quit");
3299 staticpro (&Qinhibit_quit
);
3301 Qautoload
= intern ("autoload");
3302 staticpro (&Qautoload
);
3304 Qdebug_on_error
= intern ("debug-on-error");
3305 staticpro (&Qdebug_on_error
);
3307 Qmacro
= intern ("macro");
3308 staticpro (&Qmacro
);
3310 Qdeclare
= intern ("declare");
3311 staticpro (&Qdeclare
);
3313 /* Note that the process handling also uses Qexit, but we don't want
3314 to staticpro it twice, so we just do it here. */
3315 Qexit
= intern ("exit");
3318 Qinteractive
= intern ("interactive");
3319 staticpro (&Qinteractive
);
3321 Qcommandp
= intern ("commandp");
3322 staticpro (&Qcommandp
);
3324 Qdefun
= intern ("defun");
3325 staticpro (&Qdefun
);
3327 Qdefvar
= intern ("defvar");
3328 staticpro (&Qdefvar
);
3330 Qand_rest
= intern ("&rest");
3331 staticpro (&Qand_rest
);
3333 Qand_optional
= intern ("&optional");
3334 staticpro (&Qand_optional
);
3336 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3337 doc
: /* *Non-nil means errors display a backtrace buffer.
3338 More precisely, this happens for any error that is handled
3339 by the editor command loop.
3340 If the value is a list, an error only means to display a backtrace
3341 if one of its condition symbols appears in the list. */);
3342 Vstack_trace_on_error
= Qnil
;
3344 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3345 doc
: /* *Non-nil means enter debugger if an error is signaled.
3346 Does not apply to errors handled by `condition-case' or those
3347 matched by `debug-ignored-errors'.
3348 If the value is a list, an error only means to enter the debugger
3349 if one of its condition symbols appears in the list.
3350 When you evaluate an expression interactively, this variable
3351 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3352 See also variable `debug-on-quit'. */);
3353 Vdebug_on_error
= Qnil
;
3355 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3356 doc
: /* *List of errors for which the debugger should not be called.
3357 Each element may be a condition-name or a regexp that matches error messages.
3358 If any element applies to a given error, that error skips the debugger
3359 and just returns to top level.
3360 This overrides the variable `debug-on-error'.
3361 It does not apply to errors handled by `condition-case'. */);
3362 Vdebug_ignored_errors
= Qnil
;
3364 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3365 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3366 Does not apply if quit is handled by a `condition-case'.
3367 When you evaluate an expression interactively, this variable
3368 is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil. */);
3371 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3372 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3374 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3375 doc
: /* Non-nil means debugger may continue execution.
3376 This is nil when the debugger is called under circumstances where it
3377 might not be safe to continue. */);
3378 debugger_may_continue
= 1;
3380 DEFVAR_LISP ("debugger", &Vdebugger
,
3381 doc
: /* Function to call to invoke debugger.
3382 If due to frame exit, args are `exit' and the value being returned;
3383 this function's value will be returned instead of that.
3384 If due to error, args are `error' and a list of the args to `signal'.
3385 If due to `apply' or `funcall' entry, one arg, `lambda'.
3386 If due to `eval' entry, one arg, t. */);
3389 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3390 doc
: /* If non-nil, this is a function for `signal' to call.
3391 It receives the same arguments that `signal' was given.
3392 The Edebug package uses this to regain control. */);
3393 Vsignal_hook_function
= Qnil
;
3395 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3396 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3397 Note that `debug-on-error', `debug-on-quit' and friends
3398 still determine whether to handle the particular condition. */);
3399 Vdebug_on_signal
= Qnil
;
3401 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3402 doc
: /* Function to process declarations in a macro definition.
3403 The function will be called with two args MACRO and DECL.
3404 MACRO is the name of the macro being defined.
3405 DECL is a list `(declare ...)' containing the declarations.
3406 The value the function returns is not used. */);
3407 Vmacro_declaration_function
= Qnil
;
3409 Vrun_hooks
= intern ("run-hooks");
3410 staticpro (&Vrun_hooks
);
3412 staticpro (&Vautoload_queue
);
3413 Vautoload_queue
= Qnil
;
3414 staticpro (&Vsignaling_function
);
3415 Vsignaling_function
= Qnil
;
3426 defsubr (&Sfunction
);
3428 defsubr (&Sdefmacro
);
3430 defsubr (&Sdefvaralias
);
3431 defsubr (&Sdefconst
);
3432 defsubr (&Suser_variable_p
);
3436 defsubr (&Smacroexpand
);
3439 defsubr (&Sunwind_protect
);
3440 defsubr (&Scondition_case
);
3442 defsubr (&Sinteractive_p
);
3443 defsubr (&Scommandp
);
3444 defsubr (&Sautoload
);
3447 defsubr (&Sfuncall
);
3448 defsubr (&Srun_hooks
);
3449 defsubr (&Srun_hook_with_args
);
3450 defsubr (&Srun_hook_with_args_until_success
);
3451 defsubr (&Srun_hook_with_args_until_failure
);
3452 defsubr (&Sfetch_bytecode
);
3453 defsubr (&Sbacktrace_debug
);
3454 defsubr (&Sbacktrace
);
3455 defsubr (&Sbacktrace_frame
);
3458 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
3459 (do not change this comment) */