Mercurial > hg > xemacs-beta

comparison src/callint.c @ 0:376386a54a3c r19-14

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