(Fcall_interactively): Fix previous change.
[bpt/emacs.git] / src / callint.c
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include <config.h>
22 #include "lisp.h"
23 #include "buffer.h"
24 #include "commands.h"
25 #include "keyboard.h"
26 #include "window.h"
27 #include "mocklisp.h"
28
29 extern char *index ();
30
31 int current_prefix_partial;
32 Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus, Qplus;
33 Lisp_Object Qcall_interactively;
34 Lisp_Object Vcommand_history;
35
36 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
37 Lisp_Object Qenable_recursive_minibuffers;
38
39 /* Non-nil means treat the mark as active
40 even if mark_active is 0. */
41 Lisp_Object Vmark_even_if_inactive;
42
43 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
44
45 Lisp_Object Qlist;
46 static Lisp_Object preserved_fns;
47
48 /* Marker used within call-interactively to refer to point. */
49 static Lisp_Object point_marker;
50
51
52 void
53 clear_prefix_arg ()
54 {
55 Vprefix_arg = Qnil;
56 if (!current_prefix_partial)
57 {
58 current_kboard->prefix_factor = Qnil;
59 current_kboard->prefix_value = Qnil;
60 current_kboard->prefix_sign = 1;
61 current_kboard->prefix_partial = 0;
62 }
63 }
64
65 void
66 finalize_prefix_arg ()
67 {
68 if (!NILP (current_kboard->prefix_factor))
69 Vprefix_arg = Fcons (current_kboard->prefix_factor, Qnil);
70 else if (NILP (current_kboard->prefix_value))
71 Vprefix_arg = (current_kboard->prefix_sign > 0 ? Qnil : Qminus);
72 else if (current_kboard->prefix_sign > 0)
73 Vprefix_arg = current_kboard->prefix_value;
74 else
75 XSETINT (Vprefix_arg, -XINT (current_kboard->prefix_value));
76 current_kboard->prefix_partial = 0;
77 }
78
79 static void
80 describe_prefix_arg ()
81 {
82 if (INTEGERP (Vprefix_arg))
83 message ("Arg: %d", Vprefix_arg);
84 else if (CONSP (Vprefix_arg))
85 message ("Arg: [%d]", XCONS (Vprefix_arg)->car);
86 else if (EQ (Vprefix_arg, Qminus))
87 message ("Arg: -");
88 }
89
90
91 /* This comment supplies the doc string for interactive,
92 for make-docfile to see. We cannot put this in the real DEFUN
93 due to limits in the Unix cpp.
94
95 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
96 "Specify a way of parsing arguments for interactive use of a function.\n\
97 For example, write\n\
98 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
99 to make ARG be the prefix argument when `foo' is called as a command.\n\
100 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
101 it tells `call-interactively' how to read arguments\n\
102 to pass to the function.\n\
103 When actually called, `interactive' just returns nil.\n\
104 \n\
105 The argument of `interactive' is usually a string containing a code letter\n\
106 followed by a prompt. (Some code letters do not use I/O to get\n\
107 the argument and do not need prompts.) To prompt for multiple arguments,\n\
108 give a code letter, its prompt, a newline, and another code letter, etc.\n\
109 Prompts are passed to format, and may use % escapes to print the\n\
110 arguments that have already been read.\n\
111 If the argument is not a string, it is evaluated to get a list of\n\
112 arguments to pass to the function.\n\
113 Just `(interactive)' means pass no args when calling interactively.\n\
114 \nCode letters available are:\n\
115 a -- Function name: symbol with a function definition.\n\
116 b -- Name of existing buffer.\n\
117 B -- Name of buffer, possibly nonexistent.\n\
118 c -- Character.\n\
119 C -- Command name: symbol with interactive function definition.\n\
120 d -- Value of point as number. Does not do I/O.\n\
121 D -- Directory name.\n\
122 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
123 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
124 This skips events that are integers or symbols.\n\
125 f -- Existing file name.\n\
126 F -- Possibly nonexistent file name.\n\
127 k -- Key sequence (downcase the last event if needed to get a definition).\n\
128 K -- Key sequence to be redefined (do not downcase the last event).\n\
129 m -- Value of mark as number. Does not do I/O.\n\
130 n -- Number read using minibuffer.\n\
131 N -- Raw prefix arg, or if none, do like code `n'.\n\
132 p -- Prefix arg converted to number. Does not do I/O.\n\
133 P -- Prefix arg in raw form. Does not do I/O.\n\
134 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
135 s -- Any string.\n\
136 S -- Any symbol.\n\
137 v -- Variable name: symbol that is user-variable-p.\n\
138 x -- Lisp expression read but not evaluated.\n\
139 X -- Lisp expression read and evaluated.\n\
140 In addition, if the string begins with `*'\n\
141 then an error is signaled if the buffer is read-only.\n\
142 This happens before reading any arguments.\n\
143 If the string begins with `@', then Emacs searches the key sequence\n\
144 which invoked the command for its first mouse click (or any other\n\
145 event which specifies a window), and selects that window before\n\
146 reading any arguments. You may use both `@' and `*'; they are\n\
147 processed in the order that they appear." */
148
149 /* ARGSUSED */
150 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
151 0 /* See immediately above */)
152 (args)
153 Lisp_Object args;
154 {
155 return Qnil;
156 }
157
158 /* Quotify EXP: if EXP is constant, return it.
159 If EXP is not constant, return (quote EXP). */
160 Lisp_Object
161 quotify_arg (exp)
162 register Lisp_Object exp;
163 {
164 if (!INTEGERP (exp) && !STRINGP (exp)
165 && !NILP (exp) && !EQ (exp, Qt))
166 return Fcons (Qquote, Fcons (exp, Qnil));
167
168 return exp;
169 }
170
171 /* Modify EXP by quotifying each element (except the first). */
172 Lisp_Object
173 quotify_args (exp)
174 Lisp_Object exp;
175 {
176 register Lisp_Object tail;
177 register struct Lisp_Cons *ptr;
178 for (tail = exp; CONSP (tail); tail = ptr->cdr)
179 {
180 ptr = XCONS (tail);
181 ptr->car = quotify_arg (ptr->car);
182 }
183 return exp;
184 }
185
186 char *callint_argfuns[]
187 = {"", "point", "mark", "region-beginning", "region-end"};
188
189 static void
190 check_mark ()
191 {
192 Lisp_Object tem;
193 tem = Fmarker_buffer (current_buffer->mark);
194 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
195 error ("The mark is not set now");
196 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
197 && NILP (current_buffer->mark_active))
198 Fsignal (Qmark_inactive, Qnil);
199 }
200
201
202 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
203 "Call FUNCTION, reading args according to its interactive calling specs.\n\
204 The function contains a specification of how to do the argument reading.\n\
205 In the case of user-defined functions, this is specified by placing a call\n\
206 to the function `interactive' at the top level of the function body.\n\
207 See `interactive'.\n\
208 \n\
209 Optional second arg RECORD-FLAG non-nil\n\
210 means unconditionally put this command in the command-history.\n\
211 Otherwise, this is done only if an arg is read using the minibuffer.")
212 (function, record)
213 Lisp_Object function, record;
214 {
215 Lisp_Object *args, *visargs;
216 unsigned char **argstrings;
217 Lisp_Object fun;
218 Lisp_Object funcar;
219 Lisp_Object specs;
220 Lisp_Object teml;
221 Lisp_Object enable;
222 int speccount = specpdl_ptr - specpdl;
223
224 /* The index of the next element of this_command_keys to examine for
225 the 'e' interactive code. */
226 int next_event;
227
228 Lisp_Object prefix_arg;
229 unsigned char *string;
230 unsigned char *tem;
231
232 /* If varies[i] > 0, the i'th argument shouldn't just have its value
233 in this call quoted in the command history. It should be
234 recorded as a call to the function named callint_argfuns[varies[i]]. */
235 int *varies;
236
237 register int i, j;
238 int count, foo;
239 char prompt[100];
240 char prompt1[100];
241 char *tem1;
242 int arg_from_tty = 0;
243 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
244
245 /* Save this now, since use of minibuffer will clobber it. */
246 prefix_arg = Vcurrent_prefix_arg;
247
248 retry:
249
250 if (SYMBOLP (function))
251 enable = Fget (function, Qenable_recursive_minibuffers);
252
253 fun = indirect_function (function);
254
255 specs = Qnil;
256 string = 0;
257
258 /* Decode the kind of function. Either handle it and return,
259 or go to `lose' if not interactive, or go to `retry'
260 to specify a different function, or set either STRING or SPECS. */
261
262 if (SUBRP (fun))
263 {
264 string = (unsigned char *) XSUBR (fun)->prompt;
265 if (!string)
266 {
267 lose:
268 function = wrong_type_argument (Qcommandp, function);
269 goto retry;
270 }
271 if ((EMACS_INT) string == 1)
272 /* Let SPECS (which is nil) be used as the args. */
273 string = 0;
274 }
275 else if (COMPILEDP (fun))
276 {
277 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
278 goto lose;
279 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
280 }
281 else if (!CONSP (fun))
282 goto lose;
283 else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
284 {
285 GCPRO2 (function, prefix_arg);
286 do_autoload (fun, function);
287 UNGCPRO;
288 goto retry;
289 }
290 else if (EQ (funcar, Qlambda))
291 {
292 specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
293 if (NILP (specs))
294 goto lose;
295 specs = Fcar (Fcdr (specs));
296 }
297 else if (EQ (funcar, Qmocklisp))
298 {
299 #ifdef MULTI_KBOARD
300 kboard_locked = 1;
301 #endif
302 return ml_apply (fun, Qinteractive);
303 }
304 else
305 goto lose;
306
307 /* If either specs or string is set to a string, use it. */
308 if (STRINGP (specs))
309 {
310 /* Make a copy of string so that if a GC relocates specs,
311 `string' will still be valid. */
312 string = (unsigned char *) alloca (XSTRING (specs)->size + 1);
313 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
314 }
315 else if (string == 0)
316 {
317 Lisp_Object input;
318 i = num_input_chars;
319 input = specs;
320 /* Compute the arg values using the user's expression. */
321 specs = Feval (specs);
322 if (i != num_input_chars || !NILP (record))
323 {
324 /* We should record this command on the command history. */
325 Lisp_Object values, car;
326 /* Make a copy of the list of values, for the command history,
327 and turn them into things we can eval. */
328 values = quotify_args (Fcopy_sequence (specs));
329 /* If the list of args was produced with an explicit call to `list',
330 look for elements that were computed with (region-beginning)
331 or (region-end), and put those expressions into VALUES
332 instead of the present values. */
333 car = Fcar (input);
334 if (EQ (car, Qlist))
335 {
336 Lisp_Object intail, valtail;
337 for (intail = Fcdr (input), valtail = values;
338 CONSP (valtail);
339 intail = Fcdr (intail), valtail = Fcdr (valtail))
340 {
341 Lisp_Object elt;
342 elt = Fcar (intail);
343 if (CONSP (elt))
344 {
345 Lisp_Object presflag;
346 presflag = Fmemq (Fcar (elt), preserved_fns);
347 if (!NILP (presflag))
348 Fsetcar (valtail, Fcar (intail));
349 }
350 }
351 }
352 Vcommand_history
353 = Fcons (Fcons (function, values), Vcommand_history);
354 }
355 #ifdef MULTI_KBOARD
356 kboard_locked = 1;
357 #endif
358 return apply1 (function, specs);
359 }
360
361 /* Here if function specifies a string to control parsing the defaults */
362
363 /* Set next_event to point to the first event with parameters. */
364 for (next_event = 0; next_event < this_command_key_count; next_event++)
365 if (EVENT_HAS_PARAMETERS
366 (XVECTOR (this_command_keys)->contents[next_event]))
367 break;
368
369 /* Handle special starting chars `*' and `@'. Also `-'. */
370 /* Note that `+' is reserved for user extensions. */
371 while (1)
372 {
373 if (*string == '+')
374 error ("`+' is not used in `interactive' for ordinary commands");
375 else if (*string == '*')
376 {
377 string++;
378 if (!NILP (current_buffer->read_only))
379 Fbarf_if_buffer_read_only ();
380 }
381 /* Ignore this for semi-compatibility with Lucid. */
382 else if (*string == '-')
383 string++;
384 else if (*string == '@')
385 {
386 Lisp_Object event;
387
388 event = XVECTOR (this_command_keys)->contents[next_event];
389 if (EVENT_HAS_PARAMETERS (event)
390 && (event = XCONS (event)->car, CONSP (event))
391 && (event = XCONS (event)->car, CONSP (event))
392 && (event = XCONS (event)->car), WINDOWP (event))
393 {
394 if (MINI_WINDOW_P (XWINDOW (event))
395 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
396 error ("Attempt to select inactive minibuffer window");
397
398 /* If the current buffer wants to clean up, let it. */
399 if (!NILP (Vmouse_leave_buffer_hook))
400 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
401
402 Fselect_window (event);
403 }
404 string++;
405 }
406 else break;
407 }
408
409 /* Count the number of arguments the interactive spec would have
410 us give to the function. */
411 tem = string;
412 for (j = 0; *tem; j++)
413 {
414 /* 'r' specifications ("point and mark as 2 numeric args")
415 produce *two* arguments. */
416 if (*tem == 'r') j++;
417 tem = (unsigned char *) index (tem, '\n');
418 if (tem)
419 tem++;
420 else
421 tem = (unsigned char *) "";
422 }
423 count = j;
424
425 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
426 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
427 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
428 varies = (int *) alloca ((count + 1) * sizeof (int));
429
430 for (i = 0; i < (count + 1); i++)
431 {
432 args[i] = Qnil;
433 visargs[i] = Qnil;
434 varies[i] = 0;
435 }
436
437 GCPRO4 (prefix_arg, function, *args, *visargs);
438 gcpro3.nvars = (count + 1);
439 gcpro4.nvars = (count + 1);
440
441 if (!NILP (enable))
442 specbind (Qenable_recursive_minibuffers, Qt);
443
444 tem = string;
445 for (i = 1; *tem; i++)
446 {
447 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
448 prompt1[sizeof prompt1 - 1] = 0;
449 tem1 = index (prompt1, '\n');
450 if (tem1) *tem1 = 0;
451 /* Fill argstrings with a vector of C strings
452 corresponding to the Lisp strings in visargs. */
453 for (j = 1; j < i; j++)
454 argstrings[j]
455 = EQ (visargs[j], Qnil)
456 ? (unsigned char *) ""
457 : XSTRING (visargs[j])->data;
458
459 doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1);
460
461 switch (*tem)
462 {
463 case 'a': /* Symbol defined as a function */
464 visargs[i] = Fcompleting_read (build_string (prompt),
465 Vobarray, Qfboundp, Qt, Qnil, Qnil);
466 /* Passing args[i] directly stimulates compiler bug */
467 teml = visargs[i];
468 args[i] = Fintern (teml, Qnil);
469 break;
470
471 case 'b': /* Name of existing buffer */
472 args[i] = Fcurrent_buffer ();
473 if (EQ (selected_window, minibuf_window))
474 args[i] = Fother_buffer (args[i], Qnil);
475 args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
476 break;
477
478 case 'B': /* Name of buffer, possibly nonexistent */
479 args[i] = Fread_buffer (build_string (prompt),
480 Fother_buffer (Fcurrent_buffer (), Qnil),
481 Qnil);
482 break;
483
484 case 'c': /* Character */
485 message1 (prompt);
486 args[i] = Fread_char ();
487 /* Passing args[i] directly stimulates compiler bug */
488 teml = args[i];
489 visargs[i] = Fchar_to_string (teml);
490 break;
491
492 case 'C': /* Command: symbol with interactive function */
493 visargs[i] = Fcompleting_read (build_string (prompt),
494 Vobarray, Qcommandp, Qt, Qnil, Qnil);
495 /* Passing args[i] directly stimulates compiler bug */
496 teml = visargs[i];
497 args[i] = Fintern (teml, Qnil);
498 break;
499
500 case 'd': /* Value of point. Does not do I/O. */
501 Fset_marker (point_marker, make_number (PT), Qnil);
502 args[i] = point_marker;
503 /* visargs[i] = Qnil; */
504 varies[i] = 1;
505 break;
506
507 case 'D': /* Directory name. */
508 args[i] = Fread_file_name (build_string (prompt), Qnil,
509 current_buffer->directory, Qlambda, Qnil);
510 break;
511
512 case 'f': /* Existing file name. */
513 args[i] = Fread_file_name (build_string (prompt),
514 Qnil, Qnil, Qlambda, Qnil);
515 break;
516
517 case 'F': /* Possibly nonexistent file name. */
518 args[i] = Fread_file_name (build_string (prompt),
519 Qnil, Qnil, Qnil, Qnil);
520 break;
521
522 case 'k': /* Key sequence. */
523 args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qnil, Qnil);
524 teml = args[i];
525 visargs[i] = Fkey_description (teml);
526 break;
527
528 case 'K': /* Key sequence to be defined. */
529 args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qt, Qnil);
530 teml = args[i];
531 visargs[i] = Fkey_description (teml);
532 break;
533
534 case 'e': /* The invoking event. */
535 if (next_event >= this_command_key_count)
536 error ("%s must be bound to an event with parameters",
537 (SYMBOLP (function)
538 ? (char *) XSYMBOL (function)->name->data
539 : "command"));
540 args[i] = XVECTOR (this_command_keys)->contents[next_event++];
541 varies[i] = -1;
542
543 /* Find the next parameterized event. */
544 while (next_event < this_command_key_count
545 && ! (EVENT_HAS_PARAMETERS
546 (XVECTOR (this_command_keys)->contents[next_event])))
547 next_event++;
548
549 break;
550
551 case 'm': /* Value of mark. Does not do I/O. */
552 check_mark ();
553 /* visargs[i] = Qnil; */
554 args[i] = current_buffer->mark;
555 varies[i] = 2;
556 break;
557
558 case 'N': /* Prefix arg, else number from minibuffer */
559 if (!NILP (prefix_arg))
560 goto have_prefix_arg;
561 case 'n': /* Read number from minibuffer. */
562 do
563 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
564 while (! NUMBERP (args[i]));
565 visargs[i] = last_minibuf_string;
566 break;
567
568 case 'P': /* Prefix arg in raw form. Does no I/O. */
569 have_prefix_arg:
570 args[i] = prefix_arg;
571 /* visargs[i] = Qnil; */
572 varies[i] = -1;
573 break;
574
575 case 'p': /* Prefix arg converted to number. No I/O. */
576 args[i] = Fprefix_numeric_value (prefix_arg);
577 /* visargs[i] = Qnil; */
578 varies[i] = -1;
579 break;
580
581 case 'r': /* Region, point and mark as 2 args. */
582 check_mark ();
583 Fset_marker (point_marker, make_number (PT), Qnil);
584 /* visargs[i+1] = Qnil; */
585 foo = marker_position (current_buffer->mark);
586 /* visargs[i] = Qnil; */
587 args[i] = point < foo ? point_marker : current_buffer->mark;
588 varies[i] = 3;
589 args[++i] = point > foo ? point_marker : current_buffer->mark;
590 varies[i] = 4;
591 break;
592
593 case 's': /* String read via minibuffer. */
594 args[i] = Fread_string (build_string (prompt), Qnil, Qnil);
595 break;
596
597 case 'S': /* Any symbol. */
598 visargs[i] = Fread_string (build_string (prompt), Qnil, Qnil);
599 /* Passing args[i] directly stimulates compiler bug */
600 teml = visargs[i];
601 args[i] = Fintern (teml, Qnil);
602 break;
603
604 case 'v': /* Variable name: symbol that is
605 user-variable-p. */
606 args[i] = Fread_variable (build_string (prompt));
607 visargs[i] = last_minibuf_string;
608 break;
609
610 case 'x': /* Lisp expression read but not evaluated */
611 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
612 visargs[i] = last_minibuf_string;
613 break;
614
615 case 'X': /* Lisp expression read and evaluated */
616 args[i] = Feval_minibuffer (build_string (prompt), Qnil);
617 visargs[i] = last_minibuf_string;
618 break;
619
620 /* We have a case for `+' so we get an error
621 if anyone tries to define one here. */
622 case '+':
623 default:
624 error ("Invalid control letter `%c' (%03o) in interactive calling string",
625 *tem, *tem);
626 }
627
628 if (varies[i] == 0)
629 arg_from_tty = 1;
630
631 if (NILP (visargs[i]) && STRINGP (args[i]))
632 visargs[i] = args[i];
633
634 tem = (unsigned char *) index (tem, '\n');
635 if (tem) tem++;
636 else tem = (unsigned char *) "";
637 }
638 unbind_to (speccount, Qnil);
639
640 QUIT;
641
642 args[0] = function;
643
644 if (arg_from_tty || !NILP (record))
645 {
646 visargs[0] = function;
647 for (i = 1; i < count + 1; i++)
648 {
649 if (varies[i] > 0)
650 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
651 else
652 visargs[i] = quotify_arg (args[i]);
653 }
654 Vcommand_history = Fcons (Flist (count + 1, visargs),
655 Vcommand_history);
656 }
657
658 /* If we used a marker to hold point, mark, or an end of the region,
659 temporarily, convert it to an integer now. */
660 for (i = 1; i <= count; i++)
661 if (varies[i] >= 1 && varies[i] <= 4)
662 XSETINT (args[i], marker_position (args[i]));
663
664 #ifdef MULTI_KBOARD
665 kboard_locked = 1;
666 #endif
667
668 {
669 Lisp_Object val;
670 specbind (Qcommand_debug_status, Qnil);
671
672 val = Ffuncall (count + 1, args);
673 UNGCPRO;
674 return unbind_to (speccount, val);
675 }
676 }
677
678 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
679 1, 1, 0,
680 "Return numeric meaning of raw prefix argument ARG.\n\
681 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
682 Its numeric meaning is what you would get from `(interactive \"p\")'.")
683 (raw)
684 Lisp_Object raw;
685 {
686 Lisp_Object val;
687
688 if (NILP (raw))
689 XSETFASTINT (val, 1);
690 else if (EQ (raw, Qminus))
691 XSETINT (val, -1);
692 else if (CONSP (raw))
693 XSETINT (val, XINT (XCONS (raw)->car));
694 else if (INTEGERP (raw))
695 val = raw;
696 else
697 XSETFASTINT (val, 1);
698
699 return val;
700 }
701
702 DEFUN ("universal-argument", Funiversal_argument, Suniversal_argument, 0, 0, "",
703 "Begin a numeric argument for the following command.\n\
704 Digits or minus sign following \\[universal-argument] make up the numeric argument.\n\
705 \\[universal-argument] following the digits or minus sign ends the argument.\n\
706 \\[universal-argument] without digits or minus sign provides 4 as argument.\n\
707 Repeating \\[universal-argument] without digits or minus sign\n\
708 multiplies the argument by 4 each time.")
709 ()
710 {
711 if (!current_prefix_partial)
712 {
713 /* First C-u */
714 XSETFASTINT (current_kboard->prefix_factor, 4);
715 current_kboard->prefix_value = Qnil;
716 current_kboard->prefix_sign = 1;
717 current_kboard->prefix_partial = 1;
718 }
719 else if (!NILP (current_kboard->prefix_factor))
720 {
721 /* Subsequent C-u */
722 XSETINT (current_kboard->prefix_factor,
723 XINT (current_kboard->prefix_factor) * 4);
724 current_kboard->prefix_partial = 1;
725 }
726 else
727 {
728 /* Terminating C-u */
729 finalize_prefix_arg ();
730 describe_prefix_arg ();
731 }
732 }
733
734 DEFUN ("negative-argument", Fnegative_argument, Snegative_argument, 0, 0, "",
735 "Begin a negative numeric argument for the next command.\n\
736 \\[universal-argument] following digits or minus sign ends the argument.")
737 ()
738 {
739 current_kboard->prefix_factor = Qnil;
740 current_kboard->prefix_sign *= -1;
741 current_kboard->prefix_partial = 1;
742 }
743
744 DEFUN ("digit-argument", Fdigit_argument, Sdigit_argument, 0, 0, "",
745 "Part of the numeric argument for the next command.\n\
746 \\[universal-argument] following digits or minus sign ends the argument.")
747 ()
748 {
749 int c;
750 if (!(INTEGERP (last_command_char)
751 && (c = (XINT (last_command_char) & 0177)) >= '0' && c <= '9'))
752 error("digit-argument must be bound to a digit key");
753 current_kboard->prefix_factor = Qnil;
754 if (NILP (current_kboard->prefix_value))
755 XSETFASTINT (current_kboard->prefix_value, 0);
756 XSETINT (current_kboard->prefix_value,
757 XINT (current_kboard->prefix_value) * 10 + (c - '0'));
758 current_kboard->prefix_partial = 1;
759 }
760
761 syms_of_callint ()
762 {
763 point_marker = Fmake_marker ();
764 staticpro (&point_marker);
765
766 preserved_fns = Fcons (intern ("region-beginning"),
767 Fcons (intern ("region-end"),
768 Fcons (intern ("point"),
769 Fcons (intern ("mark"), Qnil))));
770 staticpro (&preserved_fns);
771
772 Qlist = intern ("list");
773 staticpro (&Qlist);
774
775 Qminus = intern ("-");
776 staticpro (&Qminus);
777
778 Qplus = intern ("+");
779 staticpro (&Qplus);
780
781 Qcall_interactively = intern ("call-interactively");
782 staticpro (&Qcall_interactively);
783
784 Qcommand_debug_status = intern ("command-debug-status");
785 staticpro (&Qcommand_debug_status);
786
787 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
788 staticpro (&Qenable_recursive_minibuffers);
789
790 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
791 staticpro (&Qmouse_leave_buffer_hook);
792
793 DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
794 "The value of the prefix argument for the next editing command.\n\
795 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
796 or a list whose car is a number for just one or more C-U's\n\
797 or nil if no argument has been specified.\n\
798 \n\
799 You cannot examine this variable to find the argument for this command\n\
800 since it has been set to nil by the time you can look.\n\
801 Instead, you should use the variable `current-prefix-arg', although\n\
802 normally commands can get this prefix argument with (interactive \"P\").");
803 Vprefix_arg = Qnil;
804
805 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
806 "The value of the prefix argument for this editing command.\n\
807 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
808 or a list whose car is a number for just one or more C-U's\n\
809 or nil if no argument has been specified.\n\
810 This is what `(interactive \"P\")' returns.");
811 Vcurrent_prefix_arg = Qnil;
812
813 DEFVAR_LISP ("command-history", &Vcommand_history,
814 "List of recent commands that read arguments from terminal.\n\
815 Each command is represented as a form to evaluate.");
816 Vcommand_history = Qnil;
817
818 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
819 "Debugging status of current interactive command.\n\
820 Bound each time `call-interactively' is called;\n\
821 may be set by the debugger as a reminder for itself.");
822 Vcommand_debug_status = Qnil;
823
824 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
825 "*Non-nil means you can use the mark even when inactive.\n\
826 This option makes a difference in Transient Mark mode.\n\
827 When the option is non-nil, deactivation of the mark\n\
828 turns off region highlighting, but commands that use the mark\n\
829 behave as if the mark were still active.");
830 Vmark_even_if_inactive = Qnil;
831
832 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
833 "Hook to run when about to switch windows with a mouse command.\n\
834 Its purpose is to give temporary modes such as Isearch mode\n\
835 a way to turn themselves off when a mouse command switches windows.");
836 Vmouse_leave_buffer_hook = Qnil;
837
838 defsubr (&Sinteractive);
839 defsubr (&Scall_interactively);
840 defsubr (&Sprefix_numeric_value);
841 defsubr (&Suniversal_argument);
842 defsubr (&Snegative_argument);
843 defsubr (&Sdigit_argument);
844 }