ERC-NEWS: Improve description of erc-ssl and erc-tls change
[bpt/emacs.git] / src / callint.c
... / ...
CommitLineData
1/* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 3, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
21
22
23#include <config.h>
24
25#include "lisp.h"
26#include "buffer.h"
27#include "commands.h"
28#include "keyboard.h"
29#include "window.h"
30#include "keymap.h"
31
32#ifdef HAVE_INDEX
33extern char *index P_ ((const char *, int));
34#endif
35
36extern Lisp_Object Qcursor_in_echo_area;
37extern Lisp_Object Qfile_directory_p;
38
39Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
40Lisp_Object Qcall_interactively;
41Lisp_Object Vcommand_history;
42
43extern Lisp_Object Vhistory_length;
44extern Lisp_Object Vthis_original_command, real_this_command;
45
46Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
47Lisp_Object Qenable_recursive_minibuffers;
48
49/* Non-nil means treat the mark as active
50 even if mark_active is 0. */
51Lisp_Object Vmark_even_if_inactive;
52
53Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
54
55Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
56static Lisp_Object preserved_fns;
57
58/* Marker used within call-interactively to refer to point. */
59static Lisp_Object point_marker;
60
61/* String for the prompt text used in Fcall_interactively. */
62static Lisp_Object callint_message;
63\f
64/* ARGSUSED */
65DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
66 doc: /* Specify a way of parsing arguments for interactive use of a function.
67For example, write
68 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
69to make ARG be the prefix argument when `foo' is called as a command.
70The "call" to `interactive' is actually a declaration rather than a function;
71 it tells `call-interactively' how to read arguments
72 to pass to the function.
73When actually called, `interactive' just returns nil.
74
75The argument of `interactive' is usually a string containing a code letter
76 followed by a prompt. (Some code letters do not use I/O to get
77 the argument and do not need prompts.) To prompt for multiple arguments,
78 give a code letter, its prompt, a newline, and another code letter, etc.
79 Prompts are passed to format, and may use % escapes to print the
80 arguments that have already been read.
81If the argument is not a string, it is evaluated to get a list of
82 arguments to pass to the function.
83Just `(interactive)' means pass no args when calling interactively.
84
85Code letters available are:
86a -- Function name: symbol with a function definition.
87b -- Name of existing buffer.
88B -- Name of buffer, possibly nonexistent.
89c -- Character (no input method is used).
90C -- Command name: symbol with interactive function definition.
91d -- Value of point as number. Does not do I/O.
92D -- Directory name.
93e -- Parametrized event (i.e., one that's a list) that invoked this command.
94 If used more than once, the Nth `e' returns the Nth parameterized event.
95 This skips events that are integers or symbols.
96f -- Existing file name.
97F -- Possibly nonexistent file name.
98G -- Possibly nonexistent file name, defaulting to just directory name.
99i -- Ignored, i.e. always nil. Does not do I/O.
100k -- Key sequence (downcase the last event if needed to get a definition).
101K -- Key sequence to be redefined (do not downcase the last event).
102m -- Value of mark as number. Does not do I/O.
103M -- Any string. Inherits the current input method.
104n -- Number read using minibuffer.
105N -- Numeric prefix arg, or if none, do like code `n'.
106p -- Prefix arg converted to number. Does not do I/O.
107P -- Prefix arg in raw form. Does not do I/O.
108r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
109s -- Any string. Does not inherit the current input method.
110S -- Any symbol.
111U -- Mouse up event discarded by a previous k or K argument.
112v -- Variable name: symbol that is user-variable-p.
113x -- Lisp expression read but not evaluated.
114X -- Lisp expression read and evaluated.
115z -- Coding system.
116Z -- Coding system, nil if no prefix arg.
117In addition, if the string begins with `*'
118 then an error is signaled if the buffer is read-only.
119 This happens before reading any arguments.
120If the string begins with `@', then Emacs searches the key sequence
121 which invoked the command for its first mouse click (or any other
122 event which specifies a window), and selects that window before
123 reading any arguments. You may use both `@' and `*'; they are
124 processed in the order that they appear.
125usage: (interactive ARGS) */)
126 (args)
127 Lisp_Object args;
128{
129 return Qnil;
130}
131
132/* Quotify EXP: if EXP is constant, return it.
133 If EXP is not constant, return (quote EXP). */
134Lisp_Object
135quotify_arg (exp)
136 register Lisp_Object exp;
137{
138 if (!INTEGERP (exp) && !STRINGP (exp)
139 && !NILP (exp) && !EQ (exp, Qt))
140 return Fcons (Qquote, Fcons (exp, Qnil));
141
142 return exp;
143}
144
145/* Modify EXP by quotifying each element (except the first). */
146Lisp_Object
147quotify_args (exp)
148 Lisp_Object exp;
149{
150 register Lisp_Object tail;
151 Lisp_Object next;
152 for (tail = exp; CONSP (tail); tail = next)
153 {
154 next = XCDR (tail);
155 XSETCAR (tail, quotify_arg (XCAR (tail)));
156 }
157 return exp;
158}
159
160char *callint_argfuns[]
161 = {"", "point", "mark", "region-beginning", "region-end"};
162
163static void
164check_mark (for_region)
165 int for_region;
166{
167 Lisp_Object tem;
168 tem = Fmarker_buffer (current_buffer->mark);
169 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
170 error (for_region ? "The mark is not set now, so there is no region"
171 : "The mark is not set now");
172 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
173 && NILP (current_buffer->mark_active))
174 xsignal0 (Qmark_inactive);
175}
176
177/* If the list of args INPUT was produced with an explicit call to
178 `list', look for elements that were computed with
179 (region-beginning) or (region-end), and put those expressions into
180 VALUES instead of the present values.
181
182 This function doesn't return a value because it modifies elements
183 of VALUES to do its job. */
184
185static void
186fix_command (input, values)
187 Lisp_Object input, values;
188{
189 if (CONSP (input))
190 {
191 Lisp_Object car;
192
193 car = XCAR (input);
194 /* Skip through certain special forms. */
195 while (EQ (car, Qlet) || EQ (car, Qletx)
196 || EQ (car, Qsave_excursion)
197 || EQ (car, Qprogn))
198 {
199 while (CONSP (XCDR (input)))
200 input = XCDR (input);
201 input = XCAR (input);
202 if (!CONSP (input))
203 break;
204 car = XCAR (input);
205 }
206 if (EQ (car, Qlist))
207 {
208 Lisp_Object intail, valtail;
209 for (intail = Fcdr (input), valtail = values;
210 CONSP (valtail);
211 intail = Fcdr (intail), valtail = XCDR (valtail))
212 {
213 Lisp_Object elt;
214 elt = Fcar (intail);
215 if (CONSP (elt))
216 {
217 Lisp_Object presflag, carelt;
218 carelt = Fcar (elt);
219 /* If it is (if X Y), look at Y. */
220 if (EQ (carelt, Qif)
221 && EQ (Fnthcdr (make_number (3), elt), Qnil))
222 elt = Fnth (make_number (2), elt);
223 /* If it is (when ... Y), look at Y. */
224 else if (EQ (carelt, Qwhen))
225 {
226 while (CONSP (XCDR (elt)))
227 elt = XCDR (elt);
228 elt = Fcar (elt);
229 }
230
231 /* If the function call we're looking at
232 is a special preserved one, copy the
233 whole expression for this argument. */
234 if (CONSP (elt))
235 {
236 presflag = Fmemq (Fcar (elt), preserved_fns);
237 if (!NILP (presflag))
238 Fsetcar (valtail, Fcar (intail));
239 }
240 }
241 }
242 }
243 }
244}
245
246DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
247 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
248Return the value FUNCTION returns.
249The function contains a specification of how to do the argument reading.
250In the case of user-defined functions, this is specified by placing a call
251to the function `interactive' at the top level of the function body.
252See `interactive'.
253
254Optional second arg RECORD-FLAG non-nil
255means unconditionally put this command in the command-history.
256Otherwise, this is done only if an arg is read using the minibuffer.
257
258Optional third arg KEYS, if given, specifies the sequence of events to
259supply, as a vector, if the command inquires which events were used to
260invoke it. If KEYS is omitted or nil, the return value of
261`this-command-keys-vector' is used. */)
262 (function, record_flag, keys)
263 Lisp_Object function, record_flag, keys;
264{
265 Lisp_Object *args, *visargs;
266 Lisp_Object fun;
267 Lisp_Object specs;
268 Lisp_Object filter_specs;
269 Lisp_Object teml;
270 Lisp_Object up_event;
271 Lisp_Object enable;
272 int speccount = SPECPDL_INDEX ();
273
274 /* The index of the next element of this_command_keys to examine for
275 the 'e' interactive code. */
276 int next_event;
277
278 Lisp_Object prefix_arg;
279 unsigned char *string;
280 unsigned char *tem;
281
282 /* If varies[i] > 0, the i'th argument shouldn't just have its value
283 in this call quoted in the command history. It should be
284 recorded as a call to the function named callint_argfuns[varies[i]]. */
285 int *varies;
286
287 register int i, j;
288 int count, foo;
289 char prompt1[100];
290 char *tem1;
291 int arg_from_tty = 0;
292 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
293 int key_count;
294 int record_then_fail = 0;
295
296 Lisp_Object save_this_command, save_last_command;
297 Lisp_Object save_this_original_command, save_real_this_command;
298
299 save_this_command = Vthis_command;
300 save_this_original_command = Vthis_original_command;
301 save_real_this_command = real_this_command;
302 save_last_command = current_kboard->Vlast_command;
303
304 if (NILP (keys))
305 keys = this_command_keys, key_count = this_command_key_count;
306 else
307 {
308 CHECK_VECTOR (keys);
309 key_count = XVECTOR (keys)->size;
310 }
311
312 /* Save this now, since use of minibuffer will clobber it. */
313 prefix_arg = Vcurrent_prefix_arg;
314
315 if (SYMBOLP (function))
316 enable = Fget (function, Qenable_recursive_minibuffers);
317 else
318 enable = Qnil;
319
320 fun = indirect_function (function);
321
322 specs = Qnil;
323 string = 0;
324 /* The idea of FILTER_SPECS is to provide away to
325 specify how to represent the arguments in command history.
326 The feature is not fully implemented. */
327 filter_specs = Qnil;
328
329 /* If k or K discard an up-event, save it here so it can be retrieved with U */
330 up_event = Qnil;
331
332 /* Decode the kind of function. Either handle it and return,
333 or go to `lose' if not interactive, or set either STRING or SPECS. */
334
335 if (SUBRP (fun))
336 {
337 string = (unsigned char *) XSUBR (fun)->prompt;
338 if (!string)
339 {
340 lose:
341 wrong_type_argument (Qcommandp, function);
342 }
343 }
344 else if (COMPILEDP (fun))
345 {
346 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
347 goto lose;
348 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
349 }
350 else
351 {
352 Lisp_Object form;
353 GCPRO2 (function, prefix_arg);
354 form = Finteractive_form (function);
355 UNGCPRO;
356 if (CONSP (form))
357 specs = filter_specs = Fcar (XCDR (form));
358 else
359 goto lose;
360 }
361
362 /* If either SPECS or STRING is set to a string, use it. */
363 if (STRINGP (specs))
364 {
365 /* Make a copy of string so that if a GC relocates specs,
366 `string' will still be valid. */
367 string = (unsigned char *) alloca (SBYTES (specs) + 1);
368 bcopy (SDATA (specs), string,
369 SBYTES (specs) + 1);
370 }
371 else if (string == 0)
372 {
373 Lisp_Object input;
374 i = num_input_events;
375 input = specs;
376 /* Compute the arg values using the user's expression. */
377 GCPRO2 (input, filter_specs);
378 specs = Feval (specs);
379 UNGCPRO;
380 if (i != num_input_events || !NILP (record_flag))
381 {
382 /* We should record this command on the command history. */
383 Lisp_Object values;
384 /* Make a copy of the list of values, for the command history,
385 and turn them into things we can eval. */
386 values = quotify_args (Fcopy_sequence (specs));
387 fix_command (input, values);
388 Vcommand_history
389 = Fcons (Fcons (function, values), Vcommand_history);
390
391 /* Don't keep command history around forever. */
392 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
393 {
394 teml = Fnthcdr (Vhistory_length, Vcommand_history);
395 if (CONSP (teml))
396 XSETCDR (teml, Qnil);
397 }
398 }
399
400 Vthis_command = save_this_command;
401 Vthis_original_command = save_this_original_command;
402 real_this_command= save_real_this_command;
403 current_kboard->Vlast_command = save_last_command;
404
405 temporarily_switch_to_single_kboard (NULL);
406 return unbind_to (speccount, apply1 (function, specs));
407 }
408
409 /* Here if function specifies a string to control parsing the defaults */
410
411 /* Set next_event to point to the first event with parameters. */
412 for (next_event = 0; next_event < key_count; next_event++)
413 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
414 break;
415
416 /* Handle special starting chars `*' and `@'. Also `-'. */
417 /* Note that `+' is reserved for user extensions. */
418 while (1)
419 {
420 if (*string == '+')
421 error ("`+' is not used in `interactive' for ordinary commands");
422 else if (*string == '*')
423 {
424 string++;
425 if (!NILP (current_buffer->read_only))
426 {
427 if (!NILP (record_flag))
428 {
429 unsigned char *p = string;
430 while (*p)
431 {
432 if (! (*p == 'r' || *p == 'p' || *p == 'P'
433 || *p == '\n'))
434 Fbarf_if_buffer_read_only ();
435 p++;
436 }
437 record_then_fail = 1;
438 }
439 else
440 Fbarf_if_buffer_read_only ();
441 }
442 }
443 /* Ignore this for semi-compatibility with Lucid. */
444 else if (*string == '-')
445 string++;
446 else if (*string == '@')
447 {
448 Lisp_Object event, tem;
449
450 event = (next_event < key_count
451 ? XVECTOR (keys)->contents[next_event]
452 : Qnil);
453 if (EVENT_HAS_PARAMETERS (event)
454 && (tem = XCDR (event), CONSP (tem))
455 && (tem = XCAR (tem), CONSP (tem))
456 && (tem = XCAR (tem), WINDOWP (tem)))
457 {
458 if (MINI_WINDOW_P (XWINDOW (tem))
459 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
460 error ("Attempt to select inactive minibuffer window");
461
462 /* If the current buffer wants to clean up, let it. */
463 if (!NILP (Vmouse_leave_buffer_hook))
464 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
465
466 Fselect_window (tem, Qnil);
467 }
468 string++;
469 }
470 else break;
471 }
472
473 /* Count the number of arguments the interactive spec would have
474 us give to the function. */
475 tem = string;
476 for (j = 0; *tem;)
477 {
478 /* 'r' specifications ("point and mark as 2 numeric args")
479 produce *two* arguments. */
480 if (*tem == 'r')
481 j += 2;
482 else
483 j++;
484 tem = (unsigned char *) index (tem, '\n');
485 if (tem)
486 ++tem;
487 else
488 break;
489 }
490 count = j;
491
492 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
493 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
494 varies = (int *) alloca ((count + 1) * sizeof (int));
495
496 for (i = 0; i < (count + 1); i++)
497 {
498 args[i] = Qnil;
499 visargs[i] = Qnil;
500 varies[i] = 0;
501 }
502
503 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
504 gcpro3.nvars = (count + 1);
505 gcpro4.nvars = (count + 1);
506
507 if (!NILP (enable))
508 specbind (Qenable_recursive_minibuffers, Qt);
509
510 tem = string;
511 for (i = 1; *tem; i++)
512 {
513 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
514 prompt1[sizeof prompt1 - 1] = 0;
515 tem1 = (char *) index (prompt1, '\n');
516 if (tem1) *tem1 = 0;
517
518 visargs[0] = build_string (prompt1);
519 if (index (prompt1, '%'))
520 callint_message = Fformat (i, visargs);
521 else
522 callint_message = visargs[0];
523
524 switch (*tem)
525 {
526 case 'a': /* Symbol defined as a function */
527 visargs[i] = Fcompleting_read (callint_message,
528 Vobarray, Qfboundp, Qt,
529 Qnil, Qnil, Qnil, Qnil);
530 /* Passing args[i] directly stimulates compiler bug */
531 teml = visargs[i];
532 args[i] = Fintern (teml, Qnil);
533 break;
534
535 case 'b': /* Name of existing buffer */
536 args[i] = Fcurrent_buffer ();
537 if (EQ (selected_window, minibuf_window))
538 args[i] = Fother_buffer (args[i], Qnil, Qnil);
539 args[i] = Fread_buffer (callint_message, args[i], Qt);
540 break;
541
542 case 'B': /* Name of buffer, possibly nonexistent */
543 args[i] = Fread_buffer (callint_message,
544 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
545 Qnil);
546 break;
547
548 case 'c': /* Character */
549 args[i] = Fread_char (callint_message, Qnil, Qnil);
550 message1_nolog ((char *) 0);
551 /* Passing args[i] directly stimulates compiler bug */
552 teml = args[i];
553 visargs[i] = Fchar_to_string (teml);
554 break;
555
556 case 'C': /* Command: symbol with interactive function */
557 visargs[i] = Fcompleting_read (callint_message,
558 Vobarray, Qcommandp,
559 Qt, Qnil, Qnil, Qnil, Qnil);
560 /* Passing args[i] directly stimulates compiler bug */
561 teml = visargs[i];
562 args[i] = Fintern (teml, Qnil);
563 break;
564
565 case 'd': /* Value of point. Does not do I/O. */
566 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
567 args[i] = point_marker;
568 /* visargs[i] = Qnil; */
569 varies[i] = 1;
570 break;
571
572 case 'D': /* Directory name. */
573 args[i] = Fread_file_name (callint_message, Qnil,
574 current_buffer->directory, Qlambda, Qnil,
575 Qfile_directory_p);
576 break;
577
578 case 'f': /* Existing file name. */
579 args[i] = Fread_file_name (callint_message,
580 Qnil, Qnil, Qlambda, Qnil, Qnil);
581 break;
582
583 case 'F': /* Possibly nonexistent file name. */
584 args[i] = Fread_file_name (callint_message,
585 Qnil, Qnil, Qnil, Qnil, Qnil);
586 break;
587
588 case 'G': /* Possibly nonexistent file name,
589 default to directory alone. */
590 args[i] = Fread_file_name (callint_message,
591 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
592 break;
593
594 case 'i': /* Ignore an argument -- Does not do I/O */
595 varies[i] = -1;
596 break;
597
598 case 'k': /* Key sequence. */
599 {
600 int speccount1 = SPECPDL_INDEX ();
601 specbind (Qcursor_in_echo_area, Qt);
602 args[i] = Fread_key_sequence (callint_message,
603 Qnil, Qnil, Qnil, Qnil);
604 unbind_to (speccount1, Qnil);
605 teml = args[i];
606 visargs[i] = Fkey_description (teml, Qnil);
607
608 /* If the key sequence ends with a down-event,
609 discard the following up-event. */
610 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
611 if (CONSP (teml))
612 teml = XCAR (teml);
613 if (SYMBOLP (teml))
614 {
615 Lisp_Object tem2;
616
617 teml = Fget (teml, intern ("event-symbol-elements"));
618 /* Ignore first element, which is the base key. */
619 tem2 = Fmemq (intern ("down"), Fcdr (teml));
620 if (! NILP (tem2))
621 up_event = Fread_event (Qnil, Qnil, Qnil);
622 }
623 }
624 break;
625
626 case 'K': /* Key sequence to be defined. */
627 {
628 int speccount1 = SPECPDL_INDEX ();
629 specbind (Qcursor_in_echo_area, Qt);
630 args[i] = Fread_key_sequence (callint_message,
631 Qnil, Qt, Qnil, Qnil);
632 teml = args[i];
633 visargs[i] = Fkey_description (teml, Qnil);
634 unbind_to (speccount1, Qnil);
635
636 /* If the key sequence ends with a down-event,
637 discard the following up-event. */
638 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
639 if (CONSP (teml))
640 teml = XCAR (teml);
641 if (SYMBOLP (teml))
642 {
643 Lisp_Object tem2;
644
645 teml = Fget (teml, intern ("event-symbol-elements"));
646 /* Ignore first element, which is the base key. */
647 tem2 = Fmemq (intern ("down"), Fcdr (teml));
648 if (! NILP (tem2))
649 up_event = Fread_event (Qnil, Qnil, Qnil);
650 }
651 }
652 break;
653
654 case 'U': /* Up event from last k or K */
655 if (!NILP (up_event))
656 {
657 args[i] = Fmake_vector (make_number (1), up_event);
658 up_event = Qnil;
659 teml = args[i];
660 visargs[i] = Fkey_description (teml, Qnil);
661 }
662 break;
663
664 case 'e': /* The invoking event. */
665 if (next_event >= key_count)
666 error ("%s must be bound to an event with parameters",
667 (SYMBOLP (function)
668 ? (char *) SDATA (SYMBOL_NAME (function))
669 : "command"));
670 args[i] = XVECTOR (keys)->contents[next_event++];
671 varies[i] = -1;
672
673 /* Find the next parameterized event. */
674 while (next_event < key_count
675 && ! (EVENT_HAS_PARAMETERS
676 (XVECTOR (keys)->contents[next_event])))
677 next_event++;
678
679 break;
680
681 case 'm': /* Value of mark. Does not do I/O. */
682 check_mark (0);
683 /* visargs[i] = Qnil; */
684 args[i] = current_buffer->mark;
685 varies[i] = 2;
686 break;
687
688 case 'M': /* String read via minibuffer with
689 inheriting the current input method. */
690 args[i] = Fread_string (callint_message,
691 Qnil, Qnil, Qnil, Qt);
692 break;
693
694 case 'N': /* Prefix arg as number, else number from minibuffer */
695 if (!NILP (prefix_arg))
696 goto have_prefix_arg;
697 case 'n': /* Read number from minibuffer. */
698 {
699 int first = 1;
700 do
701 {
702 Lisp_Object tem;
703 if (! first)
704 {
705 message ("Please enter a number.");
706 sit_for (make_number (1), 0, 0);
707 }
708 first = 0;
709
710 tem = Fread_from_minibuffer (callint_message,
711 Qnil, Qnil, Qnil, Qnil, Qnil,
712 Qnil);
713 if (! STRINGP (tem) || SCHARS (tem) == 0)
714 args[i] = Qnil;
715 else
716 args[i] = Fread (tem);
717 }
718 while (! NUMBERP (args[i]));
719 }
720 visargs[i] = args[i];
721 break;
722
723 case 'P': /* Prefix arg in raw form. Does no I/O. */
724 args[i] = prefix_arg;
725 /* visargs[i] = Qnil; */
726 varies[i] = -1;
727 break;
728
729 case 'p': /* Prefix arg converted to number. No I/O. */
730 have_prefix_arg:
731 args[i] = Fprefix_numeric_value (prefix_arg);
732 /* visargs[i] = Qnil; */
733 varies[i] = -1;
734 break;
735
736 case 'r': /* Region, point and mark as 2 args. */
737 check_mark (1);
738 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
739 /* visargs[i+1] = Qnil; */
740 foo = marker_position (current_buffer->mark);
741 /* visargs[i] = Qnil; */
742 args[i] = PT < foo ? point_marker : current_buffer->mark;
743 varies[i] = 3;
744 args[++i] = PT > foo ? point_marker : current_buffer->mark;
745 varies[i] = 4;
746 break;
747
748 case 's': /* String read via minibuffer without
749 inheriting the current input method. */
750 args[i] = Fread_string (callint_message,
751 Qnil, Qnil, Qnil, Qnil);
752 break;
753
754 case 'S': /* Any symbol. */
755 visargs[i] = Fread_string (callint_message,
756 Qnil, Qnil, Qnil, Qnil);
757 /* Passing args[i] directly stimulates compiler bug */
758 teml = visargs[i];
759 args[i] = Fintern (teml, Qnil);
760 break;
761
762 case 'v': /* Variable name: symbol that is
763 user-variable-p. */
764 args[i] = Fread_variable (callint_message, Qnil);
765 visargs[i] = last_minibuf_string;
766 break;
767
768 case 'x': /* Lisp expression read but not evaluated */
769 args[i] = Fread_minibuffer (callint_message, Qnil);
770 visargs[i] = last_minibuf_string;
771 break;
772
773 case 'X': /* Lisp expression read and evaluated */
774 args[i] = Feval_minibuffer (callint_message, Qnil);
775 visargs[i] = last_minibuf_string;
776 break;
777
778 case 'Z': /* Coding-system symbol, or ignore the
779 argument if no prefix */
780 if (NILP (prefix_arg))
781 {
782 args[i] = Qnil;
783 varies[i] = -1;
784 }
785 else
786 {
787 args[i]
788 = Fread_non_nil_coding_system (callint_message);
789 visargs[i] = last_minibuf_string;
790 }
791 break;
792
793 case 'z': /* Coding-system symbol or nil */
794 args[i] = Fread_coding_system (callint_message, Qnil);
795 visargs[i] = last_minibuf_string;
796 break;
797
798 /* We have a case for `+' so we get an error
799 if anyone tries to define one here. */
800 case '+':
801 default:
802 error ("Invalid control letter `%c' (%03o) in interactive calling string",
803 *tem, *tem);
804 }
805
806 if (varies[i] == 0)
807 arg_from_tty = 1;
808
809 if (NILP (visargs[i]) && STRINGP (args[i]))
810 visargs[i] = args[i];
811
812 tem = (unsigned char *) index (tem, '\n');
813 if (tem) tem++;
814 else tem = (unsigned char *) "";
815 }
816 unbind_to (speccount, Qnil);
817
818 QUIT;
819
820 args[0] = function;
821
822 if (arg_from_tty || !NILP (record_flag))
823 {
824 visargs[0] = function;
825 for (i = 1; i < count + 1; i++)
826 {
827 if (varies[i] > 0)
828 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
829 else
830 visargs[i] = quotify_arg (args[i]);
831 }
832 Vcommand_history = Fcons (Flist (count + 1, visargs),
833 Vcommand_history);
834 /* Don't keep command history around forever. */
835 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
836 {
837 teml = Fnthcdr (Vhistory_length, Vcommand_history);
838 if (CONSP (teml))
839 XSETCDR (teml, Qnil);
840 }
841 }
842
843 /* If we used a marker to hold point, mark, or an end of the region,
844 temporarily, convert it to an integer now. */
845 for (i = 1; i <= count; i++)
846 if (varies[i] >= 1 && varies[i] <= 4)
847 XSETINT (args[i], marker_position (args[i]));
848
849 if (record_then_fail)
850 Fbarf_if_buffer_read_only ();
851
852 Vthis_command = save_this_command;
853 Vthis_original_command = save_this_original_command;
854 real_this_command= save_real_this_command;
855 current_kboard->Vlast_command = save_last_command;
856
857 {
858 Lisp_Object val;
859 specbind (Qcommand_debug_status, Qnil);
860
861 temporarily_switch_to_single_kboard (NULL);
862 val = Ffuncall (count + 1, args);
863 UNGCPRO;
864 return unbind_to (speccount, val);
865 }
866}
867
868DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
869 1, 1, 0,
870 doc: /* Return numeric meaning of raw prefix argument RAW.
871A raw prefix argument is what you get from `(interactive "P")'.
872Its numeric meaning is what you would get from `(interactive "p")'. */)
873 (raw)
874 Lisp_Object raw;
875{
876 Lisp_Object val;
877
878 if (NILP (raw))
879 XSETFASTINT (val, 1);
880 else if (EQ (raw, Qminus))
881 XSETINT (val, -1);
882 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
883 XSETINT (val, XINT (XCAR (raw)));
884 else if (INTEGERP (raw))
885 val = raw;
886 else
887 XSETFASTINT (val, 1);
888
889 return val;
890}
891
892void
893syms_of_callint ()
894{
895 point_marker = Fmake_marker ();
896 staticpro (&point_marker);
897
898 callint_message = Qnil;
899 staticpro (&callint_message);
900
901 preserved_fns = Fcons (intern ("region-beginning"),
902 Fcons (intern ("region-end"),
903 Fcons (intern ("point"),
904 Fcons (intern ("mark"), Qnil))));
905 staticpro (&preserved_fns);
906
907 Qlist = intern ("list");
908 staticpro (&Qlist);
909 Qlet = intern ("let");
910 staticpro (&Qlet);
911 Qif = intern ("if");
912 staticpro (&Qif);
913 Qwhen = intern ("when");
914 staticpro (&Qwhen);
915 Qletx = intern ("let*");
916 staticpro (&Qletx);
917 Qsave_excursion = intern ("save-excursion");
918 staticpro (&Qsave_excursion);
919 Qprogn = intern ("progn");
920 staticpro (&Qprogn);
921
922 Qminus = intern ("-");
923 staticpro (&Qminus);
924
925 Qplus = intern ("+");
926 staticpro (&Qplus);
927
928 Qcall_interactively = intern ("call-interactively");
929 staticpro (&Qcall_interactively);
930
931 Qcommand_debug_status = intern ("command-debug-status");
932 staticpro (&Qcommand_debug_status);
933
934 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
935 staticpro (&Qenable_recursive_minibuffers);
936
937 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
938 staticpro (&Qmouse_leave_buffer_hook);
939
940 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
941 doc: /* The value of the prefix argument for the next editing command.
942It may be a number, or the symbol `-' for just a minus sign as arg,
943or a list whose car is a number for just one or more C-u's
944or nil if no argument has been specified.
945
946You cannot examine this variable to find the argument for this command
947since it has been set to nil by the time you can look.
948Instead, you should use the variable `current-prefix-arg', although
949normally commands can get this prefix argument with (interactive "P"). */);
950
951 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
952 doc: /* The value of the prefix argument for the previous editing command.
953See `prefix-arg' for the meaning of the value. */);
954
955 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
956 doc: /* The value of the prefix argument for this editing command.
957It may be a number, or the symbol `-' for just a minus sign as arg,
958or a list whose car is a number for just one or more C-u's
959or nil if no argument has been specified.
960This is what `(interactive \"P\")' returns. */);
961 Vcurrent_prefix_arg = Qnil;
962
963 DEFVAR_LISP ("command-history", &Vcommand_history,
964 doc: /* List of recent commands that read arguments from terminal.
965Each command is represented as a form to evaluate. */);
966 Vcommand_history = Qnil;
967
968 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
969 doc: /* Debugging status of current interactive command.
970Bound each time `call-interactively' is called;
971may be set by the debugger as a reminder for itself. */);
972 Vcommand_debug_status = Qnil;
973
974 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
975 doc: /* *Non-nil means you can use the mark even when inactive.
976This option makes a difference in Transient Mark mode.
977When the option is non-nil, deactivation of the mark
978turns off region highlighting, but commands that use the mark
979behave as if the mark were still active. */);
980 Vmark_even_if_inactive = Qnil;
981
982 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
983 doc: /* Hook to run when about to switch windows with a mouse command.
984Its purpose is to give temporary modes such as Isearch mode
985a way to turn themselves off when a mouse command switches windows. */);
986 Vmouse_leave_buffer_hook = Qnil;
987
988 defsubr (&Sinteractive);
989 defsubr (&Scall_interactively);
990 defsubr (&Sprefix_numeric_value);
991}
992
993/* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
994 (do not change this comment) */