1 /* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
3 2002, 2004, 2005 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
;
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
= 1000;
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 the function was run directly by user input.
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),
547 and Emacs is not running in batch mode (`noninteractive' is nil).
549 The only known proper use of `interactive-p' is in deciding whether to
550 display a helpful message, or how to display it. If you're thinking
551 of using it for any other purpose, it is quite likely that you're
552 making a mistake. Think: what do you want to do when the command is
553 called from a keyboard macro?
555 If you want to test whether your function was called with
556 `call-interactively', the way to do that is by adding an extra
557 optional argument, and making the `interactive' spec specify non-nil
558 unconditionally for that argument. (`p' is a good way to do this.) */)
561 return (INTERACTIVE
&& interactive_p (1)) ? Qt
: Qnil
;
565 DEFUN ("called-interactively-p", Fcalled_interactively_p
, Scalled_interactively_p
, 0, 0, 0,
566 doc
: /* Return t if the function using this was called with call-interactively.
567 This is used for implementing advice and other function-modifying
570 The cleanest way to test whether your function was called with
571 `call-interactively', the way to do that is by adding an extra
572 optional argument, and making the `interactive' spec specify non-nil
573 unconditionally for that argument. (`p' is a good way to do this.) */)
576 return interactive_p (1) ? Qt
: Qnil
;
580 /* Return 1 if function in which this appears was called using
583 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
584 called is a built-in. */
587 interactive_p (exclude_subrs_p
)
590 struct backtrace
*btp
;
593 btp
= backtrace_list
;
595 /* If this isn't a byte-compiled function, there may be a frame at
596 the top for Finteractive_p. If so, skip it. */
597 fun
= Findirect_function (*btp
->function
);
598 if (SUBRP (fun
) && (XSUBR (fun
) == &Sinteractive_p
599 || XSUBR (fun
) == &Scalled_interactively_p
))
602 /* If we're running an Emacs 18-style byte-compiled function, there
603 may be a frame for Fbytecode at the top level. In any version of
604 Emacs there can be Fbytecode frames for subexpressions evaluated
605 inside catch and condition-case. Skip past them.
607 If this isn't a byte-compiled function, then we may now be
608 looking at several frames for special forms. Skip past them. */
610 && (EQ (*btp
->function
, Qbytecode
)
611 || btp
->nargs
== UNEVALLED
))
614 /* btp now points at the frame of the innermost function that isn't
615 a special form, ignoring frames for Finteractive_p and/or
616 Fbytecode at the top. If this frame is for a built-in function
617 (such as load or eval-region) return nil. */
618 fun
= Findirect_function (*btp
->function
);
619 if (exclude_subrs_p
&& SUBRP (fun
))
622 /* btp points to the frame of a Lisp function that called interactive-p.
623 Return t if that function was called interactively. */
624 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
630 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
631 doc
: /* Define NAME as a function.
632 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
633 See also the function `interactive'.
634 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
638 register Lisp_Object fn_name
;
639 register Lisp_Object defn
;
641 fn_name
= Fcar (args
);
642 CHECK_SYMBOL (fn_name
);
643 defn
= Fcons (Qlambda
, Fcdr (args
));
644 if (!NILP (Vpurify_flag
))
645 defn
= Fpurecopy (defn
);
646 if (CONSP (XSYMBOL (fn_name
)->function
)
647 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
648 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
649 Ffset (fn_name
, defn
);
650 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
654 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
655 doc
: /* Define NAME as a macro.
656 The actual definition looks like
657 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
658 When the macro is called, as in (NAME ARGS...),
659 the function (lambda ARGLIST BODY...) is applied to
660 the list ARGS... as it appears in the expression,
661 and the result should be a form to be evaluated instead of the original.
663 DECL is a declaration, optional, which can specify how to indent
664 calls to this macro and how Edebug should handle it. It looks like this:
666 The elements can look like this:
668 Set NAME's `lisp-indent-function' property to INDENT.
671 Set NAME's `edebug-form-spec' property to DEBUG. (This is
672 equivalent to writing a `def-edebug-spec' for the macro.)
673 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
677 register Lisp_Object fn_name
;
678 register Lisp_Object defn
;
679 Lisp_Object lambda_list
, doc
, tail
;
681 fn_name
= Fcar (args
);
682 CHECK_SYMBOL (fn_name
);
683 lambda_list
= Fcar (Fcdr (args
));
684 tail
= Fcdr (Fcdr (args
));
687 if (STRINGP (Fcar (tail
)))
693 while (CONSP (Fcar (tail
))
694 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
696 if (!NILP (Vmacro_declaration_function
))
700 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
708 tail
= Fcons (lambda_list
, tail
);
710 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
711 defn
= Fcons (Qmacro
, Fcons (Qlambda
, tail
));
713 if (!NILP (Vpurify_flag
))
714 defn
= Fpurecopy (defn
);
715 if (CONSP (XSYMBOL (fn_name
)->function
)
716 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
717 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
718 Ffset (fn_name
, defn
);
719 LOADHIST_ATTACH (Fcons (Qdefun
, fn_name
));
724 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
725 doc
: /* Make SYMBOL a variable alias for symbol ALIASED.
726 Setting the value of SYMBOL will subsequently set the value of ALIASED,
727 and getting the value of SYMBOL will return the value ALIASED has.
728 Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. If it is
729 omitted or nil, SYMBOL gets the documentation string of ALIASED, or of the
730 variable at the end of the chain of aliases, if ALIASED is itself an alias.
731 The return value is ALIASED. */)
732 (symbol
, aliased
, docstring
)
733 Lisp_Object symbol
, aliased
, docstring
;
735 struct Lisp_Symbol
*sym
;
737 CHECK_SYMBOL (symbol
);
738 CHECK_SYMBOL (aliased
);
740 if (SYMBOL_CONSTANT_P (symbol
))
741 error ("Cannot make a constant an alias");
743 sym
= XSYMBOL (symbol
);
744 sym
->indirect_variable
= 1;
745 sym
->value
= aliased
;
746 sym
->constant
= SYMBOL_CONSTANT_P (aliased
);
747 LOADHIST_ATTACH (symbol
);
748 if (!NILP (docstring
))
749 Fput (symbol
, Qvariable_documentation
, docstring
);
755 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
756 doc
: /* Define SYMBOL as a variable.
757 You are not required to define a variable in order to use it,
758 but the definition can supply documentation and an initial value
759 in a way that tags can recognize.
761 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
762 If SYMBOL is buffer-local, its default value is what is set;
763 buffer-local values are not affected.
764 INITVALUE and DOCSTRING are optional.
765 If DOCSTRING starts with *, this variable is identified as a user option.
766 This means that M-x set-variable recognizes it.
767 See also `user-variable-p'.
768 If INITVALUE is missing, SYMBOL's value is not set.
770 If SYMBOL has a local binding, then this form affects the local
771 binding. This is usually not what you want. Thus, if you need to
772 load a file defining variables, with this form or with `defconst' or
773 `defcustom', you should always load that file _outside_ any bindings
774 for these variables. \(`defconst' and `defcustom' behave similarly in
776 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
780 register Lisp_Object sym
, tem
, tail
;
784 if (!NILP (Fcdr (Fcdr (tail
))))
785 error ("too many arguments");
787 tem
= Fdefault_boundp (sym
);
791 Fset_default (sym
, Feval (Fcar (tail
)));
793 { /* Check if there is really a global binding rather than just a let
794 binding that shadows the global unboundness of the var. */
795 volatile struct specbinding
*pdl
= specpdl_ptr
;
796 while (--pdl
>= specpdl
)
798 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
799 && EQ (pdl
->old_value
, Qunbound
))
801 message_with_string ("Warning: defvar ignored because %s is let-bound",
802 SYMBOL_NAME (sym
), 1);
811 if (!NILP (Vpurify_flag
))
812 tem
= Fpurecopy (tem
);
813 Fput (sym
, Qvariable_documentation
, tem
);
815 LOADHIST_ATTACH (sym
);
818 /* Simple (defvar <var>) should not count as a definition at all.
819 It could get in the way of other definitions, and unloading this
820 package could try to make the variable unbound. */
826 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
827 doc
: /* Define SYMBOL as a constant variable.
828 The intent is that neither programs nor users should ever change this value.
829 Always sets the value of SYMBOL to the result of evalling INITVALUE.
830 If SYMBOL is buffer-local, its default value is what is set;
831 buffer-local values are not affected.
832 DOCSTRING is optional.
834 If SYMBOL has a local binding, then this form sets the local binding's
835 value. However, you should normally not make local bindings for
836 variables defined with this form.
837 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
841 register Lisp_Object sym
, tem
;
844 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
845 error ("too many arguments");
847 tem
= Feval (Fcar (Fcdr (args
)));
848 if (!NILP (Vpurify_flag
))
849 tem
= Fpurecopy (tem
);
850 Fset_default (sym
, tem
);
851 tem
= Fcar (Fcdr (Fcdr (args
)));
854 if (!NILP (Vpurify_flag
))
855 tem
= Fpurecopy (tem
);
856 Fput (sym
, Qvariable_documentation
, tem
);
858 LOADHIST_ATTACH (sym
);
862 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
863 doc
: /* Returns t if VARIABLE is intended to be set and modified by users.
864 \(The alternative is a variable used internally in a Lisp program.)
865 Determined by whether the first character of the documentation
866 for the variable is `*' or if the variable is customizable (has a non-nil
867 value of `standard-value' or of `custom-autoload' on its property list). */)
869 Lisp_Object variable
;
871 Lisp_Object documentation
;
873 if (!SYMBOLP (variable
))
876 documentation
= Fget (variable
, Qvariable_documentation
);
877 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
879 if (STRINGP (documentation
)
880 && ((unsigned char) SREF (documentation
, 0) == '*'))
882 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
883 if (CONSP (documentation
)
884 && STRINGP (XCAR (documentation
))
885 && INTEGERP (XCDR (documentation
))
886 && XINT (XCDR (documentation
)) < 0)
888 /* Customizable? See `custom-variable-p'. */
889 if ((!NILP (Fget (variable
, intern ("standard-value"))))
890 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
895 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
896 doc
: /* Bind variables according to VARLIST then eval BODY.
897 The value of the last form in BODY is returned.
898 Each element of VARLIST is a symbol (which is bound to nil)
899 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
900 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
901 usage: (let* VARLIST BODY...) */)
905 Lisp_Object varlist
, val
, elt
;
906 int count
= SPECPDL_INDEX ();
907 struct gcpro gcpro1
, gcpro2
, gcpro3
;
909 GCPRO3 (args
, elt
, varlist
);
911 varlist
= Fcar (args
);
912 while (!NILP (varlist
))
915 elt
= Fcar (varlist
);
917 specbind (elt
, Qnil
);
918 else if (! NILP (Fcdr (Fcdr (elt
))))
920 Fcons (build_string ("`let' bindings can have only one value-form"),
924 val
= Feval (Fcar (Fcdr (elt
)));
925 specbind (Fcar (elt
), val
);
927 varlist
= Fcdr (varlist
);
930 val
= Fprogn (Fcdr (args
));
931 return unbind_to (count
, val
);
934 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
935 doc
: /* Bind variables according to VARLIST then eval BODY.
936 The value of the last form in BODY is returned.
937 Each element of VARLIST is a symbol (which is bound to nil)
938 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
939 All the VALUEFORMs are evalled before any symbols are bound.
940 usage: (let VARLIST BODY...) */)
944 Lisp_Object
*temps
, tem
;
945 register Lisp_Object elt
, varlist
;
946 int count
= SPECPDL_INDEX ();
948 struct gcpro gcpro1
, gcpro2
;
950 varlist
= Fcar (args
);
952 /* Make space to hold the values to give the bound variables */
953 elt
= Flength (varlist
);
954 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
956 /* Compute the values and store them in `temps' */
958 GCPRO2 (args
, *temps
);
961 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
964 elt
= Fcar (varlist
);
966 temps
[argnum
++] = Qnil
;
967 else if (! NILP (Fcdr (Fcdr (elt
))))
969 Fcons (build_string ("`let' bindings can have only one value-form"),
972 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
973 gcpro2
.nvars
= argnum
;
977 varlist
= Fcar (args
);
978 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
980 elt
= Fcar (varlist
);
981 tem
= temps
[argnum
++];
985 specbind (Fcar (elt
), tem
);
988 elt
= Fprogn (Fcdr (args
));
989 return unbind_to (count
, elt
);
992 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
993 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
994 The order of execution is thus TEST, BODY, TEST, BODY and so on
995 until TEST returns nil.
996 usage: (while TEST BODY...) */)
1000 Lisp_Object test
, body
;
1001 struct gcpro gcpro1
, gcpro2
;
1003 GCPRO2 (test
, body
);
1007 while (!NILP (Feval (test
)))
1017 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1018 doc
: /* Return result of expanding macros at top level of FORM.
1019 If FORM is not a macro call, it is returned unchanged.
1020 Otherwise, the macro is expanded and the expansion is considered
1021 in place of FORM. When a non-macro-call results, it is returned.
1023 The second optional arg ENVIRONMENT specifies an environment of macro
1024 definitions to shadow the loaded ones for use in file byte-compilation. */)
1027 Lisp_Object environment
;
1029 /* With cleanups from Hallvard Furuseth. */
1030 register Lisp_Object expander
, sym
, def
, tem
;
1034 /* Come back here each time we expand a macro call,
1035 in case it expands into another macro call. */
1038 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1039 def
= sym
= XCAR (form
);
1041 /* Trace symbols aliases to other symbols
1042 until we get a symbol that is not an alias. */
1043 while (SYMBOLP (def
))
1047 tem
= Fassq (sym
, environment
);
1050 def
= XSYMBOL (sym
)->function
;
1051 if (!EQ (def
, Qunbound
))
1056 /* Right now TEM is the result from SYM in ENVIRONMENT,
1057 and if TEM is nil then DEF is SYM's function definition. */
1060 /* SYM is not mentioned in ENVIRONMENT.
1061 Look at its function definition. */
1062 if (EQ (def
, Qunbound
) || !CONSP (def
))
1063 /* Not defined or definition not suitable */
1065 if (EQ (XCAR (def
), Qautoload
))
1067 /* Autoloading function: will it be a macro when loaded? */
1068 tem
= Fnth (make_number (4), def
);
1069 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1070 /* Yes, load it and try again. */
1072 struct gcpro gcpro1
;
1074 do_autoload (def
, sym
);
1081 else if (!EQ (XCAR (def
), Qmacro
))
1083 else expander
= XCDR (def
);
1087 expander
= XCDR (tem
);
1088 if (NILP (expander
))
1091 form
= apply1 (expander
, XCDR (form
));
1096 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1097 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1098 TAG is evalled to get the tag to use; it must not be nil.
1100 Then the BODY is executed.
1101 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1102 If no throw happens, `catch' returns the value of the last BODY form.
1103 If a throw happens, it specifies the value to return from `catch'.
1104 usage: (catch TAG BODY...) */)
1108 register Lisp_Object tag
;
1109 struct gcpro gcpro1
;
1112 tag
= Feval (Fcar (args
));
1114 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1117 /* Set up a catch, then call C function FUNC on argument ARG.
1118 FUNC should return a Lisp_Object.
1119 This is how catches are done from within C code. */
1122 internal_catch (tag
, func
, arg
)
1124 Lisp_Object (*func
) ();
1127 /* This structure is made part of the chain `catchlist'. */
1130 /* Fill in the components of c, and put it on the list. */
1134 c
.backlist
= backtrace_list
;
1135 c
.handlerlist
= handlerlist
;
1136 c
.lisp_eval_depth
= lisp_eval_depth
;
1137 c
.pdlcount
= SPECPDL_INDEX ();
1138 c
.poll_suppress_count
= poll_suppress_count
;
1139 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1140 c
.gcpro
= gcprolist
;
1141 c
.byte_stack
= byte_stack_list
;
1145 if (! _setjmp (c
.jmp
))
1146 c
.val
= (*func
) (arg
);
1148 /* Throw works by a longjmp that comes right here. */
1153 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1154 jump to that CATCH, returning VALUE as the value of that catch.
1156 This is the guts Fthrow and Fsignal; they differ only in the way
1157 they choose the catch tag to throw to. A catch tag for a
1158 condition-case form has a TAG of Qnil.
1160 Before each catch is discarded, unbind all special bindings and
1161 execute all unwind-protect clauses made above that catch. Unwind
1162 the handler stack as we go, so that the proper handlers are in
1163 effect for each unwind-protect clause we run. At the end, restore
1164 some static info saved in CATCH, and longjmp to the location
1167 This is used for correct unwinding in Fthrow and Fsignal. */
1170 unwind_to_catch (catch, value
)
1171 struct catchtag
*catch;
1174 register int last_time
;
1176 /* Save the value in the tag. */
1179 /* Restore certain special C variables. */
1180 set_poll_suppress_count (catch->poll_suppress_count
);
1181 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked
);
1182 handling_signal
= 0;
1187 last_time
= catchlist
== catch;
1189 /* Unwind the specpdl stack, and then restore the proper set of
1191 unbind_to (catchlist
->pdlcount
, Qnil
);
1192 handlerlist
= catchlist
->handlerlist
;
1193 catchlist
= catchlist
->next
;
1195 while (! last_time
);
1197 byte_stack_list
= catch->byte_stack
;
1198 gcprolist
= catch->gcpro
;
1201 gcpro_level
= gcprolist
->level
+ 1;
1205 backtrace_list
= catch->backlist
;
1206 lisp_eval_depth
= catch->lisp_eval_depth
;
1208 _longjmp (catch->jmp
, 1);
1211 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1212 doc
: /* Throw to the catch for TAG and return VALUE from it.
1213 Both TAG and VALUE are evalled. */)
1215 register Lisp_Object tag
, value
;
1217 register struct catchtag
*c
;
1222 for (c
= catchlist
; c
; c
= c
->next
)
1224 if (EQ (c
->tag
, tag
))
1225 unwind_to_catch (c
, value
);
1227 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1232 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1233 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1234 If BODYFORM completes normally, its value is returned
1235 after executing the UNWINDFORMS.
1236 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1237 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1242 int count
= SPECPDL_INDEX ();
1244 record_unwind_protect (Fprogn
, Fcdr (args
));
1245 val
= Feval (Fcar (args
));
1246 return unbind_to (count
, val
);
1249 /* Chain of condition handlers currently in effect.
1250 The elements of this chain are contained in the stack frames
1251 of Fcondition_case and internal_condition_case.
1252 When an error is signaled (by calling Fsignal, below),
1253 this chain is searched for an element that applies. */
1255 struct handler
*handlerlist
;
1257 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1258 doc
: /* Regain control when an error is signaled.
1259 Executes BODYFORM and returns its value if no error happens.
1260 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1261 where the BODY is made of Lisp expressions.
1263 A handler is applicable to an error
1264 if CONDITION-NAME is one of the error's condition names.
1265 If an error happens, the first applicable handler is run.
1267 The car of a handler may be a list of condition names
1268 instead of a single condition name.
1270 When a handler handles an error,
1271 control returns to the condition-case and the handler BODY... is executed
1272 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1273 VAR may be nil; then you do not get access to the signal information.
1275 The value of the last BODY form is returned from the condition-case.
1276 See also the function `signal' for more info.
1277 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1284 register Lisp_Object bodyform
, handlers
;
1285 volatile Lisp_Object var
;
1288 bodyform
= Fcar (Fcdr (args
));
1289 handlers
= Fcdr (Fcdr (args
));
1292 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1298 && (SYMBOLP (XCAR (tem
))
1299 || CONSP (XCAR (tem
))))))
1300 error ("Invalid condition handler", tem
);
1305 c
.backlist
= backtrace_list
;
1306 c
.handlerlist
= handlerlist
;
1307 c
.lisp_eval_depth
= lisp_eval_depth
;
1308 c
.pdlcount
= SPECPDL_INDEX ();
1309 c
.poll_suppress_count
= poll_suppress_count
;
1310 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1311 c
.gcpro
= gcprolist
;
1312 c
.byte_stack
= byte_stack_list
;
1313 if (_setjmp (c
.jmp
))
1316 specbind (h
.var
, c
.val
);
1317 val
= Fprogn (Fcdr (h
.chosen_clause
));
1319 /* Note that this just undoes the binding of h.var; whoever
1320 longjumped to us unwound the stack to c.pdlcount before
1322 unbind_to (c
.pdlcount
, Qnil
);
1329 h
.handler
= handlers
;
1330 h
.next
= handlerlist
;
1334 val
= Feval (bodyform
);
1336 handlerlist
= h
.next
;
1340 /* Call the function BFUN with no arguments, catching errors within it
1341 according to HANDLERS. If there is an error, call HFUN with
1342 one argument which is the data that describes the error:
1345 HANDLERS can be a list of conditions to catch.
1346 If HANDLERS is Qt, catch all errors.
1347 If HANDLERS is Qerror, catch all errors
1348 but allow the debugger to run if that is enabled. */
1351 internal_condition_case (bfun
, handlers
, hfun
)
1352 Lisp_Object (*bfun
) ();
1353 Lisp_Object handlers
;
1354 Lisp_Object (*hfun
) ();
1360 #if 0 /* We now handle interrupt_input_blocked properly.
1361 What we still do not handle is exiting a signal handler. */
1367 c
.backlist
= backtrace_list
;
1368 c
.handlerlist
= handlerlist
;
1369 c
.lisp_eval_depth
= lisp_eval_depth
;
1370 c
.pdlcount
= SPECPDL_INDEX ();
1371 c
.poll_suppress_count
= poll_suppress_count
;
1372 c
.interrupt_input_blocked
= interrupt_input_blocked
;
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
;
1389 handlerlist
= h
.next
;
1393 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1396 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1397 Lisp_Object (*bfun
) ();
1399 Lisp_Object handlers
;
1400 Lisp_Object (*hfun
) ();
1408 c
.backlist
= backtrace_list
;
1409 c
.handlerlist
= handlerlist
;
1410 c
.lisp_eval_depth
= lisp_eval_depth
;
1411 c
.pdlcount
= SPECPDL_INDEX ();
1412 c
.poll_suppress_count
= poll_suppress_count
;
1413 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1414 c
.gcpro
= gcprolist
;
1415 c
.byte_stack
= byte_stack_list
;
1416 if (_setjmp (c
.jmp
))
1418 return (*hfun
) (c
.val
);
1422 h
.handler
= handlers
;
1424 h
.next
= handlerlist
;
1428 val
= (*bfun
) (arg
);
1430 handlerlist
= h
.next
;
1435 /* Like internal_condition_case but call BFUN with NARGS as first,
1436 and ARGS as second argument. */
1439 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1440 Lisp_Object (*bfun
) ();
1443 Lisp_Object handlers
;
1444 Lisp_Object (*hfun
) ();
1452 c
.backlist
= backtrace_list
;
1453 c
.handlerlist
= handlerlist
;
1454 c
.lisp_eval_depth
= lisp_eval_depth
;
1455 c
.pdlcount
= SPECPDL_INDEX ();
1456 c
.poll_suppress_count
= poll_suppress_count
;
1457 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1458 c
.gcpro
= gcprolist
;
1459 c
.byte_stack
= byte_stack_list
;
1460 if (_setjmp (c
.jmp
))
1462 return (*hfun
) (c
.val
);
1466 h
.handler
= handlers
;
1468 h
.next
= handlerlist
;
1472 val
= (*bfun
) (nargs
, args
);
1474 handlerlist
= h
.next
;
1479 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1480 Lisp_Object
, Lisp_Object
,
1483 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1484 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1485 This function does not return.
1487 An error symbol is a symbol with an `error-conditions' property
1488 that is a list of condition names.
1489 A handler for any of those names will get to handle this signal.
1490 The symbol `error' should normally be one of them.
1492 DATA should be a list. Its elements are printed as part of the error message.
1493 See Info anchor `(elisp)Definition of signal' for some details on how this
1494 error message is constructed.
1495 If the signal is handled, DATA is made available to the handler.
1496 See also the function `condition-case'. */)
1497 (error_symbol
, data
)
1498 Lisp_Object error_symbol
, data
;
1500 /* When memory is full, ERROR-SYMBOL is nil,
1501 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1502 That is a special case--don't do this in other situations. */
1503 register struct handler
*allhandlers
= handlerlist
;
1504 Lisp_Object conditions
;
1505 extern int gc_in_progress
;
1506 extern int waiting_for_input
;
1507 Lisp_Object debugger_value
;
1509 Lisp_Object real_error_symbol
;
1510 struct backtrace
*bp
;
1512 immediate_quit
= handling_signal
= 0;
1514 if (gc_in_progress
|| waiting_for_input
)
1517 if (NILP (error_symbol
))
1518 real_error_symbol
= Fcar (data
);
1520 real_error_symbol
= error_symbol
;
1522 #if 0 /* rms: I don't know why this was here,
1523 but it is surely wrong for an error that is handled. */
1524 #ifdef HAVE_X_WINDOWS
1525 if (display_hourglass_p
)
1526 cancel_hourglass ();
1530 /* This hook is used by edebug. */
1531 if (! NILP (Vsignal_hook_function
)
1532 && ! NILP (error_symbol
))
1533 call2 (Vsignal_hook_function
, error_symbol
, data
);
1535 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1537 /* Remember from where signal was called. Skip over the frame for
1538 `signal' itself. If a frame for `error' follows, skip that,
1539 too. Don't do this when ERROR_SYMBOL is nil, because that
1540 is a memory-full error. */
1541 Vsignaling_function
= Qnil
;
1542 if (backtrace_list
&& !NILP (error_symbol
))
1544 bp
= backtrace_list
->next
;
1545 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1547 if (bp
&& bp
->function
)
1548 Vsignaling_function
= *bp
->function
;
1551 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1553 register Lisp_Object clause
;
1555 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1556 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1558 if (specpdl_size
+ 40 > max_specpdl_size
)
1559 max_specpdl_size
= specpdl_size
+ 40;
1561 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1562 error_symbol
, data
, &debugger_value
);
1564 if (EQ (clause
, Qlambda
))
1566 /* We can't return values to code which signaled an error, but we
1567 can continue code which has signaled a quit. */
1568 if (EQ (real_error_symbol
, Qquit
))
1571 error ("Cannot return from the debugger in an error");
1576 Lisp_Object unwind_data
;
1577 struct handler
*h
= handlerlist
;
1579 handlerlist
= allhandlers
;
1581 if (NILP (error_symbol
))
1584 unwind_data
= Fcons (error_symbol
, data
);
1585 h
->chosen_clause
= clause
;
1586 unwind_to_catch (h
->tag
, unwind_data
);
1590 handlerlist
= allhandlers
;
1591 /* If no handler is present now, try to run the debugger,
1592 and if that fails, throw to top level. */
1593 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1595 Fthrow (Qtop_level
, Qt
);
1597 if (! NILP (error_symbol
))
1598 data
= Fcons (error_symbol
, data
);
1600 string
= Ferror_message_string (data
);
1601 fatal ("%s", SDATA (string
), 0);
1604 /* Return nonzero iff LIST is a non-nil atom or
1605 a list containing one of CONDITIONS. */
1608 wants_debugger (list
, conditions
)
1609 Lisp_Object list
, conditions
;
1616 while (CONSP (conditions
))
1618 Lisp_Object
this, tail
;
1619 this = XCAR (conditions
);
1620 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1621 if (EQ (XCAR (tail
), this))
1623 conditions
= XCDR (conditions
);
1628 /* Return 1 if an error with condition-symbols CONDITIONS,
1629 and described by SIGNAL-DATA, should skip the debugger
1630 according to debugger-ignored-errors. */
1633 skip_debugger (conditions
, data
)
1634 Lisp_Object conditions
, data
;
1637 int first_string
= 1;
1638 Lisp_Object error_message
;
1640 error_message
= Qnil
;
1641 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1643 if (STRINGP (XCAR (tail
)))
1647 error_message
= Ferror_message_string (data
);
1651 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1656 Lisp_Object contail
;
1658 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1659 if (EQ (XCAR (tail
), XCAR (contail
)))
1667 /* Value of Qlambda means we have called debugger and user has continued.
1668 There are two ways to pass SIG and DATA:
1669 = SIG is the error symbol, and DATA is the rest of the data.
1670 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1671 This is for memory-full errors only.
1673 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1676 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1677 Lisp_Object handlers
, conditions
, sig
, data
;
1678 Lisp_Object
*debugger_value_ptr
;
1680 register Lisp_Object h
;
1681 register Lisp_Object tem
;
1683 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1685 /* error is used similarly, but means print an error message
1686 and run the debugger if that is enabled. */
1687 if (EQ (handlers
, Qerror
)
1688 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1689 there is a handler. */
1691 int count
= SPECPDL_INDEX ();
1692 int debugger_called
= 0;
1693 Lisp_Object sig_symbol
, combined_data
;
1694 /* This is set to 1 if we are handling a memory-full error,
1695 because these must not run the debugger.
1696 (There is no room in memory to do that!) */
1697 int no_debugger
= 0;
1701 combined_data
= data
;
1702 sig_symbol
= Fcar (data
);
1707 combined_data
= Fcons (sig
, data
);
1711 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1714 internal_with_output_to_temp_buffer ("*Backtrace*",
1715 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1718 internal_with_output_to_temp_buffer ("*Backtrace*",
1723 && (EQ (sig_symbol
, Qquit
)
1725 : wants_debugger (Vdebug_on_error
, conditions
))
1726 && ! skip_debugger (conditions
, combined_data
)
1727 && when_entered_debugger
< num_nonmacro_input_events
)
1729 specbind (Qdebug_on_error
, Qnil
);
1731 = call_debugger (Fcons (Qerror
,
1732 Fcons (combined_data
, Qnil
)));
1733 debugger_called
= 1;
1735 /* If there is no handler, return saying whether we ran the debugger. */
1736 if (EQ (handlers
, Qerror
))
1738 if (debugger_called
)
1739 return unbind_to (count
, Qlambda
);
1743 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1745 Lisp_Object handler
, condit
;
1748 if (!CONSP (handler
))
1750 condit
= Fcar (handler
);
1751 /* Handle a single condition name in handler HANDLER. */
1752 if (SYMBOLP (condit
))
1754 tem
= Fmemq (Fcar (handler
), conditions
);
1758 /* Handle a list of condition names in handler HANDLER. */
1759 else if (CONSP (condit
))
1761 while (CONSP (condit
))
1763 tem
= Fmemq (Fcar (condit
), conditions
);
1766 condit
= XCDR (condit
);
1773 /* dump an error message; called like printf */
1777 error (m
, a1
, a2
, a3
)
1797 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1802 buffer
= (char *) xrealloc (buffer
, size
);
1805 buffer
= (char *) xmalloc (size
);
1810 string
= build_string (buffer
);
1814 Fsignal (Qerror
, Fcons (string
, Qnil
));
1818 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1819 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1820 This means it contains a description for how to read arguments to give it.
1821 The value is nil for an invalid function or a symbol with no function
1824 Interactively callable functions include strings and vectors (treated
1825 as keyboard macros), lambda-expressions that contain a top-level call
1826 to `interactive', autoload definitions made by `autoload' with non-nil
1827 fourth argument, and some of the built-in functions of Lisp.
1829 Also, a symbol satisfies `commandp' if its function definition does so.
1831 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1832 then strings and vectors are not accepted. */)
1833 (function
, for_call_interactively
)
1834 Lisp_Object function
, for_call_interactively
;
1836 register Lisp_Object fun
;
1837 register Lisp_Object funcar
;
1841 fun
= indirect_function (fun
);
1842 if (EQ (fun
, Qunbound
))
1845 /* Emacs primitives are interactive if their DEFUN specifies an
1846 interactive spec. */
1849 if (XSUBR (fun
)->prompt
)
1855 /* Bytecode objects are interactive if they are long enough to
1856 have an element whose index is COMPILED_INTERACTIVE, which is
1857 where the interactive spec is stored. */
1858 else if (COMPILEDP (fun
))
1859 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1862 /* Strings and vectors are keyboard macros. */
1863 if (NILP (for_call_interactively
) && (STRINGP (fun
) || VECTORP (fun
)))
1866 /* Lists may represent commands. */
1869 funcar
= XCAR (fun
);
1870 if (EQ (funcar
, Qlambda
))
1871 return Fassq (Qinteractive
, Fcdr (XCDR (fun
)));
1872 if (EQ (funcar
, Qautoload
))
1873 return Fcar (Fcdr (Fcdr (XCDR (fun
))));
1879 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1880 doc
: /* Define FUNCTION to autoload from FILE.
1881 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1882 Third arg DOCSTRING is documentation for the function.
1883 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1884 Fifth arg TYPE indicates the type of the object:
1885 nil or omitted says FUNCTION is a function,
1886 `keymap' says FUNCTION is really a keymap, and
1887 `macro' or t says FUNCTION is really a macro.
1888 Third through fifth args give info about the real definition.
1889 They default to nil.
1890 If FUNCTION is already defined other than as an autoload,
1891 this does nothing and returns nil. */)
1892 (function
, file
, docstring
, interactive
, type
)
1893 Lisp_Object function
, file
, docstring
, interactive
, type
;
1896 Lisp_Object args
[4];
1899 CHECK_SYMBOL (function
);
1900 CHECK_STRING (file
);
1902 /* If function is defined and not as an autoload, don't override */
1903 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1904 && !(CONSP (XSYMBOL (function
)->function
)
1905 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1908 if (NILP (Vpurify_flag
))
1909 /* Only add entries after dumping, because the ones before are
1910 not useful and else we get loads of them from the loaddefs.el. */
1911 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1915 args
[1] = docstring
;
1916 args
[2] = interactive
;
1919 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1920 #else /* NO_ARG_ARRAY */
1921 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1922 #endif /* not NO_ARG_ARRAY */
1926 un_autoload (oldqueue
)
1927 Lisp_Object oldqueue
;
1929 register Lisp_Object queue
, first
, second
;
1931 /* Queue to unwind is current value of Vautoload_queue.
1932 oldqueue is the shadowed value to leave in Vautoload_queue. */
1933 queue
= Vautoload_queue
;
1934 Vautoload_queue
= oldqueue
;
1935 while (CONSP (queue
))
1937 first
= XCAR (queue
);
1938 second
= Fcdr (first
);
1939 first
= Fcar (first
);
1940 if (EQ (second
, Qnil
))
1943 Ffset (first
, second
);
1944 queue
= XCDR (queue
);
1949 /* Load an autoloaded function.
1950 FUNNAME is the symbol which is the function's name.
1951 FUNDEF is the autoload definition (a list). */
1954 do_autoload (fundef
, funname
)
1955 Lisp_Object fundef
, funname
;
1957 int count
= SPECPDL_INDEX ();
1958 Lisp_Object fun
, queue
, first
, second
;
1959 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1961 /* This is to make sure that loadup.el gives a clear picture
1962 of what files are preloaded and when. */
1963 if (! NILP (Vpurify_flag
))
1964 error ("Attempt to autoload %s while preparing to dump",
1965 SDATA (SYMBOL_NAME (funname
)));
1968 CHECK_SYMBOL (funname
);
1969 GCPRO3 (fun
, funname
, fundef
);
1971 /* Preserve the match data. */
1972 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1974 /* Value saved here is to be restored into Vautoload_queue. */
1975 record_unwind_protect (un_autoload
, Vautoload_queue
);
1976 Vautoload_queue
= Qt
;
1977 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1979 /* Save the old autoloads, in case we ever do an unload. */
1980 queue
= Vautoload_queue
;
1981 while (CONSP (queue
))
1983 first
= XCAR (queue
);
1984 second
= Fcdr (first
);
1985 first
= Fcar (first
);
1987 if (CONSP (second
) && EQ (XCAR (second
), Qautoload
))
1988 Fput (first
, Qautoload
, (XCDR (second
)));
1990 queue
= XCDR (queue
);
1993 /* Once loading finishes, don't undo it. */
1994 Vautoload_queue
= Qt
;
1995 unbind_to (count
, Qnil
);
1997 fun
= Findirect_function (fun
);
1999 if (!NILP (Fequal (fun
, fundef
)))
2000 error ("Autoloading failed to define function %s",
2001 SDATA (SYMBOL_NAME (funname
)));
2006 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
2007 doc
: /* Evaluate FORM and return its value. */)
2011 Lisp_Object fun
, val
, original_fun
, original_args
;
2013 struct backtrace backtrace
;
2014 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2016 if (handling_signal
)
2020 return Fsymbol_value (form
);
2025 if (consing_since_gc
> gc_cons_threshold
)
2028 Fgarbage_collect ();
2032 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2034 if (max_lisp_eval_depth
< 100)
2035 max_lisp_eval_depth
= 100;
2036 if (lisp_eval_depth
> max_lisp_eval_depth
)
2037 error ("Lisp nesting exceeds max-lisp-eval-depth");
2040 original_fun
= Fcar (form
);
2041 original_args
= Fcdr (form
);
2043 backtrace
.next
= backtrace_list
;
2044 backtrace_list
= &backtrace
;
2045 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2046 backtrace
.args
= &original_args
;
2047 backtrace
.nargs
= UNEVALLED
;
2048 backtrace
.evalargs
= 1;
2049 backtrace
.debug_on_exit
= 0;
2051 if (debug_on_next_call
)
2052 do_debug_on_call (Qt
);
2054 /* At this point, only original_fun and original_args
2055 have values that will be used below */
2057 fun
= Findirect_function (original_fun
);
2061 Lisp_Object numargs
;
2062 Lisp_Object argvals
[8];
2063 Lisp_Object args_left
;
2064 register int i
, maxargs
;
2066 args_left
= original_args
;
2067 numargs
= Flength (args_left
);
2071 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2072 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2073 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2075 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2077 backtrace
.evalargs
= 0;
2078 val
= (*XSUBR (fun
)->function
) (args_left
);
2082 if (XSUBR (fun
)->max_args
== MANY
)
2084 /* Pass a vector of evaluated arguments */
2086 register int argnum
= 0;
2088 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2090 GCPRO3 (args_left
, fun
, fun
);
2094 while (!NILP (args_left
))
2096 vals
[argnum
++] = Feval (Fcar (args_left
));
2097 args_left
= Fcdr (args_left
);
2098 gcpro3
.nvars
= argnum
;
2101 backtrace
.args
= vals
;
2102 backtrace
.nargs
= XINT (numargs
);
2104 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2109 GCPRO3 (args_left
, fun
, fun
);
2110 gcpro3
.var
= argvals
;
2113 maxargs
= XSUBR (fun
)->max_args
;
2114 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2116 argvals
[i
] = Feval (Fcar (args_left
));
2122 backtrace
.args
= argvals
;
2123 backtrace
.nargs
= XINT (numargs
);
2128 val
= (*XSUBR (fun
)->function
) ();
2131 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2134 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2137 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2141 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2142 argvals
[2], argvals
[3]);
2145 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2146 argvals
[3], argvals
[4]);
2149 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2150 argvals
[3], argvals
[4], argvals
[5]);
2153 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2154 argvals
[3], argvals
[4], argvals
[5],
2159 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2160 argvals
[3], argvals
[4], argvals
[5],
2161 argvals
[6], argvals
[7]);
2165 /* Someone has created a subr that takes more arguments than
2166 is supported by this code. We need to either rewrite the
2167 subr to use a different argument protocol, or add more
2168 cases to this switch. */
2172 if (COMPILEDP (fun
))
2173 val
= apply_lambda (fun
, original_args
, 1);
2177 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2178 funcar
= Fcar (fun
);
2179 if (!SYMBOLP (funcar
))
2180 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2181 if (EQ (funcar
, Qautoload
))
2183 do_autoload (fun
, original_fun
);
2186 if (EQ (funcar
, Qmacro
))
2187 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2188 else if (EQ (funcar
, Qlambda
))
2189 val
= apply_lambda (fun
, original_args
, 1);
2191 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2197 if (backtrace
.debug_on_exit
)
2198 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2199 backtrace_list
= backtrace
.next
;
2204 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2205 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2206 Then return the value FUNCTION returns.
2207 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2208 usage: (apply FUNCTION &rest ARGUMENTS) */)
2213 register int i
, numargs
;
2214 register Lisp_Object spread_arg
;
2215 register Lisp_Object
*funcall_args
;
2217 struct gcpro gcpro1
;
2221 spread_arg
= args
[nargs
- 1];
2222 CHECK_LIST (spread_arg
);
2224 numargs
= XINT (Flength (spread_arg
));
2227 return Ffuncall (nargs
- 1, args
);
2228 else if (numargs
== 1)
2230 args
[nargs
- 1] = XCAR (spread_arg
);
2231 return Ffuncall (nargs
, args
);
2234 numargs
+= nargs
- 2;
2236 fun
= indirect_function (fun
);
2237 if (EQ (fun
, Qunbound
))
2239 /* Let funcall get the error */
2246 if (numargs
< XSUBR (fun
)->min_args
2247 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2248 goto funcall
; /* Let funcall get the error */
2249 else if (XSUBR (fun
)->max_args
> numargs
)
2251 /* Avoid making funcall cons up a yet another new vector of arguments
2252 by explicitly supplying nil's for optional values */
2253 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2254 * sizeof (Lisp_Object
));
2255 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2256 funcall_args
[++i
] = Qnil
;
2257 GCPRO1 (*funcall_args
);
2258 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2262 /* We add 1 to numargs because funcall_args includes the
2263 function itself as well as its arguments. */
2266 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2267 * sizeof (Lisp_Object
));
2268 GCPRO1 (*funcall_args
);
2269 gcpro1
.nvars
= 1 + numargs
;
2272 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2273 /* Spread the last arg we got. Its first element goes in
2274 the slot that it used to occupy, hence this value of I. */
2276 while (!NILP (spread_arg
))
2278 funcall_args
[i
++] = XCAR (spread_arg
);
2279 spread_arg
= XCDR (spread_arg
);
2282 /* By convention, the caller needs to gcpro Ffuncall's args. */
2283 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2286 /* Run hook variables in various ways. */
2288 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2289 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2290 enum run_hooks_condition
));
2292 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2293 doc
: /* Run each hook in HOOKS. Major mode functions use this.
2294 Each argument should be a symbol, a hook variable.
2295 These symbols are processed in the order specified.
2296 If a hook symbol has a non-nil value, that value may be a function
2297 or a list of functions to be called to run the hook.
2298 If the value is a function, it is called with no arguments.
2299 If it is a list, the elements are called, in order, with no arguments.
2301 Do not use `make-local-variable' to make a hook variable buffer-local.
2302 Instead, use `add-hook' and specify t for the LOCAL argument.
2303 usage: (run-hooks &rest HOOKS) */)
2308 Lisp_Object hook
[1];
2311 for (i
= 0; i
< nargs
; i
++)
2314 run_hook_with_args (1, hook
, to_completion
);
2320 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2321 Srun_hook_with_args
, 1, MANY
, 0,
2322 doc
: /* Run HOOK with the specified arguments ARGS.
2323 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2324 value, that value may be a function or a list of functions to be
2325 called to run the hook. If the value is a function, it is called with
2326 the given arguments and its return value is returned. If it is a list
2327 of functions, those functions are called, in order,
2328 with the given arguments ARGS.
2329 It is best not to depend on the value returned by `run-hook-with-args',
2332 Do not use `make-local-variable' to make a hook variable buffer-local.
2333 Instead, use `add-hook' and specify t for the LOCAL argument.
2334 usage: (run-hook-with-args HOOK &rest ARGS) */)
2339 return run_hook_with_args (nargs
, args
, to_completion
);
2342 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2343 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2344 doc
: /* Run HOOK with the specified arguments ARGS.
2345 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2346 value, that value may be a function or a list of functions to be
2347 called to run the hook. If the value is a function, it is called with
2348 the given arguments and its return value is returned.
2349 If it is a list of functions, those functions are called, in order,
2350 with the given arguments ARGS, until one of them
2351 returns a non-nil value. Then we return that value.
2352 However, if they all return nil, we return nil.
2354 Do not use `make-local-variable' to make a hook variable buffer-local.
2355 Instead, use `add-hook' and specify t for the LOCAL argument.
2356 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2361 return run_hook_with_args (nargs
, args
, until_success
);
2364 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2365 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2366 doc
: /* Run HOOK with the specified arguments ARGS.
2367 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2368 value, that value may be a function or a list of functions to be
2369 called to run the hook. If the value is a function, it is called with
2370 the given arguments and its return value is returned.
2371 If it is a list of functions, those functions are called, in order,
2372 with the given arguments ARGS, until one of them returns nil.
2373 Then we return nil. However, if they all return non-nil, we return non-nil.
2375 Do not use `make-local-variable' to make a hook variable buffer-local.
2376 Instead, use `add-hook' and specify t for the LOCAL argument.
2377 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2382 return run_hook_with_args (nargs
, args
, until_failure
);
2385 /* ARGS[0] should be a hook symbol.
2386 Call each of the functions in the hook value, passing each of them
2387 as arguments all the rest of ARGS (all NARGS - 1 elements).
2388 COND specifies a condition to test after each call
2389 to decide whether to stop.
2390 The caller (or its caller, etc) must gcpro all of ARGS,
2391 except that it isn't necessary to gcpro ARGS[0]. */
2394 run_hook_with_args (nargs
, args
, cond
)
2397 enum run_hooks_condition cond
;
2399 Lisp_Object sym
, val
, ret
;
2400 Lisp_Object globals
;
2401 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2403 /* If we are dying or still initializing,
2404 don't do anything--it would probably crash if we tried. */
2405 if (NILP (Vrun_hooks
))
2409 val
= find_symbol_value (sym
);
2410 ret
= (cond
== until_failure
? Qt
: Qnil
);
2412 if (EQ (val
, Qunbound
) || NILP (val
))
2414 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2417 return Ffuncall (nargs
, args
);
2422 GCPRO3 (sym
, val
, globals
);
2425 CONSP (val
) && ((cond
== to_completion
)
2426 || (cond
== until_success
? NILP (ret
)
2430 if (EQ (XCAR (val
), Qt
))
2432 /* t indicates this hook has a local binding;
2433 it means to run the global binding too. */
2435 for (globals
= Fdefault_value (sym
);
2436 CONSP (globals
) && ((cond
== to_completion
)
2437 || (cond
== until_success
? NILP (ret
)
2439 globals
= XCDR (globals
))
2441 args
[0] = XCAR (globals
);
2442 /* In a global value, t should not occur. If it does, we
2443 must ignore it to avoid an endless loop. */
2444 if (!EQ (args
[0], Qt
))
2445 ret
= Ffuncall (nargs
, args
);
2450 args
[0] = XCAR (val
);
2451 ret
= Ffuncall (nargs
, args
);
2460 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2461 present value of that symbol.
2462 Call each element of FUNLIST,
2463 passing each of them the rest of ARGS.
2464 The caller (or its caller, etc) must gcpro all of ARGS,
2465 except that it isn't necessary to gcpro ARGS[0]. */
2468 run_hook_list_with_args (funlist
, nargs
, args
)
2469 Lisp_Object funlist
;
2475 Lisp_Object globals
;
2476 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2480 GCPRO3 (sym
, val
, globals
);
2482 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2484 if (EQ (XCAR (val
), Qt
))
2486 /* t indicates this hook has a local binding;
2487 it means to run the global binding too. */
2489 for (globals
= Fdefault_value (sym
);
2491 globals
= XCDR (globals
))
2493 args
[0] = XCAR (globals
);
2494 /* In a global value, t should not occur. If it does, we
2495 must ignore it to avoid an endless loop. */
2496 if (!EQ (args
[0], Qt
))
2497 Ffuncall (nargs
, args
);
2502 args
[0] = XCAR (val
);
2503 Ffuncall (nargs
, args
);
2510 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2513 run_hook_with_args_2 (hook
, arg1
, arg2
)
2514 Lisp_Object hook
, arg1
, arg2
;
2516 Lisp_Object temp
[3];
2521 Frun_hook_with_args (3, temp
);
2524 /* Apply fn to arg */
2527 Lisp_Object fn
, arg
;
2529 struct gcpro gcpro1
;
2533 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2537 Lisp_Object args
[2];
2541 RETURN_UNGCPRO (Fapply (2, args
));
2543 #else /* not NO_ARG_ARRAY */
2544 RETURN_UNGCPRO (Fapply (2, &fn
));
2545 #endif /* not NO_ARG_ARRAY */
2548 /* Call function fn on no arguments */
2553 struct gcpro gcpro1
;
2556 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2559 /* Call function fn with 1 argument arg1 */
2563 Lisp_Object fn
, arg1
;
2565 struct gcpro gcpro1
;
2567 Lisp_Object args
[2];
2573 RETURN_UNGCPRO (Ffuncall (2, args
));
2574 #else /* not NO_ARG_ARRAY */
2577 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2578 #endif /* not NO_ARG_ARRAY */
2581 /* Call function fn with 2 arguments arg1, arg2 */
2584 call2 (fn
, arg1
, arg2
)
2585 Lisp_Object fn
, arg1
, arg2
;
2587 struct gcpro gcpro1
;
2589 Lisp_Object args
[3];
2595 RETURN_UNGCPRO (Ffuncall (3, args
));
2596 #else /* not NO_ARG_ARRAY */
2599 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2600 #endif /* not NO_ARG_ARRAY */
2603 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2606 call3 (fn
, arg1
, arg2
, arg3
)
2607 Lisp_Object fn
, arg1
, arg2
, arg3
;
2609 struct gcpro gcpro1
;
2611 Lisp_Object args
[4];
2618 RETURN_UNGCPRO (Ffuncall (4, args
));
2619 #else /* not NO_ARG_ARRAY */
2622 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2623 #endif /* not NO_ARG_ARRAY */
2626 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2629 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2630 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2632 struct gcpro gcpro1
;
2634 Lisp_Object args
[5];
2642 RETURN_UNGCPRO (Ffuncall (5, args
));
2643 #else /* not NO_ARG_ARRAY */
2646 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2647 #endif /* not NO_ARG_ARRAY */
2650 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2653 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2654 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2656 struct gcpro gcpro1
;
2658 Lisp_Object args
[6];
2667 RETURN_UNGCPRO (Ffuncall (6, args
));
2668 #else /* not NO_ARG_ARRAY */
2671 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2672 #endif /* not NO_ARG_ARRAY */
2675 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2678 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2679 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2681 struct gcpro gcpro1
;
2683 Lisp_Object args
[7];
2693 RETURN_UNGCPRO (Ffuncall (7, args
));
2694 #else /* not NO_ARG_ARRAY */
2697 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2698 #endif /* not NO_ARG_ARRAY */
2701 /* The caller should GCPRO all the elements of ARGS. */
2703 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2704 doc
: /* Call first argument as a function, passing remaining arguments to it.
2705 Return the value that function returns.
2706 Thus, (funcall 'cons 'x 'y) returns (x . y).
2707 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2714 int numargs
= nargs
- 1;
2715 Lisp_Object lisp_numargs
;
2717 struct backtrace backtrace
;
2718 register Lisp_Object
*internal_args
;
2722 if (consing_since_gc
> gc_cons_threshold
)
2723 Fgarbage_collect ();
2725 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2727 if (max_lisp_eval_depth
< 100)
2728 max_lisp_eval_depth
= 100;
2729 if (lisp_eval_depth
> max_lisp_eval_depth
)
2730 error ("Lisp nesting exceeds max-lisp-eval-depth");
2733 backtrace
.next
= backtrace_list
;
2734 backtrace_list
= &backtrace
;
2735 backtrace
.function
= &args
[0];
2736 backtrace
.args
= &args
[1];
2737 backtrace
.nargs
= nargs
- 1;
2738 backtrace
.evalargs
= 0;
2739 backtrace
.debug_on_exit
= 0;
2741 if (debug_on_next_call
)
2742 do_debug_on_call (Qlambda
);
2750 fun
= Findirect_function (fun
);
2754 if (numargs
< XSUBR (fun
)->min_args
2755 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2757 XSETFASTINT (lisp_numargs
, numargs
);
2758 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2761 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2762 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2764 if (XSUBR (fun
)->max_args
== MANY
)
2766 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2770 if (XSUBR (fun
)->max_args
> numargs
)
2772 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2773 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2774 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2775 internal_args
[i
] = Qnil
;
2778 internal_args
= args
+ 1;
2779 switch (XSUBR (fun
)->max_args
)
2782 val
= (*XSUBR (fun
)->function
) ();
2785 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2788 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2792 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2796 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2801 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2802 internal_args
[2], internal_args
[3],
2806 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2807 internal_args
[2], internal_args
[3],
2808 internal_args
[4], internal_args
[5]);
2811 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2812 internal_args
[2], internal_args
[3],
2813 internal_args
[4], internal_args
[5],
2818 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2819 internal_args
[2], internal_args
[3],
2820 internal_args
[4], internal_args
[5],
2821 internal_args
[6], internal_args
[7]);
2826 /* If a subr takes more than 8 arguments without using MANY
2827 or UNEVALLED, we need to extend this function to support it.
2828 Until this is done, there is no way to call the function. */
2832 if (COMPILEDP (fun
))
2833 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2837 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2838 funcar
= Fcar (fun
);
2839 if (!SYMBOLP (funcar
))
2840 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2841 if (EQ (funcar
, Qlambda
))
2842 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2843 else if (EQ (funcar
, Qautoload
))
2845 do_autoload (fun
, args
[0]);
2850 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2855 if (backtrace
.debug_on_exit
)
2856 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2857 backtrace_list
= backtrace
.next
;
2862 apply_lambda (fun
, args
, eval_flag
)
2863 Lisp_Object fun
, args
;
2866 Lisp_Object args_left
;
2867 Lisp_Object numargs
;
2868 register Lisp_Object
*arg_vector
;
2869 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2871 register Lisp_Object tem
;
2873 numargs
= Flength (args
);
2874 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2877 GCPRO3 (*arg_vector
, args_left
, fun
);
2880 for (i
= 0; i
< XINT (numargs
);)
2882 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2883 if (eval_flag
) tem
= Feval (tem
);
2884 arg_vector
[i
++] = tem
;
2892 backtrace_list
->args
= arg_vector
;
2893 backtrace_list
->nargs
= i
;
2895 backtrace_list
->evalargs
= 0;
2896 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2898 /* Do the debug-on-exit now, while arg_vector still exists. */
2899 if (backtrace_list
->debug_on_exit
)
2900 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2901 /* Don't do it again when we return to eval. */
2902 backtrace_list
->debug_on_exit
= 0;
2906 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2907 and return the result of evaluation.
2908 FUN must be either a lambda-expression or a compiled-code object. */
2911 funcall_lambda (fun
, nargs
, arg_vector
)
2914 register Lisp_Object
*arg_vector
;
2916 Lisp_Object val
, syms_left
, next
;
2917 int count
= SPECPDL_INDEX ();
2918 int i
, optional
, rest
;
2922 syms_left
= XCDR (fun
);
2923 if (CONSP (syms_left
))
2924 syms_left
= XCAR (syms_left
);
2926 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2928 else if (COMPILEDP (fun
))
2929 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2933 i
= optional
= rest
= 0;
2934 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2938 next
= XCAR (syms_left
);
2939 while (!SYMBOLP (next
))
2940 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2942 if (EQ (next
, Qand_rest
))
2944 else if (EQ (next
, Qand_optional
))
2948 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2952 specbind (next
, arg_vector
[i
++]);
2954 return Fsignal (Qwrong_number_of_arguments
,
2955 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2957 specbind (next
, Qnil
);
2960 if (!NILP (syms_left
))
2961 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2963 return Fsignal (Qwrong_number_of_arguments
,
2964 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2967 val
= Fprogn (XCDR (XCDR (fun
)));
2970 /* If we have not actually read the bytecode string
2971 and constants vector yet, fetch them from the file. */
2972 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2973 Ffetch_bytecode (fun
);
2974 val
= Fbyte_code (AREF (fun
, COMPILED_BYTECODE
),
2975 AREF (fun
, COMPILED_CONSTANTS
),
2976 AREF (fun
, COMPILED_STACK_DEPTH
));
2979 return unbind_to (count
, val
);
2982 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2984 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2990 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2992 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2995 tem
= AREF (object
, COMPILED_BYTECODE
);
2996 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2997 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2999 error ("Invalid byte code");
3001 AREF (object
, COMPILED_BYTECODE
) = XCAR (tem
);
3002 AREF (object
, COMPILED_CONSTANTS
) = XCDR (tem
);
3010 register int count
= SPECPDL_INDEX ();
3011 if (specpdl_size
>= max_specpdl_size
)
3013 if (max_specpdl_size
< 400)
3014 max_specpdl_size
= 400;
3015 if (specpdl_size
>= max_specpdl_size
)
3017 if (!NILP (Vdebug_on_error
))
3018 /* Leave room for some specpdl in the debugger. */
3019 max_specpdl_size
= specpdl_size
+ 100;
3021 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
3025 if (specpdl_size
> max_specpdl_size
)
3026 specpdl_size
= max_specpdl_size
;
3027 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3028 specpdl_ptr
= specpdl
+ count
;
3032 specbind (symbol
, value
)
3033 Lisp_Object symbol
, value
;
3036 Lisp_Object valcontents
;
3038 CHECK_SYMBOL (symbol
);
3039 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3042 /* The most common case is that of a non-constant symbol with a
3043 trivial value. Make that as fast as we can. */
3044 valcontents
= SYMBOL_VALUE (symbol
);
3045 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
3047 specpdl_ptr
->symbol
= symbol
;
3048 specpdl_ptr
->old_value
= valcontents
;
3049 specpdl_ptr
->func
= NULL
;
3051 SET_SYMBOL_VALUE (symbol
, value
);
3055 Lisp_Object valcontents
;
3057 ovalue
= find_symbol_value (symbol
);
3058 specpdl_ptr
->func
= 0;
3059 specpdl_ptr
->old_value
= ovalue
;
3061 valcontents
= XSYMBOL (symbol
)->value
;
3063 if (BUFFER_LOCAL_VALUEP (valcontents
)
3064 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
3065 || BUFFER_OBJFWDP (valcontents
))
3067 Lisp_Object where
, current_buffer
;
3069 current_buffer
= Fcurrent_buffer ();
3071 /* For a local variable, record both the symbol and which
3072 buffer's or frame's value we are saving. */
3073 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3074 where
= current_buffer
;
3075 else if (!BUFFER_OBJFWDP (valcontents
)
3076 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3077 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3081 /* We're not using the `unused' slot in the specbinding
3082 structure because this would mean we have to do more
3083 work for simple variables. */
3084 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3086 /* If SYMBOL is a per-buffer variable which doesn't have a
3087 buffer-local value here, make the `let' change the global
3088 value by changing the value of SYMBOL in all buffers not
3089 having their own value. This is consistent with what
3090 happens with other buffer-local variables. */
3092 && BUFFER_OBJFWDP (valcontents
))
3095 Fset_default (symbol
, value
);
3100 specpdl_ptr
->symbol
= symbol
;
3103 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3104 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3106 set_internal (symbol
, value
, 0, 1);
3111 record_unwind_protect (function
, arg
)
3112 Lisp_Object (*function
) P_ ((Lisp_Object
));
3115 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3117 specpdl_ptr
->func
= function
;
3118 specpdl_ptr
->symbol
= Qnil
;
3119 specpdl_ptr
->old_value
= arg
;
3124 unbind_to (count
, value
)
3128 int quitf
= !NILP (Vquit_flag
);
3129 struct gcpro gcpro1
;
3134 while (specpdl_ptr
!= specpdl
+ count
)
3136 /* Copy the binding, and decrement specpdl_ptr, before we do
3137 the work to unbind it. We decrement first
3138 so that an error in unbinding won't try to unbind
3139 the same entry again, and we copy the binding first
3140 in case more bindings are made during some of the code we run. */
3142 struct specbinding this_binding
;
3143 this_binding
= *--specpdl_ptr
;
3145 if (this_binding
.func
!= 0)
3146 (*this_binding
.func
) (this_binding
.old_value
);
3147 /* If the symbol is a list, it is really (SYMBOL WHERE
3148 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3149 frame. If WHERE is a buffer or frame, this indicates we
3150 bound a variable that had a buffer-local or frame-local
3151 binding. WHERE nil means that the variable had the default
3152 value when it was bound. CURRENT-BUFFER is the buffer that
3153 was current when the variable was bound. */
3154 else if (CONSP (this_binding
.symbol
))
3156 Lisp_Object symbol
, where
;
3158 symbol
= XCAR (this_binding
.symbol
);
3159 where
= XCAR (XCDR (this_binding
.symbol
));
3162 Fset_default (symbol
, this_binding
.old_value
);
3163 else if (BUFFERP (where
))
3164 set_internal (symbol
, this_binding
.old_value
, XBUFFER (where
), 1);
3166 set_internal (symbol
, this_binding
.old_value
, NULL
, 1);
3170 /* If variable has a trivial value (no forwarding), we can
3171 just set it. No need to check for constant symbols here,
3172 since that was already done by specbind. */
3173 if (!MISCP (SYMBOL_VALUE (this_binding
.symbol
)))
3174 SET_SYMBOL_VALUE (this_binding
.symbol
, this_binding
.old_value
);
3176 set_internal (this_binding
.symbol
, this_binding
.old_value
, 0, 1);
3180 if (NILP (Vquit_flag
) && quitf
)
3187 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3188 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3189 The debugger is entered when that frame exits, if the flag is non-nil. */)
3191 Lisp_Object level
, flag
;
3193 register struct backtrace
*backlist
= backtrace_list
;
3196 CHECK_NUMBER (level
);
3198 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3200 backlist
= backlist
->next
;
3204 backlist
->debug_on_exit
= !NILP (flag
);
3209 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3210 doc
: /* Print a trace of Lisp function calls currently active.
3211 Output stream used is value of `standard-output'. */)
3214 register struct backtrace
*backlist
= backtrace_list
;
3218 extern Lisp_Object Vprint_level
;
3219 struct gcpro gcpro1
;
3221 XSETFASTINT (Vprint_level
, 3);
3228 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3229 if (backlist
->nargs
== UNEVALLED
)
3231 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3232 write_string ("\n", -1);
3236 tem
= *backlist
->function
;
3237 Fprin1 (tem
, Qnil
); /* This can QUIT */
3238 write_string ("(", -1);
3239 if (backlist
->nargs
== MANY
)
3241 for (tail
= *backlist
->args
, i
= 0;
3243 tail
= Fcdr (tail
), i
++)
3245 if (i
) write_string (" ", -1);
3246 Fprin1 (Fcar (tail
), Qnil
);
3251 for (i
= 0; i
< backlist
->nargs
; i
++)
3253 if (i
) write_string (" ", -1);
3254 Fprin1 (backlist
->args
[i
], Qnil
);
3257 write_string (")\n", -1);
3259 backlist
= backlist
->next
;
3262 Vprint_level
= Qnil
;
3267 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3268 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3269 If that frame has not evaluated the arguments yet (or is a special form),
3270 the value is (nil FUNCTION ARG-FORMS...).
3271 If that frame has evaluated its arguments and called its function already,
3272 the value is (t FUNCTION ARG-VALUES...).
3273 A &rest arg is represented as the tail of the list ARG-VALUES.
3274 FUNCTION is whatever was supplied as car of evaluated list,
3275 or a lambda expression for macro calls.
3276 If NFRAMES is more than the number of frames, the value is nil. */)
3278 Lisp_Object nframes
;
3280 register struct backtrace
*backlist
= backtrace_list
;
3284 CHECK_NATNUM (nframes
);
3286 /* Find the frame requested. */
3287 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3288 backlist
= backlist
->next
;
3292 if (backlist
->nargs
== UNEVALLED
)
3293 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3296 if (backlist
->nargs
== MANY
)
3297 tem
= *backlist
->args
;
3299 tem
= Flist (backlist
->nargs
, backlist
->args
);
3301 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3309 register struct backtrace
*backlist
;
3312 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3314 mark_object (*backlist
->function
);
3316 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
3319 i
= backlist
->nargs
- 1;
3321 mark_object (backlist
->args
[i
]);
3328 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3329 doc
: /* *Limit on number of Lisp variable bindings & unwind-protects.
3330 If Lisp code tries to make more than this many at once,
3331 an error is signaled.
3332 You can safely use a value considerably larger than the default value,
3333 if that proves inconveniently small. However, if you increase it too far,
3334 Emacs could run out of memory trying to make the stack bigger. */);
3336 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3337 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3339 This limit serves to catch infinite recursions for you before they cause
3340 actual stack overflow in C, which would be fatal for Emacs.
3341 You can safely make it considerably larger than its default value,
3342 if that proves inconveniently small. However, if you increase it too far,
3343 Emacs could overflow the real C stack, and crash. */);
3345 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3346 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3347 If the value is t, that means do an ordinary quit.
3348 If the value equals `throw-on-input', that means quit by throwing
3349 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
3350 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3351 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3354 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3355 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3356 Note that `quit-flag' will still be set by typing C-g,
3357 so a quit will be signaled as soon as `inhibit-quit' is nil.
3358 To prevent this happening, set `quit-flag' to nil
3359 before making `inhibit-quit' nil. */);
3360 Vinhibit_quit
= Qnil
;
3362 Qinhibit_quit
= intern ("inhibit-quit");
3363 staticpro (&Qinhibit_quit
);
3365 Qautoload
= intern ("autoload");
3366 staticpro (&Qautoload
);
3368 Qdebug_on_error
= intern ("debug-on-error");
3369 staticpro (&Qdebug_on_error
);
3371 Qmacro
= intern ("macro");
3372 staticpro (&Qmacro
);
3374 Qdeclare
= intern ("declare");
3375 staticpro (&Qdeclare
);
3377 /* Note that the process handling also uses Qexit, but we don't want
3378 to staticpro it twice, so we just do it here. */
3379 Qexit
= intern ("exit");
3382 Qinteractive
= intern ("interactive");
3383 staticpro (&Qinteractive
);
3385 Qcommandp
= intern ("commandp");
3386 staticpro (&Qcommandp
);
3388 Qdefun
= intern ("defun");
3389 staticpro (&Qdefun
);
3391 Qand_rest
= intern ("&rest");
3392 staticpro (&Qand_rest
);
3394 Qand_optional
= intern ("&optional");
3395 staticpro (&Qand_optional
);
3397 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3398 doc
: /* *Non-nil means errors display a backtrace buffer.
3399 More precisely, this happens for any error that is handled
3400 by the editor command loop.
3401 If the value is a list, an error only means to display a backtrace
3402 if one of its condition symbols appears in the list. */);
3403 Vstack_trace_on_error
= Qnil
;
3405 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3406 doc
: /* *Non-nil means enter debugger if an error is signaled.
3407 Does not apply to errors handled by `condition-case' or those
3408 matched by `debug-ignored-errors'.
3409 If the value is a list, an error only means to enter the debugger
3410 if one of its condition symbols appears in the list.
3411 When you evaluate an expression interactively, this variable
3412 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3413 See also variable `debug-on-quit'. */);
3414 Vdebug_on_error
= Qnil
;
3416 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3417 doc
: /* *List of errors for which the debugger should not be called.
3418 Each element may be a condition-name or a regexp that matches error messages.
3419 If any element applies to a given error, that error skips the debugger
3420 and just returns to top level.
3421 This overrides the variable `debug-on-error'.
3422 It does not apply to errors handled by `condition-case'. */);
3423 Vdebug_ignored_errors
= Qnil
;
3425 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3426 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3427 Does not apply if quit is handled by a `condition-case'.
3428 When you evaluate an expression interactively, this variable
3429 is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil. */);
3432 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3433 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3435 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3436 doc
: /* Non-nil means debugger may continue execution.
3437 This is nil when the debugger is called under circumstances where it
3438 might not be safe to continue. */);
3439 debugger_may_continue
= 1;
3441 DEFVAR_LISP ("debugger", &Vdebugger
,
3442 doc
: /* Function to call to invoke debugger.
3443 If due to frame exit, args are `exit' and the value being returned;
3444 this function's value will be returned instead of that.
3445 If due to error, args are `error' and a list of the args to `signal'.
3446 If due to `apply' or `funcall' entry, one arg, `lambda'.
3447 If due to `eval' entry, one arg, t. */);
3450 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3451 doc
: /* If non-nil, this is a function for `signal' to call.
3452 It receives the same arguments that `signal' was given.
3453 The Edebug package uses this to regain control. */);
3454 Vsignal_hook_function
= Qnil
;
3456 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3457 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3458 Note that `debug-on-error', `debug-on-quit' and friends
3459 still determine whether to handle the particular condition. */);
3460 Vdebug_on_signal
= Qnil
;
3462 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3463 doc
: /* Function to process declarations in a macro definition.
3464 The function will be called with two args MACRO and DECL.
3465 MACRO is the name of the macro being defined.
3466 DECL is a list `(declare ...)' containing the declarations.
3467 The value the function returns is not used. */);
3468 Vmacro_declaration_function
= Qnil
;
3470 Vrun_hooks
= intern ("run-hooks");
3471 staticpro (&Vrun_hooks
);
3473 staticpro (&Vautoload_queue
);
3474 Vautoload_queue
= Qnil
;
3475 staticpro (&Vsignaling_function
);
3476 Vsignaling_function
= Qnil
;
3487 defsubr (&Sfunction
);
3489 defsubr (&Sdefmacro
);
3491 defsubr (&Sdefvaralias
);
3492 defsubr (&Sdefconst
);
3493 defsubr (&Suser_variable_p
);
3497 defsubr (&Smacroexpand
);
3500 defsubr (&Sunwind_protect
);
3501 defsubr (&Scondition_case
);
3503 defsubr (&Sinteractive_p
);
3504 defsubr (&Scalled_interactively_p
);
3505 defsubr (&Scommandp
);
3506 defsubr (&Sautoload
);
3509 defsubr (&Sfuncall
);
3510 defsubr (&Srun_hooks
);
3511 defsubr (&Srun_hook_with_args
);
3512 defsubr (&Srun_hook_with_args_until_success
);
3513 defsubr (&Srun_hook_with_args_until_failure
);
3514 defsubr (&Sfetch_bytecode
);
3515 defsubr (&Sbacktrace_debug
);
3516 defsubr (&Sbacktrace
);
3517 defsubr (&Sbacktrace_frame
);
3520 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
3521 (do not change this comment) */