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