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