Mercurial > hg > xemacs-beta
annotate src/callint.c @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 05 Aug 2013 10:05:32 +0100 |
parents | 56144c8593a8 |
children |
rev | line source |
---|---|
428 | 1 /* Call a Lisp function interactively. |
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. | |
793 | 3 Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4744
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
428 | 8 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4744
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4744
diff
changeset
|
10 option) any later version. |
428 | 11 |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4744
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
428 | 19 |
20 /* Synched up with: FSF 19.30, Mule 2.0. */ | |
21 | |
22 /* Authorship: | |
23 | |
24 FSF: long ago. | |
25 Mly or JWZ: various changes. | |
26 */ | |
27 | |
28 #include <config.h> | |
29 #include "lisp.h" | |
30 | |
31 #include "buffer.h" | |
32 #include "bytecode.h" | |
33 #include "commands.h" | |
34 #include "events.h" | |
35 #include "insdel.h" | |
872 | 36 #include "window-impl.h" /* WINDOW_MINI_P */ |
428 | 37 |
1204 | 38 extern Charcount num_input_chars; |
428 | 39 |
40 Lisp_Object Vcurrent_prefix_arg; | |
41 Lisp_Object Qcall_interactively; | |
42 Lisp_Object Vcommand_history; | |
43 | |
44 Lisp_Object Vcommand_debug_status, Qcommand_debug_status; | |
45 Lisp_Object Qenable_recursive_minibuffers; | |
46 | |
47 #if 0 /* FSFmacs */ | |
48 /* Non-nil means treat the mark as active | |
49 even if mark_active is 0. */ | |
50 Lisp_Object Vmark_even_if_inactive; | |
51 #endif | |
52 | |
53 #if 0 /* ill-conceived */ | |
444 | 54 /* FSF calls Qmouse_leave_buffer_hook at all sorts of random places, |
55 including a bunch of places in their mouse.el. If this is | |
56 implemented, it has to be done cleanly. */ | |
428 | 57 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; |
58 #endif | |
59 | |
442 | 60 Lisp_Object QletX, Qsave_excursion; |
428 | 61 |
62 Lisp_Object Qread_from_minibuffer; | |
63 Lisp_Object Qread_file_name; | |
64 Lisp_Object Qread_directory_name; | |
65 Lisp_Object Qcompleting_read; | |
66 Lisp_Object Qread_buffer; | |
67 Lisp_Object Qread_function; | |
68 Lisp_Object Qread_variable; | |
69 Lisp_Object Qread_expression; | |
70 Lisp_Object Qread_command; | |
71 Lisp_Object Qread_number; | |
72 Lisp_Object Qread_string; | |
73 Lisp_Object Qevents_to_keys; | |
74 | |
75 Lisp_Object Qread_coding_system; | |
76 Lisp_Object Qread_non_nil_coding_system; | |
77 | |
78 /* ARGSUSED */ | |
79 DEFUN ("interactive", Finteractive, 0, UNEVALLED, 0, /* | |
80 Specify a way of parsing arguments for interactive use of a function. | |
81 For example, write | |
82 (defun foo (arg) "Doc string" (interactive "p") ...use arg...) | |
83 to make ARG be the prefix argument when `foo' is called as a command. | |
84 The "call" to `interactive' is actually a declaration rather than a function; | |
85 it tells `call-interactively' how to read arguments | |
86 to pass to the function. | |
4644
b0ae008bf1a0
Documentment placement restriction. <87d490jb7v.fsf@uwakimon.sk.tsukuba.ac.jp>
Stephen J. Turnbull <stephen@xemacs.org>
parents:
2367
diff
changeset
|
87 The interactive form must appear at the top level of the function body. If |
b0ae008bf1a0
Documentment placement restriction. <87d490jb7v.fsf@uwakimon.sk.tsukuba.ac.jp>
Stephen J. Turnbull <stephen@xemacs.org>
parents:
2367
diff
changeset
|
88 it is wrapped in a `let' or `progn' or similar, Lisp will not even realize |
b0ae008bf1a0
Documentment placement restriction. <87d490jb7v.fsf@uwakimon.sk.tsukuba.ac.jp>
Stephen J. Turnbull <stephen@xemacs.org>
parents:
2367
diff
changeset
|
89 the function is an interactive command! |
428 | 90 When actually called, `interactive' just returns nil. |
91 | |
92 The argument of `interactive' is usually a string containing a code letter | |
93 followed by a prompt. (Some code letters do not use I/O to get | |
94 the argument and do not need prompts.) To prompt for multiple arguments, | |
95 give a code letter, its prompt, a newline, and another code letter, etc. | |
96 Prompts are passed to format, and may use % escapes to print the | |
97 arguments that have already been read. | |
98 If the argument is not a string, it is evaluated to get a list of | |
99 arguments to pass to the function. | |
100 Just `(interactive)' means pass no args when calling interactively. | |
101 | |
102 Code letters available are: | |
103 a -- Function name: symbol with a function definition. | |
104 b -- Name of existing buffer. | |
105 B -- Name of buffer, possibly nonexistent. | |
106 c -- Character. | |
107 C -- Command name: symbol with interactive function definition. | |
108 d -- Value of point as number. Does not do I/O. | |
109 D -- Directory name. | |
110 e -- Last mouse-button or misc-user event that invoked this command. | |
111 If used more than once, the Nth `e' returns the Nth such event. | |
112 Does not do I/O. | |
113 f -- Existing file name. | |
114 F -- Possibly nonexistent file name. | |
115 i -- Always nil, ignore. Use to skip arguments when interactive. | |
116 k -- Key sequence (a vector of events). | |
117 K -- Key sequence to be redefined (do not automatically down-case). | |
118 m -- Value of mark as number. Does not do I/O. | |
119 n -- Number read using minibuffer. | |
120 N -- Prefix arg converted to number, or if none, do like code `n'. | |
121 p -- Prefix arg converted to number. Does not do I/O. | |
122 P -- Prefix arg in raw form. Does not do I/O. | |
123 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O. | |
124 s -- Any string. | |
125 S -- Any symbol. | |
126 v -- Variable name: symbol that is user-variable-p. | |
127 x -- Lisp expression read but not evaluated. | |
128 X -- Lisp expression read and evaluated. | |
129 z -- Coding system. (Always nil if no Mule support.) | |
130 Z -- Coding system, nil if no prefix arg. (Always nil if no Mule support.) | |
131 In addition, if the string begins with `*' | |
132 then an error is signaled if the buffer is read-only. | |
133 This happens before reading any arguments. | |
134 If the string begins with `@', then the window the mouse is over is selected | |
135 before anything else is done. | |
136 If the string begins with `_', then this command will not cause the region | |
137 to be deactivated when it completes; that is, `zmacs-region-stays' will be | |
138 set to t when the command exits successfully. | |
139 You may use any of `@', `*' and `_' at the beginning of the string; | |
140 they are processed in the order that they appear. | |
502 | 141 |
142 | |
143 When writing your own interactive spec, it can be useful to know the | |
144 equivalent Lisp expressions for the various code letters. They are: | |
145 | |
146 a -- (read-function "PROMPT") | |
147 b -- (let ((def (current-buffer))) | |
148 (if (eq (selected-window) (active-minibuffer-window)) | |
149 (setq def (other-buffer def)) | |
150 (read-buffer "PROMPT" def t))) | |
151 B -- (read-buffer "PROMPT" (other-buffer (current-buffer))) | |
152 c -- (prog1 | |
153 (let ((cursor-in-echo-area t)) | |
154 (message "%s" "PROMPT") | |
155 (read-char)) | |
156 (message nil)) | |
157 C -- (read-command "PROMPT") | |
158 d -- (point) | |
159 D -- (read-directory-name "PROMPT" nil default-directory t) | |
160 e -- current-mouse-event ;; #### not quite right. needs access to the KEYS | |
161 ;; argument of `call-interactively', but that's | |
162 ;; currently impossible. | |
163 f -- (read-file-name "PROMPT" nil nil 0) | |
164 F -- (read-file-name "PROMPT") | |
165 i -- nil | |
166 k -- (read-key-sequence "PROMPT") | |
167 K -- (read-key-sequence "PROMPT" nil t) | |
168 m -- (mark) | |
169 n -- (read-number "PROMPT") | |
170 N -- (if current-prefix-arg | |
171 (prefix-numeric-value current-prefix-arg) | |
172 (read-number "PROMPT")) | |
173 p -- (prefix-numeric-value current-prefix-arg) | |
174 P -- current-prefix-arg | |
175 r -- (if (and zmacs-regions (not zmacs-region-active-p)) | |
176 (error "The region is not active now")) | |
177 (let ((tem (marker-buffer (mark-marker t)))) | |
178 (unless (and tem (eq tem (current-buffer))) | |
179 (error "The mark is now set now"))) | |
180 (region-beginning) + | |
181 (region-end) | |
182 s -- (read-string "PROMPT") | |
183 S -- (let (tem prev-tem) | |
184 (while (not tem) | |
185 (setq tem (completing-read "PROMPT" obarray nil nil prev-tem)) | |
186 (setq prev-tem tem) | |
187 (setq tem (intern tem)) | |
188 (if (= (length tem) 0) | |
189 (setq tem nil)))) | |
190 v -- (read-variable "PROMPT") | |
191 x -- (read-expression "PROMPT") | |
192 X -- (eval (read-expression "PROMPT")) | |
193 z -- (and (fboundp 'read-coding-system) (read-coding-system "PROMPT")) | |
194 Z -- (and current-prefix-arg (fboundp 'read-coding-system) | |
195 (read-coding-system "PROMPT")) | |
196 | |
197 `*' (barf-if-buffer-read-only) | |
198 `@' (let ((event current-mouse-event)) ;; #### not quite right; needs the | |
199 (when event ;; value from the `e' spec above. | |
200 (let ((window event-window event)) | |
201 (when window | |
202 (if (and (window-minibuffer-p window) | |
203 (not (and (> (minibuffer-depth) 0) | |
204 (eq window (active-minibuffer-window))))) | |
205 (error "Attempt to select inactive minibuffer window")) | |
206 (select window))))) | |
4652 | 207 `_' (setq zmacs-region-stays t) *//* FIXME: moving end of previous comment |
208 to a separate line causes docstring lossage! */ | |
2286 | 209 (UNUSED (args))) |
428 | 210 { |
211 return Qnil; | |
212 } | |
213 | |
214 /* Modify EXPR by quotifying each element (except the first). */ | |
215 static Lisp_Object | |
216 quotify_args (Lisp_Object expr) | |
217 { | |
2367 | 218 EXTERNAL_LIST_LOOP_3 (elt, expr, tail) |
219 XSETCAR (tail, Fquote_maybe (elt)); | |
428 | 220 return expr; |
221 } | |
222 | |
665 | 223 static Charbpos |
428 | 224 check_mark (void) |
225 { | |
226 Lisp_Object tem; | |
227 | |
228 if (zmacs_regions && !zmacs_region_active_p) | |
563 | 229 invalid_operation ("The region is not active now", Qunbound); |
428 | 230 |
231 tem = Fmarker_buffer (current_buffer->mark); | |
232 if (NILP (tem) || (XBUFFER (tem) != current_buffer)) | |
563 | 233 invalid_operation ("The mark is not set now", Qunbound); |
428 | 234 |
235 return marker_position (current_buffer->mark); | |
236 } | |
237 | |
238 static Lisp_Object | |
867 | 239 callint_prompt (const Ibyte *prompt_start, Bytecount prompt_length, |
442 | 240 const Lisp_Object *args, int nargs) |
428 | 241 { |
242 Lisp_Object s = make_string (prompt_start, prompt_length); | |
243 struct gcpro gcpro1; | |
244 | |
245 /* Fformat no longer smashes its arg vector, so no need to copy it. */ | |
246 | |
247 if (!strchr ((char *) XSTRING_DATA (s), '%')) | |
248 return s; | |
249 GCPRO1 (s); | |
771 | 250 RETURN_UNGCPRO (emacs_vsprintf_string_lisp (0, s, nargs, args)); |
428 | 251 } |
252 | |
253 /* `lambda' for RECORD-FLAG is an XEmacs addition. */ | |
254 | |
255 DEFUN ("call-interactively", Fcall_interactively, 1, 3, 0, /* | |
256 Call FUNCTION, reading args according to its interactive calling specs. | |
257 Return the value FUNCTION returns. | |
258 The function contains a specification of how to do the argument reading. | |
259 In the case of user-defined functions, this is specified by placing a call | |
260 to the function `interactive' at the top level of the function body. | |
261 See `interactive'. | |
262 | |
263 If optional second arg RECORD-FLAG is the symbol `lambda', the interactive | |
264 calling arguments for FUNCTION are read and returned as a list, | |
265 but the function is not called on them. | |
266 | |
267 If RECORD-FLAG is `t' then unconditionally put this command in the | |
268 command-history. Otherwise, this is done only if an arg is read using | |
269 the minibuffer. | |
270 | |
271 The argument KEYS specifies the value to use instead of (this-command-keys) | |
272 when reading the arguments. | |
273 */ | |
274 (function, record_flag, keys)) | |
275 { | |
276 /* This function can GC */ | |
277 int speccount = specpdl_depth (); | |
278 Lisp_Object prefix; | |
279 | |
280 Lisp_Object fun; | |
281 Lisp_Object specs = Qnil; | |
282 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS | |
283 Lisp_Object enable; | |
284 #endif | |
793 | 285 /* If SPECS is a string, we reset prompt_data to XSTRING_DATA (specs) |
286 every time a GC might have occurred */ | |
442 | 287 const char *prompt_data = 0; |
428 | 288 int prompt_index = 0; |
289 int argcount; | |
290 int set_zmacs_region_stays = 0; | |
291 int mouse_event_count = 0; | |
292 | |
293 if (!NILP (keys)) | |
294 { | |
295 int i, len; | |
296 | |
297 CHECK_VECTOR (keys); | |
298 len = XVECTOR_LENGTH (keys); | |
299 for (i = 0; i < len; i++) | |
300 CHECK_LIVE_EVENT (XVECTOR_DATA (keys)[i]); | |
301 } | |
302 | |
303 /* Save this now, since use of minibuffer will clobber it. */ | |
304 prefix = Vcurrent_prefix_arg; | |
305 | |
306 retry: | |
307 | |
308 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS | |
309 /* Marginal kludge. Use an evaluated interactive spec instead of this! */ | |
310 if (SYMBOLP (function)) | |
311 enable = Fget (function, Qenable_recursive_minibuffers, Qnil); | |
312 #endif | |
313 | |
314 fun = indirect_function (function, 1); | |
315 | |
316 /* Decode the kind of function. Either handle it and return, | |
317 or go to `lose' if not interactive, or go to `retry' | |
318 to specify a different function, or set either PROMPT_DATA or SPECS. */ | |
319 | |
320 if (SUBRP (fun)) | |
321 { | |
322 prompt_data = XSUBR (fun)->prompt; | |
323 if (!prompt_data) | |
324 { | |
325 lose: | |
326 function = wrong_type_argument (Qcommandp, function); | |
327 goto retry; | |
328 } | |
329 #if 0 /* FSFmacs */ /* Huh? Where is this used? */ | |
330 if ((EMACS_INT) prompt_data == 1) | |
331 /* Let SPECS (which is nil) be used as the args. */ | |
332 prompt_data = 0; | |
333 #endif | |
334 } | |
335 else if (COMPILED_FUNCTIONP (fun)) | |
336 { | |
337 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); | |
338 if (! f->flags.interactivep) | |
339 goto lose; | |
340 specs = compiled_function_interactive (f); | |
341 } | |
342 else if (!CONSP (fun)) | |
343 goto lose; | |
344 else | |
345 { | |
346 Lisp_Object funcar = Fcar (fun); | |
347 | |
348 if (EQ (funcar, Qautoload)) | |
349 { | |
970 | 350 struct gcpro gcpro1; |
351 GCPRO1 (prefix); | |
352 /* do_autoload GCPROs both arguments */ | |
428 | 353 do_autoload (fun, function); |
354 UNGCPRO; | |
355 goto retry; | |
356 } | |
357 else if (EQ (funcar, Qlambda)) | |
358 { | |
359 specs = Fassq (Qinteractive, Fcdr (Fcdr (fun))); | |
360 if (NILP (specs)) | |
361 goto lose; | |
362 specs = Fcar (Fcdr (specs)); | |
363 } | |
364 else | |
365 goto lose; | |
366 } | |
367 | |
2367 | 368 /* FSFmacs makes an ALLOCA() copy of prompt_data here. |
428 | 369 We're more intelligent about this and just reset prompt_data |
370 as necessary. */ | |
371 /* If either specs or prompt_data is set to a string, use it. */ | |
372 if (!STRINGP (specs) && prompt_data == 0) | |
373 { | |
374 struct gcpro gcpro1, gcpro2, gcpro3; | |
375 int i = num_input_chars; | |
376 Lisp_Object input = specs; | |
377 | |
378 GCPRO3 (function, specs, input); | |
379 /* Compute the arg values using the user's expression. */ | |
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4654
diff
changeset
|
380 specs = IGNORE_MULTIPLE_VALUES (Feval (specs)); |
428 | 381 if (EQ (record_flag, Qlambda)) /* XEmacs addition */ |
382 { | |
383 UNGCPRO; | |
384 return specs; | |
385 } | |
386 if (!NILP (record_flag) || i != num_input_chars) | |
387 { | |
388 /* We should record this command on the command history. */ | |
389 /* #### The following is too specific; should have general | |
390 mechanism for doing this. */ | |
391 Lisp_Object values, car; | |
392 /* Make a copy of the list of values, for the command history, | |
393 and turn them into things we can eval. */ | |
394 values = quotify_args (Fcopy_sequence (specs)); | |
395 /* If the list of args was produced with an explicit call to `list', | |
396 look for elements that were computed with (region-beginning) | |
397 or (region-end), and put those expressions into VALUES | |
398 instead of the present values. */ | |
399 if (CONSP (input)) | |
400 { | |
401 car = XCAR (input); | |
402 /* Skip through certain special forms. */ | |
403 while (EQ (car, Qlet) || EQ (car, QletX) | |
404 || EQ (car, Qsave_excursion)) | |
405 { | |
406 while (CONSP (XCDR (input))) | |
407 input = XCDR (input); | |
408 input = XCAR (input); | |
409 if (!CONSP (input)) | |
410 break; | |
411 car = XCAR (input); | |
412 } | |
413 if (EQ (car, Qlist)) | |
414 { | |
415 Lisp_Object intail, valtail; | |
416 for (intail = Fcdr (input), valtail = values; | |
417 CONSP (valtail); | |
418 intail = Fcdr (intail), valtail = Fcdr (valtail)) | |
419 { | |
420 Lisp_Object elt; | |
421 elt = Fcar (intail); | |
422 if (CONSP (elt)) | |
423 { | |
424 Lisp_Object eltcar = Fcar (elt); | |
425 if (EQ (eltcar, Qpoint) || | |
426 EQ (eltcar, Qmark) || | |
427 EQ (eltcar, Qregion_beginning) || | |
428 EQ (eltcar, Qregion_end)) | |
429 Fsetcar (valtail, Fcar (intail)); | |
430 } | |
431 } | |
432 } | |
433 } | |
434 Vcommand_history | |
435 = Fcons (Fcons (function, values), Vcommand_history); | |
436 } | |
437 single_console_state (); | |
438 RETURN_UNGCPRO (apply1 (fun, specs)); | |
439 } | |
440 | |
441 /* Here if function specifies a string to control parsing the defaults */ | |
442 | |
443 #ifdef I18N3 | |
444 /* Translate interactive prompt. */ | |
445 if (STRINGP (specs)) | |
446 { | |
447 Lisp_Object domain = Qnil; | |
448 if (COMPILED_FUNCTIONP (fun)) | |
449 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun)); | |
450 if (NILP (domain)) | |
451 specs = Fgettext (specs); | |
452 else | |
453 specs = Fdgettext (domain, specs); | |
454 } | |
455 else if (prompt_data) | |
456 /* We do not have to worry about domains in this case because | |
457 prompt_data is non-nil only for built-in functions, which | |
458 always use the default domain. */ | |
459 prompt_data = gettext (prompt_data); | |
460 #endif | |
461 | |
462 /* Handle special starting chars `*' and `@' and `_'. */ | |
463 /* Note that `+' is reserved for user extensions. */ | |
464 prompt_index = 0; | |
465 { | |
466 struct gcpro gcpro1, gcpro2; | |
467 GCPRO2 (function, specs); | |
468 | |
469 for (;;) | |
470 { | |
471 if (STRINGP (specs)) | |
442 | 472 prompt_data = (const char *) XSTRING_DATA (specs); |
428 | 473 |
474 if (prompt_data[prompt_index] == '+') | |
563 | 475 syntax_error ("`+' is not used in `interactive' for ordinary commands", Qunbound); |
428 | 476 else if (prompt_data[prompt_index] == '*') |
477 { | |
478 prompt_index++; | |
479 if (!NILP (current_buffer->read_only)) | |
480 barf_if_buffer_read_only (current_buffer, -1, -1); | |
481 } | |
482 else if (prompt_data[prompt_index] == '@') | |
483 { | |
484 Lisp_Object event; | |
485 prompt_index++; | |
486 | |
487 if (!NILP (keys)) | |
488 event = extract_vector_nth_mouse_event (keys, 0); | |
489 else | |
490 #if 0 | |
491 event = extract_this_command_keys_nth_mouse_event (0); | |
492 #else | |
493 /* Doesn't work; see below */ | |
494 event = Vcurrent_mouse_event; | |
495 #endif | |
496 if (! NILP (event)) | |
497 { | |
498 Lisp_Object window = Fevent_window (event); | |
499 if (!NILP (window)) | |
500 { | |
501 if (MINI_WINDOW_P (XWINDOW (window)) | |
502 && ! (minibuf_level > 0 && EQ (window, | |
503 minibuf_window))) | |
563 | 504 invalid_operation ("Attempt to select inactive minibuffer window", Qunbound); |
428 | 505 |
506 #if 0 /* unclean! see event-stream.c */ | |
507 /* If the current buffer wants to clean up, let it. */ | |
508 if (!NILP (Vmouse_leave_buffer_hook)) | |
509 run_hook (Qmouse_leave_buffer_hook); | |
510 #endif | |
511 | |
512 Fselect_window (window, Qnil); | |
513 } | |
514 } | |
515 } | |
516 else if (prompt_data[prompt_index] == '_') | |
517 { | |
518 prompt_index++; | |
519 set_zmacs_region_stays = 1; | |
520 } | |
521 else | |
522 { | |
523 UNGCPRO; | |
524 break; | |
525 } | |
526 } | |
527 } | |
528 | |
529 /* Count the number of arguments the interactive spec would have | |
530 us give to the function. */ | |
531 argcount = 0; | |
532 { | |
442 | 533 const char *tem; |
428 | 534 for (tem = prompt_data + prompt_index; *tem; ) |
535 { | |
536 /* 'r' specifications ("point and mark as 2 numeric args") | |
537 produce *two* arguments. */ | |
538 if (*tem == 'r') | |
539 argcount += 2; | |
540 else | |
541 argcount += 1; | |
442 | 542 tem = (const char *) strchr (tem + 1, '\n'); |
428 | 543 if (!tem) |
544 break; | |
545 tem++; | |
546 } | |
547 } | |
548 | |
549 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS | |
550 if (!NILP (enable)) | |
551 specbind (Qenable_recursive_minibuffers, Qt); | |
552 #endif | |
553 | |
554 if (argcount == 0) | |
555 { | |
556 /* Interactive function or no arguments; just call it */ | |
557 if (EQ (record_flag, Qlambda)) | |
558 return Qnil; | |
559 if (!NILP (record_flag)) | |
560 { | |
561 Vcommand_history = Fcons (list1 (function), Vcommand_history); | |
562 } | |
563 specbind (Qcommand_debug_status, Qnil); | |
564 /* XEmacs: was fun = call0 (fun), but that's backtraced wrong */ | |
565 { | |
566 struct gcpro gcpro1; | |
567 | |
568 GCPRO1 (fun); | |
569 fun = Ffuncall (1, &fun); | |
570 UNGCPRO; | |
571 } | |
572 if (set_zmacs_region_stays) | |
573 zmacs_region_stays = 1; | |
771 | 574 return unbind_to_1 (speccount, fun); |
428 | 575 } |
576 | |
577 /* Read interactive arguments */ | |
578 { | |
579 /* args[-1] is the function to call */ | |
580 /* args[n] is the n'th argument to the function */ | |
581 int alloca_size = (1 /* function to call */ | |
582 + argcount /* actual arguments */ | |
583 + argcount /* visargs */ | |
584 + argcount /* varies */ | |
585 ); | |
586 Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1; | |
587 /* visargs is an array of either Qnil or user-friendlier versions (often | |
588 * strings) of previous arguments, to use in prompts for successive | |
589 * arguments. ("Often strings" because emacs didn't used to have | |
590 * format %S and prin1-to-string.) */ | |
591 Lisp_Object *visargs = args + argcount; | |
592 /* If varies[i] is non-null, the i'th argument shouldn't just have | |
593 its value in this call quoted in the command history. It should be | |
594 recorded as a call to the function named varies[i]]. */ | |
595 Lisp_Object *varies = visargs + argcount; | |
596 int arg_from_tty = 0; | |
597 REGISTER int argnum; | |
598 struct gcpro gcpro1, gcpro2; | |
599 | |
600 args[-1] = function; | |
601 for (argnum = 0; argnum < alloca_size - 1; argnum++) | |
602 args[argnum] = Qnil; | |
603 | |
604 /* Must GC-protect args[-1] (ie function) because Ffuncall doesn't */ | |
605 /* `function' itself isn't GC-protected -- use args[-1] from here | |
606 (actually, doesn't matter since Emacs GC doesn't relocate, sigh) */ | |
607 GCPRO2 (prefix, args[-1]); | |
608 gcpro2.nvars = alloca_size; | |
609 | |
610 for (argnum = 0; ; argnum++) | |
611 { | |
442 | 612 const char *prompt_start = prompt_data + prompt_index + 1; |
613 const char *prompt_limit = (const char *) strchr (prompt_start, '\n'); | |
428 | 614 int prompt_length; |
615 prompt_length = ((prompt_limit) | |
616 ? (prompt_limit - prompt_start) | |
664 | 617 : (int) strlen (prompt_start)); |
428 | 618 if (prompt_limit && prompt_limit[1] == 0) |
619 { | |
620 prompt_limit = 0; /* "sfoo:\n" -- strip tailing return */ | |
621 prompt_length -= 1; | |
622 } | |
623 /* This uses `visargs' instead of `args' so that global-set-key | |
624 prompts with "Set key C-x C-f to command: "instead of printing | |
625 event objects in there. | |
626 */ | |
867 | 627 #define PROMPT() callint_prompt ((const Ibyte *) prompt_start, prompt_length, visargs, argnum) |
428 | 628 switch (prompt_data[prompt_index]) |
629 { | |
630 case 'a': /* Symbol defined as a function */ | |
631 { | |
632 Lisp_Object tem = call1 (Qread_function, PROMPT ()); | |
633 args[argnum] = tem; | |
634 arg_from_tty = 1; | |
635 break; | |
636 } | |
637 case 'b': /* Name of existing buffer */ | |
638 { | |
639 Lisp_Object def = Fcurrent_buffer (); | |
640 if (EQ (Fselected_window (Qnil), minibuf_window)) | |
641 def = Fother_buffer (def, Qnil, Qnil); | |
642 /* read-buffer returns a buffer name, not a buffer! */ | |
643 args[argnum] = call3 (Qread_buffer, PROMPT (), def, | |
644 Qt); | |
645 arg_from_tty = 1; | |
646 break; | |
647 } | |
648 case 'B': /* Name of buffer, possibly nonexistent */ | |
649 { | |
650 /* read-buffer returns a buffer name, not a buffer! */ | |
651 args[argnum] = call2 (Qread_buffer, PROMPT (), | |
652 Fother_buffer (Fcurrent_buffer (), Qnil, | |
653 Qnil)); | |
654 arg_from_tty = 1; | |
655 break; | |
656 } | |
657 case 'c': /* Character */ | |
658 { | |
659 Lisp_Object tem; | |
660 int shadowing_speccount = specpdl_depth (); | |
661 | |
662 specbind (Qcursor_in_echo_area, Qt); | |
663 message ("%s", XSTRING_DATA (PROMPT ())); | |
664 tem = (call0 (Qread_char)); | |
665 args[argnum] = tem; | |
666 /* visargs[argnum] = Fsingle_key_description (tem); */ | |
667 /* FSF has visargs[argnum] = Fchar_to_string (tem); */ | |
668 | |
771 | 669 unbind_to (shadowing_speccount); |
428 | 670 |
671 /* #### `C-x / a' should not leave the prompt in the minibuffer. | |
672 This isn't the right fix, because (message ...) (read-char) | |
673 shouldn't leave the message there either... */ | |
674 clear_message (); | |
675 | |
676 arg_from_tty = 1; | |
677 break; | |
678 } | |
679 case 'C': /* Command: symbol with interactive function */ | |
680 { | |
681 Lisp_Object tem = call1 (Qread_command, PROMPT ()); | |
682 args[argnum] = tem; | |
683 arg_from_tty = 1; | |
684 break; | |
685 } | |
686 case 'd': /* Value of point. Does not do I/O. */ | |
687 { | |
688 args[argnum] = Fcopy_marker (current_buffer->point_marker, Qt); | |
689 varies[argnum] = Qpoint; | |
690 break; | |
691 } | |
692 case 'e': | |
693 { | |
694 Lisp_Object event; | |
695 | |
696 if (!NILP (keys)) | |
697 event = extract_vector_nth_mouse_event (keys, | |
698 mouse_event_count); | |
699 else | |
700 #if 0 | |
701 /* This doesn't quite work because this-command-keys | |
702 behaves in utterly counterintuitive ways. Sometimes | |
703 it retrieves an event back in the future, e.g. when | |
704 one command invokes another command and both are | |
705 invoked with the mouse. */ | |
706 event = (extract_this_command_keys_nth_mouse_event | |
707 (mouse_event_count)); | |
708 #else | |
709 event = Vcurrent_mouse_event; | |
710 #endif | |
711 | |
712 if (NILP (event)) | |
563 | 713 signal_error (Qinvalid_operation, |
714 "function must be bound to a mouse or misc-user event", | |
715 function); | |
428 | 716 args[argnum] = event; |
717 mouse_event_count++; | |
718 break; | |
719 } | |
720 case 'D': /* Directory name. */ | |
721 { | |
722 args[argnum] = call4 (Qread_directory_name, PROMPT (), | |
723 Qnil, /* dir */ | |
724 current_buffer->directory, /* default */ | |
725 Qt /* must-match */ | |
726 ); | |
727 arg_from_tty = 1; | |
728 break; | |
729 } | |
730 case 'f': /* Existing file name. */ | |
731 { | |
732 Lisp_Object tem = call4 (Qread_file_name, PROMPT (), | |
733 Qnil, /* dir */ | |
734 Qnil, /* default */ | |
735 Qzero /* must-match */ | |
736 ); | |
737 args[argnum] = tem; | |
738 arg_from_tty = 1; | |
739 break; | |
740 } | |
741 case 'F': /* Possibly nonexistent file name. */ | |
742 { | |
743 args[argnum] = call4 (Qread_file_name, PROMPT (), | |
744 Qnil, /* dir */ | |
745 Qnil, /* default */ | |
746 Qnil /* must-match */ | |
747 ); | |
748 arg_from_tty = 1; | |
749 break; | |
750 } | |
751 case 'i': /* Ignore: always nil. Use to skip arguments. */ | |
752 { | |
753 args[argnum] = Qnil; | |
754 break; | |
755 } | |
756 case 'k': /* Key sequence (vector of events) */ | |
757 { | |
758 struct gcpro ngcpro1; | |
759 Lisp_Object tem; | |
760 Lisp_Object key_prompt = PROMPT (); | |
761 | |
762 NGCPRO1(key_prompt); | |
763 tem = Fread_key_sequence (key_prompt, Qnil, Qnil); | |
764 NUNGCPRO; | |
765 | |
766 visargs[argnum] = Fkey_description (tem); | |
767 /* The following makes `describe-key' not work with | |
768 extent-local keymaps and such; and anyway, it's | |
769 contrary to the documentation. */ | |
770 /* args[argnum] = call1 (Qevents_to_keys, tem); */ | |
771 args[argnum] = tem; | |
772 arg_from_tty = 1; | |
773 break; | |
774 } | |
775 case 'K': /* Key sequence (vector of events), | |
776 no automatic downcasing */ | |
777 { | |
778 struct gcpro ngcpro1; | |
779 Lisp_Object tem; | |
780 Lisp_Object key_prompt = PROMPT (); | |
781 | |
782 NGCPRO1(key_prompt); | |
783 tem = Fread_key_sequence (key_prompt, Qnil, Qt); | |
784 NUNGCPRO; | |
785 | |
786 visargs[argnum] = Fkey_description (tem); | |
787 /* The following makes `describe-key' not work with | |
788 extent-local keymaps and such; and anyway, it's | |
789 contrary to the documentation. */ | |
790 /* args[argnum] = call1 (Qevents_to_keys, tem); */ | |
791 args[argnum] = tem; | |
792 arg_from_tty = 1; | |
793 break; | |
794 } | |
795 | |
796 case 'm': /* Value of mark. Does not do I/O. */ | |
797 { | |
798 args[argnum] = current_buffer->mark; | |
799 varies[argnum] = Qmark; | |
800 break; | |
801 } | |
802 case 'n': /* Read number from minibuffer. */ | |
803 { | |
804 read_number: | |
805 args[argnum] = call2 (Qread_number, PROMPT (), Qnil); | |
806 /* numbers are too boring to go on command history */ | |
807 /* arg_from_tty = 1; */ | |
808 break; | |
809 } | |
810 case 'N': /* Prefix arg, else number from minibuffer */ | |
811 { | |
812 if (NILP (prefix)) | |
813 goto read_number; | |
814 else | |
815 goto prefix_value; | |
816 } | |
817 case 'P': /* Prefix arg in raw form. Does no I/O. */ | |
818 { | |
819 args[argnum] = prefix; | |
820 break; | |
821 } | |
822 case 'p': /* Prefix arg converted to number. No I/O. */ | |
823 { | |
824 prefix_value: | |
825 { | |
826 Lisp_Object tem = Fprefix_numeric_value (prefix); | |
827 args[argnum] = tem; | |
828 } | |
829 break; | |
830 } | |
831 case 'r': /* Region, point and mark as 2 args. */ | |
832 { | |
665 | 833 Charbpos tem = check_mark (); |
428 | 834 args[argnum] = (BUF_PT (current_buffer) < tem |
835 ? Fcopy_marker (current_buffer->point_marker, Qt) | |
836 : current_buffer->mark); | |
837 varies[argnum] = Qregion_beginning; | |
838 args[++argnum] = (BUF_PT (current_buffer) > tem | |
839 ? Fcopy_marker (current_buffer->point_marker, | |
840 Qt) | |
841 : current_buffer->mark); | |
842 varies[argnum] = Qregion_end; | |
843 break; | |
844 } | |
845 case 's': /* String read via minibuffer. */ | |
846 { | |
847 args[argnum] = call1 (Qread_string, PROMPT ()); | |
848 arg_from_tty = 1; | |
849 break; | |
850 } | |
851 case 'S': /* Any symbol. */ | |
852 { | |
853 visargs[argnum] = Qnil; | |
854 for (;;) | |
855 { | |
856 Lisp_Object tem = call5 (Qcompleting_read, | |
857 PROMPT (), | |
858 Vobarray, | |
859 Qnil, | |
860 Qnil, | |
861 /* nil, or prev attempt */ | |
862 visargs[argnum]); | |
863 visargs[argnum] = tem; | |
864 /* I could use condition-case with this loser, but why bother? | |
865 * tem = Fread (tem); check-symbol-p; | |
866 */ | |
867 tem = Fintern (tem, Qnil); | |
868 args[argnum] = tem; | |
793 | 869 if (XSTRING_LENGTH (XSYMBOL (tem)->name) > 0) |
428 | 870 /* Don't accept the empty-named symbol. If the loser |
871 really wants this s/he can call completing-read | |
872 directly */ | |
873 break; | |
874 } | |
875 arg_from_tty = 1; | |
876 break; | |
877 } | |
878 case 'v': /* Variable name: user-variable-p symbol */ | |
879 { | |
880 Lisp_Object tem = call1 (Qread_variable, PROMPT ()); | |
881 args[argnum] = tem; | |
882 arg_from_tty = 1; | |
883 break; | |
884 } | |
885 case 'x': /* Lisp expression read but not evaluated */ | |
886 { | |
887 args[argnum] = call1 (Qread_expression, PROMPT ()); | |
888 /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */ | |
889 arg_from_tty = 1; | |
890 break; | |
891 } | |
892 case 'X': /* Lisp expression read and evaluated */ | |
893 { | |
894 Lisp_Object tem = call1 (Qread_expression, PROMPT ()); | |
895 /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */ | |
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4654
diff
changeset
|
896 args[argnum] = IGNORE_MULTIPLE_VALUES (Feval (tem)); |
428 | 897 arg_from_tty = 1; |
898 break; | |
899 } | |
900 case 'Z': /* Coding-system symbol or nil if no prefix */ | |
901 { | |
902 if (NILP (prefix)) | |
903 { | |
904 args[argnum] = Qnil; | |
905 } | |
906 else | |
907 { | |
908 args[argnum] = | |
909 call1 (Qread_non_nil_coding_system, PROMPT ()); | |
910 arg_from_tty = 1; | |
911 } | |
912 break; | |
913 } | |
914 case 'z': /* Coding-system symbol */ | |
915 { | |
916 args[argnum] = call1 (Qread_coding_system, PROMPT ()); | |
917 arg_from_tty = 1; | |
918 break; | |
919 } | |
920 | |
921 /* We have a case for `+' so we get an error | |
922 if anyone tries to define one here. */ | |
923 case '+': | |
924 default: | |
925 { | |
826 | 926 signal_ferror |
927 (Qsyntax_error, | |
928 "Invalid `interactive' control letter \"%c\" (#o%03o).", | |
929 prompt_data[prompt_index], prompt_data[prompt_index]); | |
428 | 930 } |
931 } | |
932 #undef PROMPT | |
933 if (NILP (visargs[argnum])) | |
934 visargs[argnum] = args[argnum]; | |
935 | |
936 if (!prompt_limit) | |
937 break; | |
938 if (STRINGP (specs)) | |
442 | 939 prompt_data = (const char *) XSTRING_DATA (specs); |
428 | 940 prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */ |
941 } | |
771 | 942 unbind_to (speccount); |
428 | 943 |
944 QUIT; | |
945 | |
946 if (EQ (record_flag, Qlambda)) | |
947 { | |
948 RETURN_UNGCPRO (Flist (argcount, args)); | |
949 } | |
950 | |
951 if (arg_from_tty || !NILP (record_flag)) | |
952 { | |
953 /* Reuse visargs as a temporary for constructing the command history */ | |
954 for (argnum = 0; argnum < argcount; argnum++) | |
955 { | |
956 if (!NILP (varies[argnum])) | |
957 visargs[argnum] = list1 (varies[argnum]); | |
958 else | |
959 visargs[argnum] = Fquote_maybe (args[argnum]); | |
960 } | |
961 Vcommand_history = Fcons (Fcons (args[-1], Flist (argcount, visargs)), | |
962 Vcommand_history); | |
963 } | |
964 | |
965 /* If we used a marker to hold point, mark, or an end of the region, | |
966 temporarily, convert it to an integer now. */ | |
967 for (argnum = 0; argnum < argcount; argnum++) | |
968 if (!NILP (varies[argnum])) | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
969 args[argnum] = make_fixnum (marker_position (args[argnum])); |
428 | 970 |
971 single_console_state (); | |
972 specbind (Qcommand_debug_status, Qnil); | |
973 fun = Ffuncall (argcount + 1, args - 1); | |
974 UNGCPRO; | |
975 if (set_zmacs_region_stays) | |
976 zmacs_region_stays = 1; | |
771 | 977 return unbind_to_1 (speccount, fun); |
428 | 978 } |
979 } | |
980 | |
981 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /* | |
444 | 982 Return numeric meaning of raw prefix argument RAW. |
428 | 983 A raw prefix argument is what you get from `(interactive "P")'. |
984 Its numeric meaning is what you would get from `(interactive "p")'. | |
985 */ | |
986 (raw)) | |
987 { | |
988 if (NILP (raw)) | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
989 return make_fixnum (1); |
428 | 990 if (EQ (raw, Qminus)) |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
991 return make_fixnum (-1); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
992 if (FIXNUMP (raw)) |
428 | 993 return raw; |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
994 if (CONSP (raw) && FIXNUMP (XCAR (raw))) |
428 | 995 return XCAR (raw); |
996 | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
997 return make_fixnum (1); |
428 | 998 } |
999 | |
1000 void | |
1001 syms_of_callint (void) | |
1002 { | |
563 | 1003 DEFSYMBOL (Qcall_interactively); |
1004 DEFSYMBOL (Qread_from_minibuffer); | |
1005 DEFSYMBOL (Qcompleting_read); | |
1006 DEFSYMBOL (Qread_file_name); | |
1007 DEFSYMBOL (Qread_directory_name); | |
1008 DEFSYMBOL (Qread_string); | |
1009 DEFSYMBOL (Qread_buffer); | |
1010 DEFSYMBOL (Qread_variable); | |
1011 DEFSYMBOL (Qread_function); | |
1012 DEFSYMBOL (Qread_command); | |
1013 DEFSYMBOL (Qread_number); | |
1014 DEFSYMBOL (Qread_expression); | |
1015 DEFSYMBOL (Qread_coding_system); | |
1016 DEFSYMBOL (Qread_non_nil_coding_system); | |
1017 DEFSYMBOL (Qevents_to_keys); | |
1018 DEFSYMBOL (Qcommand_debug_status); | |
1019 DEFSYMBOL (Qenable_recursive_minibuffers); | |
428 | 1020 |
1021 defsymbol (&QletX, "let*"); | |
563 | 1022 DEFSYMBOL (Qsave_excursion); |
428 | 1023 #if 0 /* ill-conceived */ |
563 | 1024 DEFSYMBOL (Qmouse_leave_buffer_hook); |
428 | 1025 #endif |
1026 | |
1027 DEFSUBR (Finteractive); | |
1028 DEFSUBR (Fcall_interactively); | |
1029 DEFSUBR (Fprefix_numeric_value); | |
1030 } | |
1031 | |
1032 void | |
1033 vars_of_callint (void) | |
1034 { | |
1035 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg /* | |
1036 The value of the prefix argument for this editing command. | |
1037 It may be a number, or the symbol `-' for just a minus sign as arg, | |
1038 or a list whose car is a number for just one or more C-U's | |
1039 or nil if no argument has been specified. | |
1040 This is what `(interactive "P")' returns. | |
1041 */ ); | |
1042 Vcurrent_prefix_arg = Qnil; | |
1043 | |
1044 DEFVAR_LISP ("command-history", &Vcommand_history /* | |
1045 List of recent commands that read arguments from terminal. | |
1046 Each command is represented as a form to evaluate. | |
1047 */ ); | |
1048 Vcommand_history = Qnil; | |
1049 | |
1050 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status /* | |
1051 Debugging status of current interactive command. | |
1052 Bound each time `call-interactively' is called; | |
1053 may be set by the debugger as a reminder for itself. | |
1054 */ ); | |
1055 Vcommand_debug_status = Qnil; | |
1056 | |
1057 #if 0 /* FSFmacs */ | |
1058 xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /* | |
1059 *Non-nil means you can use the mark even when inactive. | |
1060 This option makes a difference in Transient Mark mode. | |
1061 When the option is non-nil, deactivation of the mark | |
1062 turns off region highlighting, but commands that use the mark | |
1063 behave as if the mark were still active. | |
1064 */ ); | |
1065 Vmark_even_if_inactive = Qnil; | |
1066 #endif | |
1067 | |
1068 #if 0 /* Doesn't work and is totally ill-conceived anyway. */ | |
1069 xxDEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook /* | |
1070 Hook to run when about to switch windows with a mouse command. | |
1071 Its purpose is to give temporary modes such as Isearch mode | |
1072 a way to turn themselves off when a mouse command switches windows. | |
1073 */ ); | |
1074 Vmouse_leave_buffer_hook = Qnil; | |
1075 #endif | |
1076 } |