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