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