|
272
|
1 /* Evaluator for GNU Emacs Lisp interpreter.
|
61901
787052160d87
(do_autoload): Record only autoloads in the autoload property of symbols.
Lute Kamstra <lute@gnu.org>
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
|
|
106815
|
3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
|
|
79759
|
4 Free Software Foundation, Inc.
|
|
272
|
5
|
|
|
6 This file is part of GNU Emacs.
|
|
|
7
|
|
94963
|
8 GNU Emacs is free software: you can redistribute it and/or modify
|
|
272
|
9 it under the terms of the GNU General Public License as published by
|
|
94963
|
10 the Free Software Foundation, either version 3 of the License, or
|
|
|
11 (at your option) any later version.
|
|
272
|
12
|
|
|
13 GNU Emacs is distributed in the hope that it will be useful,
|
|
|
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
16 GNU General Public License for more details.
|
|
|
17
|
|
|
18 You should have received a copy of the GNU General Public License
|
|
94963
|
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
|
272
|
20
|
|
|
21
|
|
4696
|
22 #include <config.h>
|
|
105669
|
23 #include <setjmp.h>
|
|
272
|
24 #include "lisp.h"
|
|
2439
|
25 #include "blockinput.h"
|
|
272
|
26 #include "commands.h"
|
|
515
|
27 #include "keyboard.h"
|
|
26764
|
28 #include "dispextern.h"
|
|
272
|
29
|
73323
d38d245297fa
Include xterm.h for x_fully_uncatch_errors and friends.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
30 #if HAVE_X_WINDOWS
|
d38d245297fa
Include xterm.h for x_fully_uncatch_errors and friends.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
31 #include "xterm.h"
|
d38d245297fa
Include xterm.h for x_fully_uncatch_errors and friends.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
32 #endif
|
d38d245297fa
Include xterm.h for x_fully_uncatch_errors and friends.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
33
|
|
272
|
34 /* This definition is duplicated in alloc.c and keyboard.c */
|
|
|
35 /* Putting it in lisp.h makes cc bomb out! */
|
|
|
36
|
|
|
37 struct backtrace
|
|
30080
|
38 {
|
|
|
39 struct backtrace *next;
|
|
|
40 Lisp_Object *function;
|
|
|
41 Lisp_Object *args; /* Points to vector of args. */
|
|
|
42 int nargs; /* Length of vector.
|
|
727
|
43 If nargs is UNEVALLED, args points to slot holding
|
|
|
44 list of unevalled args */
|
|
30080
|
45 char evalargs;
|
|
|
46 /* Nonzero means call value of debugger when done with this operation. */
|
|
|
47 char debug_on_exit;
|
|
|
48 };
|
|
272
|
49
|
|
|
50 struct backtrace *backtrace_list;
|
|
|
51
|
|
|
52 struct catchtag *catchlist;
|
|
|
53
|
|
26297
|
54 #ifdef DEBUG_GCPRO
|
|
|
55 /* Count levels of GCPRO to detect failure to UNGCPRO. */
|
|
|
56 int gcpro_level;
|
|
|
57 #endif
|
|
|
58
|
|
59109
|
59 Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
|
|
381
|
60 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
|
|
272
|
61 Lisp_Object Qand_rest, Qand_optional;
|
|
|
62 Lisp_Object Qdebug_on_error;
|
|
44132
|
63 Lisp_Object Qdeclare;
|
|
78141
|
64 Lisp_Object Qdebug;
|
|
102719
|
65 extern Lisp_Object Qinteractive_form;
|
|
272
|
66
|
|
16296
|
67 /* This holds either the symbol `run-hooks' or nil.
|
|
|
68 It is nil at an early stage of startup, and when Emacs
|
|
|
69 is shutting down. */
|
|
30080
|
70
|
|
272
|
71 Lisp_Object Vrun_hooks;
|
|
|
72
|
|
|
73 /* Non-nil means record all fset's and provide's, to be undone
|
|
|
74 if the file being autoloaded is not fully loaded.
|
|
|
75 They are recorded by being consed onto the front of Vautoload_queue:
|
67810
65be704fdaf2
(un_autoload): Expect (0 . OFEATURES) in Vautoload_queue to undo a `provide'.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
76 (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide. */
|
|
272
|
77
|
|
|
78 Lisp_Object Vautoload_queue;
|
|
|
79
|
|
|
80 /* Current number of specbindings allocated in specpdl. */
|
|
30080
|
81
|
|
272
|
82 int specpdl_size;
|
|
|
83
|
|
|
84 /* Pointer to beginning of specpdl. */
|
|
30080
|
85
|
|
272
|
86 struct specbinding *specpdl;
|
|
|
87
|
|
|
88 /* Pointer to first unused element in specpdl. */
|
|
30080
|
89
|
69158
812b2bed63c2
(specpdl_ptr): Remove volatile qualifier for consistency with lisp.h.
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
90 struct specbinding *specpdl_ptr;
|
|
272
|
91
|
|
|
92 /* Maximum size allowed for specpdl allocation */
|
|
30080
|
93
|
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
94 EMACS_INT max_specpdl_size;
|
|
272
|
95
|
|
|
96 /* Depth in Lisp evaluations and function calls. */
|
|
30080
|
97
|
|
272
|
98 int lisp_eval_depth;
|
|
|
99
|
|
|
100 /* Maximum allowed depth in Lisp evaluations and function calls. */
|
|
30080
|
101
|
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
102 EMACS_INT max_lisp_eval_depth;
|
|
272
|
103
|
|
|
104 /* Nonzero means enter debugger before next function call */
|
|
30080
|
105
|
|
272
|
106 int debug_on_next_call;
|
|
|
107
|
|
40661
|
108 /* Non-zero means debugger may continue. This is zero when the
|
|
26947
|
109 debugger is called during redisplay, where it might not be safe to
|
|
|
110 continue the interrupted redisplay. */
|
|
|
111
|
|
|
112 int debugger_may_continue;
|
|
|
113
|
|
684
|
114 /* List of conditions (non-nil atom means all) which cause a backtrace
|
|
706
|
115 if an error is handled by the command loop's error handler. */
|
|
30080
|
116
|
|
684
|
117 Lisp_Object Vstack_trace_on_error;
|
|
272
|
118
|
|
684
|
119 /* List of conditions (non-nil atom means all) which enter the debugger
|
|
706
|
120 if an error is handled by the command loop's error handler. */
|
|
30080
|
121
|
|
684
|
122 Lisp_Object Vdebug_on_error;
|
|
272
|
123
|
|
13768
|
124 /* List of conditions and regexps specifying error messages which
|
|
40661
|
125 do not enter the debugger even if Vdebug_on_error says they should. */
|
|
30080
|
126
|
|
13768
|
127 Lisp_Object Vdebug_ignored_errors;
|
|
|
128
|
|
16355
|
129 /* Non-nil means call the debugger even if the error will be handled. */
|
|
30080
|
130
|
|
16443
|
131 Lisp_Object Vdebug_on_signal;
|
|
16355
|
132
|
|
|
133 /* Hook for edebug to use. */
|
|
30080
|
134
|
|
16355
|
135 Lisp_Object Vsignal_hook_function;
|
|
|
136
|
|
272
|
137 /* Nonzero means enter debugger if a quit signal
|
|
684
|
138 is handled by the command loop's error handler. */
|
|
30080
|
139
|
|
272
|
140 int debug_on_quit;
|
|
|
141
|
|
17872
|
142 /* The value of num_nonmacro_input_events as of the last time we
|
|
1196
|
143 started to enter the debugger. If we decide to enter the debugger
|
|
17872
|
144 again when this is still equal to num_nonmacro_input_events, then we
|
|
1196
|
145 know that the debugger itself has an error, and we should just
|
|
|
146 signal the error instead of entering an infinite loop of debugger
|
|
|
147 invocations. */
|
|
30080
|
148
|
|
1196
|
149 int when_entered_debugger;
|
|
272
|
150
|
|
|
151 Lisp_Object Vdebugger;
|
|
|
152
|
|
30073
|
153 /* The function from which the last `signal' was called. Set in
|
|
|
154 Fsignal. */
|
|
|
155
|
|
|
156 Lisp_Object Vsignaling_function;
|
|
|
157
|
|
30080
|
158 /* Set to non-zero while processing X events. Checked in Feval to
|
|
|
159 make sure the Lisp interpreter isn't called from a signal handler,
|
|
|
160 which is unsafe because the interpreter isn't reentrant. */
|
|
|
161
|
|
|
162 int handling_signal;
|
|
|
163
|
|
44132
|
164 /* Function to process declarations in defmacro forms. */
|
|
|
165
|
|
|
166 Lisp_Object Vmacro_declaration_function;
|
|
|
167
|
|
71341
|
168 extern Lisp_Object Qrisky_local_variable;
|
|
44132
|
169
|
|
82463
|
170 extern Lisp_Object Qfunction;
|
|
|
171
|
41114
242c6928accc
(max_specpdl_size, max_lisp_eval_depth): Use EMACS_INT.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
172 static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
|
|
72005
|
173 static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
|
72610
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
174
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
175 #if __GNUC__
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
176 /* "gcc -O3" enables automatic function inlining, which optimizes out
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
177 the arguments for the invocations of these functions, whereas they
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
178 expect these values on the stack. */
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
179 Lisp_Object apply1 () __attribute__((noinline));
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
180 Lisp_Object call2 () __attribute__((noinline));
|
01fdc3c9ea0e
(apply1, call2) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
181 #endif
|
|
71341
|
182
|
|
21514
|
183 void
|
|
272
|
184 init_eval_once ()
|
|
|
185 {
|
|
|
186 specpdl_size = 50;
|
|
7885
|
187 specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
|
|
14600
|
188 specpdl_ptr = specpdl;
|
|
70084
|
189 /* Don't forget to update docs (lispref node "Local Variables"). */
|
|
58827
|
190 max_specpdl_size = 1000;
|
104392
02a71b0c9a96
(init_eval_once): Bump max_lisp_eval_depth to 500 for js.el.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
191 max_lisp_eval_depth = 500;
|
|
8980
|
192
|
|
|
193 Vrun_hooks = Qnil;
|
|
272
|
194 }
|
|
|
195
|
|
21514
|
196 void
|
|
272
|
197 init_eval ()
|
|
|
198 {
|
|
|
199 specpdl_ptr = specpdl;
|
|
|
200 catchlist = 0;
|
|
|
201 handlerlist = 0;
|
|
|
202 backtrace_list = 0;
|
|
|
203 Vquit_flag = Qnil;
|
|
|
204 debug_on_next_call = 0;
|
|
|
205 lisp_eval_depth = 0;
|
|
26307
|
206 #ifdef DEBUG_GCPRO
|
|
26297
|
207 gcpro_level = 0;
|
|
26307
|
208 #endif
|
|
17872
|
209 /* This is less than the initial value of num_nonmacro_input_events. */
|
|
7213
|
210 when_entered_debugger = -1;
|
|
272
|
211 }
|
|
|
212
|
|
63767
|
213 /* unwind-protect function used by call_debugger. */
|
|
|
214
|
|
|
215 static Lisp_Object
|
|
|
216 restore_stack_limits (data)
|
|
|
217 Lisp_Object data;
|
|
|
218 {
|
|
|
219 max_specpdl_size = XINT (XCAR (data));
|
|
|
220 max_lisp_eval_depth = XINT (XCDR (data));
|
|
64568
|
221 return Qnil;
|
|
63767
|
222 }
|
|
|
223
|
|
|
224 /* Call the Lisp debugger, giving it argument ARG. */
|
|
|
225
|
|
272
|
226 Lisp_Object
|
|
|
227 call_debugger (arg)
|
|
|
228 Lisp_Object arg;
|
|
|
229 {
|
|
26764
|
230 int debug_while_redisplaying;
|
|
46293
|
231 int count = SPECPDL_INDEX ();
|
|
26764
|
232 Lisp_Object val;
|
|
63767
|
233 int old_max = max_specpdl_size;
|
|
|
234
|
|
|
235 /* Temporarily bump up the stack limits,
|
|
|
236 so the debugger won't run out of stack. */
|
|
|
237
|
|
|
238 max_specpdl_size += 1;
|
|
|
239 record_unwind_protect (restore_stack_limits,
|
|
|
240 Fcons (make_number (old_max),
|
|
|
241 make_number (max_lisp_eval_depth)));
|
|
|
242 max_specpdl_size = old_max;
|
|
|
243
|
|
|
244 if (lisp_eval_depth + 40 > max_lisp_eval_depth)
|
|
|
245 max_lisp_eval_depth = lisp_eval_depth + 40;
|
|
|
246
|
|
|
247 if (SPECPDL_INDEX () + 100 > max_specpdl_size)
|
|
|
248 max_specpdl_size = SPECPDL_INDEX () + 100;
|
|
49600
|
249
|
|
93071
|
250 #ifdef HAVE_WINDOW_SYSTEM
|
36256
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
251 if (display_hourglass_p)
|
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
252 cancel_hourglass ();
|
|
28383
|
253 #endif
|
|
|
254
|
|
272
|
255 debug_on_next_call = 0;
|
|
17872
|
256 when_entered_debugger = num_nonmacro_input_events;
|
|
26764
|
257
|
|
|
258 /* Resetting redisplaying_p to 0 makes sure that debug output is
|
|
|
259 displayed if the debugger is invoked during redisplay. */
|
|
|
260 debug_while_redisplaying = redisplaying_p;
|
|
|
261 redisplaying_p = 0;
|
|
26947
|
262 specbind (intern ("debugger-may-continue"),
|
|
|
263 debug_while_redisplaying ? Qnil : Qt);
|
|
37043
|
264 specbind (Qinhibit_redisplay, Qnil);
|
|
63767
|
265 specbind (Qdebug_on_error, Qnil);
|
|
37799
|
266
|
|
|
267 #if 0 /* Binding this prevents execution of Lisp code during
|
|
|
268 redisplay, which necessarily leads to display problems. */
|
|
37043
|
269 specbind (Qinhibit_eval_during_redisplay, Qt);
|
|
37799
|
270 #endif
|
|
49600
|
271
|
|
26764
|
272 val = apply1 (Vdebugger, arg);
|
|
|
273
|
|
|
274 /* Interrupting redisplay and resuming it later is not safe under
|
|
|
275 all circumstances. So, when the debugger returns, abort the
|
|
40661
|
276 interrupted redisplay by going back to the top-level. */
|
|
26764
|
277 if (debug_while_redisplaying)
|
|
|
278 Ftop_level ();
|
|
|
279
|
|
26947
|
280 return unbind_to (count, val);
|
|
272
|
281 }
|
|
|
282
|
|
21514
|
283 void
|
|
272
|
284 do_debug_on_call (code)
|
|
|
285 Lisp_Object code;
|
|
|
286 {
|
|
|
287 debug_on_next_call = 0;
|
|
|
288 backtrace_list->debug_on_exit = 1;
|
|
|
289 call_debugger (Fcons (code, Qnil));
|
|
|
290 }
|
|
|
291
|
|
|
292 /* NOTE!!! Every function that can call EVAL must protect its args
|
|
|
293 and temporaries from garbage collection while it needs them.
|
|
|
294 The definition of `For' shows what you have to do. */
|
|
|
295
|
|
|
296 DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
|
|
40570
|
297 doc: /* Eval args until one of them yields non-nil, then return that value.
|
|
|
298 The remaining args are not evalled at all.
|
|
|
299 If all args return nil, return nil.
|
|
78153
|
300 usage: (or CONDITIONS...) */)
|
|
40570
|
301 (args)
|
|
272
|
302 Lisp_Object args;
|
|
|
303 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
304 register Lisp_Object val = Qnil;
|
|
272
|
305 struct gcpro gcpro1;
|
|
|
306
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
307 GCPRO1 (args);
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
308
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
309 while (CONSP (args))
|
|
272
|
310 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
311 val = Feval (XCAR (args));
|
|
485
|
312 if (!NILP (val))
|
|
272
|
313 break;
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
314 args = XCDR (args);
|
|
272
|
315 }
|
|
|
316
|
|
|
317 UNGCPRO;
|
|
|
318 return val;
|
|
|
319 }
|
|
|
320
|
|
|
321 DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
|
|
40983
|
322 doc: /* Eval args until one of them yields nil, then return nil.
|
|
40570
|
323 The remaining args are not evalled at all.
|
|
|
324 If no arg yields nil, return the last arg's value.
|
|
78153
|
325 usage: (and CONDITIONS...) */)
|
|
40570
|
326 (args)
|
|
272
|
327 Lisp_Object args;
|
|
|
328 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
329 register Lisp_Object val = Qt;
|
|
272
|
330 struct gcpro gcpro1;
|
|
|
331
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
332 GCPRO1 (args);
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
333
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
334 while (CONSP (args))
|
|
272
|
335 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
336 val = Feval (XCAR (args));
|
|
485
|
337 if (NILP (val))
|
|
272
|
338 break;
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
339 args = XCDR (args);
|
|
272
|
340 }
|
|
|
341
|
|
|
342 UNGCPRO;
|
|
|
343 return val;
|
|
|
344 }
|
|
|
345
|
|
|
346 DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
|
|
40983
|
347 doc: /* If COND yields non-nil, do THEN, else do ELSE...
|
|
40570
|
348 Returns the value of THEN or the value of the last of the ELSE's.
|
|
|
349 THEN must be one expression, but ELSE... can be zero or more expressions.
|
|
|
350 If COND yields nil, and there are no ELSE's, the value is nil.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
351 usage: (if COND THEN ELSE...) */)
|
|
40570
|
352 (args)
|
|
272
|
353 Lisp_Object args;
|
|
|
354 {
|
|
|
355 register Lisp_Object cond;
|
|
|
356 struct gcpro gcpro1;
|
|
|
357
|
|
|
358 GCPRO1 (args);
|
|
|
359 cond = Feval (Fcar (args));
|
|
|
360 UNGCPRO;
|
|
|
361
|
|
485
|
362 if (!NILP (cond))
|
|
272
|
363 return Feval (Fcar (Fcdr (args)));
|
|
|
364 return Fprogn (Fcdr (Fcdr (args)));
|
|
|
365 }
|
|
|
366
|
|
|
367 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
|
|
40570
|
368 doc: /* Try each clause until one succeeds.
|
|
|
369 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
|
|
|
370 and, if the value is non-nil, this clause succeeds:
|
|
|
371 then the expressions in BODY are evaluated and the last one's
|
|
|
372 value is the value of the cond-form.
|
|
|
373 If no clause succeeds, cond returns nil.
|
|
|
374 If a clause has one element, as in (CONDITION),
|
|
|
375 CONDITION's value if non-nil is returned from the cond-form.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
376 usage: (cond CLAUSES...) */)
|
|
40570
|
377 (args)
|
|
272
|
378 Lisp_Object args;
|
|
|
379 {
|
|
|
380 register Lisp_Object clause, val;
|
|
|
381 struct gcpro gcpro1;
|
|
|
382
|
|
|
383 val = Qnil;
|
|
|
384 GCPRO1 (args);
|
|
485
|
385 while (!NILP (args))
|
|
272
|
386 {
|
|
|
387 clause = Fcar (args);
|
|
|
388 val = Feval (Fcar (clause));
|
|
485
|
389 if (!NILP (val))
|
|
272
|
390 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
391 if (!EQ (XCDR (clause), Qnil))
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
392 val = Fprogn (XCDR (clause));
|
|
272
|
393 break;
|
|
|
394 }
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
395 args = XCDR (args);
|
|
272
|
396 }
|
|
|
397 UNGCPRO;
|
|
|
398
|
|
|
399 return val;
|
|
|
400 }
|
|
|
401
|
|
|
402 DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
|
|
40570
|
403 doc: /* Eval BODY forms sequentially and return value of last one.
|
|
78153
|
404 usage: (progn BODY...) */)
|
|
40570
|
405 (args)
|
|
272
|
406 Lisp_Object args;
|
|
|
407 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
408 register Lisp_Object val = Qnil;
|
|
272
|
409 struct gcpro gcpro1;
|
|
|
410
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
411 GCPRO1 (args);
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
412
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
413 while (CONSP (args))
|
|
272
|
414 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
415 val = Feval (XCAR (args));
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
416 args = XCDR (args);
|
|
272
|
417 }
|
|
|
418
|
|
|
419 UNGCPRO;
|
|
|
420 return val;
|
|
|
421 }
|
|
|
422
|
|
|
423 DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
|
|
96643
|
424 doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
|
|
40570
|
425 The value of FIRST is saved during the evaluation of the remaining args,
|
|
|
426 whose values are discarded.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
427 usage: (prog1 FIRST BODY...) */)
|
|
40570
|
428 (args)
|
|
272
|
429 Lisp_Object args;
|
|
|
430 {
|
|
|
431 Lisp_Object val;
|
|
|
432 register Lisp_Object args_left;
|
|
|
433 struct gcpro gcpro1, gcpro2;
|
|
|
434 register int argnum = 0;
|
|
|
435
|
|
79082
|
436 if (NILP (args))
|
|
272
|
437 return Qnil;
|
|
|
438
|
|
|
439 args_left = args;
|
|
|
440 val = Qnil;
|
|
|
441 GCPRO2 (args, val);
|
|
|
442
|
|
|
443 do
|
|
|
444 {
|
|
|
445 if (!(argnum++))
|
|
|
446 val = Feval (Fcar (args_left));
|
|
|
447 else
|
|
|
448 Feval (Fcar (args_left));
|
|
|
449 args_left = Fcdr (args_left);
|
|
|
450 }
|
|
485
|
451 while (!NILP(args_left));
|
|
272
|
452
|
|
|
453 UNGCPRO;
|
|
|
454 return val;
|
|
|
455 }
|
|
|
456
|
|
|
457 DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
|
|
96643
|
458 doc: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
|
64499
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
459 The value of FORM2 is saved during the evaluation of the
|
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
460 remaining args, whose values are discarded.
|
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
461 usage: (prog2 FORM1 FORM2 BODY...) */)
|
|
40570
|
462 (args)
|
|
272
|
463 Lisp_Object args;
|
|
|
464 {
|
|
|
465 Lisp_Object val;
|
|
|
466 register Lisp_Object args_left;
|
|
|
467 struct gcpro gcpro1, gcpro2;
|
|
|
468 register int argnum = -1;
|
|
|
469
|
|
|
470 val = Qnil;
|
|
|
471
|
|
6803
|
472 if (NILP (args))
|
|
272
|
473 return Qnil;
|
|
|
474
|
|
|
475 args_left = args;
|
|
|
476 val = Qnil;
|
|
|
477 GCPRO2 (args, val);
|
|
|
478
|
|
|
479 do
|
|
|
480 {
|
|
|
481 if (!(argnum++))
|
|
|
482 val = Feval (Fcar (args_left));
|
|
|
483 else
|
|
|
484 Feval (Fcar (args_left));
|
|
|
485 args_left = Fcdr (args_left);
|
|
|
486 }
|
|
6803
|
487 while (!NILP (args_left));
|
|
272
|
488
|
|
|
489 UNGCPRO;
|
|
|
490 return val;
|
|
|
491 }
|
|
|
492
|
|
|
493 DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
|
|
40570
|
494 doc: /* Set each SYM to the value of its VAL.
|
|
|
495 The symbols SYM are variables; they are literal (not evaluated).
|
|
|
496 The values VAL are expressions; they are evaluated.
|
|
|
497 Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
|
|
|
498 The second VAL is not computed until after the first SYM is set, and so on;
|
|
|
499 each VAL can use the new value of variables set earlier in the `setq'.
|
|
|
500 The return value of the `setq' form is the value of the last VAL.
|
|
78141
|
501 usage: (setq [SYM VAL]...) */)
|
|
40570
|
502 (args)
|
|
272
|
503 Lisp_Object args;
|
|
|
504 {
|
|
|
505 register Lisp_Object args_left;
|
|
|
506 register Lisp_Object val, sym;
|
|
|
507 struct gcpro gcpro1;
|
|
|
508
|
|
82463
|
509 if (NILP (args))
|
|
272
|
510 return Qnil;
|
|
|
511
|
|
|
512 args_left = args;
|
|
|
513 GCPRO1 (args);
|
|
|
514
|
|
|
515 do
|
|
|
516 {
|
|
|
517 val = Feval (Fcar (Fcdr (args_left)));
|
|
|
518 sym = Fcar (args_left);
|
|
|
519 Fset (sym, val);
|
|
|
520 args_left = Fcdr (Fcdr (args_left));
|
|
|
521 }
|
|
485
|
522 while (!NILP(args_left));
|
|
272
|
523
|
|
|
524 UNGCPRO;
|
|
|
525 return val;
|
|
|
526 }
|
|
49600
|
527
|
|
272
|
528 DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
|
|
40570
|
529 doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
|
|
|
530 usage: (quote ARG) */)
|
|
|
531 (args)
|
|
272
|
532 Lisp_Object args;
|
|
|
533 {
|
|
82463
|
534 if (!NILP (Fcdr (args)))
|
|
|
535 xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
|
|
272
|
536 return Fcar (args);
|
|
|
537 }
|
|
49600
|
538
|
|
272
|
539 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
|
|
40570
|
540 doc: /* Like `quote', but preferred for objects which are functions.
|
|
|
541 In byte compilation, `function' causes its argument to be compiled.
|
|
|
542 `quote' cannot do that.
|
|
|
543 usage: (function ARG) */)
|
|
|
544 (args)
|
|
272
|
545 Lisp_Object args;
|
|
|
546 {
|
|
82463
|
547 if (!NILP (Fcdr (args)))
|
|
|
548 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
|
|
272
|
549 return Fcar (args);
|
|
|
550 }
|
|
|
551
|
|
35774
|
552
|
|
272
|
553 DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
|
|
104290
|
554 doc: /* Return t if the containing function was run directly by user input.
|
64499
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
555 This means that the function was called with `call-interactively'
|
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
556 \(which includes being called as the binding of a key)
|
|
104290
|
557 and input is currently coming from the keyboard (not a keyboard macro),
|
|
57873
|
558 and Emacs is not running in batch mode (`noninteractive' is nil).
|
|
|
559
|
|
|
560 The only known proper use of `interactive-p' is in deciding whether to
|
|
|
561 display a helpful message, or how to display it. If you're thinking
|
|
|
562 of using it for any other purpose, it is quite likely that you're
|
|
|
563 making a mistake. Think: what do you want to do when the command is
|
|
|
564 called from a keyboard macro?
|
|
|
565
|
|
104290
|
566 To test whether your function was called with `call-interactively',
|
|
|
567 either (i) add an extra optional argument and give it an `interactive'
|
|
|
568 spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
|
|
|
569 use `called-interactively-p'. */)
|
|
40570
|
570 ()
|
|
272
|
571 {
|
|
57873
|
572 return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
|
|
35774
|
573 }
|
|
|
574
|
|
|
575
|
105364
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
576 DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
|
|
104290
|
577 doc: /* Return t if the containing function was called by `call-interactively'.
|
105364
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
578 If KIND is `interactive', then only return t if the call was made
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
579 interactively by the user, i.e. not in `noninteractive' mode nor
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
580 when `executing-kbd-macro'.
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
581 If KIND is `any', on the other hand, it will return t for any kind of
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
582 interactive call, including being called as the binding of a key, or
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
583 from a keyboard macro, or in `noninteractive' mode.
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
584
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
585 The only known proper use of `interactive' for KIND is in deciding
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
586 whether to display a helpful message, or how to display it. If you're
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
587 thinking of using it for any other purpose, it is quite likely that
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
588 you're making a mistake. Think: what do you want to do when the
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
589 command is called from a keyboard macro?
|
|
104290
|
590
|
|
|
591 This function is meant for implementing advice and other
|
|
|
592 function-modifying features. Instead of using this, it is sometimes
|
|
|
593 cleaner to give your function an extra optional argument whose
|
|
|
594 `interactive' spec specifies non-nil unconditionally (\"p\" is a good
|
105364
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
595 way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
596 (kind)
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
597 Lisp_Object kind;
|
|
57873
|
598 {
|
105364
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
599 return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
|
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
600 && interactive_p (1)) ? Qt : Qnil;
|
|
57873
|
601 }
|
|
|
602
|
|
|
603
|
|
|
604 /* Return 1 if function in which this appears was called using
|
|
|
605 call-interactively.
|
|
35774
|
606
|
|
|
607 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
|
|
|
608 called is a built-in. */
|
|
|
609
|
|
|
610 int
|
|
|
611 interactive_p (exclude_subrs_p)
|
|
|
612 int exclude_subrs_p;
|
|
|
613 {
|
|
|
614 struct backtrace *btp;
|
|
|
615 Lisp_Object fun;
|
|
272
|
616
|
|
|
617 btp = backtrace_list;
|
|
727
|
618
|
|
|
619 /* If this isn't a byte-compiled function, there may be a frame at
|
|
35774
|
620 the top for Finteractive_p. If so, skip it. */
|
|
68758
|
621 fun = Findirect_function (*btp->function, Qnil);
|
|
58734
|
622 if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
|
|
|
623 || XSUBR (fun) == &Scalled_interactively_p))
|
|
323
|
624 btp = btp->next;
|
|
|
625
|
|
727
|
626 /* If we're running an Emacs 18-style byte-compiled function, there
|
|
48492
|
627 may be a frame for Fbytecode at the top level. In any version of
|
|
|
628 Emacs there can be Fbytecode frames for subexpressions evaluated
|
|
|
629 inside catch and condition-case. Skip past them.
|
|
|
630
|
|
|
631 If this isn't a byte-compiled function, then we may now be
|
|
727
|
632 looking at several frames for special forms. Skip past them. */
|
|
48492
|
633 while (btp
|
|
|
634 && (EQ (*btp->function, Qbytecode)
|
|
|
635 || btp->nargs == UNEVALLED))
|
|
727
|
636 btp = btp->next;
|
|
|
637
|
|
|
638 /* btp now points at the frame of the innermost function that isn't
|
|
|
639 a special form, ignoring frames for Finteractive_p and/or
|
|
|
640 Fbytecode at the top. If this frame is for a built-in function
|
|
|
641 (such as load or eval-region) return nil. */
|
|
68758
|
642 fun = Findirect_function (*btp->function, Qnil);
|
|
35774
|
643 if (exclude_subrs_p && SUBRP (fun))
|
|
|
644 return 0;
|
|
49600
|
645
|
|
272
|
646 /* btp points to the frame of a Lisp function that called interactive-p.
|
|
|
647 Return t if that function was called interactively. */
|
|
|
648 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
|
|
35774
|
649 return 1;
|
|
|
650 return 0;
|
|
272
|
651 }
|
|
|
652
|
|
35774
|
653
|
|
272
|
654 DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
|
|
40570
|
655 doc: /* Define NAME as a function.
|
|
|
656 The definition is (lambda ARGLIST [DOCSTRING] BODY...).
|
|
|
657 See also the function `interactive'.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
658 usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
|
|
40570
|
659 (args)
|
|
272
|
660 Lisp_Object args;
|
|
|
661 {
|
|
|
662 register Lisp_Object fn_name;
|
|
|
663 register Lisp_Object defn;
|
|
|
664
|
|
|
665 fn_name = Fcar (args);
|
|
56052
|
666 CHECK_SYMBOL (fn_name);
|
|
272
|
667 defn = Fcons (Qlambda, Fcdr (args));
|
|
485
|
668 if (!NILP (Vpurify_flag))
|
|
272
|
669 defn = Fpurecopy (defn);
|
48724
ccd782f27e54
(Fdefun, Fdefmacro): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
670 if (CONSP (XSYMBOL (fn_name)->function)
|
ccd782f27e54
(Fdefun, Fdefmacro): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
671 && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
|
ccd782f27e54
(Fdefun, Fdefmacro): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
672 LOADHIST_ATTACH (Fcons (Qt, fn_name));
|
|
272
|
673 Ffset (fn_name, defn);
|
|
59109
|
674 LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
|
|
272
|
675 return fn_name;
|
|
|
676 }
|
|
|
677
|
|
|
678 DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
|
|
40570
|
679 doc: /* Define NAME as a macro.
|
|
46198
|
680 The actual definition looks like
|
|
|
681 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
|
|
40570
|
682 When the macro is called, as in (NAME ARGS...),
|
|
|
683 the function (lambda ARGLIST BODY...) is applied to
|
|
|
684 the list ARGS... as it appears in the expression,
|
|
|
685 and the result should be a form to be evaluated instead of the original.
|
|
46198
|
686
|
|
|
687 DECL is a declaration, optional, which can specify how to indent
|
|
95543
|
688 calls to this macro, how Edebug should handle it, and which argument
|
|
|
689 should be treated as documentation. It looks like this:
|
|
46198
|
690 (declare SPECS...)
|
|
|
691 The elements can look like this:
|
|
|
692 (indent INDENT)
|
|
|
693 Set NAME's `lisp-indent-function' property to INDENT.
|
|
|
694
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
695 (debug DEBUG)
|
|
46198
|
696 Set NAME's `edebug-form-spec' property to DEBUG. (This is
|
|
49752
|
697 equivalent to writing a `def-edebug-spec' for the macro.)
|
|
95543
|
698
|
|
|
699 (doc-string ELT)
|
|
|
700 Set NAME's `doc-string-elt' property to ELT.
|
|
|
701
|
|
46198
|
702 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
|
|
40570
|
703 (args)
|
|
272
|
704 Lisp_Object args;
|
|
|
705 {
|
|
|
706 register Lisp_Object fn_name;
|
|
|
707 register Lisp_Object defn;
|
|
44132
|
708 Lisp_Object lambda_list, doc, tail;
|
|
272
|
709
|
|
|
710 fn_name = Fcar (args);
|
|
56356
|
711 CHECK_SYMBOL (fn_name);
|
|
44132
|
712 lambda_list = Fcar (Fcdr (args));
|
|
|
713 tail = Fcdr (Fcdr (args));
|
|
|
714
|
|
|
715 doc = Qnil;
|
|
|
716 if (STRINGP (Fcar (tail)))
|
|
|
717 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
718 doc = XCAR (tail);
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
719 tail = XCDR (tail);
|
|
44132
|
720 }
|
|
|
721
|
|
|
722 while (CONSP (Fcar (tail))
|
|
|
723 && EQ (Fcar (Fcar (tail)), Qdeclare))
|
|
|
724 {
|
|
|
725 if (!NILP (Vmacro_declaration_function))
|
|
|
726 {
|
|
|
727 struct gcpro gcpro1;
|
|
|
728 GCPRO1 (args);
|
|
|
729 call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
|
|
|
730 UNGCPRO;
|
|
|
731 }
|
|
49600
|
732
|
|
44132
|
733 tail = Fcdr (tail);
|
|
|
734 }
|
|
|
735
|
|
|
736 if (NILP (doc))
|
|
|
737 tail = Fcons (lambda_list, tail);
|
|
|
738 else
|
|
|
739 tail = Fcons (lambda_list, Fcons (doc, tail));
|
|
|
740 defn = Fcons (Qmacro, Fcons (Qlambda, tail));
|
|
49600
|
741
|
|
485
|
742 if (!NILP (Vpurify_flag))
|
|
272
|
743 defn = Fpurecopy (defn);
|
48724
ccd782f27e54
(Fdefun, Fdefmacro): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
744 if (CONSP (XSYMBOL (fn_name)->function)
|
ccd782f27e54
(Fdefun, Fdefmacro): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
745 && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
|
ccd782f27e54
(Fdefun, Fdefmacro): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
746 LOADHIST_ATTACH (Fcons (Qt, fn_name));
|
|
272
|
747 Ffset (fn_name, defn);
|
|
59109
|
748 LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
|
|
272
|
749 return fn_name;
|
|
|
750 }
|
|
|
751
|
|
39577
|
752
|
|
46388
|
753 DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
754 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
|
|
71574
|
755 Aliased variables always have the same value; setting one sets the other.
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
756 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
|
|
93989
|
757 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
|
|
|
758 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
|
|
|
759 itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
|
|
|
760 then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
761 The return value is BASE-VARIABLE. */)
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
762 (new_alias, base_variable, docstring)
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
763 Lisp_Object new_alias, base_variable, docstring;
|
|
39577
|
764 {
|
|
|
765 struct Lisp_Symbol *sym;
|
|
46388
|
766
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
767 CHECK_SYMBOL (new_alias);
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
768 CHECK_SYMBOL (base_variable);
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
769
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
770 if (SYMBOL_CONSTANT_P (new_alias))
|
|
39577
|
771 error ("Cannot make a constant an alias");
|
|
|
772
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
773 sym = XSYMBOL (new_alias);
|
|
93989
|
774 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
|
|
|
775 If n_a is bound, but b_v is not, set the value of b_v to n_a.
|
|
|
776 This is for the sake of define-obsolete-variable-alias and user
|
|
|
777 customizations. */
|
|
|
778 if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias)))
|
|
|
779 XSYMBOL(base_variable)->value = sym->value;
|
|
39577
|
780 sym->indirect_variable = 1;
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
781 sym->value = base_variable;
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
782 sym->constant = SYMBOL_CONSTANT_P (base_variable);
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
783 LOADHIST_ATTACH (new_alias);
|
|
46388
|
784 if (!NILP (docstring))
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
785 Fput (new_alias, Qvariable_documentation, docstring);
|
62178
91b45e7531ea
(Fdefvaralias): Remove any pre-existing variable-documentation
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
786 else
|
63391
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
787 Fput (new_alias, Qvariable_documentation, Qnil);
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
788
|
e44f5953ff6a
(Fdefvaralias): Rename arguments SYMBOL and ALIASED to NEW-ALIAS and
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
789 return base_variable;
|
|
39577
|
790 }
|
|
|
791
|
|
|
792
|
|
272
|
793 DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
|
|
64540
|
794 doc: /* Define SYMBOL as a variable, and return SYMBOL.
|
|
40570
|
795 You are not required to define a variable in order to use it,
|
|
|
796 but the definition can supply documentation and an initial value
|
|
|
797 in a way that tags can recognize.
|
|
|
798
|
|
|
799 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
|
|
|
800 If SYMBOL is buffer-local, its default value is what is set;
|
|
|
801 buffer-local values are not affected.
|
|
|
802 INITVALUE and DOCSTRING are optional.
|
|
|
803 If DOCSTRING starts with *, this variable is identified as a user option.
|
|
|
804 This means that M-x set-variable recognizes it.
|
|
|
805 See also `user-variable-p'.
|
|
|
806 If INITVALUE is missing, SYMBOL's value is not set.
|
|
56557
|
807
|
|
|
808 If SYMBOL has a local binding, then this form affects the local
|
|
|
809 binding. This is usually not what you want. Thus, if you need to
|
|
|
810 load a file defining variables, with this form or with `defconst' or
|
|
|
811 `defcustom', you should always load that file _outside_ any bindings
|
|
|
812 for these variables. \(`defconst' and `defcustom' behave similarly in
|
|
|
813 this respect.)
|
40703
21597de09a0d
(top_level_value, top_level_set): Remove commented and #ifdef'd-out code.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
814 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
|
|
40570
|
815 (args)
|
|
272
|
816 Lisp_Object args;
|
|
|
817 {
|
|
10161
|
818 register Lisp_Object sym, tem, tail;
|
|
272
|
819
|
|
|
820 sym = Fcar (args);
|
|
10161
|
821 tail = Fcdr (args);
|
|
|
822 if (!NILP (Fcdr (Fcdr (tail))))
|
63697
9f617bb41e22
(Fdefvar, Fdefconst, Feval, Ffuncall): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
823 error ("Too many arguments");
|
|
10161
|
824
|
37732
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
825 tem = Fdefault_boundp (sym);
|
|
10161
|
826 if (!NILP (tail))
|
|
272
|
827 {
|
|
64638
|
828 if (SYMBOL_CONSTANT_P (sym))
|
|
|
829 {
|
|
|
830 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
|
|
|
831 Lisp_Object tem = Fcar (tail);
|
|
|
832 if (! (CONSP (tem)
|
|
|
833 && EQ (XCAR (tem), Qquote)
|
|
|
834 && CONSP (XCDR (tem))
|
|
|
835 && EQ (XCAR (XCDR (tem)), sym)))
|
|
|
836 error ("Constant symbol `%s' specified in defvar",
|
|
|
837 SDATA (SYMBOL_NAME (sym)));
|
|
|
838 }
|
|
|
839
|
|
485
|
840 if (NILP (tem))
|
37732
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
841 Fset_default (sym, Feval (Fcar (tail)));
|
58413
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
842 else
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
843 { /* Check if there is really a global binding rather than just a let
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
844 binding that shadows the global unboundness of the var. */
|
|
58523
|
845 volatile struct specbinding *pdl = specpdl_ptr;
|
58413
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
846 while (--pdl >= specpdl)
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
847 {
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
848 if (EQ (pdl->symbol, sym) && !pdl->func
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
849 && EQ (pdl->old_value, Qunbound))
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
850 {
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
851 message_with_string ("Warning: defvar ignored because %s is let-bound",
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
852 SYMBOL_NAME (sym), 1);
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
853 break;
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
854 }
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
855 }
|
73c39b73a189
(Fdefvar): Warn when var is let-bound but globally void.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
856 }
|
37732
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
857 tail = Fcdr (tail);
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
858 tem = Fcar (tail);
|
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
859 if (!NILP (tem))
|
37732
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
860 {
|
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
861 if (!NILP (Vpurify_flag))
|
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
862 tem = Fpurecopy (tem);
|
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
863 Fput (sym, Qvariable_documentation, tem);
|
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
864 }
|
|
59109
|
865 LOADHIST_ATTACH (sym);
|
|
272
|
866 }
|
37732
f98176963881
(Fdefvar): Only record (defvar <var>) in the load-history
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
867 else
|
|
47022
|
868 /* Simple (defvar <var>) should not count as a definition at all.
|
|
|
869 It could get in the way of other definitions, and unloading this
|
|
|
870 package could try to make the variable unbound. */
|
|
47026
|
871 ;
|
|
|
872
|
|
272
|
873 return sym;
|
|
|
874 }
|
|
|
875
|
|
|
876 DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
|
|
40570
|
877 doc: /* Define SYMBOL as a constant variable.
|
|
|
878 The intent is that neither programs nor users should ever change this value.
|
|
|
879 Always sets the value of SYMBOL to the result of evalling INITVALUE.
|
|
|
880 If SYMBOL is buffer-local, its default value is what is set;
|
|
|
881 buffer-local values are not affected.
|
|
|
882 DOCSTRING is optional.
|
|
56557
|
883
|
|
|
884 If SYMBOL has a local binding, then this form sets the local binding's
|
|
|
885 value. However, you should normally not make local bindings for
|
|
|
886 variables defined with this form.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
887 usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
|
|
40570
|
888 (args)
|
|
272
|
889 Lisp_Object args;
|
|
|
890 {
|
|
|
891 register Lisp_Object sym, tem;
|
|
|
892
|
|
|
893 sym = Fcar (args);
|
|
10161
|
894 if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
|
63697
9f617bb41e22
(Fdefvar, Fdefconst, Feval, Ffuncall): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
895 error ("Too many arguments");
|
|
10161
|
896
|
|
27554
|
897 tem = Feval (Fcar (Fcdr (args)));
|
|
|
898 if (!NILP (Vpurify_flag))
|
|
|
899 tem = Fpurecopy (tem);
|
|
|
900 Fset_default (sym, tem);
|
|
272
|
901 tem = Fcar (Fcdr (Fcdr (args)));
|
|
485
|
902 if (!NILP (tem))
|
|
272
|
903 {
|
|
485
|
904 if (!NILP (Vpurify_flag))
|
|
272
|
905 tem = Fpurecopy (tem);
|
|
|
906 Fput (sym, Qvariable_documentation, tem);
|
|
|
907 }
|
|
71341
|
908 Fput (sym, Qrisky_local_variable, Qt);
|
|
59109
|
909 LOADHIST_ATTACH (sym);
|
|
272
|
910 return sym;
|
|
|
911 }
|
|
|
912
|
|
63826
|
913 /* Error handler used in Fuser_variable_p. */
|
|
|
914 static Lisp_Object
|
|
|
915 user_variable_p_eh (ignore)
|
|
|
916 Lisp_Object ignore;
|
|
|
917 {
|
|
|
918 return Qnil;
|
|
|
919 }
|
|
|
920
|
95118
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
921 static Lisp_Object
|
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
922 lisp_indirect_variable (Lisp_Object sym)
|
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
923 {
|
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
924 XSETSYMBOL (sym, indirect_variable (XSYMBOL (sym)));
|
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
925 return sym;
|
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
926 }
|
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
927
|
|
272
|
928 DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
|
|
63826
|
929 doc: /* Return t if VARIABLE is intended to be set and modified by users.
|
|
40570
|
930 \(The alternative is a variable used internally in a Lisp program.)
|
|
63826
|
931 A variable is a user variable if
|
|
|
932 \(1) the first character of its documentation is `*', or
|
|
|
933 \(2) it is customizable (its property list contains a non-nil value
|
|
|
934 of `standard-value' or `custom-autoload'), or
|
|
|
935 \(3) it is an alias for another user variable.
|
|
|
936 Return nil if VARIABLE is an alias and there is a loop in the
|
|
|
937 chain of symbols. */)
|
|
40570
|
938 (variable)
|
|
272
|
939 Lisp_Object variable;
|
|
|
940 {
|
|
|
941 Lisp_Object documentation;
|
|
49600
|
942
|
|
17275
|
943 if (!SYMBOLP (variable))
|
|
|
944 return Qnil;
|
|
|
945
|
|
63826
|
946 /* If indirect and there's an alias loop, don't check anything else. */
|
|
|
947 if (XSYMBOL (variable)->indirect_variable
|
95118
d426dda989b7
* xdisp.c (select_frame_for_redisplay): Adjust for last change to
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
948 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
|
|
63826
|
949 Qt, user_variable_p_eh)))
|
|
|
950 return Qnil;
|
|
|
951
|
|
|
952 while (1)
|
|
|
953 {
|
|
|
954 documentation = Fget (variable, Qvariable_documentation);
|
|
|
955 if (INTEGERP (documentation) && XINT (documentation) < 0)
|
|
|
956 return Qt;
|
|
|
957 if (STRINGP (documentation)
|
|
|
958 && ((unsigned char) SREF (documentation, 0) == '*'))
|
|
|
959 return Qt;
|
|
|
960 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
|
|
|
961 if (CONSP (documentation)
|
|
|
962 && STRINGP (XCAR (documentation))
|
|
|
963 && INTEGERP (XCDR (documentation))
|
|
|
964 && XINT (XCDR (documentation)) < 0)
|
|
|
965 return Qt;
|
|
|
966 /* Customizable? See `custom-variable-p'. */
|
|
|
967 if ((!NILP (Fget (variable, intern ("standard-value"))))
|
|
|
968 || (!NILP (Fget (variable, intern ("custom-autoload")))))
|
|
|
969 return Qt;
|
|
|
970
|
|
|
971 if (!XSYMBOL (variable)->indirect_variable)
|
|
|
972 return Qnil;
|
|
|
973
|
|
|
974 /* An indirect variable? Let's follow the chain. */
|
|
|
975 variable = XSYMBOL (variable)->value;
|
|
|
976 }
|
|
49600
|
977 }
|
|
272
|
978
|
|
|
979 DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
|
|
40570
|
980 doc: /* Bind variables according to VARLIST then eval BODY.
|
|
|
981 The value of the last form in BODY is returned.
|
|
|
982 Each element of VARLIST is a symbol (which is bound to nil)
|
|
|
983 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
|
|
|
984 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
985 usage: (let* VARLIST BODY...) */)
|
|
40570
|
986 (args)
|
|
272
|
987 Lisp_Object args;
|
|
|
988 {
|
|
|
989 Lisp_Object varlist, val, elt;
|
|
46293
|
990 int count = SPECPDL_INDEX ();
|
|
272
|
991 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
992
|
|
|
993 GCPRO3 (args, elt, varlist);
|
|
|
994
|
|
|
995 varlist = Fcar (args);
|
|
485
|
996 while (!NILP (varlist))
|
|
272
|
997 {
|
|
|
998 QUIT;
|
|
|
999 elt = Fcar (varlist);
|
|
9148
|
1000 if (SYMBOLP (elt))
|
|
272
|
1001 specbind (elt, Qnil);
|
|
604
|
1002 else if (! NILP (Fcdr (Fcdr (elt))))
|
|
71976
|
1003 signal_error ("`let' bindings can have only one value-form", elt);
|
|
272
|
1004 else
|
|
|
1005 {
|
|
|
1006 val = Feval (Fcar (Fcdr (elt)));
|
|
|
1007 specbind (Fcar (elt), val);
|
|
|
1008 }
|
|
|
1009 varlist = Fcdr (varlist);
|
|
|
1010 }
|
|
|
1011 UNGCPRO;
|
|
|
1012 val = Fprogn (Fcdr (args));
|
|
|
1013 return unbind_to (count, val);
|
|
|
1014 }
|
|
|
1015
|
|
|
1016 DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
|
|
40570
|
1017 doc: /* Bind variables according to VARLIST then eval BODY.
|
|
|
1018 The value of the last form in BODY is returned.
|
|
|
1019 Each element of VARLIST is a symbol (which is bound to nil)
|
|
|
1020 or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
|
|
|
1021 All the VALUEFORMs are evalled before any symbols are bound.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1022 usage: (let VARLIST BODY...) */)
|
|
40570
|
1023 (args)
|
|
272
|
1024 Lisp_Object args;
|
|
|
1025 {
|
|
|
1026 Lisp_Object *temps, tem;
|
|
|
1027 register Lisp_Object elt, varlist;
|
|
46293
|
1028 int count = SPECPDL_INDEX ();
|
|
272
|
1029 register int argnum;
|
|
|
1030 struct gcpro gcpro1, gcpro2;
|
|
109929
|
1031 USE_SAFE_ALLOCA;
|
|
272
|
1032
|
|
|
1033 varlist = Fcar (args);
|
|
|
1034
|
|
|
1035 /* Make space to hold the values to give the bound variables */
|
|
|
1036 elt = Flength (varlist);
|
109930
7daea44c7bcc
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP
Andreas Schwab <schwab@linux-m68k.org>
diff
changeset
|
1037 SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
|
|
272
|
1038
|
|
|
1039 /* Compute the values and store them in `temps' */
|
|
|
1040
|
|
|
1041 GCPRO2 (args, *temps);
|
|
|
1042 gcpro2.nvars = 0;
|
|
|
1043
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1044 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
|
|
272
|
1045 {
|
|
|
1046 QUIT;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1047 elt = XCAR (varlist);
|
|
9148
|
1048 if (SYMBOLP (elt))
|
|
272
|
1049 temps [argnum++] = Qnil;
|
|
604
|
1050 else if (! NILP (Fcdr (Fcdr (elt))))
|
|
71976
|
1051 signal_error ("`let' bindings can have only one value-form", elt);
|
|
272
|
1052 else
|
|
|
1053 temps [argnum++] = Feval (Fcar (Fcdr (elt)));
|
|
|
1054 gcpro2.nvars = argnum;
|
|
|
1055 }
|
|
|
1056 UNGCPRO;
|
|
|
1057
|
|
|
1058 varlist = Fcar (args);
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1059 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
|
|
272
|
1060 {
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1061 elt = XCAR (varlist);
|
|
272
|
1062 tem = temps[argnum++];
|
|
9148
|
1063 if (SYMBOLP (elt))
|
|
272
|
1064 specbind (elt, tem);
|
|
|
1065 else
|
|
|
1066 specbind (Fcar (elt), tem);
|
|
|
1067 }
|
|
|
1068
|
|
|
1069 elt = Fprogn (Fcdr (args));
|
|
109929
|
1070 SAFE_FREE ();
|
|
272
|
1071 return unbind_to (count, elt);
|
|
|
1072 }
|
|
|
1073
|
|
|
1074 DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
|
|
40570
|
1075 doc: /* If TEST yields non-nil, eval BODY... and repeat.
|
|
|
1076 The order of execution is thus TEST, BODY, TEST, BODY and so on
|
|
|
1077 until TEST returns nil.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1078 usage: (while TEST BODY...) */)
|
|
40570
|
1079 (args)
|
|
272
|
1080 Lisp_Object args;
|
|
|
1081 {
|
|
42277
|
1082 Lisp_Object test, body;
|
|
272
|
1083 struct gcpro gcpro1, gcpro2;
|
|
|
1084
|
|
|
1085 GCPRO2 (test, body);
|
|
|
1086
|
|
|
1087 test = Fcar (args);
|
|
|
1088 body = Fcdr (args);
|
|
42277
|
1089 while (!NILP (Feval (test)))
|
|
272
|
1090 {
|
|
|
1091 QUIT;
|
|
|
1092 Fprogn (body);
|
|
|
1093 }
|
|
|
1094
|
|
|
1095 UNGCPRO;
|
|
|
1096 return Qnil;
|
|
|
1097 }
|
|
|
1098
|
|
|
1099 DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
|
|
40570
|
1100 doc: /* Return result of expanding macros at top level of FORM.
|
|
|
1101 If FORM is not a macro call, it is returned unchanged.
|
|
|
1102 Otherwise, the macro is expanded and the expansion is considered
|
|
|
1103 in place of FORM. When a non-macro-call results, it is returned.
|
|
|
1104
|
|
|
1105 The second optional arg ENVIRONMENT specifies an environment of macro
|
|
|
1106 definitions to shadow the loaded ones for use in file byte-compilation. */)
|
|
|
1107 (form, environment)
|
|
16113
|
1108 Lisp_Object form;
|
|
14073
|
1109 Lisp_Object environment;
|
|
272
|
1110 {
|
|
753
|
1111 /* With cleanups from Hallvard Furuseth. */
|
|
272
|
1112 register Lisp_Object expander, sym, def, tem;
|
|
|
1113
|
|
|
1114 while (1)
|
|
|
1115 {
|
|
|
1116 /* Come back here each time we expand a macro call,
|
|
|
1117 in case it expands into another macro call. */
|
|
9148
|
1118 if (!CONSP (form))
|
|
272
|
1119 break;
|
|
753
|
1120 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1121 def = sym = XCAR (form);
|
|
753
|
1122 tem = Qnil;
|
|
272
|
1123 /* Trace symbols aliases to other symbols
|
|
|
1124 until we get a symbol that is not an alias. */
|
|
9148
|
1125 while (SYMBOLP (def))
|
|
272
|
1126 {
|
|
|
1127 QUIT;
|
|
753
|
1128 sym = def;
|
|
14073
|
1129 tem = Fassq (sym, environment);
|
|
485
|
1130 if (NILP (tem))
|
|
272
|
1131 {
|
|
|
1132 def = XSYMBOL (sym)->function;
|
|
753
|
1133 if (!EQ (def, Qunbound))
|
|
|
1134 continue;
|
|
272
|
1135 }
|
|
753
|
1136 break;
|
|
272
|
1137 }
|
|
14073
|
1138 /* Right now TEM is the result from SYM in ENVIRONMENT,
|
|
272
|
1139 and if TEM is nil then DEF is SYM's function definition. */
|
|
485
|
1140 if (NILP (tem))
|
|
272
|
1141 {
|
|
14073
|
1142 /* SYM is not mentioned in ENVIRONMENT.
|
|
272
|
1143 Look at its function definition. */
|
|
9148
|
1144 if (EQ (def, Qunbound) || !CONSP (def))
|
|
272
|
1145 /* Not defined or definition not suitable */
|
|
|
1146 break;
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1147 if (EQ (XCAR (def), Qautoload))
|
|
272
|
1148 {
|
|
|
1149 /* Autoloading function: will it be a macro when loaded? */
|
|
1564
|
1150 tem = Fnth (make_number (4), def);
|
|
5254
|
1151 if (EQ (tem, Qt) || EQ (tem, Qmacro))
|
|
1564
|
1152 /* Yes, load it and try again. */
|
|
|
1153 {
|
|
16108
|
1154 struct gcpro gcpro1;
|
|
|
1155 GCPRO1 (form);
|
|
1564
|
1156 do_autoload (def, sym);
|
|
16108
|
1157 UNGCPRO;
|
|
1564
|
1158 continue;
|
|
|
1159 }
|
|
|
1160 else
|
|
272
|
1161 break;
|
|
|
1162 }
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1163 else if (!EQ (XCAR (def), Qmacro))
|
|
272
|
1164 break;
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1165 else expander = XCDR (def);
|
|
272
|
1166 }
|
|
|
1167 else
|
|
|
1168 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1169 expander = XCDR (tem);
|
|
485
|
1170 if (NILP (expander))
|
|
272
|
1171 break;
|
|
|
1172 }
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1173 form = apply1 (expander, XCDR (form));
|
|
272
|
1174 }
|
|
|
1175 return form;
|
|
|
1176 }
|
|
|
1177
|
|
|
1178 DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
|
|
40570
|
1179 doc: /* Eval BODY allowing nonlocal exits using `throw'.
|
|
|
1180 TAG is evalled to get the tag to use; it must not be nil.
|
|
|
1181
|
|
|
1182 Then the BODY is executed.
|
|
73602
|
1183 Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
|
|
40570
|
1184 If no throw happens, `catch' returns the value of the last BODY form.
|
|
|
1185 If a throw happens, it specifies the value to return from `catch'.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1186 usage: (catch TAG BODY...) */)
|
|
40570
|
1187 (args)
|
|
272
|
1188 Lisp_Object args;
|
|
|
1189 {
|
|
|
1190 register Lisp_Object tag;
|
|
|
1191 struct gcpro gcpro1;
|
|
|
1192
|
|
|
1193 GCPRO1 (args);
|
|
|
1194 tag = Feval (Fcar (args));
|
|
|
1195 UNGCPRO;
|
|
|
1196 return internal_catch (tag, Fprogn, Fcdr (args));
|
|
|
1197 }
|
|
|
1198
|
|
|
1199 /* Set up a catch, then call C function FUNC on argument ARG.
|
|
|
1200 FUNC should return a Lisp_Object.
|
|
|
1201 This is how catches are done from within C code. */
|
|
|
1202
|
|
|
1203 Lisp_Object
|
|
|
1204 internal_catch (tag, func, arg)
|
|
|
1205 Lisp_Object tag;
|
|
|
1206 Lisp_Object (*func) ();
|
|
|
1207 Lisp_Object arg;
|
|
|
1208 {
|
|
|
1209 /* This structure is made part of the chain `catchlist'. */
|
|
|
1210 struct catchtag c;
|
|
|
1211
|
|
|
1212 /* Fill in the components of c, and put it on the list. */
|
|
|
1213 c.next = catchlist;
|
|
|
1214 c.tag = tag;
|
|
|
1215 c.val = Qnil;
|
|
|
1216 c.backlist = backtrace_list;
|
|
|
1217 c.handlerlist = handlerlist;
|
|
|
1218 c.lisp_eval_depth = lisp_eval_depth;
|
|
46293
|
1219 c.pdlcount = SPECPDL_INDEX ();
|
|
272
|
1220 c.poll_suppress_count = poll_suppress_count;
|
|
48909
|
1221 c.interrupt_input_blocked = interrupt_input_blocked;
|
|
272
|
1222 c.gcpro = gcprolist;
|
|
26365
|
1223 c.byte_stack = byte_stack_list;
|
|
272
|
1224 catchlist = &c;
|
|
|
1225
|
|
|
1226 /* Call FUNC. */
|
|
|
1227 if (! _setjmp (c.jmp))
|
|
|
1228 c.val = (*func) (arg);
|
|
|
1229
|
|
|
1230 /* Throw works by a longjmp that comes right here. */
|
|
|
1231 catchlist = c.next;
|
|
|
1232 return c.val;
|
|
|
1233 }
|
|
|
1234
|
|
1199
|
1235 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
|
|
|
1236 jump to that CATCH, returning VALUE as the value of that catch.
|
|
|
1237
|
|
|
1238 This is the guts Fthrow and Fsignal; they differ only in the way
|
|
|
1239 they choose the catch tag to throw to. A catch tag for a
|
|
|
1240 condition-case form has a TAG of Qnil.
|
|
272
|
1241
|
|
1199
|
1242 Before each catch is discarded, unbind all special bindings and
|
|
|
1243 execute all unwind-protect clauses made above that catch. Unwind
|
|
|
1244 the handler stack as we go, so that the proper handlers are in
|
|
|
1245 effect for each unwind-protect clause we run. At the end, restore
|
|
|
1246 some static info saved in CATCH, and longjmp to the location
|
|
|
1247 specified in the
|
|
272
|
1248
|
|
1199
|
1249 This is used for correct unwinding in Fthrow and Fsignal. */
|
|
272
|
1250
|
|
|
1251 static void
|
|
1199
|
1252 unwind_to_catch (catch, value)
|
|
272
|
1253 struct catchtag *catch;
|
|
1199
|
1254 Lisp_Object value;
|
|
272
|
1255 {
|
|
|
1256 register int last_time;
|
|
|
1257
|
|
1199
|
1258 /* Save the value in the tag. */
|
|
|
1259 catch->val = value;
|
|
|
1260
|
|
58734
|
1261 /* Restore certain special C variables. */
|
|
4474
|
1262 set_poll_suppress_count (catch->poll_suppress_count);
|
|
60418
|
1263 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
|
|
58734
|
1264 handling_signal = 0;
|
|
59051
|
1265 immediate_quit = 0;
|
|
1196
|
1266
|
|
272
|
1267 do
|
|
|
1268 {
|
|
|
1269 last_time = catchlist == catch;
|
|
1196
|
1270
|
|
|
1271 /* Unwind the specpdl stack, and then restore the proper set of
|
|
|
1272 handlers. */
|
|
272
|
1273 unbind_to (catchlist->pdlcount, Qnil);
|
|
|
1274 handlerlist = catchlist->handlerlist;
|
|
|
1275 catchlist = catchlist->next;
|
|
|
1276 }
|
|
|
1277 while (! last_time);
|
|
|
1278
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1279 #if HAVE_X_WINDOWS
|
|
69387
|
1280 /* If x_catch_errors was done, turn it off now.
|
|
|
1281 (First we give unbind_to a chance to do that.) */
|
83536
0014f454c421
Fix x_catch_errors-related abort after X disconnects. (Reported by Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1282 #if 0 /* This would disable x_catch_errors after x_connection_closed.
|
0014f454c421
Fix x_catch_errors-related abort after X disconnects. (Reported by Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1283 * The catch must remain in effect during that delicate
|
0014f454c421
Fix x_catch_errors-related abort after X disconnects. (Reported by Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1284 * state. --lorentey */
|
|
69387
|
1285 x_fully_uncatch_errors ();
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1286 #endif
|
83536
0014f454c421
Fix x_catch_errors-related abort after X disconnects. (Reported by Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1287 #endif
|
|
69387
|
1288
|
|
26365
|
1289 byte_stack_list = catch->byte_stack;
|
|
272
|
1290 gcprolist = catch->gcpro;
|
|
26297
|
1291 #ifdef DEBUG_GCPRO
|
|
|
1292 if (gcprolist != 0)
|
|
|
1293 gcpro_level = gcprolist->level + 1;
|
|
|
1294 else
|
|
|
1295 gcpro_level = 0;
|
|
|
1296 #endif
|
|
272
|
1297 backtrace_list = catch->backlist;
|
|
|
1298 lisp_eval_depth = catch->lisp_eval_depth;
|
|
49600
|
1299
|
|
1199
|
1300 _longjmp (catch->jmp, 1);
|
|
272
|
1301 }
|
|
|
1302
|
|
|
1303 DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
|
|
40570
|
1304 doc: /* Throw to the catch for TAG and return VALUE from it.
|
|
|
1305 Both TAG and VALUE are evalled. */)
|
|
|
1306 (tag, value)
|
|
14073
|
1307 register Lisp_Object tag, value;
|
|
272
|
1308 {
|
|
|
1309 register struct catchtag *c;
|
|
|
1310
|
|
71872
|
1311 if (!NILP (tag))
|
|
|
1312 for (c = catchlist; c; c = c->next)
|
|
|
1313 {
|
|
|
1314 if (EQ (c->tag, tag))
|
|
|
1315 unwind_to_catch (c, value);
|
|
|
1316 }
|
|
71976
|
1317 xsignal2 (Qno_catch, tag, value);
|
|
272
|
1318 }
|
|
|
1319
|
|
|
1320
|
|
|
1321 DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
|
|
40570
|
1322 doc: /* Do BODYFORM, protecting with UNWINDFORMS.
|
|
|
1323 If BODYFORM completes normally, its value is returned
|
|
|
1324 after executing the UNWINDFORMS.
|
|
|
1325 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
|
41846
680de0f18330
Undo last change. Consistency doesn't seem to be desired.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1326 usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
|
|
40570
|
1327 (args)
|
|
272
|
1328 Lisp_Object args;
|
|
|
1329 {
|
|
|
1330 Lisp_Object val;
|
|
46293
|
1331 int count = SPECPDL_INDEX ();
|
|
272
|
1332
|
50774
cddacf81f5e7
(Funwind_protect): Use func = Fprogn rather symbol = Qnil.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1333 record_unwind_protect (Fprogn, Fcdr (args));
|
|
272
|
1334 val = Feval (Fcar (args));
|
|
49600
|
1335 return unbind_to (count, val);
|
|
272
|
1336 }
|
|
|
1337
|
|
|
1338 /* Chain of condition handlers currently in effect.
|
|
|
1339 The elements of this chain are contained in the stack frames
|
|
|
1340 of Fcondition_case and internal_condition_case.
|
|
|
1341 When an error is signaled (by calling Fsignal, below),
|
|
|
1342 this chain is searched for an element that applies. */
|
|
|
1343
|
|
|
1344 struct handler *handlerlist;
|
|
|
1345
|
|
|
1346 DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
|
|
40570
|
1347 doc: /* Regain control when an error is signaled.
|
|
40661
|
1348 Executes BODYFORM and returns its value if no error happens.
|
|
40570
|
1349 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
|
|
|
1350 where the BODY is made of Lisp expressions.
|
|
|
1351
|
|
|
1352 A handler is applicable to an error
|
|
|
1353 if CONDITION-NAME is one of the error's condition names.
|
|
|
1354 If an error happens, the first applicable handler is run.
|
|
|
1355
|
|
|
1356 The car of a handler may be a list of condition names
|
|
78664
|
1357 instead of a single condition name. Then it handles all of them.
|
|
|
1358
|
|
|
1359 When a handler handles an error, control returns to the `condition-case'
|
|
|
1360 and it executes the handler's BODY...
|
|
97735
|
1361 with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
|
|
78664
|
1362 (If VAR is nil, the handler can't access that information.)
|
|
|
1363 Then the value of the last BODY form is returned from the `condition-case'
|
|
|
1364 expression.
|
|
|
1365
|
|
40570
|
1366 See also the function `signal' for more info.
|
|
55879
|
1367 usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
|
|
40570
|
1368 (args)
|
|
272
|
1369 Lisp_Object args;
|
|
|
1370 {
|
|
32657
|
1371 register Lisp_Object bodyform, handlers;
|
|
|
1372 volatile Lisp_Object var;
|
|
1196
|
1373
|
|
|
1374 var = Fcar (args);
|
|
|
1375 bodyform = Fcar (Fcdr (args));
|
|
|
1376 handlers = Fcdr (Fcdr (args));
|
|
66528
|
1377
|
|
|
1378 return internal_lisp_condition_case (var, bodyform, handlers);
|
|
|
1379 }
|
|
|
1380
|
|
|
1381 /* Like Fcondition_case, but the args are separate
|
|
|
1382 rather than passed in a list. Used by Fbyte_code. */
|
|
|
1383
|
|
|
1384 Lisp_Object
|
|
|
1385 internal_lisp_condition_case (var, bodyform, handlers)
|
|
|
1386 volatile Lisp_Object var;
|
|
|
1387 Lisp_Object bodyform, handlers;
|
|
|
1388 {
|
|
|
1389 Lisp_Object val;
|
|
|
1390 struct catchtag c;
|
|
|
1391 struct handler h;
|
|
|
1392
|
|
40656
|
1393 CHECK_SYMBOL (var);
|
|
272
|
1394
|
|
55879
|
1395 for (val = handlers; CONSP (val); val = XCDR (val))
|
|
1196
|
1396 {
|
|
|
1397 Lisp_Object tem;
|
|
55879
|
1398 tem = XCAR (val);
|
5563
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1399 if (! (NILP (tem)
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1400 || (CONSP (tem)
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1401 && (SYMBOLP (XCAR (tem))
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1402 || CONSP (XCAR (tem))))))
|
|
1196
|
1403 error ("Invalid condition handler", tem);
|
|
|
1404 }
|
|
272
|
1405
|
|
|
1406 c.tag = Qnil;
|
|
|
1407 c.val = Qnil;
|
|
|
1408 c.backlist = backtrace_list;
|
|
|
1409 c.handlerlist = handlerlist;
|
|
|
1410 c.lisp_eval_depth = lisp_eval_depth;
|
|
46293
|
1411 c.pdlcount = SPECPDL_INDEX ();
|
|
272
|
1412 c.poll_suppress_count = poll_suppress_count;
|
|
48909
|
1413 c.interrupt_input_blocked = interrupt_input_blocked;
|
|
272
|
1414 c.gcpro = gcprolist;
|
|
26365
|
1415 c.byte_stack = byte_stack_list;
|
|
272
|
1416 if (_setjmp (c.jmp))
|
|
|
1417 {
|
|
485
|
1418 if (!NILP (h.var))
|
|
6132
|
1419 specbind (h.var, c.val);
|
|
|
1420 val = Fprogn (Fcdr (h.chosen_clause));
|
|
1196
|
1421
|
|
|
1422 /* Note that this just undoes the binding of h.var; whoever
|
|
|
1423 longjumped to us unwound the stack to c.pdlcount before
|
|
|
1424 throwing. */
|
|
272
|
1425 unbind_to (c.pdlcount, Qnil);
|
|
|
1426 return val;
|
|
|
1427 }
|
|
|
1428 c.next = catchlist;
|
|
|
1429 catchlist = &c;
|
|
49600
|
1430
|
|
1196
|
1431 h.var = var;
|
|
|
1432 h.handler = handlers;
|
|
272
|
1433 h.next = handlerlist;
|
|
|
1434 h.tag = &c;
|
|
|
1435 handlerlist = &h;
|
|
|
1436
|
|
1196
|
1437 val = Feval (bodyform);
|
|
272
|
1438 catchlist = c.next;
|
|
|
1439 handlerlist = h.next;
|
|
|
1440 return val;
|
|
|
1441 }
|
|
|
1442
|
|
14218
|
1443 /* Call the function BFUN with no arguments, catching errors within it
|
|
|
1444 according to HANDLERS. If there is an error, call HFUN with
|
|
|
1445 one argument which is the data that describes the error:
|
|
|
1446 (SIGNALNAME . DATA)
|
|
|
1447
|
|
|
1448 HANDLERS can be a list of conditions to catch.
|
|
|
1449 If HANDLERS is Qt, catch all errors.
|
|
|
1450 If HANDLERS is Qerror, catch all errors
|
|
|
1451 but allow the debugger to run if that is enabled. */
|
|
|
1452
|
|
272
|
1453 Lisp_Object
|
|
|
1454 internal_condition_case (bfun, handlers, hfun)
|
|
|
1455 Lisp_Object (*bfun) ();
|
|
|
1456 Lisp_Object handlers;
|
|
|
1457 Lisp_Object (*hfun) ();
|
|
|
1458 {
|
|
|
1459 Lisp_Object val;
|
|
|
1460 struct catchtag c;
|
|
|
1461 struct handler h;
|
|
|
1462
|
|
69387
|
1463 /* Since Fsignal will close off all calls to x_catch_errors,
|
|
|
1464 we will get the wrong results if some are not closed now. */
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1465 #if HAVE_X_WINDOWS
|
|
69387
|
1466 if (x_catching_errors ())
|
|
11365
|
1467 abort ();
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1468 #endif
|
|
11365
|
1469
|
|
272
|
1470 c.tag = Qnil;
|
|
|
1471 c.val = Qnil;
|
|
|
1472 c.backlist = backtrace_list;
|
|
|
1473 c.handlerlist = handlerlist;
|
|
|
1474 c.lisp_eval_depth = lisp_eval_depth;
|
|
46293
|
1475 c.pdlcount = SPECPDL_INDEX ();
|
|
272
|
1476 c.poll_suppress_count = poll_suppress_count;
|
|
48909
|
1477 c.interrupt_input_blocked = interrupt_input_blocked;
|
|
272
|
1478 c.gcpro = gcprolist;
|
|
26365
|
1479 c.byte_stack = byte_stack_list;
|
|
272
|
1480 if (_setjmp (c.jmp))
|
|
|
1481 {
|
|
6132
|
1482 return (*hfun) (c.val);
|
|
272
|
1483 }
|
|
|
1484 c.next = catchlist;
|
|
|
1485 catchlist = &c;
|
|
|
1486 h.handler = handlers;
|
|
|
1487 h.var = Qnil;
|
|
|
1488 h.next = handlerlist;
|
|
|
1489 h.tag = &c;
|
|
|
1490 handlerlist = &h;
|
|
|
1491
|
|
|
1492 val = (*bfun) ();
|
|
|
1493 catchlist = c.next;
|
|
|
1494 handlerlist = h.next;
|
|
|
1495 return val;
|
|
|
1496 }
|
|
|
1497
|
|
48909
|
1498 /* Like internal_condition_case but call BFUN with ARG as its argument. */
|
|
14218
|
1499
|
|
5807
|
1500 Lisp_Object
|
|
|
1501 internal_condition_case_1 (bfun, arg, handlers, hfun)
|
|
|
1502 Lisp_Object (*bfun) ();
|
|
|
1503 Lisp_Object arg;
|
|
|
1504 Lisp_Object handlers;
|
|
|
1505 Lisp_Object (*hfun) ();
|
|
|
1506 {
|
|
|
1507 Lisp_Object val;
|
|
|
1508 struct catchtag c;
|
|
|
1509 struct handler h;
|
|
|
1510
|
|
69387
|
1511 /* Since Fsignal will close off all calls to x_catch_errors,
|
|
|
1512 we will get the wrong results if some are not closed now. */
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1513 #if HAVE_X_WINDOWS
|
|
69387
|
1514 if (x_catching_errors ())
|
|
|
1515 abort ();
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1516 #endif
|
|
69387
|
1517
|
|
5807
|
1518 c.tag = Qnil;
|
|
|
1519 c.val = Qnil;
|
|
|
1520 c.backlist = backtrace_list;
|
|
|
1521 c.handlerlist = handlerlist;
|
|
|
1522 c.lisp_eval_depth = lisp_eval_depth;
|
|
46293
|
1523 c.pdlcount = SPECPDL_INDEX ();
|
|
5807
|
1524 c.poll_suppress_count = poll_suppress_count;
|
|
48909
|
1525 c.interrupt_input_blocked = interrupt_input_blocked;
|
|
5807
|
1526 c.gcpro = gcprolist;
|
|
26365
|
1527 c.byte_stack = byte_stack_list;
|
|
5807
|
1528 if (_setjmp (c.jmp))
|
|
|
1529 {
|
|
6132
|
1530 return (*hfun) (c.val);
|
|
5807
|
1531 }
|
|
|
1532 c.next = catchlist;
|
|
|
1533 catchlist = &c;
|
|
|
1534 h.handler = handlers;
|
|
|
1535 h.var = Qnil;
|
|
|
1536 h.next = handlerlist;
|
|
|
1537 h.tag = &c;
|
|
|
1538 handlerlist = &h;
|
|
|
1539
|
|
|
1540 val = (*bfun) (arg);
|
|
|
1541 catchlist = c.next;
|
|
|
1542 handlerlist = h.next;
|
|
|
1543 return val;
|
|
|
1544 }
|
|
30217
|
1545
|
|
|
1546
|
|
48909
|
1547 /* Like internal_condition_case but call BFUN with NARGS as first,
|
|
30217
|
1548 and ARGS as second argument. */
|
|
|
1549
|
|
|
1550 Lisp_Object
|
|
|
1551 internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
|
|
|
1552 Lisp_Object (*bfun) ();
|
|
|
1553 int nargs;
|
|
|
1554 Lisp_Object *args;
|
|
|
1555 Lisp_Object handlers;
|
|
|
1556 Lisp_Object (*hfun) ();
|
|
|
1557 {
|
|
|
1558 Lisp_Object val;
|
|
|
1559 struct catchtag c;
|
|
|
1560 struct handler h;
|
|
|
1561
|
|
69387
|
1562 /* Since Fsignal will close off all calls to x_catch_errors,
|
|
|
1563 we will get the wrong results if some are not closed now. */
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1564 #if HAVE_X_WINDOWS
|
|
69387
|
1565 if (x_catching_errors ())
|
|
|
1566 abort ();
|
69399
947598ed954a
(unwind_to_catch): Call x_fully_uncatch_errors only if HAVE_X_WINDOWS.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1567 #endif
|
|
69387
|
1568
|
|
30217
|
1569 c.tag = Qnil;
|
|
|
1570 c.val = Qnil;
|
|
|
1571 c.backlist = backtrace_list;
|
|
|
1572 c.handlerlist = handlerlist;
|
|
|
1573 c.lisp_eval_depth = lisp_eval_depth;
|
|
46293
|
1574 c.pdlcount = SPECPDL_INDEX ();
|
|
30217
|
1575 c.poll_suppress_count = poll_suppress_count;
|
|
48909
|
1576 c.interrupt_input_blocked = interrupt_input_blocked;
|
|
30217
|
1577 c.gcpro = gcprolist;
|
|
|
1578 c.byte_stack = byte_stack_list;
|
|
|
1579 if (_setjmp (c.jmp))
|
|
|
1580 {
|
|
|
1581 return (*hfun) (c.val);
|
|
|
1582 }
|
|
|
1583 c.next = catchlist;
|
|
|
1584 catchlist = &c;
|
|
|
1585 h.handler = handlers;
|
|
|
1586 h.var = Qnil;
|
|
|
1587 h.next = handlerlist;
|
|
|
1588 h.tag = &c;
|
|
|
1589 handlerlist = &h;
|
|
|
1590
|
|
|
1591 val = (*bfun) (nargs, args);
|
|
|
1592 catchlist = c.next;
|
|
|
1593 handlerlist = h.next;
|
|
|
1594 return val;
|
|
|
1595 }
|
|
|
1596
|
|
5807
|
1597
|
41114
242c6928accc
(max_specpdl_size, max_lisp_eval_depth): Use EMACS_INT.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1598 static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
|
|
81871
|
1599 Lisp_Object, Lisp_Object));
|
|
272
|
1600
|
|
|
1601 DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
|
|
40570
|
1602 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
|
|
|
1603 This function does not return.
|
|
|
1604
|
|
|
1605 An error symbol is a symbol with an `error-conditions' property
|
|
|
1606 that is a list of condition names.
|
|
|
1607 A handler for any of those names will get to handle this signal.
|
|
|
1608 The symbol `error' should normally be one of them.
|
|
|
1609
|
|
|
1610 DATA should be a list. Its elements are printed as part of the error message.
|
53461
abbbd322a247
(Fsignal): Add hyperlink to the definition of `signal' in the Elisp manual.
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
1611 See Info anchor `(elisp)Definition of signal' for some details on how this
|
abbbd322a247
(Fsignal): Add hyperlink to the definition of `signal' in the Elisp manual.
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
1612 error message is constructed.
|
|
40570
|
1613 If the signal is handled, DATA is made available to the handler.
|
|
|
1614 See also the function `condition-case'. */)
|
|
|
1615 (error_symbol, data)
|
|
5566
|
1616 Lisp_Object error_symbol, data;
|
|
272
|
1617 {
|
|
24171
|
1618 /* When memory is full, ERROR-SYMBOL is nil,
|
|
46315
|
1619 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
|
|
|
1620 That is a special case--don't do this in other situations. */
|
|
272
|
1621 register struct handler *allhandlers = handlerlist;
|
|
|
1622 Lisp_Object conditions;
|
|
|
1623 extern int gc_in_progress;
|
|
|
1624 extern int waiting_for_input;
|
|
16895
|
1625 Lisp_Object string;
|
|
18636
|
1626 Lisp_Object real_error_symbol;
|
|
30073
|
1627 struct backtrace *bp;
|
|
25008
|
1628
|
|
33988
|
1629 immediate_quit = handling_signal = 0;
|
|
50747
|
1630 abort_on_gc = 0;
|
|
272
|
1631 if (gc_in_progress || waiting_for_input)
|
|
|
1632 abort ();
|
|
|
1633
|
|
18636
|
1634 if (NILP (error_symbol))
|
|
|
1635 real_error_symbol = Fcar (data);
|
|
|
1636 else
|
|
|
1637 real_error_symbol = error_symbol;
|
|
|
1638
|
|
46315
|
1639 #if 0 /* rms: I don't know why this was here,
|
|
|
1640 but it is surely wrong for an error that is handled. */
|
|
93071
|
1641 #ifdef HAVE_WINDOW_SYSTEM
|
36256
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
1642 if (display_hourglass_p)
|
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
1643 cancel_hourglass ();
|
|
25008
|
1644 #endif
|
|
49600
|
1645 #endif
|
|
25008
|
1646
|
|
16355
|
1647 /* This hook is used by edebug. */
|
|
46315
|
1648 if (! NILP (Vsignal_hook_function)
|
|
|
1649 && ! NILP (error_symbol))
|
|
63767
|
1650 {
|
|
|
1651 /* Edebug takes care of restoring these variables when it exits. */
|
|
|
1652 if (lisp_eval_depth + 20 > max_lisp_eval_depth)
|
|
|
1653 max_lisp_eval_depth = lisp_eval_depth + 20;
|
|
|
1654
|
|
|
1655 if (SPECPDL_INDEX () + 40 > max_specpdl_size)
|
|
|
1656 max_specpdl_size = SPECPDL_INDEX () + 40;
|
|
|
1657
|
|
|
1658 call2 (Vsignal_hook_function, error_symbol, data);
|
|
|
1659 }
|
|
16355
|
1660
|
|
18636
|
1661 conditions = Fget (real_error_symbol, Qerror_conditions);
|
|
272
|
1662
|
|
30073
|
1663 /* Remember from where signal was called. Skip over the frame for
|
|
|
1664 `signal' itself. If a frame for `error' follows, skip that,
|
|
46315
|
1665 too. Don't do this when ERROR_SYMBOL is nil, because that
|
|
|
1666 is a memory-full error. */
|
|
30106
|
1667 Vsignaling_function = Qnil;
|
|
46315
|
1668 if (backtrace_list && !NILP (error_symbol))
|
|
30106
|
1669 {
|
|
|
1670 bp = backtrace_list->next;
|
|
|
1671 if (bp && bp->function && EQ (*bp->function, Qerror))
|
|
|
1672 bp = bp->next;
|
|
|
1673 if (bp && bp->function)
|
|
|
1674 Vsignaling_function = *bp->function;
|
|
|
1675 }
|
|
30073
|
1676
|
|
272
|
1677 for (; handlerlist; handlerlist = handlerlist->next)
|
|
|
1678 {
|
|
|
1679 register Lisp_Object clause;
|
|
49600
|
1680
|
|
272
|
1681 clause = find_handler_clause (handlerlist->handler, conditions,
|
|
81871
|
1682 error_symbol, data);
|
|
272
|
1683
|
|
|
1684 if (EQ (clause, Qlambda))
|
|
1196
|
1685 {
|
|
13945
|
1686 /* We can't return values to code which signaled an error, but we
|
|
|
1687 can continue code which has signaled a quit. */
|
|
18636
|
1688 if (EQ (real_error_symbol, Qquit))
|
|
1196
|
1689 return Qnil;
|
|
|
1690 else
|
|
3973
|
1691 error ("Cannot return from the debugger in an error");
|
|
1196
|
1692 }
|
|
272
|
1693
|
|
485
|
1694 if (!NILP (clause))
|
|
272
|
1695 {
|
|
6132
|
1696 Lisp_Object unwind_data;
|
|
272
|
1697 struct handler *h = handlerlist;
|
|
6132
|
1698
|
|
272
|
1699 handlerlist = allhandlers;
|
|
18636
|
1700
|
|
|
1701 if (NILP (error_symbol))
|
|
|
1702 unwind_data = data;
|
|
6132
|
1703 else
|
|
|
1704 unwind_data = Fcons (error_symbol, data);
|
|
|
1705 h->chosen_clause = clause;
|
|
|
1706 unwind_to_catch (h->tag, unwind_data);
|
|
272
|
1707 }
|
|
|
1708 }
|
|
|
1709
|
|
|
1710 handlerlist = allhandlers;
|
|
|
1711 /* If no handler is present now, try to run the debugger,
|
|
|
1712 and if that fails, throw to top level. */
|
|
81871
|
1713 find_handler_clause (Qerror, conditions, error_symbol, data);
|
|
16895
|
1714 if (catchlist != 0)
|
|
|
1715 Fthrow (Qtop_level, Qt);
|
|
|
1716
|
|
18636
|
1717 if (! NILP (error_symbol))
|
|
16895
|
1718 data = Fcons (error_symbol, data);
|
|
|
1719
|
|
|
1720 string = Ferror_message_string (data);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1721 fatal ("%s", SDATA (string), 0);
|
|
272
|
1722 }
|
|
|
1723
|
|
71976
|
1724 /* Internal version of Fsignal that never returns.
|
|
|
1725 Used for anything but Qquit (which can return from Fsignal). */
|
|
|
1726
|
|
|
1727 void
|
|
|
1728 xsignal (error_symbol, data)
|
|
|
1729 Lisp_Object error_symbol, data;
|
|
|
1730 {
|
|
|
1731 Fsignal (error_symbol, data);
|
|
|
1732 abort ();
|
|
|
1733 }
|
|
|
1734
|
|
|
1735 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
|
|
|
1736
|
|
|
1737 void
|
|
|
1738 xsignal0 (error_symbol)
|
|
|
1739 Lisp_Object error_symbol;
|
|
|
1740 {
|
|
|
1741 xsignal (error_symbol, Qnil);
|
|
|
1742 }
|
|
|
1743
|
|
|
1744 void
|
|
|
1745 xsignal1 (error_symbol, arg)
|
|
|
1746 Lisp_Object error_symbol, arg;
|
|
|
1747 {
|
|
|
1748 xsignal (error_symbol, list1 (arg));
|
|
|
1749 }
|
|
|
1750
|
|
|
1751 void
|
|
|
1752 xsignal2 (error_symbol, arg1, arg2)
|
|
|
1753 Lisp_Object error_symbol, arg1, arg2;
|
|
|
1754 {
|
|
|
1755 xsignal (error_symbol, list2 (arg1, arg2));
|
|
|
1756 }
|
|
|
1757
|
|
|
1758 void
|
|
|
1759 xsignal3 (error_symbol, arg1, arg2, arg3)
|
|
|
1760 Lisp_Object error_symbol, arg1, arg2, arg3;
|
|
|
1761 {
|
|
|
1762 xsignal (error_symbol, list3 (arg1, arg2, arg3));
|
|
|
1763 }
|
|
|
1764
|
|
|
1765 /* Signal `error' with message S, and additional arg ARG.
|
|
|
1766 If ARG is not a genuine list, make it a one-element list. */
|
|
|
1767
|
|
|
1768 void
|
|
|
1769 signal_error (s, arg)
|
|
|
1770 char *s;
|
|
|
1771 Lisp_Object arg;
|
|
|
1772 {
|
|
|
1773 Lisp_Object tortoise, hare;
|
|
|
1774
|
|
|
1775 hare = tortoise = arg;
|
|
|
1776 while (CONSP (hare))
|
|
|
1777 {
|
|
|
1778 hare = XCDR (hare);
|
|
|
1779 if (!CONSP (hare))
|
|
|
1780 break;
|
|
|
1781
|
|
|
1782 hare = XCDR (hare);
|
|
|
1783 tortoise = XCDR (tortoise);
|
|
|
1784
|
|
|
1785 if (EQ (hare, tortoise))
|
|
|
1786 break;
|
|
|
1787 }
|
|
|
1788
|
|
|
1789 if (!NILP (hare))
|
|
|
1790 arg = Fcons (arg, Qnil); /* Make it a list. */
|
|
|
1791
|
|
|
1792 xsignal (Qerror, Fcons (build_string (s), arg));
|
|
|
1793 }
|
|
|
1794
|
|
|
1795
|
|
78501
|
1796 /* Return nonzero if LIST is a non-nil atom or
|
|
684
|
1797 a list containing one of CONDITIONS. */
|
|
|
1798
|
|
|
1799 static int
|
|
|
1800 wants_debugger (list, conditions)
|
|
|
1801 Lisp_Object list, conditions;
|
|
|
1802 {
|
|
706
|
1803 if (NILP (list))
|
|
684
|
1804 return 0;
|
|
|
1805 if (! CONSP (list))
|
|
|
1806 return 1;
|
|
|
1807
|
|
878
|
1808 while (CONSP (conditions))
|
|
684
|
1809 {
|
|
878
|
1810 Lisp_Object this, tail;
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1811 this = XCAR (conditions);
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1812 for (tail = list; CONSP (tail); tail = XCDR (tail))
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1813 if (EQ (XCAR (tail), this))
|
|
684
|
1814 return 1;
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1815 conditions = XCDR (conditions);
|
|
684
|
1816 }
|
|
878
|
1817 return 0;
|
|
684
|
1818 }
|
|
|
1819
|
|
13768
|
1820 /* Return 1 if an error with condition-symbols CONDITIONS,
|
|
|
1821 and described by SIGNAL-DATA, should skip the debugger
|
|
40661
|
1822 according to debugger-ignored-errors. */
|
|
13768
|
1823
|
|
|
1824 static int
|
|
|
1825 skip_debugger (conditions, data)
|
|
|
1826 Lisp_Object conditions, data;
|
|
|
1827 {
|
|
|
1828 Lisp_Object tail;
|
|
|
1829 int first_string = 1;
|
|
|
1830 Lisp_Object error_message;
|
|
|
1831
|
|
32657
|
1832 error_message = Qnil;
|
|
|
1833 for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail))
|
|
13768
|
1834 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1835 if (STRINGP (XCAR (tail)))
|
|
13768
|
1836 {
|
|
|
1837 if (first_string)
|
|
|
1838 {
|
|
|
1839 error_message = Ferror_message_string (data);
|
|
|
1840 first_string = 0;
|
|
|
1841 }
|
|
49600
|
1842
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1843 if (fast_string_match (XCAR (tail), error_message) >= 0)
|
|
13768
|
1844 return 1;
|
|
|
1845 }
|
|
|
1846 else
|
|
|
1847 {
|
|
|
1848 Lisp_Object contail;
|
|
|
1849
|
|
32657
|
1850 for (contail = conditions; CONSP (contail); contail = XCDR (contail))
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1851 if (EQ (XCAR (tail), XCAR (contail)))
|
|
13768
|
1852 return 1;
|
|
|
1853 }
|
|
|
1854 }
|
|
|
1855
|
|
|
1856 return 0;
|
|
|
1857 }
|
|
|
1858
|
|
97059
|
1859 /* Call the debugger if calling it is currently enabled for CONDITIONS.
|
|
|
1860 SIG and DATA describe the signal, as in find_handler_clause. */
|
|
|
1861
|
|
|
1862 static int
|
|
|
1863 maybe_call_debugger (conditions, sig, data)
|
|
|
1864 Lisp_Object conditions, sig, data;
|
|
|
1865 {
|
|
|
1866 Lisp_Object combined_data;
|
|
|
1867
|
|
|
1868 combined_data = Fcons (sig, data);
|
|
|
1869
|
|
|
1870 if (
|
|
|
1871 /* Don't try to run the debugger with interrupts blocked.
|
|
|
1872 The editing loop would return anyway. */
|
|
|
1873 ! INPUT_BLOCKED_P
|
|
|
1874 /* Does user want to enter debugger for this kind of error? */
|
|
|
1875 && (EQ (sig, Qquit)
|
|
|
1876 ? debug_on_quit
|
|
|
1877 : wants_debugger (Vdebug_on_error, conditions))
|
|
|
1878 && ! skip_debugger (conditions, combined_data)
|
|
|
1879 /* rms: what's this for? */
|
|
|
1880 && when_entered_debugger < num_nonmacro_input_events)
|
|
|
1881 {
|
|
|
1882 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
|
|
|
1883 return 1;
|
|
|
1884 }
|
|
|
1885
|
|
|
1886 return 0;
|
|
|
1887 }
|
|
|
1888
|
|
684
|
1889 /* Value of Qlambda means we have called debugger and user has continued.
|
|
18636
|
1890 There are two ways to pass SIG and DATA:
|
|
24054
|
1891 = SIG is the error symbol, and DATA is the rest of the data.
|
|
18636
|
1892 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
|
|
24054
|
1893 This is for memory-full errors only.
|
|
18636
|
1894
|
|
63767
|
1895 We need to increase max_specpdl_size temporarily around
|
|
|
1896 anything we do that can push on the specpdl, so as not to get
|
|
|
1897 a second error here in case we're handling specpdl overflow. */
|
|
272
|
1898
|
|
|
1899 static Lisp_Object
|
|
81871
|
1900 find_handler_clause (handlers, conditions, sig, data)
|
|
272
|
1901 Lisp_Object handlers, conditions, sig, data;
|
|
|
1902 {
|
|
|
1903 register Lisp_Object h;
|
|
|
1904 register Lisp_Object tem;
|
|
81871
|
1905 int debugger_called = 0;
|
|
|
1906 int debugger_considered = 0;
|
|
|
1907
|
|
|
1908 /* t is used by handlers for all conditions, set up by C code. */
|
|
|
1909 if (EQ (handlers, Qt))
|
|
272
|
1910 return Qt;
|
|
81871
|
1911
|
|
|
1912 /* Don't run the debugger for a memory-full error.
|
|
|
1913 (There is no room in memory to do that!) */
|
|
|
1914 if (NILP (sig))
|
|
|
1915 debugger_considered = 1;
|
|
|
1916
|
|
16355
|
1917 /* error is used similarly, but means print an error message
|
|
|
1918 and run the debugger if that is enabled. */
|
|
|
1919 if (EQ (handlers, Qerror)
|
|
16443
|
1920 || !NILP (Vdebug_on_signal)) /* This says call debugger even if
|
|
|
1921 there is a handler. */
|
|
272
|
1922 {
|
|
81871
|
1923 if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
|
|
21853
|
1924 {
|
97775
88a8ab97052b
(find_handler_clause): Temporarily increase max-lisp-eval-depth while
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
1925 max_lisp_eval_depth += 15;
|
|
63767
|
1926 max_specpdl_size++;
|
105127
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1927 if (noninteractive)
|
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1928 Fbacktrace ();
|
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1929 else
|
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1930 internal_with_output_to_temp_buffer
|
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1931 ("*Backtrace*",
|
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1932 (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
|
fb0a1e29af2a
(find_handler_clause): Make stack-trace-on-error work in batch mode (bug#4228).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1933 Qnil);
|
|
63767
|
1934 max_specpdl_size--;
|
97775
88a8ab97052b
(find_handler_clause): Temporarily increase max-lisp-eval-depth while
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
1935 max_lisp_eval_depth -= 15;
|
|
21853
|
1936 }
|
|
81871
|
1937
|
|
|
1938 if (!debugger_considered)
|
|
272
|
1939 {
|
|
81871
|
1940 debugger_considered = 1;
|
|
|
1941 debugger_called = maybe_call_debugger (conditions, sig, data);
|
|
272
|
1942 }
|
|
81871
|
1943
|
|
16355
|
1944 /* If there is no handler, return saying whether we ran the debugger. */
|
|
|
1945 if (EQ (handlers, Qerror))
|
|
|
1946 {
|
|
|
1947 if (debugger_called)
|
|
63767
|
1948 return Qlambda;
|
|
16355
|
1949 return Qt;
|
|
|
1950 }
|
|
272
|
1951 }
|
|
81871
|
1952
|
|
272
|
1953 for (h = handlers; CONSP (h); h = Fcdr (h))
|
|
|
1954 {
|
5563
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1955 Lisp_Object handler, condit;
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1956
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1957 handler = Fcar (h);
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1958 if (!CONSP (handler))
|
|
272
|
1959 continue;
|
5563
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1960 condit = Fcar (handler);
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1961 /* Handle a single condition name in handler HANDLER. */
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1962 if (SYMBOLP (condit))
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1963 {
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1964 tem = Fmemq (Fcar (handler), conditions);
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1965 if (!NILP (tem))
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1966 return handler;
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1967 }
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1968 /* Handle a list of condition names in handler HANDLER. */
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1969 else if (CONSP (condit))
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1970 {
|
|
81871
|
1971 Lisp_Object tail;
|
|
|
1972 for (tail = condit; CONSP (tail); tail = XCDR (tail))
|
5563
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1973 {
|
|
81871
|
1974 tem = Fmemq (Fcar (tail), conditions);
|
5563
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1975 if (!NILP (tem))
|
|
81871
|
1976 {
|
|
|
1977 /* This handler is going to apply.
|
|
|
1978 Does it allow the debugger to run first? */
|
|
|
1979 if (! debugger_considered && !NILP (Fmemq (Qdebug, condit)))
|
|
|
1980 maybe_call_debugger (conditions, sig, data);
|
|
|
1981 return handler;
|
|
|
1982 }
|
5563
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1983 }
|
50ada322de3e
(Fcondition_case): Allow a list of condition names in a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1984 }
|
|
272
|
1985 }
|
|
81871
|
1986
|
|
272
|
1987 return Qnil;
|
|
|
1988 }
|
|
|
1989
|
|
|
1990 /* dump an error message; called like printf */
|
|
|
1991
|
|
|
1992 /* VARARGS 1 */
|
|
|
1993 void
|
|
|
1994 error (m, a1, a2, a3)
|
|
|
1995 char *m;
|
|
6225
|
1996 char *a1, *a2, *a3;
|
|
272
|
1997 {
|
|
|
1998 char buf[200];
|
|
6225
|
1999 int size = 200;
|
|
|
2000 int mlen;
|
|
|
2001 char *buffer = buf;
|
|
|
2002 char *args[3];
|
|
|
2003 int allocated = 0;
|
|
|
2004 Lisp_Object string;
|
|
|
2005
|
|
|
2006 args[0] = a1;
|
|
|
2007 args[1] = a2;
|
|
|
2008 args[2] = a3;
|
|
|
2009
|
|
|
2010 mlen = strlen (m);
|
|
272
|
2011
|
|
|
2012 while (1)
|
|
6225
|
2013 {
|
|
23206
|
2014 int used = doprnt (buffer, size, m, m + mlen, 3, args);
|
|
6225
|
2015 if (used < size)
|
|
|
2016 break;
|
|
|
2017 size *= 2;
|
|
|
2018 if (allocated)
|
|
|
2019 buffer = (char *) xrealloc (buffer, size);
|
|
7353
|
2020 else
|
|
|
2021 {
|
|
|
2022 buffer = (char *) xmalloc (size);
|
|
|
2023 allocated = 1;
|
|
|
2024 }
|
|
6225
|
2025 }
|
|
|
2026
|
|
23206
|
2027 string = build_string (buffer);
|
|
6225
|
2028 if (allocated)
|
|
30610
|
2029 xfree (buffer);
|
|
6225
|
2030
|
|
71976
|
2031 xsignal1 (Qerror, string);
|
|
272
|
2032 }
|
|
|
2033
|
|
44941
|
2034 DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
|
|
40570
|
2035 doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
|
|
|
2036 This means it contains a description for how to read arguments to give it.
|
|
|
2037 The value is nil for an invalid function or a symbol with no function
|
|
|
2038 definition.
|
|
|
2039
|
|
|
2040 Interactively callable functions include strings and vectors (treated
|
|
|
2041 as keyboard macros), lambda-expressions that contain a top-level call
|
|
|
2042 to `interactive', autoload definitions made by `autoload' with non-nil
|
|
|
2043 fourth argument, and some of the built-in functions of Lisp.
|
|
|
2044
|
|
44941
|
2045 Also, a symbol satisfies `commandp' if its function definition does so.
|
|
|
2046
|
|
|
2047 If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
|
|
45303
|
2048 then strings and vectors are not accepted. */)
|
|
44941
|
2049 (function, for_call_interactively)
|
|
|
2050 Lisp_Object function, for_call_interactively;
|
|
272
|
2051 {
|
|
|
2052 register Lisp_Object fun;
|
|
|
2053 register Lisp_Object funcar;
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2054 Lisp_Object if_prop = Qnil;
|
|
272
|
2055
|
|
|
2056 fun = function;
|
|
|
2057
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2058 fun = indirect_function (fun); /* Check cycles. */
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2059 if (NILP (fun) || EQ (fun, Qunbound))
|
|
648
|
2060 return Qnil;
|
|
272
|
2061
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2062 /* Check an `interactive-form' property if present, analogous to the
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2063 function-documentation property. */
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2064 fun = function;
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2065 while (SYMBOLP (fun))
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2066 {
|
|
102719
|
2067 Lisp_Object tmp = Fget (fun, Qinteractive_form);
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2068 if (!NILP (tmp))
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2069 if_prop = Qt;
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2070 fun = Fsymbol_function (fun);
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2071 }
|
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2072
|
|
272
|
2073 /* Emacs primitives are interactive if their DEFUN specifies an
|
|
|
2074 interactive spec. */
|
|
9148
|
2075 if (SUBRP (fun))
|
|
84436
|
2076 return XSUBR (fun)->intspec ? Qt : if_prop;
|
|
272
|
2077
|
|
|
2078 /* Bytecode objects are interactive if they are long enough to
|
|
|
2079 have an element whose index is COMPILED_INTERACTIVE, which is
|
|
|
2080 where the interactive spec is stored. */
|
|
9148
|
2081 else if (COMPILEDP (fun))
|
|
41597
|
2082 return ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2083 ? Qt : if_prop);
|
|
272
|
2084
|
|
|
2085 /* Strings and vectors are keyboard macros. */
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2086 if (STRINGP (fun) || VECTORP (fun))
|
|
82404
|
2087 return (NILP (for_call_interactively) ? Qt : Qnil);
|
|
272
|
2088
|
|
|
2089 /* Lists may represent commands. */
|
|
|
2090 if (!CONSP (fun))
|
|
|
2091 return Qnil;
|
|
54630
|
2092 funcar = XCAR (fun);
|
|
272
|
2093 if (EQ (funcar, Qlambda))
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2094 return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
|
|
272
|
2095 if (EQ (funcar, Qautoload))
|
82113
76ba0f031e99
(Fcommandp): Pay attention to the `interactive-form' property.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2096 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
|
|
272
|
2097 else
|
|
|
2098 return Qnil;
|
|
|
2099 }
|
|
|
2100
|
|
|
2101 DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
|
|
40570
|
2102 doc: /* Define FUNCTION to autoload from FILE.
|
|
|
2103 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
|
|
|
2104 Third arg DOCSTRING is documentation for the function.
|
|
|
2105 Fourth arg INTERACTIVE if non-nil says function can be called interactively.
|
|
|
2106 Fifth arg TYPE indicates the type of the object:
|
|
|
2107 nil or omitted says FUNCTION is a function,
|
|
|
2108 `keymap' says FUNCTION is really a keymap, and
|
|
|
2109 `macro' or t says FUNCTION is really a macro.
|
|
|
2110 Third through fifth args give info about the real definition.
|
|
|
2111 They default to nil.
|
|
|
2112 If FUNCTION is already defined other than as an autoload,
|
|
|
2113 this does nothing and returns nil. */)
|
|
|
2114 (function, file, docstring, interactive, type)
|
|
1564
|
2115 Lisp_Object function, file, docstring, interactive, type;
|
|
272
|
2116 {
|
|
|
2117 Lisp_Object args[4];
|
|
|
2118
|
|
40656
|
2119 CHECK_SYMBOL (function);
|
|
|
2120 CHECK_STRING (file);
|
|
272
|
2121
|
|
|
2122 /* If function is defined and not as an autoload, don't override */
|
|
|
2123 if (!EQ (XSYMBOL (function)->function, Qunbound)
|
|
9148
|
2124 && !(CONSP (XSYMBOL (function)->function)
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2125 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
|
|
272
|
2126 return Qnil;
|
|
|
2127
|
28297
f37b25e59751
* eval.c (Fautoload): Add entry in load-history (if after dump).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2128 if (NILP (Vpurify_flag))
|
f37b25e59751
* eval.c (Fautoload): Add entry in load-history (if after dump).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2129 /* Only add entries after dumping, because the ones before are
|
f37b25e59751
* eval.c (Fautoload): Add entry in load-history (if after dump).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2130 not useful and else we get loads of them from the loaddefs.el. */
|
f37b25e59751
* eval.c (Fautoload): Add entry in load-history (if after dump).
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2131 LOADHIST_ATTACH (Fcons (Qautoload, function));
|
|
105744
|
2132 else
|
|
105871
|
2133 /* We don't want the docstring in purespace (instead,
|
|
|
2134 Snarf-documentation should (hopefully) overwrite it). */
|
|
|
2135 docstring = make_number (0);
|
|
|
2136 return Ffset (function,
|
|
|
2137 Fpurecopy (list5 (Qautoload, file, docstring,
|
|
|
2138 interactive, type)));
|
|
272
|
2139 }
|
|
|
2140
|
|
|
2141 Lisp_Object
|
|
|
2142 un_autoload (oldqueue)
|
|
|
2143 Lisp_Object oldqueue;
|
|
|
2144 {
|
|
|
2145 register Lisp_Object queue, first, second;
|
|
|
2146
|
|
|
2147 /* Queue to unwind is current value of Vautoload_queue.
|
|
|
2148 oldqueue is the shadowed value to leave in Vautoload_queue. */
|
|
|
2149 queue = Vautoload_queue;
|
|
|
2150 Vautoload_queue = oldqueue;
|
|
|
2151 while (CONSP (queue))
|
|
|
2152 {
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2153 first = XCAR (queue);
|
|
272
|
2154 second = Fcdr (first);
|
|
|
2155 first = Fcar (first);
|
67810
65be704fdaf2
(un_autoload): Expect (0 . OFEATURES) in Vautoload_queue to undo a `provide'.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2156 if (EQ (first, make_number (0)))
|
65be704fdaf2
(un_autoload): Expect (0 . OFEATURES) in Vautoload_queue to undo a `provide'.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2157 Vfeatures = second;
|
|
272
|
2158 else
|
|
|
2159 Ffset (first, second);
|
50630
dfbdcffdcfc9
(For, Fand, Fprogn, un_autoload, do_autoload): Use XCDR, XCAR, CONSP.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2160 queue = XCDR (queue);
|
|
272
|
2161 }
|
|
|
2162 return Qnil;
|
|
|
2163 }
|
|
|
2164
|
|
16108
|
2165 /* Load an autoloaded function.
|
|
|
2166 FUNNAME is the symbol which is the function's name.
|
|
|
2167 FUNDEF is the autoload definition (a list). */
|
|
|
2168
|
|
20378
|
2169 void
|
|
272
|
2170 do_autoload (fundef, funname)
|
|
|
2171 Lisp_Object fundef, funname;
|
|
|
2172 {
|
|
46293
|
2173 int count = SPECPDL_INDEX ();
|
|
79082
|
2174 Lisp_Object fun;
|
|
16108
|
2175 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
272
|
2176
|
|
45039
|
2177 /* This is to make sure that loadup.el gives a clear picture
|
|
|
2178 of what files are preloaded and when. */
|
|
45036
|
2179 if (! NILP (Vpurify_flag))
|
|
|
2180 error ("Attempt to autoload %s while preparing to dump",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2181 SDATA (SYMBOL_NAME (funname)));
|
|
45036
|
2182
|
|
272
|
2183 fun = funname;
|
|
40656
|
2184 CHECK_SYMBOL (funname);
|
|
16108
|
2185 GCPRO3 (fun, funname, fundef);
|
|
272
|
2186
|
|
24605
|
2187 /* Preserve the match data. */
|
|
63147
|
2188 record_unwind_save_match_data ();
|
|
49600
|
2189
|
|
79207
|
2190 /* If autoloading gets an error (which includes the error of failing
|
|
|
2191 to define the function being called), we use Vautoload_queue
|
|
|
2192 to undo function definitions and `provide' calls made by
|
|
|
2193 the function. We do this in the specific case of autoloading
|
|
|
2194 because autoloading is not an explicit request "load this file",
|
|
|
2195 but rather a request to "call this function".
|
|
|
2196
|
|
|
2197 The value saved here is to be restored into Vautoload_queue. */
|
|
272
|
2198 record_unwind_protect (un_autoload, Vautoload_queue);
|
|
|
2199 Vautoload_queue = Qt;
|
|
84835
|
2200 Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
|
|
2547
|
2201
|
|
272
|
2202 /* Once loading finishes, don't undo it. */
|
|
|
2203 Vautoload_queue = Qt;
|
|
|
2204 unbind_to (count, Qnil);
|
|
|
2205
|
|
68758
|
2206 fun = Findirect_function (fun, Qnil);
|
|
648
|
2207
|
|
4462
|
2208 if (!NILP (Fequal (fun, fundef)))
|
|
272
|
2209 error ("Autoloading failed to define function %s",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2210 SDATA (SYMBOL_NAME (funname)));
|
|
16108
|
2211 UNGCPRO;
|
|
272
|
2212 }
|
|
30080
|
2213
|
|
272
|
2214
|
|
|
2215 DEFUN ("eval", Feval, Seval, 1, 1, 0,
|
|
40570
|
2216 doc: /* Evaluate FORM and return its value. */)
|
|
|
2217 (form)
|
|
272
|
2218 Lisp_Object form;
|
|
|
2219 {
|
|
|
2220 Lisp_Object fun, val, original_fun, original_args;
|
|
|
2221 Lisp_Object funcar;
|
|
|
2222 struct backtrace backtrace;
|
|
|
2223 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
2224
|
|
57965
|
2225 if (handling_signal)
|
|
25008
|
2226 abort ();
|
|
49600
|
2227
|
|
9148
|
2228 if (SYMBOLP (form))
|
|
42277
|
2229 return Fsymbol_value (form);
|
|
272
|
2230 if (!CONSP (form))
|
|
|
2231 return form;
|
|
|
2232
|
|
|
2233 QUIT;
|
|
66528
|
2234 if ((consing_since_gc > gc_cons_threshold
|
|
|
2235 && consing_since_gc > gc_relative_threshold)
|
|
|
2236 ||
|
|
|
2237 (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
|
|
272
|
2238 {
|
|
|
2239 GCPRO1 (form);
|
|
|
2240 Fgarbage_collect ();
|
|
|
2241 UNGCPRO;
|
|
|
2242 }
|
|
|
2243
|
|
|
2244 if (++lisp_eval_depth > max_lisp_eval_depth)
|
|
|
2245 {
|
|
|
2246 if (max_lisp_eval_depth < 100)
|
|
|
2247 max_lisp_eval_depth = 100;
|
|
|
2248 if (lisp_eval_depth > max_lisp_eval_depth)
|
63697
9f617bb41e22
(Fdefvar, Fdefconst, Feval, Ffuncall): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2249 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
|
|
272
|
2250 }
|
|
|
2251
|
|
|
2252 original_fun = Fcar (form);
|
|
|
2253 original_args = Fcdr (form);
|
|
|
2254
|
|
|
2255 backtrace.next = backtrace_list;
|
|
|
2256 backtrace_list = &backtrace;
|
|
|
2257 backtrace.function = &original_fun; /* This also protects them from gc */
|
|
|
2258 backtrace.args = &original_args;
|
|
|
2259 backtrace.nargs = UNEVALLED;
|
|
|
2260 backtrace.evalargs = 1;
|
|
|
2261 backtrace.debug_on_exit = 0;
|
|
|
2262
|
|
|
2263 if (debug_on_next_call)
|
|
|
2264 do_debug_on_call (Qt);
|
|
|
2265
|
|
|
2266 /* At this point, only original_fun and original_args
|
|
|
2267 have values that will be used below */
|
|
|
2268 retry:
|
|
71872
|
2269
|
|
|
2270 /* Optimize for no indirection. */
|
|
|
2271 fun = original_fun;
|
|
|
2272 if (SYMBOLP (fun) && !EQ (fun, Qunbound)
|
|
|
2273 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
|
|
|
2274 fun = indirect_function (fun);
|
|
272
|
2275
|
|
9148
|
2276 if (SUBRP (fun))
|
|
272
|
2277 {
|
|
|
2278 Lisp_Object numargs;
|
|
19544
|
2279 Lisp_Object argvals[8];
|
|
272
|
2280 Lisp_Object args_left;
|
|
|
2281 register int i, maxargs;
|
|
|
2282
|
|
|
2283 args_left = original_args;
|
|
|
2284 numargs = Flength (args_left);
|
|
|
2285
|
|
60418
|
2286 CHECK_CONS_LIST ();
|
|
|
2287
|
|
272
|
2288 if (XINT (numargs) < XSUBR (fun)->min_args ||
|
|
|
2289 (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
|
|
71976
|
2290 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
|
|
272
|
2291
|
|
|
2292 if (XSUBR (fun)->max_args == UNEVALLED)
|
|
|
2293 {
|
|
|
2294 backtrace.evalargs = 0;
|
|
|
2295 val = (*XSUBR (fun)->function) (args_left);
|
|
|
2296 goto done;
|
|
|
2297 }
|
|
|
2298
|
|
|
2299 if (XSUBR (fun)->max_args == MANY)
|
|
|
2300 {
|
|
|
2301 /* Pass a vector of evaluated arguments */
|
|
|
2302 Lisp_Object *vals;
|
|
|
2303 register int argnum = 0;
|
|
109929
|
2304 USE_SAFE_ALLOCA;
|
|
|
2305
|
109930
7daea44c7bcc
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP
Andreas Schwab <schwab@linux-m68k.org>
diff
changeset
|
2306 SAFE_ALLOCA_LISP (vals, XINT (numargs));
|
|
272
|
2307
|
|
|
2308 GCPRO3 (args_left, fun, fun);
|
|
|
2309 gcpro3.var = vals;
|
|
|
2310 gcpro3.nvars = 0;
|
|
|
2311
|
|
485
|
2312 while (!NILP (args_left))
|
|
272
|
2313 {
|
|
|
2314 vals[argnum++] = Feval (Fcar (args_left));
|
|
|
2315 args_left = Fcdr (args_left);
|
|
|
2316 gcpro3.nvars = argnum;
|
|
|
2317 }
|
|
|
2318
|
|
|
2319 backtrace.args = vals;
|
|
|
2320 backtrace.nargs = XINT (numargs);
|
|
|
2321
|
|
|
2322 val = (*XSUBR (fun)->function) (XINT (numargs), vals);
|
|
323
|
2323 UNGCPRO;
|
|
109929
|
2324 SAFE_FREE ();
|
|
272
|
2325 goto done;
|
|
|
2326 }
|
|
|
2327
|
|
|
2328 GCPRO3 (args_left, fun, fun);
|
|
|
2329 gcpro3.var = argvals;
|
|
|
2330 gcpro3.nvars = 0;
|
|
|
2331
|
|
|
2332 maxargs = XSUBR (fun)->max_args;
|
|
|
2333 for (i = 0; i < maxargs; args_left = Fcdr (args_left))
|
|
|
2334 {
|
|
|
2335 argvals[i] = Feval (Fcar (args_left));
|
|
|
2336 gcpro3.nvars = ++i;
|
|
|
2337 }
|
|
|
2338
|
|
|
2339 UNGCPRO;
|
|
|
2340
|
|
|
2341 backtrace.args = argvals;
|
|
|
2342 backtrace.nargs = XINT (numargs);
|
|
|
2343
|
|
|
2344 switch (i)
|
|
|
2345 {
|
|
|
2346 case 0:
|
|
|
2347 val = (*XSUBR (fun)->function) ();
|
|
|
2348 goto done;
|
|
|
2349 case 1:
|
|
|
2350 val = (*XSUBR (fun)->function) (argvals[0]);
|
|
|
2351 goto done;
|
|
|
2352 case 2:
|
|
|
2353 val = (*XSUBR (fun)->function) (argvals[0], argvals[1]);
|
|
|
2354 goto done;
|
|
|
2355 case 3:
|
|
|
2356 val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
|
|
|
2357 argvals[2]);
|
|
|
2358 goto done;
|
|
|
2359 case 4:
|
|
|
2360 val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
|
|
|
2361 argvals[2], argvals[3]);
|
|
|
2362 goto done;
|
|
|
2363 case 5:
|
|
|
2364 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
|
|
|
2365 argvals[3], argvals[4]);
|
|
|
2366 goto done;
|
|
|
2367 case 6:
|
|
|
2368 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
|
|
|
2369 argvals[3], argvals[4], argvals[5]);
|
|
|
2370 goto done;
|
|
863
|
2371 case 7:
|
|
|
2372 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
|
|
|
2373 argvals[3], argvals[4], argvals[5],
|
|
|
2374 argvals[6]);
|
|
|
2375 goto done;
|
|
272
|
2376
|
|
19544
|
2377 case 8:
|
|
|
2378 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
|
|
|
2379 argvals[3], argvals[4], argvals[5],
|
|
|
2380 argvals[6], argvals[7]);
|
|
|
2381 goto done;
|
|
|
2382
|
|
272
|
2383 default:
|
|
604
|
2384 /* Someone has created a subr that takes more arguments than
|
|
|
2385 is supported by this code. We need to either rewrite the
|
|
|
2386 subr to use a different argument protocol, or add more
|
|
|
2387 cases to this switch. */
|
|
|
2388 abort ();
|
|
272
|
2389 }
|
|
|
2390 }
|
|
9148
|
2391 if (COMPILEDP (fun))
|
|
272
|
2392 val = apply_lambda (fun, original_args, 1);
|
|
|
2393 else
|
|
|
2394 {
|
|
71872
|
2395 if (EQ (fun, Qunbound))
|
|
71976
|
2396 xsignal1 (Qvoid_function, original_fun);
|
|
272
|
2397 if (!CONSP (fun))
|
|
71976
|
2398 xsignal1 (Qinvalid_function, original_fun);
|
|
|
2399 funcar = XCAR (fun);
|
|
9148
|
2400 if (!SYMBOLP (funcar))
|
|
71976
|
2401 xsignal1 (Qinvalid_function, original_fun);
|
|
272
|
2402 if (EQ (funcar, Qautoload))
|
|
|
2403 {
|
|
|
2404 do_autoload (fun, original_fun);
|
|
|
2405 goto retry;
|
|
|
2406 }
|
|
|
2407 if (EQ (funcar, Qmacro))
|
|
|
2408 val = Feval (apply1 (Fcdr (fun), original_args));
|
|
|
2409 else if (EQ (funcar, Qlambda))
|
|
|
2410 val = apply_lambda (fun, original_args, 1);
|
|
|
2411 else
|
|
71976
|
2412 xsignal1 (Qinvalid_function, original_fun);
|
|
272
|
2413 }
|
|
|
2414 done:
|
|
60418
|
2415 CHECK_CONS_LIST ();
|
|
|
2416
|
|
272
|
2417 lisp_eval_depth--;
|
|
|
2418 if (backtrace.debug_on_exit)
|
|
|
2419 val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
|
|
|
2420 backtrace_list = backtrace.next;
|
48742
7b5cd8383f0b
Feval: On Carbon/MacOSX call mac_check_for_quit_char at each stack frame.
Steven Tamm <steventamm@mac.com>
diff
changeset
|
2421
|
|
272
|
2422 return val;
|
|
|
2423 }
|
|
|
2424
|
|
|
2425 DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
|
|
40570
|
2426 doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
|
|
|
2427 Then return the value FUNCTION returns.
|
|
|
2428 Thus, (apply '+ 1 2 '(3 4)) returns 10.
|
|
|
2429 usage: (apply FUNCTION &rest ARGUMENTS) */)
|
|
|
2430 (nargs, args)
|
|
272
|
2431 int nargs;
|
|
|
2432 Lisp_Object *args;
|
|
|
2433 {
|
|
|
2434 register int i, numargs;
|
|
|
2435 register Lisp_Object spread_arg;
|
|
|
2436 register Lisp_Object *funcall_args;
|
|
109929
|
2437 Lisp_Object fun, retval;
|
50644
0c4bf42e6557
(Fapply): Undo last change and add a comment about why.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2438 struct gcpro gcpro1;
|
|
109929
|
2439 USE_SAFE_ALLOCA;
|
|
272
|
2440
|
|
|
2441 fun = args [0];
|
|
|
2442 funcall_args = 0;
|
|
|
2443 spread_arg = args [nargs - 1];
|
|
40656
|
2444 CHECK_LIST (spread_arg);
|
|
49600
|
2445
|
|
272
|
2446 numargs = XINT (Flength (spread_arg));
|
|
|
2447
|
|
|
2448 if (numargs == 0)
|
|
|
2449 return Ffuncall (nargs - 1, args);
|
|
|
2450 else if (numargs == 1)
|
|
|
2451 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2452 args [nargs - 1] = XCAR (spread_arg);
|
|
272
|
2453 return Ffuncall (nargs, args);
|
|
|
2454 }
|
|
|
2455
|
|
323
|
2456 numargs += nargs - 2;
|
|
272
|
2457
|
|
71872
|
2458 /* Optimize for no indirection. */
|
|
|
2459 if (SYMBOLP (fun) && !EQ (fun, Qunbound)
|
|
|
2460 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
|
|
|
2461 fun = indirect_function (fun);
|
|
648
|
2462 if (EQ (fun, Qunbound))
|
|
272
|
2463 {
|
|
648
|
2464 /* Let funcall get the error */
|
|
|
2465 fun = args[0];
|
|
|
2466 goto funcall;
|
|
272
|
2467 }
|
|
|
2468
|
|
9148
|
2469 if (SUBRP (fun))
|
|
272
|
2470 {
|
|
|
2471 if (numargs < XSUBR (fun)->min_args
|
|
|
2472 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
|
|
|
2473 goto funcall; /* Let funcall get the error */
|
|
|
2474 else if (XSUBR (fun)->max_args > numargs)
|
|
|
2475 {
|
|
|
2476 /* Avoid making funcall cons up a yet another new vector of arguments
|
|
|
2477 by explicitly supplying nil's for optional values */
|
109930
7daea44c7bcc
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP
Andreas Schwab <schwab@linux-m68k.org>
diff
changeset
|
2478 SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
|
|
272
|
2479 for (i = numargs; i < XSUBR (fun)->max_args;)
|
|
|
2480 funcall_args[++i] = Qnil;
|
50644
0c4bf42e6557
(Fapply): Undo last change and add a comment about why.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2481 GCPRO1 (*funcall_args);
|
0c4bf42e6557
(Fapply): Undo last change and add a comment about why.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2482 gcpro1.nvars = 1 + XSUBR (fun)->max_args;
|
|
272
|
2483 }
|
|
|
2484 }
|
|
|
2485 funcall:
|
|
|
2486 /* We add 1 to numargs because funcall_args includes the
|
|
|
2487 function itself as well as its arguments. */
|
|
|
2488 if (!funcall_args)
|
|
323
|
2489 {
|
109930
7daea44c7bcc
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP
Andreas Schwab <schwab@linux-m68k.org>
diff
changeset
|
2490 SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
|
50644
0c4bf42e6557
(Fapply): Undo last change and add a comment about why.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2491 GCPRO1 (*funcall_args);
|
0c4bf42e6557
(Fapply): Undo last change and add a comment about why.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2492 gcpro1.nvars = 1 + numargs;
|
|
323
|
2493 }
|
|
|
2494
|
|
272
|
2495 bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
|
|
|
2496 /* Spread the last arg we got. Its first element goes in
|
|
|
2497 the slot that it used to occupy, hence this value of I. */
|
|
|
2498 i = nargs - 1;
|
|
485
|
2499 while (!NILP (spread_arg))
|
|
272
|
2500 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2501 funcall_args [i++] = XCAR (spread_arg);
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2502 spread_arg = XCDR (spread_arg);
|
|
272
|
2503 }
|
|
323
|
2504
|
50644
0c4bf42e6557
(Fapply): Undo last change and add a comment about why.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2505 /* By convention, the caller needs to gcpro Ffuncall's args. */
|
|
109929
|
2506 retval = Ffuncall (gcpro1.nvars, funcall_args);
|
|
|
2507 UNGCPRO;
|
|
|
2508 SAFE_FREE ();
|
|
|
2509
|
|
|
2510 return retval;
|
|
272
|
2511 }
|
|
|
2512
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2513 /* Run hook variables in various ways. */
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2514
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2515 enum run_hooks_condition {to_completion, until_success, until_failure};
|
41114
242c6928accc
(max_specpdl_size, max_lisp_eval_depth): Use EMACS_INT.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2516 static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
|
242c6928accc
(max_specpdl_size, max_lisp_eval_depth): Use EMACS_INT.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2517 enum run_hooks_condition));
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2518
|
|
34013
|
2519 DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
|
|
62709
|
2520 doc: /* Run each hook in HOOKS.
|
|
40570
|
2521 Each argument should be a symbol, a hook variable.
|
|
|
2522 These symbols are processed in the order specified.
|
|
|
2523 If a hook symbol has a non-nil value, that value may be a function
|
|
|
2524 or a list of functions to be called to run the hook.
|
|
|
2525 If the value is a function, it is called with no arguments.
|
|
|
2526 If it is a list, the elements are called, in order, with no arguments.
|
|
|
2527
|
|
62709
|
2528 Major modes should not use this function directly to run their mode
|
|
|
2529 hook; they should use `run-mode-hooks' instead.
|
|
|
2530
|
|
40629
|
2531 Do not use `make-local-variable' to make a hook variable buffer-local.
|
|
|
2532 Instead, use `add-hook' and specify t for the LOCAL argument.
|
|
40570
|
2533 usage: (run-hooks &rest HOOKS) */)
|
|
|
2534 (nargs, args)
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2535 int nargs;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2536 Lisp_Object *args;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2537 {
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2538 Lisp_Object hook[1];
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2539 register int i;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2540
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2541 for (i = 0; i < nargs; i++)
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2542 {
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2543 hook[0] = args[i];
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2544 run_hook_with_args (1, hook, to_completion);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2545 }
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2546
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2547 return Qnil;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2548 }
|
|
49600
|
2549
|
|
16485
|
2550 DEFUN ("run-hook-with-args", Frun_hook_with_args,
|
|
40570
|
2551 Srun_hook_with_args, 1, MANY, 0,
|
|
|
2552 doc: /* Run HOOK with the specified arguments ARGS.
|
|
|
2553 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
|
|
|
2554 value, that value may be a function or a list of functions to be
|
|
|
2555 called to run the hook. If the value is a function, it is called with
|
|
|
2556 the given arguments and its return value is returned. If it is a list
|
|
|
2557 of functions, those functions are called, in order,
|
|
|
2558 with the given arguments ARGS.
|
|
59953
|
2559 It is best not to depend on the value returned by `run-hook-with-args',
|
|
40570
|
2560 as that may change.
|
|
|
2561
|
|
40629
|
2562 Do not use `make-local-variable' to make a hook variable buffer-local.
|
|
|
2563 Instead, use `add-hook' and specify t for the LOCAL argument.
|
|
40570
|
2564 usage: (run-hook-with-args HOOK &rest ARGS) */)
|
|
|
2565 (nargs, args)
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2566 int nargs;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2567 Lisp_Object *args;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2568 {
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2569 return run_hook_with_args (nargs, args, to_completion);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2570 }
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2571
|
|
16485
|
2572 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
|
|
40570
|
2573 Srun_hook_with_args_until_success, 1, MANY, 0,
|
|
|
2574 doc: /* Run HOOK with the specified arguments ARGS.
|
|
59953
|
2575 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
|
|
|
2576 value, that value may be a function or a list of functions to be
|
|
|
2577 called to run the hook. If the value is a function, it is called with
|
|
|
2578 the given arguments and its return value is returned.
|
|
|
2579 If it is a list of functions, those functions are called, in order,
|
|
|
2580 with the given arguments ARGS, until one of them
|
|
40570
|
2581 returns a non-nil value. Then we return that value.
|
|
59953
|
2582 However, if they all return nil, we return nil.
|
|
40570
|
2583
|
|
40629
|
2584 Do not use `make-local-variable' to make a hook variable buffer-local.
|
|
|
2585 Instead, use `add-hook' and specify t for the LOCAL argument.
|
|
40570
|
2586 usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
|
|
|
2587 (nargs, args)
|
|
12654
|
2588 int nargs;
|
|
|
2589 Lisp_Object *args;
|
|
|
2590 {
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2591 return run_hook_with_args (nargs, args, until_success);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2592 }
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2593
|
|
16485
|
2594 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
|
|
40570
|
2595 Srun_hook_with_args_until_failure, 1, MANY, 0,
|
|
|
2596 doc: /* Run HOOK with the specified arguments ARGS.
|
|
59953
|
2597 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
|
|
|
2598 value, that value may be a function or a list of functions to be
|
|
|
2599 called to run the hook. If the value is a function, it is called with
|
|
|
2600 the given arguments and its return value is returned.
|
|
|
2601 If it is a list of functions, those functions are called, in order,
|
|
|
2602 with the given arguments ARGS, until one of them returns nil.
|
|
|
2603 Then we return nil. However, if they all return non-nil, we return non-nil.
|
|
40570
|
2604
|
|
40629
|
2605 Do not use `make-local-variable' to make a hook variable buffer-local.
|
|
|
2606 Instead, use `add-hook' and specify t for the LOCAL argument.
|
|
40570
|
2607 usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
|
|
|
2608 (nargs, args)
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2609 int nargs;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2610 Lisp_Object *args;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2611 {
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2612 return run_hook_with_args (nargs, args, until_failure);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2613 }
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2614
|
|
12781
|
2615 /* ARGS[0] should be a hook symbol.
|
|
|
2616 Call each of the functions in the hook value, passing each of them
|
|
|
2617 as arguments all the rest of ARGS (all NARGS - 1 elements).
|
|
|
2618 COND specifies a condition to test after each call
|
|
|
2619 to decide whether to stop.
|
|
|
2620 The caller (or its caller, etc) must gcpro all of ARGS,
|
|
|
2621 except that it isn't necessary to gcpro ARGS[0]. */
|
|
|
2622
|
41114
242c6928accc
(max_specpdl_size, max_lisp_eval_depth): Use EMACS_INT.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2623 static Lisp_Object
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2624 run_hook_with_args (nargs, args, cond)
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2625 int nargs;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2626 Lisp_Object *args;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2627 enum run_hooks_condition cond;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2628 {
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2629 Lisp_Object sym, val, ret;
|
|
25257
|
2630 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
12654
|
2631
|
|
14218
|
2632 /* If we are dying or still initializing,
|
|
|
2633 don't do anything--it would probably crash if we tried. */
|
|
|
2634 if (NILP (Vrun_hooks))
|
|
27226
|
2635 return Qnil;
|
|
14218
|
2636
|
|
12654
|
2637 sym = args[0];
|
|
12663
|
2638 val = find_symbol_value (sym);
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2639 ret = (cond == until_failure ? Qt : Qnil);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2640
|
|
12654
|
2641 if (EQ (val, Qunbound) || NILP (val))
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2642 return ret;
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2643 else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
|
|
12654
|
2644 {
|
|
|
2645 args[0] = val;
|
|
|
2646 return Ffuncall (nargs, args);
|
|
|
2647 }
|
|
|
2648 else
|
|
|
2649 {
|
106688
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2650 Lisp_Object globals = Qnil;
|
|
25257
|
2651 GCPRO3 (sym, val, globals);
|
|
12788
|
2652
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2653 for (;
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2654 CONSP (val) && ((cond == to_completion)
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2655 || (cond == until_success ? NILP (ret)
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2656 : !NILP (ret)));
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2657 val = XCDR (val))
|
|
12654
|
2658 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2659 if (EQ (XCAR (val), Qt))
|
|
12654
|
2660 {
|
|
|
2661 /* t indicates this hook has a local binding;
|
|
|
2662 it means to run the global binding too. */
|
106688
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2663 globals = Fdefault_value (sym);
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2664 if (NILP (globals)) continue;
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2665
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2666 if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2667 {
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2668 args[0] = globals;
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2669 ret = Ffuncall (nargs, args);
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2670 }
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2671 else
|
|
12654
|
2672 {
|
106688
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2673 for (;
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2674 CONSP (globals) && ((cond == to_completion)
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2675 || (cond == until_success ? NILP (ret)
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2676 : !NILP (ret)));
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2677 globals = XCDR (globals))
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2678 {
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2679 args[0] = XCAR (globals);
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2680 /* In a global value, t should not occur. If it does, we
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2681 must ignore it to avoid an endless loop. */
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2682 if (!EQ (args[0], Qt))
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2683 ret = Ffuncall (nargs, args);
|
554599f8828c
* eval.c (run_hook_with_args): Handle the case where the global
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2684 }
|
|
12654
|
2685 }
|
|
|
2686 }
|
|
|
2687 else
|
|
|
2688 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2689 args[0] = XCAR (val);
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2690 ret = Ffuncall (nargs, args);
|
|
12654
|
2691 }
|
|
|
2692 }
|
|
12788
|
2693
|
|
|
2694 UNGCPRO;
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2695 return ret;
|
|
12654
|
2696 }
|
|
|
2697 }
|
|
12781
|
2698
|
|
|
2699 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
|
|
|
2700 present value of that symbol.
|
|
|
2701 Call each element of FUNLIST,
|
|
|
2702 passing each of them the rest of ARGS.
|
|
|
2703 The caller (or its caller, etc) must gcpro all of ARGS,
|
|
|
2704 except that it isn't necessary to gcpro ARGS[0]. */
|
|
|
2705
|
|
|
2706 Lisp_Object
|
|
|
2707 run_hook_list_with_args (funlist, nargs, args)
|
|
|
2708 Lisp_Object funlist;
|
|
|
2709 int nargs;
|
|
|
2710 Lisp_Object *args;
|
|
|
2711 {
|
|
|
2712 Lisp_Object sym;
|
|
|
2713 Lisp_Object val;
|
|
25257
|
2714 Lisp_Object globals;
|
|
|
2715 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
12781
|
2716
|
|
|
2717 sym = args[0];
|
|
25257
|
2718 globals = Qnil;
|
|
|
2719 GCPRO3 (sym, val, globals);
|
|
12781
|
2720
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2721 for (val = funlist; CONSP (val); val = XCDR (val))
|
|
12781
|
2722 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2723 if (EQ (XCAR (val), Qt))
|
|
12781
|
2724 {
|
|
|
2725 /* t indicates this hook has a local binding;
|
|
|
2726 it means to run the global binding too. */
|
|
|
2727
|
|
|
2728 for (globals = Fdefault_value (sym);
|
|
|
2729 CONSP (globals);
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2730 globals = XCDR (globals))
|
|
12781
|
2731 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2732 args[0] = XCAR (globals);
|
|
13444
|
2733 /* In a global value, t should not occur. If it does, we
|
|
|
2734 must ignore it to avoid an endless loop. */
|
|
|
2735 if (!EQ (args[0], Qt))
|
|
|
2736 Ffuncall (nargs, args);
|
|
12781
|
2737 }
|
|
|
2738 }
|
|
|
2739 else
|
|
|
2740 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2741 args[0] = XCAR (val);
|
|
12781
|
2742 Ffuncall (nargs, args);
|
|
|
2743 }
|
|
|
2744 }
|
|
|
2745 UNGCPRO;
|
|
|
2746 return Qnil;
|
|
|
2747 }
|
|
13103
|
2748
|
|
|
2749 /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
|
|
|
2750
|
|
|
2751 void
|
|
|
2752 run_hook_with_args_2 (hook, arg1, arg2)
|
|
|
2753 Lisp_Object hook, arg1, arg2;
|
|
|
2754 {
|
|
|
2755 Lisp_Object temp[3];
|
|
|
2756 temp[0] = hook;
|
|
|
2757 temp[1] = arg1;
|
|
|
2758 temp[2] = arg2;
|
|
|
2759
|
|
|
2760 Frun_hook_with_args (3, temp);
|
|
|
2761 }
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2762
|
|
272
|
2763 /* Apply fn to arg */
|
|
|
2764 Lisp_Object
|
|
|
2765 apply1 (fn, arg)
|
|
|
2766 Lisp_Object fn, arg;
|
|
|
2767 {
|
|
323
|
2768 struct gcpro gcpro1;
|
|
|
2769
|
|
|
2770 GCPRO1 (fn);
|
|
485
|
2771 if (NILP (arg))
|
|
323
|
2772 RETURN_UNGCPRO (Ffuncall (1, &fn));
|
|
|
2773 gcpro1.nvars = 2;
|
|
272
|
2774 #ifdef NO_ARG_ARRAY
|
|
|
2775 {
|
|
|
2776 Lisp_Object args[2];
|
|
|
2777 args[0] = fn;
|
|
|
2778 args[1] = arg;
|
|
323
|
2779 gcpro1.var = args;
|
|
|
2780 RETURN_UNGCPRO (Fapply (2, args));
|
|
272
|
2781 }
|
|
|
2782 #else /* not NO_ARG_ARRAY */
|
|
323
|
2783 RETURN_UNGCPRO (Fapply (2, &fn));
|
|
272
|
2784 #endif /* not NO_ARG_ARRAY */
|
|
|
2785 }
|
|
|
2786
|
|
|
2787 /* Call function fn on no arguments */
|
|
|
2788 Lisp_Object
|
|
|
2789 call0 (fn)
|
|
|
2790 Lisp_Object fn;
|
|
|
2791 {
|
|
323
|
2792 struct gcpro gcpro1;
|
|
|
2793
|
|
|
2794 GCPRO1 (fn);
|
|
|
2795 RETURN_UNGCPRO (Ffuncall (1, &fn));
|
|
272
|
2796 }
|
|
|
2797
|
|
3703
|
2798 /* Call function fn with 1 argument arg1 */
|
|
272
|
2799 /* ARGSUSED */
|
|
|
2800 Lisp_Object
|
|
3703
|
2801 call1 (fn, arg1)
|
|
|
2802 Lisp_Object fn, arg1;
|
|
272
|
2803 {
|
|
323
|
2804 struct gcpro gcpro1;
|
|
272
|
2805 #ifdef NO_ARG_ARRAY
|
|
49600
|
2806 Lisp_Object args[2];
|
|
323
|
2807
|
|
272
|
2808 args[0] = fn;
|
|
3703
|
2809 args[1] = arg1;
|
|
323
|
2810 GCPRO1 (args[0]);
|
|
|
2811 gcpro1.nvars = 2;
|
|
|
2812 RETURN_UNGCPRO (Ffuncall (2, args));
|
|
272
|
2813 #else /* not NO_ARG_ARRAY */
|
|
323
|
2814 GCPRO1 (fn);
|
|
|
2815 gcpro1.nvars = 2;
|
|
|
2816 RETURN_UNGCPRO (Ffuncall (2, &fn));
|
|
272
|
2817 #endif /* not NO_ARG_ARRAY */
|
|
|
2818 }
|
|
|
2819
|
|
3703
|
2820 /* Call function fn with 2 arguments arg1, arg2 */
|
|
272
|
2821 /* ARGSUSED */
|
|
|
2822 Lisp_Object
|
|
3703
|
2823 call2 (fn, arg1, arg2)
|
|
|
2824 Lisp_Object fn, arg1, arg2;
|
|
272
|
2825 {
|
|
323
|
2826 struct gcpro gcpro1;
|
|
272
|
2827 #ifdef NO_ARG_ARRAY
|
|
|
2828 Lisp_Object args[3];
|
|
|
2829 args[0] = fn;
|
|
3703
|
2830 args[1] = arg1;
|
|
|
2831 args[2] = arg2;
|
|
323
|
2832 GCPRO1 (args[0]);
|
|
|
2833 gcpro1.nvars = 3;
|
|
|
2834 RETURN_UNGCPRO (Ffuncall (3, args));
|
|
272
|
2835 #else /* not NO_ARG_ARRAY */
|
|
323
|
2836 GCPRO1 (fn);
|
|
|
2837 gcpro1.nvars = 3;
|
|
|
2838 RETURN_UNGCPRO (Ffuncall (3, &fn));
|
|
272
|
2839 #endif /* not NO_ARG_ARRAY */
|
|
|
2840 }
|
|
|
2841
|
|
3703
|
2842 /* Call function fn with 3 arguments arg1, arg2, arg3 */
|
|
272
|
2843 /* ARGSUSED */
|
|
|
2844 Lisp_Object
|
|
3703
|
2845 call3 (fn, arg1, arg2, arg3)
|
|
|
2846 Lisp_Object fn, arg1, arg2, arg3;
|
|
272
|
2847 {
|
|
323
|
2848 struct gcpro gcpro1;
|
|
272
|
2849 #ifdef NO_ARG_ARRAY
|
|
|
2850 Lisp_Object args[4];
|
|
|
2851 args[0] = fn;
|
|
3703
|
2852 args[1] = arg1;
|
|
|
2853 args[2] = arg2;
|
|
|
2854 args[3] = arg3;
|
|
323
|
2855 GCPRO1 (args[0]);
|
|
|
2856 gcpro1.nvars = 4;
|
|
|
2857 RETURN_UNGCPRO (Ffuncall (4, args));
|
|
272
|
2858 #else /* not NO_ARG_ARRAY */
|
|
323
|
2859 GCPRO1 (fn);
|
|
|
2860 gcpro1.nvars = 4;
|
|
|
2861 RETURN_UNGCPRO (Ffuncall (4, &fn));
|
|
272
|
2862 #endif /* not NO_ARG_ARRAY */
|
|
|
2863 }
|
|
|
2864
|
|
3703
|
2865 /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
|
3598
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2866 /* ARGSUSED */
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2867 Lisp_Object
|
|
3703
|
2868 call4 (fn, arg1, arg2, arg3, arg4)
|
|
|
2869 Lisp_Object fn, arg1, arg2, arg3, arg4;
|
3598
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2870 {
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2871 struct gcpro gcpro1;
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2872 #ifdef NO_ARG_ARRAY
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2873 Lisp_Object args[5];
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2874 args[0] = fn;
|
|
3703
|
2875 args[1] = arg1;
|
|
|
2876 args[2] = arg2;
|
|
|
2877 args[3] = arg3;
|
|
|
2878 args[4] = arg4;
|
3598
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2879 GCPRO1 (args[0]);
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2880 gcpro1.nvars = 5;
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2881 RETURN_UNGCPRO (Ffuncall (5, args));
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2882 #else /* not NO_ARG_ARRAY */
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2883 GCPRO1 (fn);
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2884 gcpro1.nvars = 5;
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2885 RETURN_UNGCPRO (Ffuncall (5, &fn));
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2886 #endif /* not NO_ARG_ARRAY */
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2887 }
|
3c4b5489d2b4
* fileio.c (Frename_file): Pass all arguments to the file name handler.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2888
|
|
3703
|
2889 /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
|
|
|
2890 /* ARGSUSED */
|
|
|
2891 Lisp_Object
|
|
|
2892 call5 (fn, arg1, arg2, arg3, arg4, arg5)
|
|
|
2893 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
|
|
|
2894 {
|
|
|
2895 struct gcpro gcpro1;
|
|
|
2896 #ifdef NO_ARG_ARRAY
|
|
|
2897 Lisp_Object args[6];
|
|
|
2898 args[0] = fn;
|
|
|
2899 args[1] = arg1;
|
|
|
2900 args[2] = arg2;
|
|
|
2901 args[3] = arg3;
|
|
|
2902 args[4] = arg4;
|
|
|
2903 args[5] = arg5;
|
|
|
2904 GCPRO1 (args[0]);
|
|
|
2905 gcpro1.nvars = 6;
|
|
|
2906 RETURN_UNGCPRO (Ffuncall (6, args));
|
|
|
2907 #else /* not NO_ARG_ARRAY */
|
|
|
2908 GCPRO1 (fn);
|
|
|
2909 gcpro1.nvars = 6;
|
|
|
2910 RETURN_UNGCPRO (Ffuncall (6, &fn));
|
|
|
2911 #endif /* not NO_ARG_ARRAY */
|
|
|
2912 }
|
|
|
2913
|
|
|
2914 /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
|
|
|
2915 /* ARGSUSED */
|
|
|
2916 Lisp_Object
|
|
|
2917 call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
|
|
|
2918 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
|
|
|
2919 {
|
|
|
2920 struct gcpro gcpro1;
|
|
|
2921 #ifdef NO_ARG_ARRAY
|
|
|
2922 Lisp_Object args[7];
|
|
|
2923 args[0] = fn;
|
|
|
2924 args[1] = arg1;
|
|
|
2925 args[2] = arg2;
|
|
|
2926 args[3] = arg3;
|
|
|
2927 args[4] = arg4;
|
|
|
2928 args[5] = arg5;
|
|
|
2929 args[6] = arg6;
|
|
|
2930 GCPRO1 (args[0]);
|
|
|
2931 gcpro1.nvars = 7;
|
|
|
2932 RETURN_UNGCPRO (Ffuncall (7, args));
|
|
|
2933 #else /* not NO_ARG_ARRAY */
|
|
|
2934 GCPRO1 (fn);
|
|
|
2935 gcpro1.nvars = 7;
|
|
|
2936 RETURN_UNGCPRO (Ffuncall (7, &fn));
|
|
|
2937 #endif /* not NO_ARG_ARRAY */
|
|
|
2938 }
|
|
|
2939
|
|
53362
|
2940 /* The caller should GCPRO all the elements of ARGS. */
|
|
|
2941
|
|
272
|
2942 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
|
|
40570
|
2943 doc: /* Call first argument as a function, passing remaining arguments to it.
|
|
|
2944 Return the value that function returns.
|
|
|
2945 Thus, (funcall 'cons 'x 'y) returns (x . y).
|
|
|
2946 usage: (funcall FUNCTION &rest ARGUMENTS) */)
|
|
|
2947 (nargs, args)
|
|
272
|
2948 int nargs;
|
|
|
2949 Lisp_Object *args;
|
|
|
2950 {
|
|
71872
|
2951 Lisp_Object fun, original_fun;
|
|
272
|
2952 Lisp_Object funcar;
|
|
|
2953 int numargs = nargs - 1;
|
|
|
2954 Lisp_Object lisp_numargs;
|
|
|
2955 Lisp_Object val;
|
|
|
2956 struct backtrace backtrace;
|
|
|
2957 register Lisp_Object *internal_args;
|
|
|
2958 register int i;
|
|
|
2959
|
|
|
2960 QUIT;
|
|
66528
|
2961 if ((consing_since_gc > gc_cons_threshold
|
|
|
2962 && consing_since_gc > gc_relative_threshold)
|
|
|
2963 ||
|
|
|
2964 (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
|
|
323
|
2965 Fgarbage_collect ();
|
|
272
|
2966
|
|
|
2967 if (++lisp_eval_depth > max_lisp_eval_depth)
|
|
|
2968 {
|
|
|
2969 if (max_lisp_eval_depth < 100)
|
|
|
2970 max_lisp_eval_depth = 100;
|
|
|
2971 if (lisp_eval_depth > max_lisp_eval_depth)
|
63697
9f617bb41e22
(Fdefvar, Fdefconst, Feval, Ffuncall): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2972 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
|
|
272
|
2973 }
|
|
|
2974
|
|
|
2975 backtrace.next = backtrace_list;
|
|
|
2976 backtrace_list = &backtrace;
|
|
|
2977 backtrace.function = &args[0];
|
|
|
2978 backtrace.args = &args[1];
|
|
|
2979 backtrace.nargs = nargs - 1;
|
|
|
2980 backtrace.evalargs = 0;
|
|
|
2981 backtrace.debug_on_exit = 0;
|
|
|
2982
|
|
|
2983 if (debug_on_next_call)
|
|
|
2984 do_debug_on_call (Qlambda);
|
|
|
2985
|
|
61250
|
2986 CHECK_CONS_LIST ();
|
|
|
2987
|
|
71872
|
2988 original_fun = args[0];
|
|
|
2989
|
|
272
|
2990 retry:
|
|
|
2991
|
|
71872
|
2992 /* Optimize for no indirection. */
|
|
|
2993 fun = original_fun;
|
|
|
2994 if (SYMBOLP (fun) && !EQ (fun, Qunbound)
|
|
|
2995 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
|
|
|
2996 fun = indirect_function (fun);
|
|
272
|
2997
|
|
9148
|
2998 if (SUBRP (fun))
|
|
272
|
2999 {
|
|
61250
|
3000 if (numargs < XSUBR (fun)->min_args
|
|
272
|
3001 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
|
|
|
3002 {
|
9306
ac852c183fa1
(Feval, Ffuncall, funcall_lambda, Fbacktrace): Don't use XFASTINT as an
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3003 XSETFASTINT (lisp_numargs, numargs);
|
|
71976
|
3004 xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
|
|
272
|
3005 }
|
|
|
3006
|
|
|
3007 if (XSUBR (fun)->max_args == UNEVALLED)
|
|
71976
|
3008 xsignal1 (Qinvalid_function, original_fun);
|
|
272
|
3009
|
|
|
3010 if (XSUBR (fun)->max_args == MANY)
|
|
|
3011 {
|
|
|
3012 val = (*XSUBR (fun)->function) (numargs, args + 1);
|
|
|
3013 goto done;
|
|
|
3014 }
|
|
|
3015
|
|
|
3016 if (XSUBR (fun)->max_args > numargs)
|
|
|
3017 {
|
|
|
3018 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
|
|
|
3019 bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object));
|
|
|
3020 for (i = numargs; i < XSUBR (fun)->max_args; i++)
|
|
|
3021 internal_args[i] = Qnil;
|
|
|
3022 }
|
|
|
3023 else
|
|
|
3024 internal_args = args + 1;
|
|
|
3025 switch (XSUBR (fun)->max_args)
|
|
|
3026 {
|
|
|
3027 case 0:
|
|
|
3028 val = (*XSUBR (fun)->function) ();
|
|
|
3029 goto done;
|
|
|
3030 case 1:
|
|
|
3031 val = (*XSUBR (fun)->function) (internal_args[0]);
|
|
|
3032 goto done;
|
|
|
3033 case 2:
|
64499
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3034 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]);
|
|
272
|
3035 goto done;
|
|
|
3036 case 3:
|
|
|
3037 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
|
|
|
3038 internal_args[2]);
|
|
|
3039 goto done;
|
|
|
3040 case 4:
|
|
|
3041 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
|
64499
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3042 internal_args[2], internal_args[3]);
|
|
272
|
3043 goto done;
|
|
|
3044 case 5:
|
|
|
3045 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
|
|
|
3046 internal_args[2], internal_args[3],
|
|
|
3047 internal_args[4]);
|
|
|
3048 goto done;
|
|
|
3049 case 6:
|
|
|
3050 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
|
|
|
3051 internal_args[2], internal_args[3],
|
|
|
3052 internal_args[4], internal_args[5]);
|
|
|
3053 goto done;
|
|
863
|
3054 case 7:
|
|
|
3055 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
|
|
|
3056 internal_args[2], internal_args[3],
|
|
|
3057 internal_args[4], internal_args[5],
|
|
|
3058 internal_args[6]);
|
|
|
3059 goto done;
|
|
272
|
3060
|
|
19544
|
3061 case 8:
|
|
|
3062 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
|
|
|
3063 internal_args[2], internal_args[3],
|
|
|
3064 internal_args[4], internal_args[5],
|
|
|
3065 internal_args[6], internal_args[7]);
|
|
|
3066 goto done;
|
|
|
3067
|
|
272
|
3068 default:
|
|
573
|
3069
|
|
19544
|
3070 /* If a subr takes more than 8 arguments without using MANY
|
|
49600
|
3071 or UNEVALLED, we need to extend this function to support it.
|
|
573
|
3072 Until this is done, there is no way to call the function. */
|
|
|
3073 abort ();
|
|
272
|
3074 }
|
|
|
3075 }
|
|
9148
|
3076 if (COMPILEDP (fun))
|
|
272
|
3077 val = funcall_lambda (fun, numargs, args + 1);
|
|
|
3078 else
|
|
|
3079 {
|
|
71872
|
3080 if (EQ (fun, Qunbound))
|
|
71976
|
3081 xsignal1 (Qvoid_function, original_fun);
|
|
272
|
3082 if (!CONSP (fun))
|
|
71976
|
3083 xsignal1 (Qinvalid_function, original_fun);
|
|
|
3084 funcar = XCAR (fun);
|
|
9148
|
3085 if (!SYMBOLP (funcar))
|
|
71976
|
3086 xsignal1 (Qinvalid_function, original_fun);
|
|
272
|
3087 if (EQ (funcar, Qlambda))
|
|
|
3088 val = funcall_lambda (fun, numargs, args + 1);
|
|
|
3089 else if (EQ (funcar, Qautoload))
|
|
|
3090 {
|
|
71872
|
3091 do_autoload (fun, original_fun);
|
|
61250
|
3092 CHECK_CONS_LIST ();
|
|
272
|
3093 goto retry;
|
|
|
3094 }
|
|
|
3095 else
|
|
71976
|
3096 xsignal1 (Qinvalid_function, original_fun);
|
|
272
|
3097 }
|
|
|
3098 done:
|
|
60418
|
3099 CHECK_CONS_LIST ();
|
|
272
|
3100 lisp_eval_depth--;
|
|
|
3101 if (backtrace.debug_on_exit)
|
|
|
3102 val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
|
|
|
3103 backtrace_list = backtrace.next;
|
|
|
3104 return val;
|
|
|
3105 }
|
|
|
3106
|
|
|
3107 Lisp_Object
|
|
|
3108 apply_lambda (fun, args, eval_flag)
|
|
|
3109 Lisp_Object fun, args;
|
|
|
3110 int eval_flag;
|
|
|
3111 {
|
|
|
3112 Lisp_Object args_left;
|
|
|
3113 Lisp_Object numargs;
|
|
|
3114 register Lisp_Object *arg_vector;
|
|
|
3115 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
3116 register int i;
|
|
|
3117 register Lisp_Object tem;
|
|
109929
|
3118 USE_SAFE_ALLOCA;
|
|
272
|
3119
|
|
|
3120 numargs = Flength (args);
|
109930
7daea44c7bcc
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP
Andreas Schwab <schwab@linux-m68k.org>
diff
changeset
|
3121 SAFE_ALLOCA_LISP (arg_vector, XINT (numargs));
|
|
272
|
3122 args_left = args;
|
|
|
3123
|
|
|
3124 GCPRO3 (*arg_vector, args_left, fun);
|
|
|
3125 gcpro1.nvars = 0;
|
|
|
3126
|
|
|
3127 for (i = 0; i < XINT (numargs);)
|
|
|
3128 {
|
|
|
3129 tem = Fcar (args_left), args_left = Fcdr (args_left);
|
|
|
3130 if (eval_flag) tem = Feval (tem);
|
|
|
3131 arg_vector[i++] = tem;
|
|
|
3132 gcpro1.nvars = i;
|
|
|
3133 }
|
|
|
3134
|
|
|
3135 UNGCPRO;
|
|
|
3136
|
|
|
3137 if (eval_flag)
|
|
|
3138 {
|
|
|
3139 backtrace_list->args = arg_vector;
|
|
|
3140 backtrace_list->nargs = i;
|
|
|
3141 }
|
|
|
3142 backtrace_list->evalargs = 0;
|
|
|
3143 tem = funcall_lambda (fun, XINT (numargs), arg_vector);
|
|
|
3144
|
|
|
3145 /* Do the debug-on-exit now, while arg_vector still exists. */
|
|
|
3146 if (backtrace_list->debug_on_exit)
|
|
|
3147 tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
|
|
|
3148 /* Don't do it again when we return to eval. */
|
|
|
3149 backtrace_list->debug_on_exit = 0;
|
|
109929
|
3150 SAFE_FREE ();
|
|
272
|
3151 return tem;
|
|
|
3152 }
|
|
|
3153
|
|
|
3154 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
|
|
|
3155 and return the result of evaluation.
|
|
|
3156 FUN must be either a lambda-expression or a compiled-code object. */
|
|
|
3157
|
41114
242c6928accc
(max_specpdl_size, max_lisp_eval_depth): Use EMACS_INT.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3158 static Lisp_Object
|
|
272
|
3159 funcall_lambda (fun, nargs, arg_vector)
|
|
|
3160 Lisp_Object fun;
|
|
|
3161 int nargs;
|
|
|
3162 register Lisp_Object *arg_vector;
|
|
|
3163 {
|
|
27781
|
3164 Lisp_Object val, syms_left, next;
|
|
46293
|
3165 int count = SPECPDL_INDEX ();
|
|
27781
|
3166 int i, optional, rest;
|
|
|
3167
|
|
9148
|
3168 if (CONSP (fun))
|
|
27781
|
3169 {
|
|
|
3170 syms_left = XCDR (fun);
|
|
|
3171 if (CONSP (syms_left))
|
|
|
3172 syms_left = XCAR (syms_left);
|
|
|
3173 else
|
|
71976
|
3174 xsignal1 (Qinvalid_function, fun);
|
|
27781
|
3175 }
|
|
9148
|
3176 else if (COMPILEDP (fun))
|
|
41597
|
3177 syms_left = AREF (fun, COMPILED_ARGLIST);
|
|
27781
|
3178 else
|
|
|
3179 abort ();
|
|
|
3180
|
|
|
3181 i = optional = rest = 0;
|
|
|
3182 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
|
|
272
|
3183 {
|
|
|
3184 QUIT;
|
|
49600
|
3185
|
|
27781
|
3186 next = XCAR (syms_left);
|
|
71872
|
3187 if (!SYMBOLP (next))
|
|
71976
|
3188 xsignal1 (Qinvalid_function, fun);
|
|
49600
|
3189
|
|
272
|
3190 if (EQ (next, Qand_rest))
|
|
|
3191 rest = 1;
|
|
|
3192 else if (EQ (next, Qand_optional))
|
|
|
3193 optional = 1;
|
|
|
3194 else if (rest)
|
|
|
3195 {
|
|
431
|
3196 specbind (next, Flist (nargs - i, &arg_vector[i]));
|
|
272
|
3197 i = nargs;
|
|
|
3198 }
|
|
|
3199 else if (i < nargs)
|
|
27781
|
3200 specbind (next, arg_vector[i++]);
|
|
272
|
3201 else if (!optional)
|
|
71976
|
3202 xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
|
|
272
|
3203 else
|
|
|
3204 specbind (next, Qnil);
|
|
|
3205 }
|
|
|
3206
|
|
27781
|
3207 if (!NILP (syms_left))
|
|
71976
|
3208 xsignal1 (Qinvalid_function, fun);
|
|
27781
|
3209 else if (i < nargs)
|
|
71976
|
3210 xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
|
|
272
|
3211
|
|
9148
|
3212 if (CONSP (fun))
|
|
27781
|
3213 val = Fprogn (XCDR (XCDR (fun)));
|
|
272
|
3214 else
|
|
10201
|
3215 {
|
|
|
3216 /* If we have not actually read the bytecode string
|
|
|
3217 and constants vector yet, fetch them from the file. */
|
|
41597
|
3218 if (CONSP (AREF (fun, COMPILED_BYTECODE)))
|
|
11205
|
3219 Ffetch_bytecode (fun);
|
|
41597
|
3220 val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
|
|
|
3221 AREF (fun, COMPILED_CONSTANTS),
|
|
|
3222 AREF (fun, COMPILED_STACK_DEPTH));
|
|
10201
|
3223 }
|
|
49600
|
3224
|
|
272
|
3225 return unbind_to (count, val);
|
|
|
3226 }
|
|
11205
|
3227
|
|
|
3228 DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
|
|
40570
|
3229 1, 1, 0,
|
|
|
3230 doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
|
|
|
3231 (object)
|
|
11205
|
3232 Lisp_Object object;
|
|
|
3233 {
|
|
|
3234 Lisp_Object tem;
|
|
|
3235
|
|
41597
|
3236 if (COMPILEDP (object) && CONSP (AREF (object, COMPILED_BYTECODE)))
|
|
11205
|
3237 {
|
|
41597
|
3238 tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
|
11481
af7833ecb551
(Ffetch_bytecode): Check the type of the object being read from the file.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3239 if (!CONSP (tem))
|
|
41597
|
3240 {
|
|
|
3241 tem = AREF (object, COMPILED_BYTECODE);
|
|
|
3242 if (CONSP (tem) && STRINGP (XCAR (tem)))
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3243 error ("Invalid byte code in %s", SDATA (XCAR (tem)));
|
|
41597
|
3244 else
|
|
|
3245 error ("Invalid byte code");
|
|
|
3246 }
|
|
91607
|
3247 ASET (object, COMPILED_BYTECODE, XCAR (tem));
|
|
|
3248 ASET (object, COMPILED_CONSTANTS, XCDR (tem));
|
|
11205
|
3249 }
|
|
|
3250 return object;
|
|
|
3251 }
|
|
272
|
3252
|
|
|
3253 void
|
|
|
3254 grow_specpdl ()
|
|
|
3255 {
|
|
46293
|
3256 register int count = SPECPDL_INDEX ();
|
|
272
|
3257 if (specpdl_size >= max_specpdl_size)
|
|
|
3258 {
|
|
|
3259 if (max_specpdl_size < 400)
|
|
|
3260 max_specpdl_size = 400;
|
|
|
3261 if (specpdl_size >= max_specpdl_size)
|
|
71976
|
3262 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
|
|
272
|
3263 }
|
|
|
3264 specpdl_size *= 2;
|
|
|
3265 if (specpdl_size > max_specpdl_size)
|
|
|
3266 specpdl_size = max_specpdl_size;
|
|
|
3267 specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));
|
|
|
3268 specpdl_ptr = specpdl + count;
|
|
|
3269 }
|
|
|
3270
|
|
|
3271 void
|
|
|
3272 specbind (symbol, value)
|
|
|
3273 Lisp_Object symbol, value;
|
|
|
3274 {
|
|
39577
|
3275 Lisp_Object valcontents;
|
|
272
|
3276
|
|
40656
|
3277 CHECK_SYMBOL (symbol);
|
|
272
|
3278 if (specpdl_ptr == specpdl + specpdl_size)
|
|
|
3279 grow_specpdl ();
|
|
27781
|
3280
|
|
39577
|
3281 /* The most common case is that of a non-constant symbol with a
|
|
|
3282 trivial value. Make that as fast as we can. */
|
|
|
3283 valcontents = SYMBOL_VALUE (symbol);
|
|
|
3284 if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
|
|
27295
|
3285 {
|
|
27781
|
3286 specpdl_ptr->symbol = symbol;
|
|
39577
|
3287 specpdl_ptr->old_value = valcontents;
|
|
27781
|
3288 specpdl_ptr->func = NULL;
|
|
|
3289 ++specpdl_ptr;
|
|
39577
|
3290 SET_SYMBOL_VALUE (symbol, value);
|
|
27295
|
3291 }
|
|
|
3292 else
|
|
27781
|
3293 {
|
|
86229
|
3294 Lisp_Object ovalue = find_symbol_value (symbol);
|
|
27781
|
3295 specpdl_ptr->func = 0;
|
|
|
3296 specpdl_ptr->old_value = ovalue;
|
|
|
3297
|
|
38276
|
3298 valcontents = XSYMBOL (symbol)->value;
|
|
|
3299
|
|
|
3300 if (BUFFER_LOCAL_VALUEP (valcontents)
|
|
|
3301 || BUFFER_OBJFWDP (valcontents))
|
|
27781
|
3302 {
|
|
38290
|
3303 Lisp_Object where, current_buffer;
|
|
|
3304
|
|
|
3305 current_buffer = Fcurrent_buffer ();
|
|
49600
|
3306
|
|
27781
|
3307 /* For a local variable, record both the symbol and which
|
|
38276
|
3308 buffer's or frame's value we are saving. */
|
|
|
3309 if (!NILP (Flocal_variable_p (symbol, Qnil)))
|
|
38290
|
3310 where = current_buffer;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3311 else if (BUFFER_LOCAL_VALUEP (valcontents)
|
|
38276
|
3312 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
|
|
|
3313 where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
|
|
|
3314 else
|
|
|
3315 where = Qnil;
|
|
|
3316
|
|
|
3317 /* We're not using the `unused' slot in the specbinding
|
|
|
3318 structure because this would mean we have to do more
|
|
|
3319 work for simple variables. */
|
|
38290
|
3320 specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
|
|
35394
|
3321
|
|
|
3322 /* If SYMBOL is a per-buffer variable which doesn't have a
|
|
|
3323 buffer-local value here, make the `let' change the global
|
|
|
3324 value by changing the value of SYMBOL in all buffers not
|
|
|
3325 having their own value. This is consistent with what
|
|
|
3326 happens with other buffer-local variables. */
|
|
38276
|
3327 if (NILP (where)
|
|
|
3328 && BUFFER_OBJFWDP (valcontents))
|
|
35394
|
3329 {
|
|
|
3330 ++specpdl_ptr;
|
|
|
3331 Fset_default (symbol, value);
|
|
|
3332 return;
|
|
|
3333 }
|
|
27781
|
3334 }
|
|
|
3335 else
|
|
|
3336 specpdl_ptr->symbol = symbol;
|
|
|
3337
|
|
|
3338 specpdl_ptr++;
|
|
86229
|
3339 /* We used to do
|
|
|
3340 if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
|
|
|
3341 store_symval_forwarding (symbol, ovalue, value, NULL);
|
|
|
3342 else
|
|
|
3343 but ovalue comes from find_symbol_value which should never return
|
|
|
3344 such an internal value. */
|
|
|
3345 eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)));
|
|
|
3346 set_internal (symbol, value, 0, 1);
|
|
27781
|
3347 }
|
|
272
|
3348 }
|
|
|
3349
|
|
|
3350 void
|
|
|
3351 record_unwind_protect (function, arg)
|
|
20312
|
3352 Lisp_Object (*function) P_ ((Lisp_Object));
|
|
272
|
3353 Lisp_Object arg;
|
|
|
3354 {
|
|
69152
|
3355 eassert (!handling_signal);
|
|
|
3356
|
|
272
|
3357 if (specpdl_ptr == specpdl + specpdl_size)
|
|
|
3358 grow_specpdl ();
|
|
|
3359 specpdl_ptr->func = function;
|
|
|
3360 specpdl_ptr->symbol = Qnil;
|
|
|
3361 specpdl_ptr->old_value = arg;
|
|
|
3362 specpdl_ptr++;
|
|
|
3363 }
|
|
|
3364
|
|
|
3365 Lisp_Object
|
|
|
3366 unbind_to (count, value)
|
|
|
3367 int count;
|
|
|
3368 Lisp_Object value;
|
|
|
3369 {
|
|
62980
|
3370 Lisp_Object quitf = Vquit_flag;
|
|
|
3371 struct gcpro gcpro1, gcpro2;
|
|
|
3372
|
|
|
3373 GCPRO2 (value, quitf);
|
|
272
|
3374 Vquit_flag = Qnil;
|
|
|
3375
|
|
|
3376 while (specpdl_ptr != specpdl + count)
|
|
|
3377 {
|
|
50919
|
3378 /* Copy the binding, and decrement specpdl_ptr, before we do
|
|
|
3379 the work to unbind it. We decrement first
|
|
|
3380 so that an error in unbinding won't try to unbind
|
|
|
3381 the same entry again, and we copy the binding first
|
|
|
3382 in case more bindings are made during some of the code we run. */
|
|
|
3383
|
|
51294
|
3384 struct specbinding this_binding;
|
|
|
3385 this_binding = *--specpdl_ptr;
|
|
50919
|
3386
|
|
|
3387 if (this_binding.func != 0)
|
|
|
3388 (*this_binding.func) (this_binding.old_value);
|
|
38290
|
3389 /* If the symbol is a list, it is really (SYMBOL WHERE
|
|
|
3390 . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
|
|
|
3391 frame. If WHERE is a buffer or frame, this indicates we
|
|
40661
|
3392 bound a variable that had a buffer-local or frame-local
|
|
|
3393 binding. WHERE nil means that the variable had the default
|
|
38290
|
3394 value when it was bound. CURRENT-BUFFER is the buffer that
|
|
|
3395 was current when the variable was bound. */
|
|
50919
|
3396 else if (CONSP (this_binding.symbol))
|
|
27295
|
3397 {
|
|
38276
|
3398 Lisp_Object symbol, where;
|
|
27295
|
3399
|
|
50919
|
3400 symbol = XCAR (this_binding.symbol);
|
|
|
3401 where = XCAR (XCDR (this_binding.symbol));
|
|
38276
|
3402
|
|
|
3403 if (NILP (where))
|
|
50919
|
3404 Fset_default (symbol, this_binding.old_value);
|
|
38276
|
3405 else if (BUFFERP (where))
|
|
50919
|
3406 set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
|
|
49600
|
3407 else
|
|
50919
|
3408 set_internal (symbol, this_binding.old_value, NULL, 1);
|
|
27295
|
3409 }
|
|
272
|
3410 else
|
|
27781
|
3411 {
|
|
|
3412 /* If variable has a trivial value (no forwarding), we can
|
|
|
3413 just set it. No need to check for constant symbols here,
|
|
|
3414 since that was already done by specbind. */
|
|
50919
|
3415 if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
|
|
|
3416 SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
|
|
27781
|
3417 else
|
|
50919
|
3418 set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
|
|
27781
|
3419 }
|
|
272
|
3420 }
|
|
49600
|
3421
|
|
62980
|
3422 if (NILP (Vquit_flag) && !NILP (quitf))
|
|
|
3423 Vquit_flag = quitf;
|
|
272
|
3424
|
|
|
3425 UNGCPRO;
|
|
|
3426 return value;
|
|
|
3427 }
|
|
|
3428
|
|
|
3429 DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
|
|
40570
|
3430 doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
|
|
|
3431 The debugger is entered when that frame exits, if the flag is non-nil. */)
|
|
|
3432 (level, flag)
|
|
272
|
3433 Lisp_Object level, flag;
|
|
|
3434 {
|
|
|
3435 register struct backtrace *backlist = backtrace_list;
|
|
|
3436 register int i;
|
|
|
3437
|
|
40656
|
3438 CHECK_NUMBER (level);
|
|
272
|
3439
|
|
|
3440 for (i = 0; backlist && i < XINT (level); i++)
|
|
|
3441 {
|
|
|
3442 backlist = backlist->next;
|
|
|
3443 }
|
|
|
3444
|
|
|
3445 if (backlist)
|
|
485
|
3446 backlist->debug_on_exit = !NILP (flag);
|
|
272
|
3447
|
|
|
3448 return flag;
|
|
|
3449 }
|
|
|
3450
|
|
|
3451 DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
|
|
40570
|
3452 doc: /* Print a trace of Lisp function calls currently active.
|
|
|
3453 Output stream used is value of `standard-output'. */)
|
|
|
3454 ()
|
|
272
|
3455 {
|
|
|
3456 register struct backtrace *backlist = backtrace_list;
|
|
|
3457 register int i;
|
|
|
3458 Lisp_Object tail;
|
|
|
3459 Lisp_Object tem;
|
|
|
3460 extern Lisp_Object Vprint_level;
|
|
|
3461 struct gcpro gcpro1;
|
|
|
3462
|
9306
ac852c183fa1
(Feval, Ffuncall, funcall_lambda, Fbacktrace): Don't use XFASTINT as an
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3463 XSETFASTINT (Vprint_level, 3);
|
|
272
|
3464
|
|
|
3465 tail = Qnil;
|
|
|
3466 GCPRO1 (tail);
|
|
|
3467
|
|
|
3468 while (backlist)
|
|
|
3469 {
|
|
|
3470 write_string (backlist->debug_on_exit ? "* " : " ", 2);
|
|
|
3471 if (backlist->nargs == UNEVALLED)
|
|
|
3472 {
|
|
|
3473 Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
|
|
7533
|
3474 write_string ("\n", -1);
|
|
272
|
3475 }
|
|
|
3476 else
|
|
|
3477 {
|
|
|
3478 tem = *backlist->function;
|
|
|
3479 Fprin1 (tem, Qnil); /* This can QUIT */
|
|
|
3480 write_string ("(", -1);
|
|
|
3481 if (backlist->nargs == MANY)
|
|
|
3482 {
|
|
|
3483 for (tail = *backlist->args, i = 0;
|
|
485
|
3484 !NILP (tail);
|
|
272
|
3485 tail = Fcdr (tail), i++)
|
|
|
3486 {
|
|
|
3487 if (i) write_string (" ", -1);
|
|
|
3488 Fprin1 (Fcar (tail), Qnil);
|
|
|
3489 }
|
|
|
3490 }
|
|
|
3491 else
|
|
|
3492 {
|
|
|
3493 for (i = 0; i < backlist->nargs; i++)
|
|
|
3494 {
|
|
|
3495 if (i) write_string (" ", -1);
|
|
|
3496 Fprin1 (backlist->args[i], Qnil);
|
|
|
3497 }
|
|
|
3498 }
|
|
7533
|
3499 write_string (")\n", -1);
|
|
272
|
3500 }
|
|
|
3501 backlist = backlist->next;
|
|
|
3502 }
|
|
|
3503
|
|
|
3504 Vprint_level = Qnil;
|
|
|
3505 UNGCPRO;
|
|
|
3506 return Qnil;
|
|
|
3507 }
|
|
|
3508
|
|
32657
|
3509 DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
|
|
40570
|
3510 doc: /* Return the function and arguments NFRAMES up from current execution point.
|
|
|
3511 If that frame has not evaluated the arguments yet (or is a special form),
|
|
|
3512 the value is (nil FUNCTION ARG-FORMS...).
|
|
|
3513 If that frame has evaluated its arguments and called its function already,
|
|
|
3514 the value is (t FUNCTION ARG-VALUES...).
|
|
|
3515 A &rest arg is represented as the tail of the list ARG-VALUES.
|
|
|
3516 FUNCTION is whatever was supplied as car of evaluated list,
|
|
|
3517 or a lambda expression for macro calls.
|
|
|
3518 If NFRAMES is more than the number of frames, the value is nil. */)
|
|
|
3519 (nframes)
|
|
272
|
3520 Lisp_Object nframes;
|
|
|
3521 {
|
|
|
3522 register struct backtrace *backlist = backtrace_list;
|
|
|
3523 register int i;
|
|
|
3524 Lisp_Object tem;
|
|
|
3525
|
|
40656
|
3526 CHECK_NATNUM (nframes);
|
|
272
|
3527
|
|
|
3528 /* Find the frame requested. */
|
|
7533
|
3529 for (i = 0; backlist && i < XFASTINT (nframes); i++)
|
|
272
|
3530 backlist = backlist->next;
|
|
|
3531
|
|
|
3532 if (!backlist)
|
|
|
3533 return Qnil;
|
|
|
3534 if (backlist->nargs == UNEVALLED)
|
|
|
3535 return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
|
|
|
3536 else
|
|
|
3537 {
|
|
|
3538 if (backlist->nargs == MANY)
|
|
|
3539 tem = *backlist->args;
|
|
|
3540 else
|
|
|
3541 tem = Flist (backlist->nargs, backlist->args);
|
|
|
3542
|
|
|
3543 return Fcons (Qt, Fcons (*backlist->function, tem));
|
|
|
3544 }
|
|
|
3545 }
|
|
30073
|
3546
|
|
272
|
3547
|
|
21514
|
3548 void
|
|
55796
|
3549 mark_backtrace ()
|
|
|
3550 {
|
|
|
3551 register struct backtrace *backlist;
|
|
|
3552 register int i;
|
|
|
3553
|
|
|
3554 for (backlist = backtrace_list; backlist; backlist = backlist->next)
|
|
|
3555 {
|
|
|
3556 mark_object (*backlist->function);
|
|
|
3557
|
|
|
3558 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
|
|
|
3559 i = 0;
|
|
|
3560 else
|
|
|
3561 i = backlist->nargs - 1;
|
|
|
3562 for (; i >= 0; i--)
|
|
|
3563 mark_object (backlist->args[i]);
|
|
|
3564 }
|
|
|
3565 }
|
|
|
3566
|
|
|
3567 void
|
|
272
|
3568 syms_of_eval ()
|
|
|
3569 {
|
|
|
3570 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
|
64499
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3571 doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
|
|
63767
|
3572 If Lisp code tries to increase the total number past this amount,
|
|
45560
|
3573 an error is signaled.
|
|
|
3574 You can safely use a value considerably larger than the default value,
|
|
|
3575 if that proves inconveniently small. However, if you increase it too far,
|
|
|
3576 Emacs could run out of memory trying to make the stack bigger. */);
|
|
272
|
3577
|
|
|
3578 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
|
|
40570
|
3579 doc: /* *Limit on depth in `eval', `apply' and `funcall' before error.
|
|
45560
|
3580
|
|
|
3581 This limit serves to catch infinite recursions for you before they cause
|
|
40570
|
3582 actual stack overflow in C, which would be fatal for Emacs.
|
|
|
3583 You can safely make it considerably larger than its default value,
|
|
45560
|
3584 if that proves inconveniently small. However, if you increase it too far,
|
|
|
3585 Emacs could overflow the real C stack, and crash. */);
|
|
272
|
3586
|
|
|
3587 DEFVAR_LISP ("quit-flag", &Vquit_flag,
|
|
40570
|
3588 doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
|
|
58933
|
3589 If the value is t, that means do an ordinary quit.
|
|
|
3590 If the value equals `throw-on-input', that means quit by throwing
|
|
|
3591 to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
|
|
|
3592 Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
|
|
|
3593 but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
|
|
272
|
3594 Vquit_flag = Qnil;
|
|
|
3595
|
|
|
3596 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
|
|
40570
|
3597 doc: /* Non-nil inhibits C-g quitting from happening immediately.
|
|
|
3598 Note that `quit-flag' will still be set by typing C-g,
|
|
|
3599 so a quit will be signaled as soon as `inhibit-quit' is nil.
|
|
|
3600 To prevent this happening, set `quit-flag' to nil
|
|
|
3601 before making `inhibit-quit' nil. */);
|
|
272
|
3602 Vinhibit_quit = Qnil;
|
|
|
3603
|
|
105877
|
3604 Qinhibit_quit = intern_c_string ("inhibit-quit");
|
|
381
|
3605 staticpro (&Qinhibit_quit);
|
|
|
3606
|
|
105877
|
3607 Qautoload = intern_c_string ("autoload");
|
|
272
|
3608 staticpro (&Qautoload);
|
|
|
3609
|
|
105877
|
3610 Qdebug_on_error = intern_c_string ("debug-on-error");
|
|
272
|
3611 staticpro (&Qdebug_on_error);
|
|
|
3612
|
|
105877
|
3613 Qmacro = intern_c_string ("macro");
|
|
272
|
3614 staticpro (&Qmacro);
|
|
|
3615
|
|
105877
|
3616 Qdeclare = intern_c_string ("declare");
|
|
44132
|
3617 staticpro (&Qdeclare);
|
|
49600
|
3618
|
|
272
|
3619 /* Note that the process handling also uses Qexit, but we don't want
|
|
|
3620 to staticpro it twice, so we just do it here. */
|
|
105877
|
3621 Qexit = intern_c_string ("exit");
|
|
272
|
3622 staticpro (&Qexit);
|
|
|
3623
|
|
105877
|
3624 Qinteractive = intern_c_string ("interactive");
|
|
272
|
3625 staticpro (&Qinteractive);
|
|
|
3626
|
|
105877
|
3627 Qcommandp = intern_c_string ("commandp");
|
|
272
|
3628 staticpro (&Qcommandp);
|
|
|
3629
|
|
105877
|
3630 Qdefun = intern_c_string ("defun");
|
|
272
|
3631 staticpro (&Qdefun);
|
|
|
3632
|
|
105877
|
3633 Qand_rest = intern_c_string ("&rest");
|
|
272
|
3634 staticpro (&Qand_rest);
|
|
|
3635
|
|
105877
|
3636 Qand_optional = intern_c_string ("&optional");
|
|
272
|
3637 staticpro (&Qand_optional);
|
|
|
3638
|
|
105877
|
3639 Qdebug = intern_c_string ("debug");
|
|
78141
|
3640 staticpro (&Qdebug);
|
|
|
3641
|
|
684
|
3642 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
|
|
41029
|
3643 doc: /* *Non-nil means errors display a backtrace buffer.
|
|
|
3644 More precisely, this happens for any error that is handled
|
|
|
3645 by the editor command loop.
|
|
40570
|
3646 If the value is a list, an error only means to display a backtrace
|
|
|
3647 if one of its condition symbols appears in the list. */);
|
|
684
|
3648 Vstack_trace_on_error = Qnil;
|
|
272
|
3649
|
|
684
|
3650 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error,
|
|
40570
|
3651 doc: /* *Non-nil means enter debugger if an error is signaled.
|
|
|
3652 Does not apply to errors handled by `condition-case' or those
|
|
|
3653 matched by `debug-ignored-errors'.
|
|
|
3654 If the value is a list, an error only means to enter the debugger
|
|
|
3655 if one of its condition symbols appears in the list.
|
|
|
3656 When you evaluate an expression interactively, this variable
|
|
|
3657 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
|
|
100243
|
3658 The command `toggle-debug-on-error' toggles this.
|
|
|
3659 See also the variable `debug-on-quit'. */);
|
|
684
|
3660 Vdebug_on_error = Qnil;
|
|
272
|
3661
|
|
13768
|
3662 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,
|
|
40570
|
3663 doc: /* *List of errors for which the debugger should not be called.
|
|
|
3664 Each element may be a condition-name or a regexp that matches error messages.
|
|
|
3665 If any element applies to a given error, that error skips the debugger
|
|
|
3666 and just returns to top level.
|
|
|
3667 This overrides the variable `debug-on-error'.
|
|
|
3668 It does not apply to errors handled by `condition-case'. */);
|
|
13768
|
3669 Vdebug_ignored_errors = Qnil;
|
|
|
3670
|
|
272
|
3671 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
|
64499
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3672 doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
|
34bf5187c5aa
(Fprog2, Fcalled_interactively_p), (syms_of_eval) <debug-on-quit>: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3673 Does not apply if quit is handled by a `condition-case'. */);
|
|
272
|
3674 debug_on_quit = 0;
|
|
|
3675
|
|
|
3676 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
|
|
40570
|
3677 doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
|
|
272
|
3678
|
|
26947
|
3679 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue,
|
|
40570
|
3680 doc: /* Non-nil means debugger may continue execution.
|
|
|
3681 This is nil when the debugger is called under circumstances where it
|
|
|
3682 might not be safe to continue. */);
|
|
27031
|
3683 debugger_may_continue = 1;
|
|
26947
|
3684
|
|
272
|
3685 DEFVAR_LISP ("debugger", &Vdebugger,
|
|
40570
|
3686 doc: /* Function to call to invoke debugger.
|
|
|
3687 If due to frame exit, args are `exit' and the value being returned;
|
|
|
3688 this function's value will be returned instead of that.
|
|
|
3689 If due to error, args are `error' and a list of the args to `signal'.
|
|
|
3690 If due to `apply' or `funcall' entry, one arg, `lambda'.
|
|
|
3691 If due to `eval' entry, one arg, t. */);
|
|
272
|
3692 Vdebugger = Qnil;
|
|
|
3693
|
|
16355
|
3694 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function,
|
|
40570
|
3695 doc: /* If non-nil, this is a function for `signal' to call.
|
|
|
3696 It receives the same arguments that `signal' was given.
|
|
|
3697 The Edebug package uses this to regain control. */);
|
|
16355
|
3698 Vsignal_hook_function = Qnil;
|
|
|
3699
|
|
16443
|
3700 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,
|
|
40570
|
3701 doc: /* *Non-nil means call the debugger regardless of condition handlers.
|
|
|
3702 Note that `debug-on-error', `debug-on-quit' and friends
|
|
|
3703 still determine whether to handle the particular condition. */);
|
|
16443
|
3704 Vdebug_on_signal = Qnil;
|
|
16355
|
3705
|
|
44132
|
3706 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function,
|
|
|
3707 doc: /* Function to process declarations in a macro definition.
|
|
|
3708 The function will be called with two args MACRO and DECL.
|
|
|
3709 MACRO is the name of the macro being defined.
|
|
|
3710 DECL is a list `(declare ...)' containing the declarations.
|
|
|
3711 The value the function returns is not used. */);
|
|
|
3712 Vmacro_declaration_function = Qnil;
|
|
|
3713
|
|
105877
|
3714 Vrun_hooks = intern_c_string ("run-hooks");
|
|
16296
|
3715 staticpro (&Vrun_hooks);
|
|
272
|
3716
|
|
|
3717 staticpro (&Vautoload_queue);
|
|
|
3718 Vautoload_queue = Qnil;
|
|
30073
|
3719 staticpro (&Vsignaling_function);
|
|
|
3720 Vsignaling_function = Qnil;
|
|
272
|
3721
|
|
|
3722 defsubr (&Sor);
|
|
|
3723 defsubr (&Sand);
|
|
|
3724 defsubr (&Sif);
|
|
|
3725 defsubr (&Scond);
|
|
|
3726 defsubr (&Sprogn);
|
|
|
3727 defsubr (&Sprog1);
|
|
|
3728 defsubr (&Sprog2);
|
|
|
3729 defsubr (&Ssetq);
|
|
|
3730 defsubr (&Squote);
|
|
|
3731 defsubr (&Sfunction);
|
|
|
3732 defsubr (&Sdefun);
|
|
|
3733 defsubr (&Sdefmacro);
|
|
|
3734 defsubr (&Sdefvar);
|
|
39577
|
3735 defsubr (&Sdefvaralias);
|
|
272
|
3736 defsubr (&Sdefconst);
|
|
|
3737 defsubr (&Suser_variable_p);
|
|
|
3738 defsubr (&Slet);
|
|
|
3739 defsubr (&SletX);
|
|
|
3740 defsubr (&Swhile);
|
|
|
3741 defsubr (&Smacroexpand);
|
|
|
3742 defsubr (&Scatch);
|
|
|
3743 defsubr (&Sthrow);
|
|
|
3744 defsubr (&Sunwind_protect);
|
|
|
3745 defsubr (&Scondition_case);
|
|
|
3746 defsubr (&Ssignal);
|
|
|
3747 defsubr (&Sinteractive_p);
|
|
57889
|
3748 defsubr (&Scalled_interactively_p);
|
|
272
|
3749 defsubr (&Scommandp);
|
|
|
3750 defsubr (&Sautoload);
|
|
|
3751 defsubr (&Seval);
|
|
|
3752 defsubr (&Sapply);
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3753 defsubr (&Sfuncall);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3754 defsubr (&Srun_hooks);
|
|
12711
|
3755 defsubr (&Srun_hook_with_args);
|
12732
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3756 defsubr (&Srun_hook_with_args_until_success);
|
981b924c832b
Add Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure in terms of run_hook_with_args.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3757 defsubr (&Srun_hook_with_args_until_failure);
|
|
11205
|
3758 defsubr (&Sfetch_bytecode);
|
|
272
|
3759 defsubr (&Sbacktrace_debug);
|
|
|
3760 defsubr (&Sbacktrace);
|
|
|
3761 defsubr (&Sbacktrace_frame);
|
|
|
3762 }
|
|
52401
|
3763
|
|
|
3764 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
|
|
|
3765 (do not change this comment) */
|
