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
= 650;
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
&& 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
)
601 /* If we're running an Emacs 18-style byte-compiled function, there
602 may be a frame for Fbytecode at the top level. In any version of
603 Emacs there can be Fbytecode frames for subexpressions evaluated
604 inside catch and condition-case. Skip past them.
606 If this isn't a byte-compiled function, then we may now be
607 looking at several frames for special forms. Skip past them. */
609 && (EQ (*btp
->function
, Qbytecode
)
610 || btp
->nargs
== UNEVALLED
))
613 /* btp now points at the frame of the innermost function that isn't
614 a special form, ignoring frames for Finteractive_p and/or
615 Fbytecode at the top. If this frame is for a built-in function
616 (such as load or eval-region) return nil. */
617 fun
= Findirect_function (*btp
->function
);
618 if (exclude_subrs_p
&& SUBRP (fun
))
621 /* btp points to the frame of a Lisp function that called interactive-p.
622 Return t if that function was called interactively. */
623 if (btp
&& btp
->next
&& EQ (*btp
->next
->function
, Qcall_interactively
))
629 DEFUN ("defun", Fdefun
, Sdefun
, 2, UNEVALLED
, 0,
630 doc
: /* Define NAME as a function.
631 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
632 See also the function `interactive'.
633 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
637 register Lisp_Object fn_name
;
638 register Lisp_Object defn
;
640 fn_name
= Fcar (args
);
641 CHECK_SYMBOL (fn_name
);
642 defn
= Fcons (Qlambda
, Fcdr (args
));
643 if (!NILP (Vpurify_flag
))
644 defn
= Fpurecopy (defn
);
645 if (CONSP (XSYMBOL (fn_name
)->function
)
646 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
647 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
648 Ffset (fn_name
, defn
);
649 LOADHIST_ATTACH (fn_name
);
653 DEFUN ("defmacro", Fdefmacro
, Sdefmacro
, 2, UNEVALLED
, 0,
654 doc
: /* Define NAME as a macro.
655 The actual definition looks like
656 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
657 When the macro is called, as in (NAME ARGS...),
658 the function (lambda ARGLIST BODY...) is applied to
659 the list ARGS... as it appears in the expression,
660 and the result should be a form to be evaluated instead of the original.
662 DECL is a declaration, optional, which can specify how to indent
663 calls to this macro and how Edebug should handle it. It looks like this:
665 The elements can look like this:
667 Set NAME's `lisp-indent-function' property to INDENT.
670 Set NAME's `edebug-form-spec' property to DEBUG. (This is
671 equivalent to writing a `def-edebug-spec' for the macro.)
672 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
676 register Lisp_Object fn_name
;
677 register Lisp_Object defn
;
678 Lisp_Object lambda_list
, doc
, tail
;
680 fn_name
= Fcar (args
);
681 CHECK_SYMBOL (fn_name
);
682 lambda_list
= Fcar (Fcdr (args
));
683 tail
= Fcdr (Fcdr (args
));
686 if (STRINGP (Fcar (tail
)))
692 while (CONSP (Fcar (tail
))
693 && EQ (Fcar (Fcar (tail
)), Qdeclare
))
695 if (!NILP (Vmacro_declaration_function
))
699 call2 (Vmacro_declaration_function
, fn_name
, Fcar (tail
));
707 tail
= Fcons (lambda_list
, tail
);
709 tail
= Fcons (lambda_list
, Fcons (doc
, tail
));
710 defn
= Fcons (Qmacro
, Fcons (Qlambda
, tail
));
712 if (!NILP (Vpurify_flag
))
713 defn
= Fpurecopy (defn
);
714 if (CONSP (XSYMBOL (fn_name
)->function
)
715 && EQ (XCAR (XSYMBOL (fn_name
)->function
), Qautoload
))
716 LOADHIST_ATTACH (Fcons (Qt
, fn_name
));
717 Ffset (fn_name
, defn
);
718 LOADHIST_ATTACH (fn_name
);
723 DEFUN ("defvaralias", Fdefvaralias
, Sdefvaralias
, 2, 3, 0,
724 doc
: /* Make SYMBOL a variable alias for symbol ALIASED.
725 Setting the value of SYMBOL will subsequently set the value of ALIASED,
726 and getting the value of SYMBOL will return the value ALIASED has.
727 Third arg DOCSTRING, if non-nil, is documentation for SYMBOL.
728 The return value is ALIASED. */)
729 (symbol
, aliased
, docstring
)
730 Lisp_Object symbol
, aliased
, docstring
;
732 struct Lisp_Symbol
*sym
;
734 CHECK_SYMBOL (symbol
);
735 CHECK_SYMBOL (aliased
);
737 if (SYMBOL_CONSTANT_P (symbol
))
738 error ("Cannot make a constant an alias");
740 sym
= XSYMBOL (symbol
);
741 sym
->indirect_variable
= 1;
742 sym
->value
= aliased
;
743 sym
->constant
= SYMBOL_CONSTANT_P (aliased
);
744 LOADHIST_ATTACH (Fcons (Qdefvar
, symbol
));
745 if (!NILP (docstring
))
746 Fput (symbol
, Qvariable_documentation
, docstring
);
752 DEFUN ("defvar", Fdefvar
, Sdefvar
, 1, UNEVALLED
, 0,
753 doc
: /* Define SYMBOL as a variable.
754 You are not required to define a variable in order to use it,
755 but the definition can supply documentation and an initial value
756 in a way that tags can recognize.
758 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
759 If SYMBOL is buffer-local, its default value is what is set;
760 buffer-local values are not affected.
761 INITVALUE and DOCSTRING are optional.
762 If DOCSTRING starts with *, this variable is identified as a user option.
763 This means that M-x set-variable recognizes it.
764 See also `user-variable-p'.
765 If INITVALUE is missing, SYMBOL's value is not set.
767 If SYMBOL has a local binding, then this form affects the local
768 binding. This is usually not what you want. Thus, if you need to
769 load a file defining variables, with this form or with `defconst' or
770 `defcustom', you should always load that file _outside_ any bindings
771 for these variables. \(`defconst' and `defcustom' behave similarly in
773 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
777 register Lisp_Object sym
, tem
, tail
;
781 if (!NILP (Fcdr (Fcdr (tail
))))
782 error ("too many arguments");
784 tem
= Fdefault_boundp (sym
);
788 Fset_default (sym
, Feval (Fcar (tail
)));
790 { /* Check if there is really a global binding rather than just a let
791 binding that shadows the global unboundness of the var. */
792 volatile struct specbinding
*pdl
= specpdl_ptr
;
793 while (--pdl
>= specpdl
)
795 if (EQ (pdl
->symbol
, sym
) && !pdl
->func
796 && EQ (pdl
->old_value
, Qunbound
))
798 message_with_string ("Warning: defvar ignored because %s is let-bound",
799 SYMBOL_NAME (sym
), 1);
808 if (!NILP (Vpurify_flag
))
809 tem
= Fpurecopy (tem
);
810 Fput (sym
, Qvariable_documentation
, tem
);
812 LOADHIST_ATTACH (Fcons (Qdefvar
, sym
));
815 /* Simple (defvar <var>) should not count as a definition at all.
816 It could get in the way of other definitions, and unloading this
817 package could try to make the variable unbound. */
823 DEFUN ("defconst", Fdefconst
, Sdefconst
, 2, UNEVALLED
, 0,
824 doc
: /* Define SYMBOL as a constant variable.
825 The intent is that neither programs nor users should ever change this value.
826 Always sets the value of SYMBOL to the result of evalling INITVALUE.
827 If SYMBOL is buffer-local, its default value is what is set;
828 buffer-local values are not affected.
829 DOCSTRING is optional.
831 If SYMBOL has a local binding, then this form sets the local binding's
832 value. However, you should normally not make local bindings for
833 variables defined with this form.
834 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
838 register Lisp_Object sym
, tem
;
841 if (!NILP (Fcdr (Fcdr (Fcdr (args
)))))
842 error ("too many arguments");
844 tem
= Feval (Fcar (Fcdr (args
)));
845 if (!NILP (Vpurify_flag
))
846 tem
= Fpurecopy (tem
);
847 Fset_default (sym
, tem
);
848 tem
= Fcar (Fcdr (Fcdr (args
)));
851 if (!NILP (Vpurify_flag
))
852 tem
= Fpurecopy (tem
);
853 Fput (sym
, Qvariable_documentation
, tem
);
855 LOADHIST_ATTACH (Fcons (Qdefvar
, sym
));
859 DEFUN ("user-variable-p", Fuser_variable_p
, Suser_variable_p
, 1, 1, 0,
860 doc
: /* Returns t if VARIABLE is intended to be set and modified by users.
861 \(The alternative is a variable used internally in a Lisp program.)
862 Determined by whether the first character of the documentation
863 for the variable is `*' or if the variable is customizable (has a non-nil
864 value of `standard-value' or of `custom-autoload' on its property list). */)
866 Lisp_Object variable
;
868 Lisp_Object documentation
;
870 if (!SYMBOLP (variable
))
873 documentation
= Fget (variable
, Qvariable_documentation
);
874 if (INTEGERP (documentation
) && XINT (documentation
) < 0)
876 if (STRINGP (documentation
)
877 && ((unsigned char) SREF (documentation
, 0) == '*'))
879 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
880 if (CONSP (documentation
)
881 && STRINGP (XCAR (documentation
))
882 && INTEGERP (XCDR (documentation
))
883 && XINT (XCDR (documentation
)) < 0)
885 /* Customizable? See `custom-variable-p'. */
886 if ((!NILP (Fget (variable
, intern ("standard-value"))))
887 || (!NILP (Fget (variable
, intern ("custom-autoload")))))
892 DEFUN ("let*", FletX
, SletX
, 1, UNEVALLED
, 0,
893 doc
: /* Bind variables according to VARLIST then eval BODY.
894 The value of the last form in BODY is returned.
895 Each element of VARLIST is a symbol (which is bound to nil)
896 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
897 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
898 usage: (let* VARLIST BODY...) */)
902 Lisp_Object varlist
, val
, elt
;
903 int count
= SPECPDL_INDEX ();
904 struct gcpro gcpro1
, gcpro2
, gcpro3
;
906 GCPRO3 (args
, elt
, varlist
);
908 varlist
= Fcar (args
);
909 while (!NILP (varlist
))
912 elt
= Fcar (varlist
);
914 specbind (elt
, Qnil
);
915 else if (! NILP (Fcdr (Fcdr (elt
))))
917 Fcons (build_string ("`let' bindings can have only one value-form"),
921 val
= Feval (Fcar (Fcdr (elt
)));
922 specbind (Fcar (elt
), val
);
924 varlist
= Fcdr (varlist
);
927 val
= Fprogn (Fcdr (args
));
928 return unbind_to (count
, val
);
931 DEFUN ("let", Flet
, Slet
, 1, UNEVALLED
, 0,
932 doc
: /* Bind variables according to VARLIST then eval BODY.
933 The value of the last form in BODY is returned.
934 Each element of VARLIST is a symbol (which is bound to nil)
935 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
936 All the VALUEFORMs are evalled before any symbols are bound.
937 usage: (let VARLIST BODY...) */)
941 Lisp_Object
*temps
, tem
;
942 register Lisp_Object elt
, varlist
;
943 int count
= SPECPDL_INDEX ();
945 struct gcpro gcpro1
, gcpro2
;
947 varlist
= Fcar (args
);
949 /* Make space to hold the values to give the bound variables */
950 elt
= Flength (varlist
);
951 temps
= (Lisp_Object
*) alloca (XFASTINT (elt
) * sizeof (Lisp_Object
));
953 /* Compute the values and store them in `temps' */
955 GCPRO2 (args
, *temps
);
958 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
961 elt
= Fcar (varlist
);
963 temps
[argnum
++] = Qnil
;
964 else if (! NILP (Fcdr (Fcdr (elt
))))
966 Fcons (build_string ("`let' bindings can have only one value-form"),
969 temps
[argnum
++] = Feval (Fcar (Fcdr (elt
)));
970 gcpro2
.nvars
= argnum
;
974 varlist
= Fcar (args
);
975 for (argnum
= 0; !NILP (varlist
); varlist
= Fcdr (varlist
))
977 elt
= Fcar (varlist
);
978 tem
= temps
[argnum
++];
982 specbind (Fcar (elt
), tem
);
985 elt
= Fprogn (Fcdr (args
));
986 return unbind_to (count
, elt
);
989 DEFUN ("while", Fwhile
, Swhile
, 1, UNEVALLED
, 0,
990 doc
: /* If TEST yields non-nil, eval BODY... and repeat.
991 The order of execution is thus TEST, BODY, TEST, BODY and so on
992 until TEST returns nil.
993 usage: (while TEST BODY...) */)
997 Lisp_Object test
, body
;
998 struct gcpro gcpro1
, gcpro2
;
1000 GCPRO2 (test
, body
);
1004 while (!NILP (Feval (test
)))
1014 DEFUN ("macroexpand", Fmacroexpand
, Smacroexpand
, 1, 2, 0,
1015 doc
: /* Return result of expanding macros at top level of FORM.
1016 If FORM is not a macro call, it is returned unchanged.
1017 Otherwise, the macro is expanded and the expansion is considered
1018 in place of FORM. When a non-macro-call results, it is returned.
1020 The second optional arg ENVIRONMENT specifies an environment of macro
1021 definitions to shadow the loaded ones for use in file byte-compilation. */)
1024 Lisp_Object environment
;
1026 /* With cleanups from Hallvard Furuseth. */
1027 register Lisp_Object expander
, sym
, def
, tem
;
1031 /* Come back here each time we expand a macro call,
1032 in case it expands into another macro call. */
1035 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1036 def
= sym
= XCAR (form
);
1038 /* Trace symbols aliases to other symbols
1039 until we get a symbol that is not an alias. */
1040 while (SYMBOLP (def
))
1044 tem
= Fassq (sym
, environment
);
1047 def
= XSYMBOL (sym
)->function
;
1048 if (!EQ (def
, Qunbound
))
1053 /* Right now TEM is the result from SYM in ENVIRONMENT,
1054 and if TEM is nil then DEF is SYM's function definition. */
1057 /* SYM is not mentioned in ENVIRONMENT.
1058 Look at its function definition. */
1059 if (EQ (def
, Qunbound
) || !CONSP (def
))
1060 /* Not defined or definition not suitable */
1062 if (EQ (XCAR (def
), Qautoload
))
1064 /* Autoloading function: will it be a macro when loaded? */
1065 tem
= Fnth (make_number (4), def
);
1066 if (EQ (tem
, Qt
) || EQ (tem
, Qmacro
))
1067 /* Yes, load it and try again. */
1069 struct gcpro gcpro1
;
1071 do_autoload (def
, sym
);
1078 else if (!EQ (XCAR (def
), Qmacro
))
1080 else expander
= XCDR (def
);
1084 expander
= XCDR (tem
);
1085 if (NILP (expander
))
1088 form
= apply1 (expander
, XCDR (form
));
1093 DEFUN ("catch", Fcatch
, Scatch
, 1, UNEVALLED
, 0,
1094 doc
: /* Eval BODY allowing nonlocal exits using `throw'.
1095 TAG is evalled to get the tag to use; it must not be nil.
1097 Then the BODY is executed.
1098 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1099 If no throw happens, `catch' returns the value of the last BODY form.
1100 If a throw happens, it specifies the value to return from `catch'.
1101 usage: (catch TAG BODY...) */)
1105 register Lisp_Object tag
;
1106 struct gcpro gcpro1
;
1109 tag
= Feval (Fcar (args
));
1111 return internal_catch (tag
, Fprogn
, Fcdr (args
));
1114 /* Set up a catch, then call C function FUNC on argument ARG.
1115 FUNC should return a Lisp_Object.
1116 This is how catches are done from within C code. */
1119 internal_catch (tag
, func
, arg
)
1121 Lisp_Object (*func
) ();
1124 /* This structure is made part of the chain `catchlist'. */
1127 /* Fill in the components of c, and put it on the list. */
1131 c
.backlist
= backtrace_list
;
1132 c
.handlerlist
= handlerlist
;
1133 c
.lisp_eval_depth
= lisp_eval_depth
;
1134 c
.pdlcount
= SPECPDL_INDEX ();
1135 c
.poll_suppress_count
= poll_suppress_count
;
1136 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1137 c
.gcpro
= gcprolist
;
1138 c
.byte_stack
= byte_stack_list
;
1142 if (! _setjmp (c
.jmp
))
1143 c
.val
= (*func
) (arg
);
1145 /* Throw works by a longjmp that comes right here. */
1150 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
1151 jump to that CATCH, returning VALUE as the value of that catch.
1153 This is the guts Fthrow and Fsignal; they differ only in the way
1154 they choose the catch tag to throw to. A catch tag for a
1155 condition-case form has a TAG of Qnil.
1157 Before each catch is discarded, unbind all special bindings and
1158 execute all unwind-protect clauses made above that catch. Unwind
1159 the handler stack as we go, so that the proper handlers are in
1160 effect for each unwind-protect clause we run. At the end, restore
1161 some static info saved in CATCH, and longjmp to the location
1164 This is used for correct unwinding in Fthrow and Fsignal. */
1167 unwind_to_catch (catch, value
)
1168 struct catchtag
*catch;
1171 register int last_time
;
1173 /* Save the value in the tag. */
1176 /* Restore the polling-suppression count. */
1177 set_poll_suppress_count (catch->poll_suppress_count
);
1178 interrupt_input_blocked
= catch->interrupt_input_blocked
;
1182 last_time
= catchlist
== catch;
1184 /* Unwind the specpdl stack, and then restore the proper set of
1186 unbind_to (catchlist
->pdlcount
, Qnil
);
1187 handlerlist
= catchlist
->handlerlist
;
1188 catchlist
= catchlist
->next
;
1190 while (! last_time
);
1192 byte_stack_list
= catch->byte_stack
;
1193 gcprolist
= catch->gcpro
;
1196 gcpro_level
= gcprolist
->level
+ 1;
1200 backtrace_list
= catch->backlist
;
1201 lisp_eval_depth
= catch->lisp_eval_depth
;
1203 _longjmp (catch->jmp
, 1);
1206 DEFUN ("throw", Fthrow
, Sthrow
, 2, 2, 0,
1207 doc
: /* Throw to the catch for TAG and return VALUE from it.
1208 Both TAG and VALUE are evalled. */)
1210 register Lisp_Object tag
, value
;
1212 register struct catchtag
*c
;
1217 for (c
= catchlist
; c
; c
= c
->next
)
1219 if (EQ (c
->tag
, tag
))
1220 unwind_to_catch (c
, value
);
1222 tag
= Fsignal (Qno_catch
, Fcons (tag
, Fcons (value
, Qnil
)));
1227 DEFUN ("unwind-protect", Funwind_protect
, Sunwind_protect
, 1, UNEVALLED
, 0,
1228 doc
: /* Do BODYFORM, protecting with UNWINDFORMS.
1229 If BODYFORM completes normally, its value is returned
1230 after executing the UNWINDFORMS.
1231 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1232 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1237 int count
= SPECPDL_INDEX ();
1239 record_unwind_protect (Fprogn
, Fcdr (args
));
1240 val
= Feval (Fcar (args
));
1241 return unbind_to (count
, val
);
1244 /* Chain of condition handlers currently in effect.
1245 The elements of this chain are contained in the stack frames
1246 of Fcondition_case and internal_condition_case.
1247 When an error is signaled (by calling Fsignal, below),
1248 this chain is searched for an element that applies. */
1250 struct handler
*handlerlist
;
1252 DEFUN ("condition-case", Fcondition_case
, Scondition_case
, 2, UNEVALLED
, 0,
1253 doc
: /* Regain control when an error is signaled.
1254 Executes BODYFORM and returns its value if no error happens.
1255 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
1256 where the BODY is made of Lisp expressions.
1258 A handler is applicable to an error
1259 if CONDITION-NAME is one of the error's condition names.
1260 If an error happens, the first applicable handler is run.
1262 The car of a handler may be a list of condition names
1263 instead of a single condition name.
1265 When a handler handles an error,
1266 control returns to the condition-case and the handler BODY... is executed
1267 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
1268 VAR may be nil; then you do not get access to the signal information.
1270 The value of the last BODY form is returned from the condition-case.
1271 See also the function `signal' for more info.
1272 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1279 register Lisp_Object bodyform
, handlers
;
1280 volatile Lisp_Object var
;
1283 bodyform
= Fcar (Fcdr (args
));
1284 handlers
= Fcdr (Fcdr (args
));
1287 for (val
= handlers
; CONSP (val
); val
= XCDR (val
))
1293 && (SYMBOLP (XCAR (tem
))
1294 || CONSP (XCAR (tem
))))))
1295 error ("Invalid condition handler", tem
);
1300 c
.backlist
= backtrace_list
;
1301 c
.handlerlist
= handlerlist
;
1302 c
.lisp_eval_depth
= lisp_eval_depth
;
1303 c
.pdlcount
= SPECPDL_INDEX ();
1304 c
.poll_suppress_count
= poll_suppress_count
;
1305 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1306 c
.gcpro
= gcprolist
;
1307 c
.byte_stack
= byte_stack_list
;
1308 if (_setjmp (c
.jmp
))
1311 specbind (h
.var
, c
.val
);
1312 val
= Fprogn (Fcdr (h
.chosen_clause
));
1314 /* Note that this just undoes the binding of h.var; whoever
1315 longjumped to us unwound the stack to c.pdlcount before
1317 unbind_to (c
.pdlcount
, Qnil
);
1324 h
.handler
= handlers
;
1325 h
.next
= handlerlist
;
1329 val
= Feval (bodyform
);
1331 handlerlist
= h
.next
;
1335 /* Call the function BFUN with no arguments, catching errors within it
1336 according to HANDLERS. If there is an error, call HFUN with
1337 one argument which is the data that describes the error:
1340 HANDLERS can be a list of conditions to catch.
1341 If HANDLERS is Qt, catch all errors.
1342 If HANDLERS is Qerror, catch all errors
1343 but allow the debugger to run if that is enabled. */
1346 internal_condition_case (bfun
, handlers
, hfun
)
1347 Lisp_Object (*bfun
) ();
1348 Lisp_Object handlers
;
1349 Lisp_Object (*hfun
) ();
1355 #if 0 /* We now handle interrupt_input_blocked properly.
1356 What we still do not handle is exiting a signal handler. */
1362 c
.backlist
= backtrace_list
;
1363 c
.handlerlist
= handlerlist
;
1364 c
.lisp_eval_depth
= lisp_eval_depth
;
1365 c
.pdlcount
= SPECPDL_INDEX ();
1366 c
.poll_suppress_count
= poll_suppress_count
;
1367 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1368 c
.gcpro
= gcprolist
;
1369 c
.byte_stack
= byte_stack_list
;
1370 if (_setjmp (c
.jmp
))
1372 return (*hfun
) (c
.val
);
1376 h
.handler
= handlers
;
1378 h
.next
= handlerlist
;
1384 handlerlist
= h
.next
;
1388 /* Like internal_condition_case but call BFUN with ARG as its argument. */
1391 internal_condition_case_1 (bfun
, arg
, handlers
, hfun
)
1392 Lisp_Object (*bfun
) ();
1394 Lisp_Object handlers
;
1395 Lisp_Object (*hfun
) ();
1403 c
.backlist
= backtrace_list
;
1404 c
.handlerlist
= handlerlist
;
1405 c
.lisp_eval_depth
= lisp_eval_depth
;
1406 c
.pdlcount
= SPECPDL_INDEX ();
1407 c
.poll_suppress_count
= poll_suppress_count
;
1408 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1409 c
.gcpro
= gcprolist
;
1410 c
.byte_stack
= byte_stack_list
;
1411 if (_setjmp (c
.jmp
))
1413 return (*hfun
) (c
.val
);
1417 h
.handler
= handlers
;
1419 h
.next
= handlerlist
;
1423 val
= (*bfun
) (arg
);
1425 handlerlist
= h
.next
;
1430 /* Like internal_condition_case but call BFUN with NARGS as first,
1431 and ARGS as second argument. */
1434 internal_condition_case_2 (bfun
, nargs
, args
, handlers
, hfun
)
1435 Lisp_Object (*bfun
) ();
1438 Lisp_Object handlers
;
1439 Lisp_Object (*hfun
) ();
1447 c
.backlist
= backtrace_list
;
1448 c
.handlerlist
= handlerlist
;
1449 c
.lisp_eval_depth
= lisp_eval_depth
;
1450 c
.pdlcount
= SPECPDL_INDEX ();
1451 c
.poll_suppress_count
= poll_suppress_count
;
1452 c
.interrupt_input_blocked
= interrupt_input_blocked
;
1453 c
.gcpro
= gcprolist
;
1454 c
.byte_stack
= byte_stack_list
;
1455 if (_setjmp (c
.jmp
))
1457 return (*hfun
) (c
.val
);
1461 h
.handler
= handlers
;
1463 h
.next
= handlerlist
;
1467 val
= (*bfun
) (nargs
, args
);
1469 handlerlist
= h
.next
;
1474 static Lisp_Object find_handler_clause
P_ ((Lisp_Object
, Lisp_Object
,
1475 Lisp_Object
, Lisp_Object
,
1478 DEFUN ("signal", Fsignal
, Ssignal
, 2, 2, 0,
1479 doc
: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1480 This function does not return.
1482 An error symbol is a symbol with an `error-conditions' property
1483 that is a list of condition names.
1484 A handler for any of those names will get to handle this signal.
1485 The symbol `error' should normally be one of them.
1487 DATA should be a list. Its elements are printed as part of the error message.
1488 See Info anchor `(elisp)Definition of signal' for some details on how this
1489 error message is constructed.
1490 If the signal is handled, DATA is made available to the handler.
1491 See also the function `condition-case'. */)
1492 (error_symbol
, data
)
1493 Lisp_Object error_symbol
, data
;
1495 /* When memory is full, ERROR-SYMBOL is nil,
1496 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1497 That is a special case--don't do this in other situations. */
1498 register struct handler
*allhandlers
= handlerlist
;
1499 Lisp_Object conditions
;
1500 extern int gc_in_progress
;
1501 extern int waiting_for_input
;
1502 Lisp_Object debugger_value
;
1504 Lisp_Object real_error_symbol
;
1505 struct backtrace
*bp
;
1507 immediate_quit
= handling_signal
= 0;
1509 if (gc_in_progress
|| waiting_for_input
)
1512 if (NILP (error_symbol
))
1513 real_error_symbol
= Fcar (data
);
1515 real_error_symbol
= error_symbol
;
1517 #if 0 /* rms: I don't know why this was here,
1518 but it is surely wrong for an error that is handled. */
1519 #ifdef HAVE_X_WINDOWS
1520 if (display_hourglass_p
)
1521 cancel_hourglass ();
1525 /* This hook is used by edebug. */
1526 if (! NILP (Vsignal_hook_function
)
1527 && ! NILP (error_symbol
))
1528 call2 (Vsignal_hook_function
, error_symbol
, data
);
1530 conditions
= Fget (real_error_symbol
, Qerror_conditions
);
1532 /* Remember from where signal was called. Skip over the frame for
1533 `signal' itself. If a frame for `error' follows, skip that,
1534 too. Don't do this when ERROR_SYMBOL is nil, because that
1535 is a memory-full error. */
1536 Vsignaling_function
= Qnil
;
1537 if (backtrace_list
&& !NILP (error_symbol
))
1539 bp
= backtrace_list
->next
;
1540 if (bp
&& bp
->function
&& EQ (*bp
->function
, Qerror
))
1542 if (bp
&& bp
->function
)
1543 Vsignaling_function
= *bp
->function
;
1546 for (; handlerlist
; handlerlist
= handlerlist
->next
)
1548 register Lisp_Object clause
;
1550 if (lisp_eval_depth
+ 20 > max_lisp_eval_depth
)
1551 max_lisp_eval_depth
= lisp_eval_depth
+ 20;
1553 if (specpdl_size
+ 40 > max_specpdl_size
)
1554 max_specpdl_size
= specpdl_size
+ 40;
1556 clause
= find_handler_clause (handlerlist
->handler
, conditions
,
1557 error_symbol
, data
, &debugger_value
);
1559 if (EQ (clause
, Qlambda
))
1561 /* We can't return values to code which signaled an error, but we
1562 can continue code which has signaled a quit. */
1563 if (EQ (real_error_symbol
, Qquit
))
1566 error ("Cannot return from the debugger in an error");
1571 Lisp_Object unwind_data
;
1572 struct handler
*h
= handlerlist
;
1574 handlerlist
= allhandlers
;
1576 if (NILP (error_symbol
))
1579 unwind_data
= Fcons (error_symbol
, data
);
1580 h
->chosen_clause
= clause
;
1581 unwind_to_catch (h
->tag
, unwind_data
);
1585 handlerlist
= allhandlers
;
1586 /* If no handler is present now, try to run the debugger,
1587 and if that fails, throw to top level. */
1588 find_handler_clause (Qerror
, conditions
, error_symbol
, data
, &debugger_value
);
1590 Fthrow (Qtop_level
, Qt
);
1592 if (! NILP (error_symbol
))
1593 data
= Fcons (error_symbol
, data
);
1595 string
= Ferror_message_string (data
);
1596 fatal ("%s", SDATA (string
), 0);
1599 /* Return nonzero iff LIST is a non-nil atom or
1600 a list containing one of CONDITIONS. */
1603 wants_debugger (list
, conditions
)
1604 Lisp_Object list
, conditions
;
1611 while (CONSP (conditions
))
1613 Lisp_Object
this, tail
;
1614 this = XCAR (conditions
);
1615 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
1616 if (EQ (XCAR (tail
), this))
1618 conditions
= XCDR (conditions
);
1623 /* Return 1 if an error with condition-symbols CONDITIONS,
1624 and described by SIGNAL-DATA, should skip the debugger
1625 according to debugger-ignored-errors. */
1628 skip_debugger (conditions
, data
)
1629 Lisp_Object conditions
, data
;
1632 int first_string
= 1;
1633 Lisp_Object error_message
;
1635 error_message
= Qnil
;
1636 for (tail
= Vdebug_ignored_errors
; CONSP (tail
); tail
= XCDR (tail
))
1638 if (STRINGP (XCAR (tail
)))
1642 error_message
= Ferror_message_string (data
);
1646 if (fast_string_match (XCAR (tail
), error_message
) >= 0)
1651 Lisp_Object contail
;
1653 for (contail
= conditions
; CONSP (contail
); contail
= XCDR (contail
))
1654 if (EQ (XCAR (tail
), XCAR (contail
)))
1662 /* Value of Qlambda means we have called debugger and user has continued.
1663 There are two ways to pass SIG and DATA:
1664 = SIG is the error symbol, and DATA is the rest of the data.
1665 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1666 This is for memory-full errors only.
1668 Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
1671 find_handler_clause (handlers
, conditions
, sig
, data
, debugger_value_ptr
)
1672 Lisp_Object handlers
, conditions
, sig
, data
;
1673 Lisp_Object
*debugger_value_ptr
;
1675 register Lisp_Object h
;
1676 register Lisp_Object tem
;
1678 if (EQ (handlers
, Qt
)) /* t is used by handlers for all conditions, set up by C code. */
1680 /* error is used similarly, but means print an error message
1681 and run the debugger if that is enabled. */
1682 if (EQ (handlers
, Qerror
)
1683 || !NILP (Vdebug_on_signal
)) /* This says call debugger even if
1684 there is a handler. */
1686 int count
= SPECPDL_INDEX ();
1687 int debugger_called
= 0;
1688 Lisp_Object sig_symbol
, combined_data
;
1689 /* This is set to 1 if we are handling a memory-full error,
1690 because these must not run the debugger.
1691 (There is no room in memory to do that!) */
1692 int no_debugger
= 0;
1696 combined_data
= data
;
1697 sig_symbol
= Fcar (data
);
1702 combined_data
= Fcons (sig
, data
);
1706 if (wants_debugger (Vstack_trace_on_error
, conditions
))
1709 internal_with_output_to_temp_buffer ("*Backtrace*",
1710 (Lisp_Object (*) (Lisp_Object
)) Fbacktrace
,
1713 internal_with_output_to_temp_buffer ("*Backtrace*",
1718 && (EQ (sig_symbol
, Qquit
)
1720 : wants_debugger (Vdebug_on_error
, conditions
))
1721 && ! skip_debugger (conditions
, combined_data
)
1722 && when_entered_debugger
< num_nonmacro_input_events
)
1724 specbind (Qdebug_on_error
, Qnil
);
1726 = call_debugger (Fcons (Qerror
,
1727 Fcons (combined_data
, Qnil
)));
1728 debugger_called
= 1;
1730 /* If there is no handler, return saying whether we ran the debugger. */
1731 if (EQ (handlers
, Qerror
))
1733 if (debugger_called
)
1734 return unbind_to (count
, Qlambda
);
1738 for (h
= handlers
; CONSP (h
); h
= Fcdr (h
))
1740 Lisp_Object handler
, condit
;
1743 if (!CONSP (handler
))
1745 condit
= Fcar (handler
);
1746 /* Handle a single condition name in handler HANDLER. */
1747 if (SYMBOLP (condit
))
1749 tem
= Fmemq (Fcar (handler
), conditions
);
1753 /* Handle a list of condition names in handler HANDLER. */
1754 else if (CONSP (condit
))
1756 while (CONSP (condit
))
1758 tem
= Fmemq (Fcar (condit
), conditions
);
1761 condit
= XCDR (condit
);
1768 /* dump an error message; called like printf */
1772 error (m
, a1
, a2
, a3
)
1792 int used
= doprnt (buffer
, size
, m
, m
+ mlen
, 3, args
);
1797 buffer
= (char *) xrealloc (buffer
, size
);
1800 buffer
= (char *) xmalloc (size
);
1805 string
= build_string (buffer
);
1809 Fsignal (Qerror
, Fcons (string
, Qnil
));
1813 DEFUN ("commandp", Fcommandp
, Scommandp
, 1, 2, 0,
1814 doc
: /* Non-nil if FUNCTION makes provisions for interactive calling.
1815 This means it contains a description for how to read arguments to give it.
1816 The value is nil for an invalid function or a symbol with no function
1819 Interactively callable functions include strings and vectors (treated
1820 as keyboard macros), lambda-expressions that contain a top-level call
1821 to `interactive', autoload definitions made by `autoload' with non-nil
1822 fourth argument, and some of the built-in functions of Lisp.
1824 Also, a symbol satisfies `commandp' if its function definition does so.
1826 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
1827 then strings and vectors are not accepted. */)
1828 (function
, for_call_interactively
)
1829 Lisp_Object function
, for_call_interactively
;
1831 register Lisp_Object fun
;
1832 register Lisp_Object funcar
;
1836 fun
= indirect_function (fun
);
1837 if (EQ (fun
, Qunbound
))
1840 /* Emacs primitives are interactive if their DEFUN specifies an
1841 interactive spec. */
1844 if (XSUBR (fun
)->prompt
)
1850 /* Bytecode objects are interactive if they are long enough to
1851 have an element whose index is COMPILED_INTERACTIVE, which is
1852 where the interactive spec is stored. */
1853 else if (COMPILEDP (fun
))
1854 return ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_INTERACTIVE
1857 /* Strings and vectors are keyboard macros. */
1858 if (NILP (for_call_interactively
) && (STRINGP (fun
) || VECTORP (fun
)))
1861 /* Lists may represent commands. */
1864 funcar
= XCAR (fun
);
1865 if (EQ (funcar
, Qlambda
))
1866 return Fassq (Qinteractive
, Fcdr (XCDR (fun
)));
1867 if (EQ (funcar
, Qautoload
))
1868 return Fcar (Fcdr (Fcdr (XCDR (fun
))));
1874 DEFUN ("autoload", Fautoload
, Sautoload
, 2, 5, 0,
1875 doc
: /* Define FUNCTION to autoload from FILE.
1876 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
1877 Third arg DOCSTRING is documentation for the function.
1878 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
1879 Fifth arg TYPE indicates the type of the object:
1880 nil or omitted says FUNCTION is a function,
1881 `keymap' says FUNCTION is really a keymap, and
1882 `macro' or t says FUNCTION is really a macro.
1883 Third through fifth args give info about the real definition.
1884 They default to nil.
1885 If FUNCTION is already defined other than as an autoload,
1886 this does nothing and returns nil. */)
1887 (function
, file
, docstring
, interactive
, type
)
1888 Lisp_Object function
, file
, docstring
, interactive
, type
;
1891 Lisp_Object args
[4];
1894 CHECK_SYMBOL (function
);
1895 CHECK_STRING (file
);
1897 /* If function is defined and not as an autoload, don't override */
1898 if (!EQ (XSYMBOL (function
)->function
, Qunbound
)
1899 && !(CONSP (XSYMBOL (function
)->function
)
1900 && EQ (XCAR (XSYMBOL (function
)->function
), Qautoload
)))
1903 if (NILP (Vpurify_flag
))
1904 /* Only add entries after dumping, because the ones before are
1905 not useful and else we get loads of them from the loaddefs.el. */
1906 LOADHIST_ATTACH (Fcons (Qautoload
, function
));
1910 args
[1] = docstring
;
1911 args
[2] = interactive
;
1914 return Ffset (function
, Fcons (Qautoload
, Flist (4, &args
[0])));
1915 #else /* NO_ARG_ARRAY */
1916 return Ffset (function
, Fcons (Qautoload
, Flist (4, &file
)));
1917 #endif /* not NO_ARG_ARRAY */
1921 un_autoload (oldqueue
)
1922 Lisp_Object oldqueue
;
1924 register Lisp_Object queue
, first
, second
;
1926 /* Queue to unwind is current value of Vautoload_queue.
1927 oldqueue is the shadowed value to leave in Vautoload_queue. */
1928 queue
= Vautoload_queue
;
1929 Vautoload_queue
= oldqueue
;
1930 while (CONSP (queue
))
1932 first
= XCAR (queue
);
1933 second
= Fcdr (first
);
1934 first
= Fcar (first
);
1935 if (EQ (second
, Qnil
))
1938 Ffset (first
, second
);
1939 queue
= XCDR (queue
);
1944 /* Load an autoloaded function.
1945 FUNNAME is the symbol which is the function's name.
1946 FUNDEF is the autoload definition (a list). */
1949 do_autoload (fundef
, funname
)
1950 Lisp_Object fundef
, funname
;
1952 int count
= SPECPDL_INDEX ();
1953 Lisp_Object fun
, queue
, first
, second
;
1954 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1956 /* This is to make sure that loadup.el gives a clear picture
1957 of what files are preloaded and when. */
1958 if (! NILP (Vpurify_flag
))
1959 error ("Attempt to autoload %s while preparing to dump",
1960 SDATA (SYMBOL_NAME (funname
)));
1963 CHECK_SYMBOL (funname
);
1964 GCPRO3 (fun
, funname
, fundef
);
1966 /* Preserve the match data. */
1967 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1969 /* Value saved here is to be restored into Vautoload_queue. */
1970 record_unwind_protect (un_autoload
, Vautoload_queue
);
1971 Vautoload_queue
= Qt
;
1972 Fload (Fcar (Fcdr (fundef
)), Qnil
, noninteractive
? Qt
: Qnil
, Qnil
, Qt
);
1974 /* Save the old autoloads, in case we ever do an unload. */
1975 queue
= Vautoload_queue
;
1976 while (CONSP (queue
))
1978 first
= XCAR (queue
);
1979 second
= Fcdr (first
);
1980 first
= Fcar (first
);
1982 /* Note: This test is subtle. The cdr of an autoload-queue entry
1983 may be an atom if the autoload entry was generated by a defalias
1986 Fput (first
, Qautoload
, (XCDR (second
)));
1988 queue
= XCDR (queue
);
1991 /* Once loading finishes, don't undo it. */
1992 Vautoload_queue
= Qt
;
1993 unbind_to (count
, Qnil
);
1995 fun
= Findirect_function (fun
);
1997 if (!NILP (Fequal (fun
, fundef
)))
1998 error ("Autoloading failed to define function %s",
1999 SDATA (SYMBOL_NAME (funname
)));
2004 DEFUN ("eval", Feval
, Seval
, 1, 1, 0,
2005 doc
: /* Evaluate FORM and return its value. */)
2009 Lisp_Object fun
, val
, original_fun
, original_args
;
2011 struct backtrace backtrace
;
2012 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2014 if (handling_signal
)
2018 return Fsymbol_value (form
);
2023 if (consing_since_gc
> gc_cons_threshold
)
2026 Fgarbage_collect ();
2030 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2032 if (max_lisp_eval_depth
< 100)
2033 max_lisp_eval_depth
= 100;
2034 if (lisp_eval_depth
> max_lisp_eval_depth
)
2035 error ("Lisp nesting exceeds max-lisp-eval-depth");
2038 original_fun
= Fcar (form
);
2039 original_args
= Fcdr (form
);
2041 backtrace
.next
= backtrace_list
;
2042 backtrace_list
= &backtrace
;
2043 backtrace
.function
= &original_fun
; /* This also protects them from gc */
2044 backtrace
.args
= &original_args
;
2045 backtrace
.nargs
= UNEVALLED
;
2046 backtrace
.evalargs
= 1;
2047 backtrace
.debug_on_exit
= 0;
2049 if (debug_on_next_call
)
2050 do_debug_on_call (Qt
);
2052 /* At this point, only original_fun and original_args
2053 have values that will be used below */
2055 fun
= Findirect_function (original_fun
);
2059 Lisp_Object numargs
;
2060 Lisp_Object argvals
[8];
2061 Lisp_Object args_left
;
2062 register int i
, maxargs
;
2064 args_left
= original_args
;
2065 numargs
= Flength (args_left
);
2067 if (XINT (numargs
) < XSUBR (fun
)->min_args
||
2068 (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< XINT (numargs
)))
2069 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (numargs
, Qnil
)));
2071 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2073 backtrace
.evalargs
= 0;
2074 val
= (*XSUBR (fun
)->function
) (args_left
);
2078 if (XSUBR (fun
)->max_args
== MANY
)
2080 /* Pass a vector of evaluated arguments */
2082 register int argnum
= 0;
2084 vals
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2086 GCPRO3 (args_left
, fun
, fun
);
2090 while (!NILP (args_left
))
2092 vals
[argnum
++] = Feval (Fcar (args_left
));
2093 args_left
= Fcdr (args_left
);
2094 gcpro3
.nvars
= argnum
;
2097 backtrace
.args
= vals
;
2098 backtrace
.nargs
= XINT (numargs
);
2100 val
= (*XSUBR (fun
)->function
) (XINT (numargs
), vals
);
2105 GCPRO3 (args_left
, fun
, fun
);
2106 gcpro3
.var
= argvals
;
2109 maxargs
= XSUBR (fun
)->max_args
;
2110 for (i
= 0; i
< maxargs
; args_left
= Fcdr (args_left
))
2112 argvals
[i
] = Feval (Fcar (args_left
));
2118 backtrace
.args
= argvals
;
2119 backtrace
.nargs
= XINT (numargs
);
2124 val
= (*XSUBR (fun
)->function
) ();
2127 val
= (*XSUBR (fun
)->function
) (argvals
[0]);
2130 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1]);
2133 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2137 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1],
2138 argvals
[2], argvals
[3]);
2141 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2142 argvals
[3], argvals
[4]);
2145 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2146 argvals
[3], argvals
[4], argvals
[5]);
2149 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2150 argvals
[3], argvals
[4], argvals
[5],
2155 val
= (*XSUBR (fun
)->function
) (argvals
[0], argvals
[1], argvals
[2],
2156 argvals
[3], argvals
[4], argvals
[5],
2157 argvals
[6], argvals
[7]);
2161 /* Someone has created a subr that takes more arguments than
2162 is supported by this code. We need to either rewrite the
2163 subr to use a different argument protocol, or add more
2164 cases to this switch. */
2168 if (COMPILEDP (fun
))
2169 val
= apply_lambda (fun
, original_args
, 1);
2173 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2174 funcar
= Fcar (fun
);
2175 if (!SYMBOLP (funcar
))
2176 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2177 if (EQ (funcar
, Qautoload
))
2179 do_autoload (fun
, original_fun
);
2182 if (EQ (funcar
, Qmacro
))
2183 val
= Feval (apply1 (Fcdr (fun
), original_args
));
2184 else if (EQ (funcar
, Qlambda
))
2185 val
= apply_lambda (fun
, original_args
, 1);
2187 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2191 if (backtrace
.debug_on_exit
)
2192 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2193 backtrace_list
= backtrace
.next
;
2198 DEFUN ("apply", Fapply
, Sapply
, 2, MANY
, 0,
2199 doc
: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2200 Then return the value FUNCTION returns.
2201 Thus, (apply '+ 1 2 '(3 4)) returns 10.
2202 usage: (apply FUNCTION &rest ARGUMENTS) */)
2207 register int i
, numargs
;
2208 register Lisp_Object spread_arg
;
2209 register Lisp_Object
*funcall_args
;
2211 struct gcpro gcpro1
;
2215 spread_arg
= args
[nargs
- 1];
2216 CHECK_LIST (spread_arg
);
2218 numargs
= XINT (Flength (spread_arg
));
2221 return Ffuncall (nargs
- 1, args
);
2222 else if (numargs
== 1)
2224 args
[nargs
- 1] = XCAR (spread_arg
);
2225 return Ffuncall (nargs
, args
);
2228 numargs
+= nargs
- 2;
2230 fun
= indirect_function (fun
);
2231 if (EQ (fun
, Qunbound
))
2233 /* Let funcall get the error */
2240 if (numargs
< XSUBR (fun
)->min_args
2241 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2242 goto funcall
; /* Let funcall get the error */
2243 else if (XSUBR (fun
)->max_args
> numargs
)
2245 /* Avoid making funcall cons up a yet another new vector of arguments
2246 by explicitly supplying nil's for optional values */
2247 funcall_args
= (Lisp_Object
*) alloca ((1 + XSUBR (fun
)->max_args
)
2248 * sizeof (Lisp_Object
));
2249 for (i
= numargs
; i
< XSUBR (fun
)->max_args
;)
2250 funcall_args
[++i
] = Qnil
;
2251 GCPRO1 (*funcall_args
);
2252 gcpro1
.nvars
= 1 + XSUBR (fun
)->max_args
;
2256 /* We add 1 to numargs because funcall_args includes the
2257 function itself as well as its arguments. */
2260 funcall_args
= (Lisp_Object
*) alloca ((1 + numargs
)
2261 * sizeof (Lisp_Object
));
2262 GCPRO1 (*funcall_args
);
2263 gcpro1
.nvars
= 1 + numargs
;
2266 bcopy (args
, funcall_args
, nargs
* sizeof (Lisp_Object
));
2267 /* Spread the last arg we got. Its first element goes in
2268 the slot that it used to occupy, hence this value of I. */
2270 while (!NILP (spread_arg
))
2272 funcall_args
[i
++] = XCAR (spread_arg
);
2273 spread_arg
= XCDR (spread_arg
);
2276 /* By convention, the caller needs to gcpro Ffuncall's args. */
2277 RETURN_UNGCPRO (Ffuncall (gcpro1
.nvars
, funcall_args
));
2280 /* Run hook variables in various ways. */
2282 enum run_hooks_condition
{to_completion
, until_success
, until_failure
};
2283 static Lisp_Object run_hook_with_args
P_ ((int, Lisp_Object
*,
2284 enum run_hooks_condition
));
2286 DEFUN ("run-hooks", Frun_hooks
, Srun_hooks
, 0, MANY
, 0,
2287 doc
: /* Run each hook in HOOKS. Major mode functions use this.
2288 Each argument should be a symbol, a hook variable.
2289 These symbols are processed in the order specified.
2290 If a hook symbol has a non-nil value, that value may be a function
2291 or a list of functions to be called to run the hook.
2292 If the value is a function, it is called with no arguments.
2293 If it is a list, the elements are called, in order, with no arguments.
2295 Do not use `make-local-variable' to make a hook variable buffer-local.
2296 Instead, use `add-hook' and specify t for the LOCAL argument.
2297 usage: (run-hooks &rest HOOKS) */)
2302 Lisp_Object hook
[1];
2305 for (i
= 0; i
< nargs
; i
++)
2308 run_hook_with_args (1, hook
, to_completion
);
2314 DEFUN ("run-hook-with-args", Frun_hook_with_args
,
2315 Srun_hook_with_args
, 1, MANY
, 0,
2316 doc
: /* Run HOOK with the specified arguments ARGS.
2317 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
2318 value, that value may be a function or a list of functions to be
2319 called to run the hook. If the value is a function, it is called with
2320 the given arguments and its return value is returned. If it is a list
2321 of functions, those functions are called, in order,
2322 with the given arguments ARGS.
2323 It is best not to depend on the value return by `run-hook-with-args',
2326 Do not use `make-local-variable' to make a hook variable buffer-local.
2327 Instead, use `add-hook' and specify t for the LOCAL argument.
2328 usage: (run-hook-with-args HOOK &rest ARGS) */)
2333 return run_hook_with_args (nargs
, args
, to_completion
);
2336 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success
,
2337 Srun_hook_with_args_until_success
, 1, MANY
, 0,
2338 doc
: /* Run HOOK with the specified arguments ARGS.
2339 HOOK should be a symbol, a hook variable. Its value should
2340 be a list of functions. We call those functions, one by one,
2341 passing arguments ARGS to each of them, until one of them
2342 returns a non-nil value. Then we return that value.
2343 If all the functions return nil, we return nil.
2345 Do not use `make-local-variable' to make a hook variable buffer-local.
2346 Instead, use `add-hook' and specify t for the LOCAL argument.
2347 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2352 return run_hook_with_args (nargs
, args
, until_success
);
2355 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure
,
2356 Srun_hook_with_args_until_failure
, 1, MANY
, 0,
2357 doc
: /* Run HOOK with the specified arguments ARGS.
2358 HOOK should be a symbol, a hook variable. Its value should
2359 be a list of functions. We call those functions, one by one,
2360 passing arguments ARGS to each of them, until one of them
2361 returns nil. Then we return nil.
2362 If all the functions return non-nil, we return non-nil.
2364 Do not use `make-local-variable' to make a hook variable buffer-local.
2365 Instead, use `add-hook' and specify t for the LOCAL argument.
2366 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2371 return run_hook_with_args (nargs
, args
, until_failure
);
2374 /* ARGS[0] should be a hook symbol.
2375 Call each of the functions in the hook value, passing each of them
2376 as arguments all the rest of ARGS (all NARGS - 1 elements).
2377 COND specifies a condition to test after each call
2378 to decide whether to stop.
2379 The caller (or its caller, etc) must gcpro all of ARGS,
2380 except that it isn't necessary to gcpro ARGS[0]. */
2383 run_hook_with_args (nargs
, args
, cond
)
2386 enum run_hooks_condition cond
;
2388 Lisp_Object sym
, val
, ret
;
2389 Lisp_Object globals
;
2390 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2392 /* If we are dying or still initializing,
2393 don't do anything--it would probably crash if we tried. */
2394 if (NILP (Vrun_hooks
))
2398 val
= find_symbol_value (sym
);
2399 ret
= (cond
== until_failure
? Qt
: Qnil
);
2401 if (EQ (val
, Qunbound
) || NILP (val
))
2403 else if (!CONSP (val
) || EQ (XCAR (val
), Qlambda
))
2406 return Ffuncall (nargs
, args
);
2411 GCPRO3 (sym
, val
, globals
);
2414 CONSP (val
) && ((cond
== to_completion
)
2415 || (cond
== until_success
? NILP (ret
)
2419 if (EQ (XCAR (val
), Qt
))
2421 /* t indicates this hook has a local binding;
2422 it means to run the global binding too. */
2424 for (globals
= Fdefault_value (sym
);
2425 CONSP (globals
) && ((cond
== to_completion
)
2426 || (cond
== until_success
? NILP (ret
)
2428 globals
= XCDR (globals
))
2430 args
[0] = XCAR (globals
);
2431 /* In a global value, t should not occur. If it does, we
2432 must ignore it to avoid an endless loop. */
2433 if (!EQ (args
[0], Qt
))
2434 ret
= Ffuncall (nargs
, args
);
2439 args
[0] = XCAR (val
);
2440 ret
= Ffuncall (nargs
, args
);
2449 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2450 present value of that symbol.
2451 Call each element of FUNLIST,
2452 passing each of them the rest of ARGS.
2453 The caller (or its caller, etc) must gcpro all of ARGS,
2454 except that it isn't necessary to gcpro ARGS[0]. */
2457 run_hook_list_with_args (funlist
, nargs
, args
)
2458 Lisp_Object funlist
;
2464 Lisp_Object globals
;
2465 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2469 GCPRO3 (sym
, val
, globals
);
2471 for (val
= funlist
; CONSP (val
); val
= XCDR (val
))
2473 if (EQ (XCAR (val
), Qt
))
2475 /* t indicates this hook has a local binding;
2476 it means to run the global binding too. */
2478 for (globals
= Fdefault_value (sym
);
2480 globals
= XCDR (globals
))
2482 args
[0] = XCAR (globals
);
2483 /* In a global value, t should not occur. If it does, we
2484 must ignore it to avoid an endless loop. */
2485 if (!EQ (args
[0], Qt
))
2486 Ffuncall (nargs
, args
);
2491 args
[0] = XCAR (val
);
2492 Ffuncall (nargs
, args
);
2499 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2502 run_hook_with_args_2 (hook
, arg1
, arg2
)
2503 Lisp_Object hook
, arg1
, arg2
;
2505 Lisp_Object temp
[3];
2510 Frun_hook_with_args (3, temp
);
2513 /* Apply fn to arg */
2516 Lisp_Object fn
, arg
;
2518 struct gcpro gcpro1
;
2522 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2526 Lisp_Object args
[2];
2530 RETURN_UNGCPRO (Fapply (2, args
));
2532 #else /* not NO_ARG_ARRAY */
2533 RETURN_UNGCPRO (Fapply (2, &fn
));
2534 #endif /* not NO_ARG_ARRAY */
2537 /* Call function fn on no arguments */
2542 struct gcpro gcpro1
;
2545 RETURN_UNGCPRO (Ffuncall (1, &fn
));
2548 /* Call function fn with 1 argument arg1 */
2552 Lisp_Object fn
, arg1
;
2554 struct gcpro gcpro1
;
2556 Lisp_Object args
[2];
2562 RETURN_UNGCPRO (Ffuncall (2, args
));
2563 #else /* not NO_ARG_ARRAY */
2566 RETURN_UNGCPRO (Ffuncall (2, &fn
));
2567 #endif /* not NO_ARG_ARRAY */
2570 /* Call function fn with 2 arguments arg1, arg2 */
2573 call2 (fn
, arg1
, arg2
)
2574 Lisp_Object fn
, arg1
, arg2
;
2576 struct gcpro gcpro1
;
2578 Lisp_Object args
[3];
2584 RETURN_UNGCPRO (Ffuncall (3, args
));
2585 #else /* not NO_ARG_ARRAY */
2588 RETURN_UNGCPRO (Ffuncall (3, &fn
));
2589 #endif /* not NO_ARG_ARRAY */
2592 /* Call function fn with 3 arguments arg1, arg2, arg3 */
2595 call3 (fn
, arg1
, arg2
, arg3
)
2596 Lisp_Object fn
, arg1
, arg2
, arg3
;
2598 struct gcpro gcpro1
;
2600 Lisp_Object args
[4];
2607 RETURN_UNGCPRO (Ffuncall (4, args
));
2608 #else /* not NO_ARG_ARRAY */
2611 RETURN_UNGCPRO (Ffuncall (4, &fn
));
2612 #endif /* not NO_ARG_ARRAY */
2615 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2618 call4 (fn
, arg1
, arg2
, arg3
, arg4
)
2619 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
;
2621 struct gcpro gcpro1
;
2623 Lisp_Object args
[5];
2631 RETURN_UNGCPRO (Ffuncall (5, args
));
2632 #else /* not NO_ARG_ARRAY */
2635 RETURN_UNGCPRO (Ffuncall (5, &fn
));
2636 #endif /* not NO_ARG_ARRAY */
2639 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2642 call5 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
)
2643 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
;
2645 struct gcpro gcpro1
;
2647 Lisp_Object args
[6];
2656 RETURN_UNGCPRO (Ffuncall (6, args
));
2657 #else /* not NO_ARG_ARRAY */
2660 RETURN_UNGCPRO (Ffuncall (6, &fn
));
2661 #endif /* not NO_ARG_ARRAY */
2664 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2667 call6 (fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
)
2668 Lisp_Object fn
, arg1
, arg2
, arg3
, arg4
, arg5
, arg6
;
2670 struct gcpro gcpro1
;
2672 Lisp_Object args
[7];
2682 RETURN_UNGCPRO (Ffuncall (7, args
));
2683 #else /* not NO_ARG_ARRAY */
2686 RETURN_UNGCPRO (Ffuncall (7, &fn
));
2687 #endif /* not NO_ARG_ARRAY */
2690 /* The caller should GCPRO all the elements of ARGS. */
2692 DEFUN ("funcall", Ffuncall
, Sfuncall
, 1, MANY
, 0,
2693 doc
: /* Call first argument as a function, passing remaining arguments to it.
2694 Return the value that function returns.
2695 Thus, (funcall 'cons 'x 'y) returns (x . y).
2696 usage: (funcall FUNCTION &rest ARGUMENTS) */)
2703 int numargs
= nargs
- 1;
2704 Lisp_Object lisp_numargs
;
2706 struct backtrace backtrace
;
2707 register Lisp_Object
*internal_args
;
2711 if (consing_since_gc
> gc_cons_threshold
)
2712 Fgarbage_collect ();
2714 if (++lisp_eval_depth
> max_lisp_eval_depth
)
2716 if (max_lisp_eval_depth
< 100)
2717 max_lisp_eval_depth
= 100;
2718 if (lisp_eval_depth
> max_lisp_eval_depth
)
2719 error ("Lisp nesting exceeds max-lisp-eval-depth");
2722 backtrace
.next
= backtrace_list
;
2723 backtrace_list
= &backtrace
;
2724 backtrace
.function
= &args
[0];
2725 backtrace
.args
= &args
[1];
2726 backtrace
.nargs
= nargs
- 1;
2727 backtrace
.evalargs
= 0;
2728 backtrace
.debug_on_exit
= 0;
2730 if (debug_on_next_call
)
2731 do_debug_on_call (Qlambda
);
2737 fun
= Findirect_function (fun
);
2741 if (numargs
< XSUBR (fun
)->min_args
2742 || (XSUBR (fun
)->max_args
>= 0 && XSUBR (fun
)->max_args
< numargs
))
2744 XSETFASTINT (lisp_numargs
, numargs
);
2745 return Fsignal (Qwrong_number_of_arguments
, Fcons (fun
, Fcons (lisp_numargs
, Qnil
)));
2748 if (XSUBR (fun
)->max_args
== UNEVALLED
)
2749 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2751 if (XSUBR (fun
)->max_args
== MANY
)
2753 val
= (*XSUBR (fun
)->function
) (numargs
, args
+ 1);
2757 if (XSUBR (fun
)->max_args
> numargs
)
2759 internal_args
= (Lisp_Object
*) alloca (XSUBR (fun
)->max_args
* sizeof (Lisp_Object
));
2760 bcopy (args
+ 1, internal_args
, numargs
* sizeof (Lisp_Object
));
2761 for (i
= numargs
; i
< XSUBR (fun
)->max_args
; i
++)
2762 internal_args
[i
] = Qnil
;
2765 internal_args
= args
+ 1;
2766 switch (XSUBR (fun
)->max_args
)
2769 val
= (*XSUBR (fun
)->function
) ();
2772 val
= (*XSUBR (fun
)->function
) (internal_args
[0]);
2775 val
= (*XSUBR (fun
)->function
) (internal_args
[0],
2779 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2783 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2788 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2789 internal_args
[2], internal_args
[3],
2793 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2794 internal_args
[2], internal_args
[3],
2795 internal_args
[4], internal_args
[5]);
2798 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2799 internal_args
[2], internal_args
[3],
2800 internal_args
[4], internal_args
[5],
2805 val
= (*XSUBR (fun
)->function
) (internal_args
[0], internal_args
[1],
2806 internal_args
[2], internal_args
[3],
2807 internal_args
[4], internal_args
[5],
2808 internal_args
[6], internal_args
[7]);
2813 /* If a subr takes more than 8 arguments without using MANY
2814 or UNEVALLED, we need to extend this function to support it.
2815 Until this is done, there is no way to call the function. */
2819 if (COMPILEDP (fun
))
2820 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2824 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2825 funcar
= Fcar (fun
);
2826 if (!SYMBOLP (funcar
))
2827 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2828 if (EQ (funcar
, Qlambda
))
2829 val
= funcall_lambda (fun
, numargs
, args
+ 1);
2830 else if (EQ (funcar
, Qautoload
))
2832 do_autoload (fun
, args
[0]);
2836 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2840 if (backtrace
.debug_on_exit
)
2841 val
= call_debugger (Fcons (Qexit
, Fcons (val
, Qnil
)));
2842 backtrace_list
= backtrace
.next
;
2847 apply_lambda (fun
, args
, eval_flag
)
2848 Lisp_Object fun
, args
;
2851 Lisp_Object args_left
;
2852 Lisp_Object numargs
;
2853 register Lisp_Object
*arg_vector
;
2854 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2856 register Lisp_Object tem
;
2858 numargs
= Flength (args
);
2859 arg_vector
= (Lisp_Object
*) alloca (XINT (numargs
) * sizeof (Lisp_Object
));
2862 GCPRO3 (*arg_vector
, args_left
, fun
);
2865 for (i
= 0; i
< XINT (numargs
);)
2867 tem
= Fcar (args_left
), args_left
= Fcdr (args_left
);
2868 if (eval_flag
) tem
= Feval (tem
);
2869 arg_vector
[i
++] = tem
;
2877 backtrace_list
->args
= arg_vector
;
2878 backtrace_list
->nargs
= i
;
2880 backtrace_list
->evalargs
= 0;
2881 tem
= funcall_lambda (fun
, XINT (numargs
), arg_vector
);
2883 /* Do the debug-on-exit now, while arg_vector still exists. */
2884 if (backtrace_list
->debug_on_exit
)
2885 tem
= call_debugger (Fcons (Qexit
, Fcons (tem
, Qnil
)));
2886 /* Don't do it again when we return to eval. */
2887 backtrace_list
->debug_on_exit
= 0;
2891 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
2892 and return the result of evaluation.
2893 FUN must be either a lambda-expression or a compiled-code object. */
2896 funcall_lambda (fun
, nargs
, arg_vector
)
2899 register Lisp_Object
*arg_vector
;
2901 Lisp_Object val
, syms_left
, next
;
2902 int count
= SPECPDL_INDEX ();
2903 int i
, optional
, rest
;
2907 syms_left
= XCDR (fun
);
2908 if (CONSP (syms_left
))
2909 syms_left
= XCAR (syms_left
);
2911 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2913 else if (COMPILEDP (fun
))
2914 syms_left
= AREF (fun
, COMPILED_ARGLIST
);
2918 i
= optional
= rest
= 0;
2919 for (; CONSP (syms_left
); syms_left
= XCDR (syms_left
))
2923 next
= XCAR (syms_left
);
2924 while (!SYMBOLP (next
))
2925 next
= Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2927 if (EQ (next
, Qand_rest
))
2929 else if (EQ (next
, Qand_optional
))
2933 specbind (next
, Flist (nargs
- i
, &arg_vector
[i
]));
2937 specbind (next
, arg_vector
[i
++]);
2939 return Fsignal (Qwrong_number_of_arguments
,
2940 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2942 specbind (next
, Qnil
);
2945 if (!NILP (syms_left
))
2946 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
2948 return Fsignal (Qwrong_number_of_arguments
,
2949 Fcons (fun
, Fcons (make_number (nargs
), Qnil
)));
2952 val
= Fprogn (XCDR (XCDR (fun
)));
2955 /* If we have not actually read the bytecode string
2956 and constants vector yet, fetch them from the file. */
2957 if (CONSP (AREF (fun
, COMPILED_BYTECODE
)))
2958 Ffetch_bytecode (fun
);
2959 val
= Fbyte_code (AREF (fun
, COMPILED_BYTECODE
),
2960 AREF (fun
, COMPILED_CONSTANTS
),
2961 AREF (fun
, COMPILED_STACK_DEPTH
));
2964 return unbind_to (count
, val
);
2967 DEFUN ("fetch-bytecode", Ffetch_bytecode
, Sfetch_bytecode
,
2969 doc
: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
2975 if (COMPILEDP (object
) && CONSP (AREF (object
, COMPILED_BYTECODE
)))
2977 tem
= read_doc_string (AREF (object
, COMPILED_BYTECODE
));
2980 tem
= AREF (object
, COMPILED_BYTECODE
);
2981 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
2982 error ("Invalid byte code in %s", SDATA (XCAR (tem
)));
2984 error ("Invalid byte code");
2986 AREF (object
, COMPILED_BYTECODE
) = XCAR (tem
);
2987 AREF (object
, COMPILED_CONSTANTS
) = XCDR (tem
);
2995 register int count
= SPECPDL_INDEX ();
2996 if (specpdl_size
>= max_specpdl_size
)
2998 if (max_specpdl_size
< 400)
2999 max_specpdl_size
= 400;
3000 if (specpdl_size
>= max_specpdl_size
)
3002 if (!NILP (Vdebug_on_error
))
3003 /* Leave room for some specpdl in the debugger. */
3004 max_specpdl_size
= specpdl_size
+ 100;
3006 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil
));
3010 if (specpdl_size
> max_specpdl_size
)
3011 specpdl_size
= max_specpdl_size
;
3012 specpdl
= (struct specbinding
*) xrealloc (specpdl
, specpdl_size
* sizeof (struct specbinding
));
3013 specpdl_ptr
= specpdl
+ count
;
3017 specbind (symbol
, value
)
3018 Lisp_Object symbol
, value
;
3021 Lisp_Object valcontents
;
3023 CHECK_SYMBOL (symbol
);
3024 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3027 /* The most common case is that of a non-constant symbol with a
3028 trivial value. Make that as fast as we can. */
3029 valcontents
= SYMBOL_VALUE (symbol
);
3030 if (!MISCP (valcontents
) && !SYMBOL_CONSTANT_P (symbol
))
3032 specpdl_ptr
->symbol
= symbol
;
3033 specpdl_ptr
->old_value
= valcontents
;
3034 specpdl_ptr
->func
= NULL
;
3036 SET_SYMBOL_VALUE (symbol
, value
);
3040 Lisp_Object valcontents
;
3042 ovalue
= find_symbol_value (symbol
);
3043 specpdl_ptr
->func
= 0;
3044 specpdl_ptr
->old_value
= ovalue
;
3046 valcontents
= XSYMBOL (symbol
)->value
;
3048 if (BUFFER_LOCAL_VALUEP (valcontents
)
3049 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
3050 || BUFFER_OBJFWDP (valcontents
))
3052 Lisp_Object where
, current_buffer
;
3054 current_buffer
= Fcurrent_buffer ();
3056 /* For a local variable, record both the symbol and which
3057 buffer's or frame's value we are saving. */
3058 if (!NILP (Flocal_variable_p (symbol
, Qnil
)))
3059 where
= current_buffer
;
3060 else if (!BUFFER_OBJFWDP (valcontents
)
3061 && XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
)
3062 where
= XBUFFER_LOCAL_VALUE (valcontents
)->frame
;
3066 /* We're not using the `unused' slot in the specbinding
3067 structure because this would mean we have to do more
3068 work for simple variables. */
3069 specpdl_ptr
->symbol
= Fcons (symbol
, Fcons (where
, current_buffer
));
3071 /* If SYMBOL is a per-buffer variable which doesn't have a
3072 buffer-local value here, make the `let' change the global
3073 value by changing the value of SYMBOL in all buffers not
3074 having their own value. This is consistent with what
3075 happens with other buffer-local variables. */
3077 && BUFFER_OBJFWDP (valcontents
))
3080 Fset_default (symbol
, value
);
3085 specpdl_ptr
->symbol
= symbol
;
3088 if (BUFFER_OBJFWDP (ovalue
) || KBOARD_OBJFWDP (ovalue
))
3089 store_symval_forwarding (symbol
, ovalue
, value
, NULL
);
3091 set_internal (symbol
, value
, 0, 1);
3096 record_unwind_protect (function
, arg
)
3097 Lisp_Object (*function
) P_ ((Lisp_Object
));
3100 if (specpdl_ptr
== specpdl
+ specpdl_size
)
3102 specpdl_ptr
->func
= function
;
3103 specpdl_ptr
->symbol
= Qnil
;
3104 specpdl_ptr
->old_value
= arg
;
3109 unbind_to (count
, value
)
3113 int quitf
= !NILP (Vquit_flag
);
3114 struct gcpro gcpro1
;
3119 while (specpdl_ptr
!= specpdl
+ count
)
3121 /* Copy the binding, and decrement specpdl_ptr, before we do
3122 the work to unbind it. We decrement first
3123 so that an error in unbinding won't try to unbind
3124 the same entry again, and we copy the binding first
3125 in case more bindings are made during some of the code we run. */
3127 struct specbinding this_binding
;
3128 this_binding
= *--specpdl_ptr
;
3130 if (this_binding
.func
!= 0)
3131 (*this_binding
.func
) (this_binding
.old_value
);
3132 /* If the symbol is a list, it is really (SYMBOL WHERE
3133 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
3134 frame. If WHERE is a buffer or frame, this indicates we
3135 bound a variable that had a buffer-local or frame-local
3136 binding. WHERE nil means that the variable had the default
3137 value when it was bound. CURRENT-BUFFER is the buffer that
3138 was current when the variable was bound. */
3139 else if (CONSP (this_binding
.symbol
))
3141 Lisp_Object symbol
, where
;
3143 symbol
= XCAR (this_binding
.symbol
);
3144 where
= XCAR (XCDR (this_binding
.symbol
));
3147 Fset_default (symbol
, this_binding
.old_value
);
3148 else if (BUFFERP (where
))
3149 set_internal (symbol
, this_binding
.old_value
, XBUFFER (where
), 1);
3151 set_internal (symbol
, this_binding
.old_value
, NULL
, 1);
3155 /* If variable has a trivial value (no forwarding), we can
3156 just set it. No need to check for constant symbols here,
3157 since that was already done by specbind. */
3158 if (!MISCP (SYMBOL_VALUE (this_binding
.symbol
)))
3159 SET_SYMBOL_VALUE (this_binding
.symbol
, this_binding
.old_value
);
3161 set_internal (this_binding
.symbol
, this_binding
.old_value
, 0, 1);
3165 if (NILP (Vquit_flag
) && quitf
)
3172 DEFUN ("backtrace-debug", Fbacktrace_debug
, Sbacktrace_debug
, 2, 2, 0,
3173 doc
: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3174 The debugger is entered when that frame exits, if the flag is non-nil. */)
3176 Lisp_Object level
, flag
;
3178 register struct backtrace
*backlist
= backtrace_list
;
3181 CHECK_NUMBER (level
);
3183 for (i
= 0; backlist
&& i
< XINT (level
); i
++)
3185 backlist
= backlist
->next
;
3189 backlist
->debug_on_exit
= !NILP (flag
);
3194 DEFUN ("backtrace", Fbacktrace
, Sbacktrace
, 0, 0, "",
3195 doc
: /* Print a trace of Lisp function calls currently active.
3196 Output stream used is value of `standard-output'. */)
3199 register struct backtrace
*backlist
= backtrace_list
;
3203 extern Lisp_Object Vprint_level
;
3204 struct gcpro gcpro1
;
3206 XSETFASTINT (Vprint_level
, 3);
3213 write_string (backlist
->debug_on_exit
? "* " : " ", 2);
3214 if (backlist
->nargs
== UNEVALLED
)
3216 Fprin1 (Fcons (*backlist
->function
, *backlist
->args
), Qnil
);
3217 write_string ("\n", -1);
3221 tem
= *backlist
->function
;
3222 Fprin1 (tem
, Qnil
); /* This can QUIT */
3223 write_string ("(", -1);
3224 if (backlist
->nargs
== MANY
)
3226 for (tail
= *backlist
->args
, i
= 0;
3228 tail
= Fcdr (tail
), i
++)
3230 if (i
) write_string (" ", -1);
3231 Fprin1 (Fcar (tail
), Qnil
);
3236 for (i
= 0; i
< backlist
->nargs
; i
++)
3238 if (i
) write_string (" ", -1);
3239 Fprin1 (backlist
->args
[i
], Qnil
);
3242 write_string (")\n", -1);
3244 backlist
= backlist
->next
;
3247 Vprint_level
= Qnil
;
3252 DEFUN ("backtrace-frame", Fbacktrace_frame
, Sbacktrace_frame
, 1, 1, NULL
,
3253 doc
: /* Return the function and arguments NFRAMES up from current execution point.
3254 If that frame has not evaluated the arguments yet (or is a special form),
3255 the value is (nil FUNCTION ARG-FORMS...).
3256 If that frame has evaluated its arguments and called its function already,
3257 the value is (t FUNCTION ARG-VALUES...).
3258 A &rest arg is represented as the tail of the list ARG-VALUES.
3259 FUNCTION is whatever was supplied as car of evaluated list,
3260 or a lambda expression for macro calls.
3261 If NFRAMES is more than the number of frames, the value is nil. */)
3263 Lisp_Object nframes
;
3265 register struct backtrace
*backlist
= backtrace_list
;
3269 CHECK_NATNUM (nframes
);
3271 /* Find the frame requested. */
3272 for (i
= 0; backlist
&& i
< XFASTINT (nframes
); i
++)
3273 backlist
= backlist
->next
;
3277 if (backlist
->nargs
== UNEVALLED
)
3278 return Fcons (Qnil
, Fcons (*backlist
->function
, *backlist
->args
));
3281 if (backlist
->nargs
== MANY
)
3282 tem
= *backlist
->args
;
3284 tem
= Flist (backlist
->nargs
, backlist
->args
);
3286 return Fcons (Qt
, Fcons (*backlist
->function
, tem
));
3294 register struct backtrace
*backlist
;
3297 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
3299 mark_object (*backlist
->function
);
3301 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
3304 i
= backlist
->nargs
- 1;
3306 mark_object (backlist
->args
[i
]);
3313 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size
,
3314 doc
: /* *Limit on number of Lisp variable bindings & unwind-protects.
3315 If Lisp code tries to make more than this many at once,
3316 an error is signaled.
3317 You can safely use a value considerably larger than the default value,
3318 if that proves inconveniently small. However, if you increase it too far,
3319 Emacs could run out of memory trying to make the stack bigger. */);
3321 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth
,
3322 doc
: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3324 This limit serves to catch infinite recursions for you before they cause
3325 actual stack overflow in C, which would be fatal for Emacs.
3326 You can safely make it considerably larger than its default value,
3327 if that proves inconveniently small. However, if you increase it too far,
3328 Emacs could overflow the real C stack, and crash. */);
3330 DEFVAR_LISP ("quit-flag", &Vquit_flag
,
3331 doc
: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3332 Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'. */);
3335 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit
,
3336 doc
: /* Non-nil inhibits C-g quitting from happening immediately.
3337 Note that `quit-flag' will still be set by typing C-g,
3338 so a quit will be signaled as soon as `inhibit-quit' is nil.
3339 To prevent this happening, set `quit-flag' to nil
3340 before making `inhibit-quit' nil. */);
3341 Vinhibit_quit
= Qnil
;
3343 Qinhibit_quit
= intern ("inhibit-quit");
3344 staticpro (&Qinhibit_quit
);
3346 Qautoload
= intern ("autoload");
3347 staticpro (&Qautoload
);
3349 Qdebug_on_error
= intern ("debug-on-error");
3350 staticpro (&Qdebug_on_error
);
3352 Qmacro
= intern ("macro");
3353 staticpro (&Qmacro
);
3355 Qdeclare
= intern ("declare");
3356 staticpro (&Qdeclare
);
3358 /* Note that the process handling also uses Qexit, but we don't want
3359 to staticpro it twice, so we just do it here. */
3360 Qexit
= intern ("exit");
3363 Qinteractive
= intern ("interactive");
3364 staticpro (&Qinteractive
);
3366 Qcommandp
= intern ("commandp");
3367 staticpro (&Qcommandp
);
3369 Qdefun
= intern ("defun");
3370 staticpro (&Qdefun
);
3372 Qdefvar
= intern ("defvar");
3373 staticpro (&Qdefvar
);
3375 Qand_rest
= intern ("&rest");
3376 staticpro (&Qand_rest
);
3378 Qand_optional
= intern ("&optional");
3379 staticpro (&Qand_optional
);
3381 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error
,
3382 doc
: /* *Non-nil means errors display a backtrace buffer.
3383 More precisely, this happens for any error that is handled
3384 by the editor command loop.
3385 If the value is a list, an error only means to display a backtrace
3386 if one of its condition symbols appears in the list. */);
3387 Vstack_trace_on_error
= Qnil
;
3389 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error
,
3390 doc
: /* *Non-nil means enter debugger if an error is signaled.
3391 Does not apply to errors handled by `condition-case' or those
3392 matched by `debug-ignored-errors'.
3393 If the value is a list, an error only means to enter the debugger
3394 if one of its condition symbols appears in the list.
3395 When you evaluate an expression interactively, this variable
3396 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3397 See also variable `debug-on-quit'. */);
3398 Vdebug_on_error
= Qnil
;
3400 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors
,
3401 doc
: /* *List of errors for which the debugger should not be called.
3402 Each element may be a condition-name or a regexp that matches error messages.
3403 If any element applies to a given error, that error skips the debugger
3404 and just returns to top level.
3405 This overrides the variable `debug-on-error'.
3406 It does not apply to errors handled by `condition-case'. */);
3407 Vdebug_ignored_errors
= Qnil
;
3409 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit
,
3410 doc
: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3411 Does not apply if quit is handled by a `condition-case'.
3412 When you evaluate an expression interactively, this variable
3413 is temporarily non-nil if `eval-expression-debug-on-quit' is non-nil. */);
3416 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call
,
3417 doc
: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3419 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue
,
3420 doc
: /* Non-nil means debugger may continue execution.
3421 This is nil when the debugger is called under circumstances where it
3422 might not be safe to continue. */);
3423 debugger_may_continue
= 1;
3425 DEFVAR_LISP ("debugger", &Vdebugger
,
3426 doc
: /* Function to call to invoke debugger.
3427 If due to frame exit, args are `exit' and the value being returned;
3428 this function's value will be returned instead of that.
3429 If due to error, args are `error' and a list of the args to `signal'.
3430 If due to `apply' or `funcall' entry, one arg, `lambda'.
3431 If due to `eval' entry, one arg, t. */);
3434 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function
,
3435 doc
: /* If non-nil, this is a function for `signal' to call.
3436 It receives the same arguments that `signal' was given.
3437 The Edebug package uses this to regain control. */);
3438 Vsignal_hook_function
= Qnil
;
3440 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal
,
3441 doc
: /* *Non-nil means call the debugger regardless of condition handlers.
3442 Note that `debug-on-error', `debug-on-quit' and friends
3443 still determine whether to handle the particular condition. */);
3444 Vdebug_on_signal
= Qnil
;
3446 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function
,
3447 doc
: /* Function to process declarations in a macro definition.
3448 The function will be called with two args MACRO and DECL.
3449 MACRO is the name of the macro being defined.
3450 DECL is a list `(declare ...)' containing the declarations.
3451 The value the function returns is not used. */);
3452 Vmacro_declaration_function
= Qnil
;
3454 Vrun_hooks
= intern ("run-hooks");
3455 staticpro (&Vrun_hooks
);
3457 staticpro (&Vautoload_queue
);
3458 Vautoload_queue
= Qnil
;
3459 staticpro (&Vsignaling_function
);
3460 Vsignaling_function
= Qnil
;
3471 defsubr (&Sfunction
);
3473 defsubr (&Sdefmacro
);
3475 defsubr (&Sdefvaralias
);
3476 defsubr (&Sdefconst
);
3477 defsubr (&Suser_variable_p
);
3481 defsubr (&Smacroexpand
);
3484 defsubr (&Sunwind_protect
);
3485 defsubr (&Scondition_case
);
3487 defsubr (&Sinteractive_p
);
3488 defsubr (&Scalled_interactively_p
);
3489 defsubr (&Scommandp
);
3490 defsubr (&Sautoload
);
3493 defsubr (&Sfuncall
);
3494 defsubr (&Srun_hooks
);
3495 defsubr (&Srun_hook_with_args
);
3496 defsubr (&Srun_hook_with_args_until_success
);
3497 defsubr (&Srun_hook_with_args_until_failure
);
3498 defsubr (&Sfetch_bytecode
);
3499 defsubr (&Sbacktrace_debug
);
3500 defsubr (&Sbacktrace
);
3501 defsubr (&Sbacktrace_frame
);
3504 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
3505 (do not change this comment) */