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