don't use function-equal in nadvice
[bpt/emacs.git] / src / callint.c
CommitLineData
ec28a64d 1/* Call a Lisp function interactively.
ba318903 2 Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software
ab422c4d 3 Foundation, Inc.
ec28a64d
MB
4
5This file is part of GNU Emacs.
6
9ec0b715 7GNU Emacs is free software: you can redistribute it and/or modify
ec28a64d 8it under the terms of the GNU General Public License as published by
9ec0b715
GM
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
ec28a64d
MB
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
9ec0b715 18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
ec28a64d
MB
19
20
18160b98 21#include <config.h>
fdb82f93 22
ec28a64d 23#include "lisp.h"
e5560ff7 24#include "character.h"
ec28a64d
MB
25#include "buffer.h"
26#include "commands.h"
760cbdd3 27#include "keyboard.h"
ec28a64d 28#include "window.h"
8feddab4 29#include "keymap.h"
ec28a64d 30
29208e82 31Lisp_Object Qminus, Qplus;
0e4857b7 32static Lisp_Object Qfuncall_interactively;
955cbe7b
PE
33static Lisp_Object Qcommand_debug_status;
34static Lisp_Object Qenable_recursive_minibuffers;
ec28a64d 35
955cbe7b 36static Lisp_Object Qhandle_shift_selection;
0208ede7 37static Lisp_Object Qread_number;
9bdb1538 38
29208e82 39Lisp_Object Qmouse_leave_buffer_hook;
ef2515c0 40
12b1389c
DC
41static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif;
42Lisp_Object Qwhen, Qprogn;
824977b6
RS
43static Lisp_Object preserved_fns;
44
45/* Marker used within call-interactively to refer to point. */
46static Lisp_Object point_marker;
03e130d5 47
55b41ef5
CY
48/* String for the prompt text used in Fcall_interactively. */
49static Lisp_Object callint_message;
425b457e 50\f
ec28a64d
MB
51/* Quotify EXP: if EXP is constant, return it.
52 If EXP is not constant, return (quote EXP). */
b1349114 53static Lisp_Object
971de7fb 54quotify_arg (register Lisp_Object exp)
ec28a64d 55{
d032d5e7
SM
56 if (CONSP (exp)
57 || (SYMBOLP (exp)
58 && !NILP (exp) && !EQ (exp, Qt)))
6c6f1994 59 return list2 (Qquote, exp);
ec28a64d
MB
60
61 return exp;
62}
63
64/* Modify EXP by quotifying each element (except the first). */
b1349114 65static Lisp_Object
971de7fb 66quotify_args (Lisp_Object exp)
ec28a64d
MB
67{
68 register Lisp_Object tail;
7539e11f
KR
69 Lisp_Object next;
70 for (tail = exp; CONSP (tail); tail = next)
ec28a64d 71 {
7539e11f 72 next = XCDR (tail);
f3fbd155 73 XSETCAR (tail, quotify_arg (XCAR (tail)));
ec28a64d
MB
74 }
75 return exp;
76}
77
648801d1 78static const char *callint_argfuns[]
ec28a64d
MB
79 = {"", "point", "mark", "region-beginning", "region-end"};
80
81static void
2f221583 82check_mark (bool for_region)
ec28a64d 83{
86c1cf23 84 Lisp_Object tem;
4b4deea2 85 tem = Fmarker_buffer (BVAR (current_buffer, mark));
265a9e55 86 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
f203cf07
RS
87 error (for_region ? "The mark is not set now, so there is no region"
88 : "The mark is not set now");
6497d2d8 89 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
4b4deea2 90 && NILP (BVAR (current_buffer, mark_active)))
f439241f 91 xsignal0 (Qmark_inactive);
ec28a64d
MB
92}
93
64ea14d3
RS
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
d1135afc 102static void
971de7fb 103fix_command (Lisp_Object input, Lisp_Object values)
d1135afc 104{
d032d5e7 105 /* FIXME: Instead of this ugly hack, we should provide a way for an
7200d79c
SM
106 interactive spec to return an expression/function that will re-build the
107 args without user intervention. */
d1135afc
JB
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);
5dc05618 130 intail = Fcdr (intail), valtail = XCDR (valtail))
d1135afc
JB
131 {
132 Lisp_Object elt;
133 elt = Fcar (intail);
134 if (CONSP (elt))
135 {
136 Lisp_Object presflag, carelt;
7d7bbefd 137 carelt = XCAR (elt);
d1135afc
JB
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}
ec28a64d 164
9dc774d4
DA
165/* Helper function to call `read-file-name' from C. */
166
167static Lisp_Object
168read_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
0e4857b7
SM
185/* BEWARE: Calling this directly from C would defeat the purpose! */
186DEFUN ("funcall-interactively", Ffuncall_interactively, Sfuncall_interactively,
187 1, MANY, 0, doc: /* Like `funcall' but marks the call as interactive.
188I.e. arrange that within the called function `called-interactively-p' will
cc304290
JB
189return non-nil.
190usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */)
0e4857b7
SM
191 (ptrdiff_t nargs, Lisp_Object *args)
192{
b0412f9d 193 dynwind_begin ();
0e4857b7
SM
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. */
b0412f9d
RT
199 Lisp_Object tem = Ffuncall (nargs, args);
200 dynwind_end ();
201 return tem;
0e4857b7
SM
202}
203
d455db8e 204DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
54e10184 205 doc: /* Call FUNCTION, providing args according to its interactive calling specs.
fdb82f93
PJ
206Return the value FUNCTION returns.
207The function contains a specification of how to do the argument reading.
208In the case of user-defined functions, this is specified by placing a call
209to the function `interactive' at the top level of the function body.
210See `interactive'.
211
212Optional second arg RECORD-FLAG non-nil
213means unconditionally put this command in the command-history.
214Otherwise, this is done only if an arg is read using the minibuffer.
2a95a27c 215
fdb82f93 216Optional third arg KEYS, if given, specifies the sequence of events to
2a95a27c
CY
217supply, as a vector, if the command inquires which events were used to
218invoke it. If KEYS is omitted or nil, the return value of
219`this-command-keys-vector' is used. */)
5842a27b 220 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
ec28a64d 221{
07ff4ac6
SM
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. */
ec28a64d 225 Lisp_Object *args, *visargs;
ec28a64d 226 Lisp_Object specs;
079e479f 227 Lisp_Object filter_specs;
ec28a64d 228 Lisp_Object teml;
39900c4e 229 Lisp_Object up_event;
52614803 230 Lisp_Object enable;
3200038e 231 dynwind_begin ();
ec28a64d 232
bc78232c
JB
233 /* The index of the next element of this_command_keys to examine for
234 the 'e' interactive code. */
d311d28c 235 ptrdiff_t next_event;
bc78232c 236
ec28a64d 237 Lisp_Object prefix_arg;
a2db9982 238 char *string;
b0e80955 239 const char *tem;
63007de2
JB
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]]. */
f66c7cf8 244 signed char *varies;
63007de2 245
f66c7cf8 246 ptrdiff_t i, nargs;
2f221583
PE
247 ptrdiff_t mark;
248 bool arg_from_tty = 0;
39900c4e 249 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
d311d28c 250 ptrdiff_t key_count;
2f221583 251 bool record_then_fail = 0;
d455db8e 252
0605dd79
RS
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;
f2d6a3df 258 save_real_this_command = Vreal_this_command;
1344aad4 259 save_last_command = KVAR (current_kboard, Vlast_command);
0605dd79 260
d455db8e
RS
261 if (NILP (keys))
262 keys = this_command_keys, key_count = this_command_key_count;
263 else
264 {
b7826503 265 CHECK_VECTOR (keys);
77b37c05 266 key_count = ASIZE (keys);
d455db8e 267 }
ec28a64d 268
f2d6a3df 269 /* Save this now, since use of minibuffer will clobber it. */
8c917bf2 270 prefix_arg = Vcurrent_prefix_arg;
ec28a64d 271
6e54b3de 272 if (SYMBOLP (function))
afa4c0f3 273 enable = Fget (function, Qenable_recursive_minibuffers);
4f895918
GM
274 else
275 enable = Qnil;
52614803 276
ec28a64d
MB
277 specs = Qnil;
278 string = 0;
bd21bf41 279 /* The idea of FILTER_SPECS is to provide a way to
079e479f
RS
280 specify how to represent the arguments in command history.
281 The feature is not fully implemented. */
282 filter_specs = Qnil;
ec28a64d 283
f2d6a3df
SM
284 /* If k or K discard an up-event, save it here so it can be retrieved with
285 U. */
39900c4e
KS
286 up_event = Qnil;
287
ccb5c14f 288 /* Set SPECS to the interactive form, or barf if not interactive. */
023accd6
SM
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 }
ec28a64d 299
ccb5c14f 300 /* If SPECS is set to a string, use it as an interactive prompt. */
6e54b3de 301 if (STRINGP (specs))
5b71542d
DA
302 /* Make a copy of string so that if a GC relocates specs,
303 `string' will still be valid. */
304 string = xlispstrdupa (specs);
023accd6 305 else
ec28a64d 306 {
03e130d5 307 Lisp_Object input;
d032d5e7 308 Lisp_Object funval = Findirect_function (function, Qt);
3300e6fd 309 uintmax_t events = num_input_events;
03e130d5
RS
310 input = specs;
311 /* Compute the arg values using the user's expression. */
079e479f 312 GCPRO2 (input, filter_specs);
d032d5e7 313 specs = Feval (specs,
b5071fc7
SM
314 CONSP (funval) && EQ (Qclosure, XCAR (funval))
315 ? CAR_SAFE (XCDR (funval)) : Qnil);
079e479f 316 UNGCPRO;
a1759b76 317 if (events != num_input_events || !NILP (record_flag))
03e130d5
RS
318 {
319 /* We should record this command on the command history. */
f1321dc3 320 Lisp_Object values;
d65859c3 321 Lisp_Object this_cmd;
03e130d5
RS
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));
120d0a23 325 fix_command (input, values);
d65859c3
DN
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);
225c2157
RS
330
331 /* Don't keep command history around forever. */
b9f0b172 332 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
333 {
334 teml = Fnthcdr (Vhistory_length, Vcommand_history);
335 if (CONSP (teml))
f3fbd155 336 XSETCDR (teml, Qnil);
225c2157 337 }
03e130d5 338 }
0605dd79
RS
339
340 Vthis_command = save_this_command;
341 Vthis_original_command = save_this_original_command;
f2d6a3df 342 Vreal_this_command = save_real_this_command;
15dbb4d6 343 kset_last_command (current_kboard, save_last_command);
0605dd79 344
0e4857b7 345 {
3200038e 346 Lisp_Object tem0, args[3];
0e4857b7
SM
347 args[0] = Qfuncall_interactively;
348 args[1] = function;
349 args[2] = specs;
3200038e
BT
350 tem0 = Fapply (3, args);
351 dynwind_end ();
352 return tem0;
0e4857b7 353 }
ec28a64d
MB
354 }
355
f2d6a3df 356 /* Here if function specifies a string to control parsing the defaults. */
ec28a64d 357
dbc4e1c1 358 /* Set next_event to point to the first event with parameters. */
d455db8e 359 for (next_event = 0; next_event < key_count; next_event++)
1b511542 360 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
dbc4e1c1 361 break;
09c886dc 362
42bb2790 363 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 364 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
365 while (1)
366 {
fb775602 367 if (*string == '+')
e92d107b
RS
368 error ("`+' is not used in `interactive' for ordinary commands");
369 else if (*string == '*')
ec28a64d
MB
370 {
371 string++;
4b4deea2 372 if (!NILP (BVAR (current_buffer, read_only)))
09c886dc
RS
373 {
374 if (!NILP (record_flag))
375 {
a2db9982 376 char *p = string;
09c886dc
RS
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 }
ec28a64d 389 }
42bb2790
RS
390 /* Ignore this for semi-compatibility with Lucid. */
391 else if (*string == '-')
392 string++;
ec28a64d
MB
393 else if (*string == '@')
394 {
a3e8cbda 395 Lisp_Object event, w;
dbc4e1c1 396
170d3006 397 event = (next_event < key_count
1b511542 398 ? AREF (keys, next_event)
170d3006 399 : Qnil);
dbc4e1c1 400 if (EVENT_HAS_PARAMETERS (event)
a3e8cbda
PE
401 && (w = XCDR (event), CONSP (w))
402 && (w = XCAR (w), CONSP (w))
403 && (w = XCAR (w), WINDOWP (w)))
d1fa2e8a 404 {
a3e8cbda
PE
405 if (MINI_WINDOW_P (XWINDOW (w))
406 && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
d1fa2e8a 407 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
408
409 /* If the current buffer wants to clean up, let it. */
dee091a3 410 Frun_hooks (1, &Qmouse_leave_buffer_hook);
ef2515c0 411
a3e8cbda 412 Fselect_window (w, Qnil);
d1fa2e8a 413 }
ec28a64d 414 string++;
ec28a64d 415 }
9bdb1538
CY
416 else if (*string == '^')
417 {
84db11d6 418 call0 (Qhandle_shift_selection);
9bdb1538
CY
419 string++;
420 }
ec28a64d
MB
421 else break;
422 }
423
0e4857b7
SM
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. */
ec28a64d 427 tem = string;
0e4857b7 428 for (nargs = 2; *tem; )
ec28a64d
MB
429 {
430 /* 'r' specifications ("point and mark as 2 numeric args")
431 produce *two* arguments. */
e4305426 432 if (*tem == 'r')
becfa255 433 nargs += 2;
e4305426 434 else
becfa255 435 nargs++;
a2db9982 436 tem = strchr (tem, '\n');
ec28a64d 437 if (tem)
e4305426 438 ++tem;
ec28a64d 439 else
e4305426 440 break;
ec28a64d 441 }
ec28a64d 442
f66c7cf8 443 if (min (MOST_POSITIVE_FIXNUM,
663e2b3f 444 min (PTRDIFF_MAX, SIZE_MAX) / word_size)
f66c7cf8
PE
445 < nargs)
446 memory_full (SIZE_MAX);
447
38182d90
PE
448 args = alloca (nargs * sizeof *args);
449 visargs = alloca (nargs * sizeof *visargs);
450 varies = alloca (nargs * sizeof *varies);
ec28a64d 451
becfa255 452 for (i = 0; i < nargs; i++)
ec28a64d
MB
453 {
454 args[i] = Qnil;
455 visargs[i] = Qnil;
456 varies[i] = 0;
457 }
458
39900c4e 459 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
becfa255
PE
460 gcpro3.nvars = nargs;
461 gcpro4.nvars = nargs;
ec28a64d 462
52614803
RS
463 if (!NILP (enable))
464 specbind (Qenable_recursive_minibuffers, Qt);
465
ec28a64d 466 tem = string;
0e4857b7 467 for (i = 2; *tem; i++)
ec28a64d 468 {
0e4857b7
SM
469 visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
470 if (strchr (SSDATA (visargs[1]), '%'))
319e8ddc 471 callint_message = Fformat (i - 1, visargs + 1);
55b41ef5 472 else
0e4857b7 473 callint_message = visargs[1];
ec28a64d
MB
474
475 switch (*tem)
476 {
b09cca6a 477 case 'a': /* Symbol defined as a function. */
55b41ef5 478 visargs[i] = Fcompleting_read (callint_message,
ff9cd111 479 Vobarray, Qfboundp, Qt,
93fb51ae 480 Qnil, Qnil, Qnil, Qnil);
b09cca6a 481 /* Passing args[i] directly stimulates compiler bug. */
ec28a64d
MB
482 teml = visargs[i];
483 args[i] = Fintern (teml, Qnil);
484 break;
485
b09cca6a 486 case 'b': /* Name of existing buffer. */
f03f8f2c
JL
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
b09cca6a 493 case 'B': /* Name of buffer, possibly nonexistent. */
f03f8f2c
JL
494 args[i] = Fread_buffer (callint_message,
495 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
496 Qnil);
ec28a64d
MB
497 break;
498
b09cca6a 499 case 'c': /* Character. */
54b33868
MR
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);
55b41ef5 504 args[i] = Fread_char (callint_message, Qnil, Qnil);
7d652d97 505 message1_nolog (0);
b09cca6a 506 /* Passing args[i] directly stimulates compiler bug. */
ec28a64d 507 teml = args[i];
c8fd3bd0
GM
508 /* See bug#8479. */
509 if (! CHARACTERP (teml)) error ("Non-character input-event");
ec28a64d
MB
510 visargs[i] = Fchar_to_string (teml);
511 break;
512
b09cca6a 513 case 'C': /* Command: symbol with interactive function. */
55b41ef5 514 visargs[i] = Fcompleting_read (callint_message,
ff9cd111 515 Vobarray, Qcommandp,
93fb51ae 516 Qt, Qnil, Qnil, Qnil, Qnil);
b09cca6a 517 /* Passing args[i] directly stimulates compiler bug. */
ec28a64d
MB
518 teml = visargs[i];
519 args[i] = Fintern (teml, Qnil);
520 break;
521
522 case 'd': /* Value of point. Does not do I/O. */
dc330139 523 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 524 args[i] = point_marker;
ec28a64d
MB
525 /* visargs[i] = Qnil; */
526 varies[i] = 1;
527 break;
528
b09cca6a 529 case 'D': /* Directory name. */
9dc774d4
DA
530 args[i] = read_file_name (BVAR (current_buffer, directory), Qlambda, Qnil,
531 Qfile_directory_p);
ec28a64d
MB
532 break;
533
b09cca6a 534 case 'f': /* Existing file name. */
9dc774d4 535 args[i] = read_file_name (Qnil, Qlambda, Qnil, Qnil);
ec28a64d
MB
536 break;
537
b09cca6a 538 case 'F': /* Possibly nonexistent file name. */
9dc774d4 539 args[i] = read_file_name (Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
540 break;
541
75f9fbe8 542 case 'G': /* Possibly nonexistent file name,
b09cca6a 543 default to directory alone. */
9dc774d4 544 args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil);
75f9fbe8
RS
545 break;
546
b09cca6a 547 case 'i': /* Ignore an argument -- Does not do I/O. */
40b2421c
KH
548 varies[i] = -1;
549 break;
550
b09cca6a 551 case 'k': /* Key sequence. */
c631c234 552 {
3200038e 553 dynwind_begin ();
c631c234 554 specbind (Qcursor_in_echo_area, Qt);
54b33868
MR
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);
55b41ef5 559 args[i] = Fread_key_sequence (callint_message,
ad4ac475 560 Qnil, Qnil, Qnil, Qnil);
3200038e 561 dynwind_end ();
c631c234 562 teml = args[i];
a1bfe073 563 visargs[i] = Fkey_description (teml, Qnil);
cdfac812
RS
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))
70949dac 569 teml = XCAR (teml);
cdfac812
RS
570 if (SYMBOLP (teml))
571 {
572 Lisp_Object tem2;
573
574 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
575 /* Ignore first element, which is the base key. */
576 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 577 if (! NILP (tem2))
43811b4e 578 up_event = Fread_event (Qnil, Qnil, Qnil);
cdfac812 579 }
c631c234 580 }
1989e7bc
RS
581 break;
582
b09cca6a 583 case 'K': /* Key sequence to be defined. */
c631c234 584 {
3200038e 585 dynwind_begin ();
c631c234 586 specbind (Qcursor_in_echo_area, Qt);
54b33868
MR
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);
d99760fa
SM
591 args[i] = Fread_key_sequence_vector (callint_message,
592 Qnil, Qt, Qnil, Qnil);
c631c234 593 teml = args[i];
a1bfe073 594 visargs[i] = Fkey_description (teml, Qnil);
3200038e 595 dynwind_end ();
cdfac812
RS
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))
70949dac 601 teml = XCAR (teml);
cdfac812
RS
602 if (SYMBOLP (teml))
603 {
604 Lisp_Object tem2;
605
606 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
607 /* Ignore first element, which is the base key. */
608 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 609 if (! NILP (tem2))
43811b4e 610 up_event = Fread_event (Qnil, Qnil, Qnil);
cdfac812 611 }
c631c234 612 }
ec28a64d
MB
613 break;
614
b09cca6a 615 case 'U': /* Up event from last k or K. */
39900c4e
KS
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
bc78232c 625 case 'e': /* The invoking event. */
d455db8e 626 if (next_event >= key_count)
bc78232c 627 error ("%s must be bound to an event with parameters",
6e54b3de 628 (SYMBOLP (function)
51b59d79 629 ? SSDATA (SYMBOL_NAME (function))
bc78232c 630 : "command"));
1b511542
SM
631 args[i] = AREF (keys, next_event);
632 next_event++;
e5d77022 633 varies[i] = -1;
dbc4e1c1
JB
634
635 /* Find the next parameterized event. */
d455db8e 636 while (next_event < key_count
1b511542 637 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
dbc4e1c1
JB
638 next_event++;
639
63007de2
JB
640 break;
641
ec28a64d 642 case 'm': /* Value of mark. Does not do I/O. */
f203cf07 643 check_mark (0);
ec28a64d 644 /* visargs[i] = Qnil; */
4b4deea2 645 args[i] = BVAR (current_buffer, mark);
ec28a64d
MB
646 varies[i] = 2;
647 break;
648
93fb51ae
KH
649 case 'M': /* String read via minibuffer with
650 inheriting the current input method. */
55b41ef5 651 args[i] = Fread_string (callint_message,
93fb51ae
KH
652 Qnil, Qnil, Qnil, Qt);
653 break;
654
b09cca6a 655 case 'N': /* Prefix arg as number, else number from minibuffer. */
265a9e55 656 if (!NILP (prefix_arg))
ec28a64d
MB
657 goto have_prefix_arg;
658 case 'n': /* Read number from minibuffer. */
0208ede7 659 args[i] = call1 (Qread_number, callint_message);
a261c53e
JL
660 /* Passing args[i] directly stimulates compiler bug. */
661 teml = args[i];
662 visargs[i] = Fnumber_to_string (teml);
ec28a64d
MB
663 break;
664
665 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
666 args[i] = prefix_arg;
667 /* visargs[i] = Qnil; */
668 varies[i] = -1;
669 break;
670
b09cca6a 671 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 672 have_prefix_arg:
ec28a64d
MB
673 args[i] = Fprefix_numeric_value (prefix_arg);
674 /* visargs[i] = Qnil; */
675 varies[i] = -1;
676 break;
677
b09cca6a 678 case 'r': /* Region, point and mark as 2 args. */
f203cf07 679 check_mark (1);
dc330139 680 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d 681 /* visargs[i+1] = Qnil; */
2f221583 682 mark = marker_position (BVAR (current_buffer, mark));
ec28a64d 683 /* visargs[i] = Qnil; */
2f221583 684 args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
ec28a64d 685 varies[i] = 3;
2f221583 686 args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
ec28a64d
MB
687 varies[i] = 4;
688 break;
689
93fb51ae
KH
690 case 's': /* String read via minibuffer without
691 inheriting the current input method. */
55b41ef5 692 args[i] = Fread_string (callint_message,
93fb51ae 693 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
694 break;
695
696 case 'S': /* Any symbol. */
55b41ef5 697 visargs[i] = Fread_string (callint_message,
93fb51ae 698 Qnil, Qnil, Qnil, Qnil);
b09cca6a 699 /* Passing args[i] directly stimulates compiler bug. */
ec28a64d
MB
700 teml = visargs[i];
701 args[i] = Fintern (teml, Qnil);
702 break;
703
704 case 'v': /* Variable name: symbol that is
b09cca6a 705 custom-variable-p. */
55b41ef5 706 args[i] = Fread_variable (callint_message, Qnil);
ec28a64d
MB
707 visargs[i] = last_minibuf_string;
708 break;
709
b09cca6a 710 case 'x': /* Lisp expression read but not evaluated. */
30c7e542 711 args[i] = call1 (intern ("read-minibuffer"), callint_message);
ec28a64d
MB
712 visargs[i] = last_minibuf_string;
713 break;
714
b09cca6a 715 case 'X': /* Lisp expression read and evaluated. */
30c7e542 716 args[i] = call1 (intern ("eval-minibuffer"), callint_message);
ec28a64d
MB
717 visargs[i] = last_minibuf_string;
718 break;
719
40b2421c 720 case 'Z': /* Coding-system symbol, or ignore the
b09cca6a 721 argument if no prefix. */
40b2421c
KH
722 if (NILP (prefix_arg))
723 {
724 args[i] = Qnil;
725 varies[i] = -1;
726 }
177c0ea7 727 else
40b2421c
KH
728 {
729 args[i]
55b41ef5 730 = Fread_non_nil_coding_system (callint_message);
40b2421c
KH
731 visargs[i] = last_minibuf_string;
732 }
733 break;
734
b09cca6a 735 case 'z': /* Coding-system symbol or nil. */
55b41ef5 736 args[i] = Fread_coding_system (callint_message, Qnil);
40b2421c
KH
737 visargs[i] = last_minibuf_string;
738 break;
739
e92d107b
RS
740 /* We have a case for `+' so we get an error
741 if anyone tries to define one here. */
742 case '+':
ec28a64d 743 default:
e6c3da20
EZ
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));
ec28a64d
MB
748 }
749
750 if (varies[i] == 0)
751 arg_from_tty = 1;
752
6e54b3de 753 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
754 visargs[i] = args[i];
755
a2db9982 756 tem = strchr (tem, '\n');
ec28a64d 757 if (tem) tem++;
a2db9982 758 else tem = "";
ec28a64d 759 }
3200038e 760 dynwind_end ();
b0412f9d 761 dynwind_begin ();
ec28a64d
MB
762
763 QUIT;
764
0e4857b7
SM
765 args[0] = Qfuncall_interactively;
766 args[1] = function;
ec28a64d 767
7868a977 768 if (arg_from_tty || !NILP (record_flag))
ec28a64d 769 {
07ff4ac6
SM
770 /* We don't need `visargs' any more, so let's recycle it since we need
771 an array of just the same size. */
0e4857b7
SM
772 visargs[1] = function;
773 for (i = 2; i < nargs; i++)
824977b6
RS
774 {
775 if (varies[i] > 0)
6c6f1994 776 visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
824977b6
RS
777 else
778 visargs[i] = quotify_arg (args[i]);
779 }
0e4857b7 780 Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1),
ec28a64d 781 Vcommand_history);
225c2157 782 /* Don't keep command history around forever. */
b9f0b172 783 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
784 {
785 teml = Fnthcdr (Vhistory_length, Vcommand_history);
786 if (CONSP (teml))
f3fbd155 787 XSETCDR (teml, Qnil);
225c2157 788 }
ec28a64d
MB
789 }
790
824977b6
RS
791 /* If we used a marker to hold point, mark, or an end of the region,
792 temporarily, convert it to an integer now. */
0e4857b7 793 for (i = 2; i < nargs; i++)
824977b6
RS
794 if (varies[i] >= 1 && varies[i] <= 4)
795 XSETINT (args[i], marker_position (args[i]));
796
09c886dc
RS
797 if (record_then_fail)
798 Fbarf_if_buffer_read_only ();
799
0605dd79
RS
800 Vthis_command = save_this_command;
801 Vthis_original_command = save_this_original_command;
f2d6a3df 802 Vreal_this_command = save_real_this_command;
15dbb4d6 803 kset_last_command (current_kboard, save_last_command);
0605dd79 804
ec28a64d 805 {
0e4857b7 806 Lisp_Object val = Ffuncall (nargs, args);
ec28a64d 807 UNGCPRO;
3200038e
BT
808 dynwind_end ();
809 return val;
ec28a64d 810 }
177c0ea7 811}
ec28a64d 812
a7ca3326 813DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
fdb82f93
PJ
814 1, 1, 0,
815 doc: /* Return numeric meaning of raw prefix argument RAW.
816A raw prefix argument is what you get from `(interactive "P")'.
817Its numeric meaning is what you would get from `(interactive "p")'. */)
5842a27b 818 (Lisp_Object raw)
ec28a64d
MB
819{
820 Lisp_Object val;
177c0ea7 821
265a9e55 822 if (NILP (raw))
acab6442 823 XSETFASTINT (val, 1);
fd5285f3 824 else if (EQ (raw, Qminus))
ec28a64d 825 XSETINT (val, -1);
70949dac
KR
826 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
827 XSETINT (val, XINT (XCAR (raw)));
6e54b3de 828 else if (INTEGERP (raw))
ec28a64d
MB
829 val = raw;
830 else
acab6442 831 XSETFASTINT (val, 1);
ec28a64d
MB
832
833 return val;
834}
835
dfcf069d 836void
971de7fb 837syms_of_callint (void)
ec28a64d 838{
172a66a1
BT
839#include "callint.x"
840
824977b6
RS
841 point_marker = Fmake_marker ();
842 staticpro (&point_marker);
843
55b41ef5
CY
844 callint_message = Qnil;
845 staticpro (&callint_message);
846
3438fe21 847 preserved_fns = listn (CONSTYPE_PURE, 4,
694b6c97
DA
848 intern_c_string ("region-beginning"),
849 intern_c_string ("region-end"),
850 intern_c_string ("point"),
851 intern_c_string ("mark"));
03e130d5 852
cd3520a4
JB
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");
0208ede7 863 DEFSYM (Qread_number, "read-number");
0e4857b7 864 DEFSYM (Qfuncall_interactively, "funcall-interactively");
cd3520a4
JB
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");
ef2515c0 868
1e0c5826 869 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
fdb82f93
PJ
870 doc: /* The value of the prefix argument for the next editing command.
871It may be a number, or the symbol `-' for just a minus sign as arg,
872or a list whose car is a number for just one or more C-u's
873or nil if no argument has been specified.
874
875You cannot examine this variable to find the argument for this command
876since it has been set to nil by the time you can look.
877Instead, you should use the variable `current-prefix-arg', although
878normally commands can get this prefix argument with (interactive "P"). */);
8c917bf2 879
fe3fbdcc 880 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
fdb82f93
PJ
881 doc: /* The value of the prefix argument for the previous editing command.
882See `prefix-arg' for the meaning of the value. */);
fe3fbdcc 883
29208e82 884 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
fdb82f93
PJ
885 doc: /* The value of the prefix argument for this editing command.
886It may be a number, or the symbol `-' for just a minus sign as arg,
887or a list whose car is a number for just one or more C-u's
888or nil if no argument has been specified.
889This is what `(interactive \"P\")' returns. */);
8c917bf2
KH
890 Vcurrent_prefix_arg = Qnil;
891
29208e82 892 DEFVAR_LISP ("command-history", Vcommand_history,
fdb82f93 893 doc: /* List of recent commands that read arguments from terminal.
b014713c
EZ
894Each command is represented as a form to evaluate.
895
896Maximum length of the history list is determined by the value
897of `history-length', which see. */);
ec28a64d
MB
898 Vcommand_history = Qnil;
899
29208e82 900 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
fdb82f93
PJ
901 doc: /* Debugging status of current interactive command.
902Bound each time `call-interactively' is called;
903may be set by the debugger as a reminder for itself. */);
ec28a64d
MB
904 Vcommand_debug_status = Qnil;
905
29208e82 906 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
fb7ada5f 907 doc: /* Non-nil means you can use the mark even when inactive.
fdb82f93
PJ
908This option makes a difference in Transient Mark mode.
909When the option is non-nil, deactivation of the mark
910turns off region highlighting, but commands that use the mark
911behave as if the mark were still active. */);
a2b84f35 912 Vmark_even_if_inactive = Qt;
9f315aeb 913
29208e82 914 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
fdb82f93
PJ
915 doc: /* Hook to run when about to switch windows with a mouse command.
916Its purpose is to give temporary modes such as Isearch mode
917a way to turn themselves off when a mouse command switches windows. */);
ef2515c0 918 Vmouse_leave_buffer_hook = Qnil;
ec28a64d 919}