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 single_kboard_state ();
300 return ml_apply (fun, Qinteractive);
301 }
302 else
303 goto lose;
304
305 /* If either specs or string is set to a string, use it. */
306 if (STRINGP (specs))
307 {
308 /* Make a copy of string so that if a GC relocates specs,
309 `string' will still be valid. */
310 string = (unsigned char *) alloca (XSTRING (specs)->size + 1);
311 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
312 }
313 else if (string == 0)
314 {
315 Lisp_Object input;
316 i = num_input_chars;
317 input = specs;
318 /* Compute the arg values using the user's expression. */
319 specs = Feval (specs);
320 if (i != num_input_chars || !NILP (record))
321 {
322 /* We should record this command on the command history. */
323 Lisp_Object values, car;
324 /* Make a copy of the list of values, for the command history,
325 and turn them into things we can eval. */
326 values = quotify_args (Fcopy_sequence (specs));
327 /* If the list of args was produced with an explicit call to `list',
328 look for elements that were computed with (region-beginning)
329 or (region-end), and put those expressions into VALUES
330 instead of the present values. */
331 car = Fcar (input);
332 if (EQ (car, Qlist))
333 {
334 Lisp_Object intail, valtail;
335 for (intail = Fcdr (input), valtail = values;
336 CONSP (valtail);
337 intail = Fcdr (intail), valtail = Fcdr (valtail))
338 {
339 Lisp_Object elt;
340 elt = Fcar (intail);
341 if (CONSP (elt))
342 {
343 Lisp_Object presflag;
344 presflag = Fmemq (Fcar (elt), preserved_fns);
345 if (!NILP (presflag))
346 Fsetcar (valtail, Fcar (intail));
347 }
348 }
349 }
350 Vcommand_history
351 = Fcons (Fcons (function, values), Vcommand_history);
352 }
353 single_kboard_state ();
354 return apply1 (function, specs);
355 }
356
357 /* Here if function specifies a string to control parsing the defaults */
358
359 /* Set next_event to point to the first event with parameters. */
360 for (next_event = 0; next_event < this_command_key_count; next_event++)
361 if (EVENT_HAS_PARAMETERS
362 (XVECTOR (this_command_keys)->contents[next_event]))
363 break;
364
365 /* Handle special starting chars `*' and `@'. Also `-'. */
366 /* Note that `+' is reserved for user extensions. */
367 while (1)
368 {
369 if (*string == '+')
370 error ("`+' is not used in `interactive' for ordinary commands");
371 else if (*string == '*')
372 {
373 string++;
374 if (!NILP (current_buffer->read_only))
375 Fbarf_if_buffer_read_only ();
376 }
377 /* Ignore this for semi-compatibility with Lucid. */
378 else if (*string == '-')
379 string++;
380 else if (*string == '@')
381 {
382 Lisp_Object event;
383
384 event = XVECTOR (this_command_keys)->contents[next_event];
385 if (EVENT_HAS_PARAMETERS (event)
386 && (event = XCONS (event)->cdr, CONSP (event))
387 && (event = XCONS (event)->car, CONSP (event))
388 && (event = XCONS (event)->car, WINDOWP (event)))
389 {
390 if (MINI_WINDOW_P (XWINDOW (event))
391 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
392 error ("Attempt to select inactive minibuffer window");
393
394 /* If the current buffer wants to clean up, let it. */
395 if (!NILP (Vmouse_leave_buffer_hook))
396 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
397
398 Fselect_window (event);
399 }
400 string++;
401 }
402 else break;
403 }
404
405 /* Count the number of arguments the interactive spec would have
406 us give to the function. */
407 tem = string;
408 for (j = 0; *tem; j++)
409 {
410 /* 'r' specifications ("point and mark as 2 numeric args")
411 produce *two* arguments. */
412 if (*tem == 'r') j++;
413 tem = (unsigned char *) index (tem, '\n');
414 if (tem)
415 tem++;
416 else
417 tem = (unsigned char *) "";
418 }
419 count = j;
420
421 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
422 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
423 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
424 varies = (int *) alloca ((count + 1) * sizeof (int));
425
426 for (i = 0; i < (count + 1); i++)
427 {
428 args[i] = Qnil;
429 visargs[i] = Qnil;
430 varies[i] = 0;
431 }
432
433 GCPRO4 (prefix_arg, function, *args, *visargs);
434 gcpro3.nvars = (count + 1);
435 gcpro4.nvars = (count + 1);
436
437 if (!NILP (enable))
438 specbind (Qenable_recursive_minibuffers, Qt);
439
440 tem = string;
441 for (i = 1; *tem; i++)
442 {
443 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
444 prompt1[sizeof prompt1 - 1] = 0;
445 tem1 = index (prompt1, '\n');
446 if (tem1) *tem1 = 0;
447 /* Fill argstrings with a vector of C strings
448 corresponding to the Lisp strings in visargs. */
449 for (j = 1; j < i; j++)
450 argstrings[j]
451 = EQ (visargs[j], Qnil)
452 ? (unsigned char *) ""
453 : XSTRING (visargs[j])->data;
454
455 doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1);
456
457 switch (*tem)
458 {
459 case 'a': /* Symbol defined as a function */
460 visargs[i] = Fcompleting_read (build_string (prompt),
461 Vobarray, Qfboundp, Qt, Qnil, Qnil);
462 /* Passing args[i] directly stimulates compiler bug */
463 teml = visargs[i];
464 args[i] = Fintern (teml, Qnil);
465 break;
466
467 case 'b': /* Name of existing buffer */
468 args[i] = Fcurrent_buffer ();
469 if (EQ (selected_window, minibuf_window))
470 args[i] = Fother_buffer (args[i], Qnil);
471 args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
472 break;
473
474 case 'B': /* Name of buffer, possibly nonexistent */
475 args[i] = Fread_buffer (build_string (prompt),
476 Fother_buffer (Fcurrent_buffer (), Qnil),
477 Qnil);
478 break;
479
480 case 'c': /* Character */
481 message1 (prompt);
482 args[i] = Fread_char ();
483 /* Passing args[i] directly stimulates compiler bug */
484 teml = args[i];
485 visargs[i] = Fchar_to_string (teml);
486 break;
487
488 case 'C': /* Command: symbol with interactive function */
489 visargs[i] = Fcompleting_read (build_string (prompt),
490 Vobarray, Qcommandp, Qt, Qnil, Qnil);
491 /* Passing args[i] directly stimulates compiler bug */
492 teml = visargs[i];
493 args[i] = Fintern (teml, Qnil);
494 break;
495
496 case 'd': /* Value of point. Does not do I/O. */
497 Fset_marker (point_marker, make_number (PT), Qnil);
498 args[i] = point_marker;
499 /* visargs[i] = Qnil; */
500 varies[i] = 1;
501 break;
502
503 case 'D': /* Directory name. */
504 args[i] = Fread_file_name (build_string (prompt), Qnil,
505 current_buffer->directory, Qlambda, Qnil);
506 break;
507
508 case 'f': /* Existing file name. */
509 args[i] = Fread_file_name (build_string (prompt),
510 Qnil, Qnil, Qlambda, Qnil);
511 break;
512
513 case 'F': /* Possibly nonexistent file name. */
514 args[i] = Fread_file_name (build_string (prompt),
515 Qnil, Qnil, Qnil, Qnil);
516 break;
517
518 case 'k': /* Key sequence. */
519 args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qnil, Qnil);
520 teml = args[i];
521 visargs[i] = Fkey_description (teml);
522 break;
523
524 case 'K': /* Key sequence to be defined. */
525 args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qt, Qnil);
526 teml = args[i];
527 visargs[i] = Fkey_description (teml);
528 break;
529
530 case 'e': /* The invoking event. */
531 if (next_event >= this_command_key_count)
532 error ("%s must be bound to an event with parameters",
533 (SYMBOLP (function)
534 ? (char *) XSYMBOL (function)->name->data
535 : "command"));
536 args[i] = XVECTOR (this_command_keys)->contents[next_event++];
537 varies[i] = -1;
538
539 /* Find the next parameterized event. */
540 while (next_event < this_command_key_count
541 && ! (EVENT_HAS_PARAMETERS
542 (XVECTOR (this_command_keys)->contents[next_event])))
543 next_event++;
544
545 break;
546
547 case 'm': /* Value of mark. Does not do I/O. */
548 check_mark ();
549 /* visargs[i] = Qnil; */
550 args[i] = current_buffer->mark;
551 varies[i] = 2;
552 break;
553
554 case 'N': /* Prefix arg, else number from minibuffer */
555 if (!NILP (prefix_arg))
556 goto have_prefix_arg;
557 case 'n': /* Read number from minibuffer. */
558 do
559 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
560 while (! NUMBERP (args[i]));
561 visargs[i] = last_minibuf_string;
562 break;
563
564 case 'P': /* Prefix arg in raw form. Does no I/O. */
565 have_prefix_arg:
566 args[i] = prefix_arg;
567 /* visargs[i] = Qnil; */
568 varies[i] = -1;
569 break;
570
571 case 'p': /* Prefix arg converted to number. No I/O. */
572 args[i] = Fprefix_numeric_value (prefix_arg);
573 /* visargs[i] = Qnil; */
574 varies[i] = -1;
575 break;
576
577 case 'r': /* Region, point and mark as 2 args. */
578 check_mark ();
579 Fset_marker (point_marker, make_number (PT), Qnil);
580 /* visargs[i+1] = Qnil; */
581 foo = marker_position (current_buffer->mark);
582 /* visargs[i] = Qnil; */
583 args[i] = point < foo ? point_marker : current_buffer->mark;
584 varies[i] = 3;
585 args[++i] = point > foo ? point_marker : current_buffer->mark;
586 varies[i] = 4;
587 break;
588
589 case 's': /* String read via minibuffer. */
590 args[i] = Fread_string (build_string (prompt), Qnil, Qnil);
591 break;
592
593 case 'S': /* Any symbol. */
594 visargs[i] = Fread_string (build_string (prompt), Qnil, Qnil);
595 /* Passing args[i] directly stimulates compiler bug */
596 teml = visargs[i];
597 args[i] = Fintern (teml, Qnil);
598 break;
599
600 case 'v': /* Variable name: symbol that is
601 user-variable-p. */
602 args[i] = Fread_variable (build_string (prompt));
603 visargs[i] = last_minibuf_string;
604 break;
605
606 case 'x': /* Lisp expression read but not evaluated */
607 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
608 visargs[i] = last_minibuf_string;
609 break;
610
611 case 'X': /* Lisp expression read and evaluated */
612 args[i] = Feval_minibuffer (build_string (prompt), Qnil);
613 visargs[i] = last_minibuf_string;
614 break;
615
616 /* We have a case for `+' so we get an error
617 if anyone tries to define one here. */
618 case '+':
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 single_kboard_state ();
661
662 {
663 Lisp_Object val;
664 specbind (Qcommand_debug_status, Qnil);
665
666 val = Ffuncall (count + 1, args);
667 UNGCPRO;
668 return unbind_to (speccount, val);
669 }
670 }
671
672 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
673 1, 1, 0,
674 "Return numeric meaning of raw prefix argument ARG.\n\
675 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
676 Its numeric meaning is what you would get from `(interactive \"p\")'.")
677 (raw)
678 Lisp_Object raw;
679 {
680 Lisp_Object val;
681
682 if (NILP (raw))
683 XSETFASTINT (val, 1);
684 else if (EQ (raw, Qminus))
685 XSETINT (val, -1);
686 else if (CONSP (raw))
687 XSETINT (val, XINT (XCONS (raw)->car));
688 else if (INTEGERP (raw))
689 val = raw;
690 else
691 XSETFASTINT (val, 1);
692
693 return val;
694 }
695
696 DEFUN ("universal-argument", Funiversal_argument, Suniversal_argument, 0, 0, "",
697 "Begin a numeric argument for the following command.\n\
698 Digits or minus sign following \\[universal-argument] make up the numeric argument.\n\
699 \\[universal-argument] following the digits or minus sign ends the argument.\n\
700 \\[universal-argument] without digits or minus sign provides 4 as argument.\n\
701 Repeating \\[universal-argument] without digits or minus sign\n\
702 multiplies the argument by 4 each time.")
703 ()
704 {
705 if (!current_prefix_partial)
706 {
707 /* First C-u */
708 XSETFASTINT (current_kboard->prefix_factor, 4);
709 current_kboard->prefix_value = Qnil;
710 current_kboard->prefix_sign = 1;
711 current_kboard->prefix_partial = 1;
712 }
713 else if (!NILP (current_kboard->prefix_factor))
714 {
715 /* Subsequent C-u */
716 XSETINT (current_kboard->prefix_factor,
717 XINT (current_kboard->prefix_factor) * 4);
718 current_kboard->prefix_partial = 1;
719 }
720 else
721 {
722 /* Terminating C-u */
723 finalize_prefix_arg ();
724 describe_prefix_arg ();
725 }
726 }
727
728 DEFUN ("negative-argument", Fnegative_argument, Snegative_argument, 0, 0, "",
729 "Begin a negative numeric argument for the next command.\n\
730 \\[universal-argument] following digits or minus sign ends the argument.")
731 ()
732 {
733 current_kboard->prefix_factor = Qnil;
734 current_kboard->prefix_sign *= -1;
735 current_kboard->prefix_partial = 1;
736 }
737
738 DEFUN ("digit-argument", Fdigit_argument, Sdigit_argument, 0, 0, "",
739 "Part of the numeric argument for the next command.\n\
740 \\[universal-argument] following digits or minus sign ends the argument.")
741 ()
742 {
743 int c;
744 if (!(INTEGERP (last_command_char)
745 && (c = (XINT (last_command_char) & 0177)) >= '0' && c <= '9'))
746 error("digit-argument must be bound to a digit key");
747 current_kboard->prefix_factor = Qnil;
748 if (NILP (current_kboard->prefix_value))
749 XSETFASTINT (current_kboard->prefix_value, 0);
750 XSETINT (current_kboard->prefix_value,
751 XINT (current_kboard->prefix_value) * 10 + (c - '0'));
752 current_kboard->prefix_partial = 1;
753 }
754
755 syms_of_callint ()
756 {
757 point_marker = Fmake_marker ();
758 staticpro (&point_marker);
759
760 preserved_fns = Fcons (intern ("region-beginning"),
761 Fcons (intern ("region-end"),
762 Fcons (intern ("point"),
763 Fcons (intern ("mark"), Qnil))));
764 staticpro (&preserved_fns);
765
766 Qlist = intern ("list");
767 staticpro (&Qlist);
768
769 Qminus = intern ("-");
770 staticpro (&Qminus);
771
772 Qplus = intern ("+");
773 staticpro (&Qplus);
774
775 Qcall_interactively = intern ("call-interactively");
776 staticpro (&Qcall_interactively);
777
778 Qcommand_debug_status = intern ("command-debug-status");
779 staticpro (&Qcommand_debug_status);
780
781 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
782 staticpro (&Qenable_recursive_minibuffers);
783
784 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
785 staticpro (&Qmouse_leave_buffer_hook);
786
787 DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
788 "The value of the prefix argument for the next editing command.\n\
789 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
790 or a list whose car is a number for just one or more C-U's\n\
791 or nil if no argument has been specified.\n\
792 \n\
793 You cannot examine this variable to find the argument for this command\n\
794 since it has been set to nil by the time you can look.\n\
795 Instead, you should use the variable `current-prefix-arg', although\n\
796 normally commands can get this prefix argument with (interactive \"P\").");
797 Vprefix_arg = Qnil;
798
799 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
800 "The value of the prefix argument for this editing command.\n\
801 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
802 or a list whose car is a number for just one or more C-U's\n\
803 or nil if no argument has been specified.\n\
804 This is what `(interactive \"P\")' returns.");
805 Vcurrent_prefix_arg = Qnil;
806
807 DEFVAR_LISP ("command-history", &Vcommand_history,
808 "List of recent commands that read arguments from terminal.\n\
809 Each command is represented as a form to evaluate.");
810 Vcommand_history = Qnil;
811
812 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
813 "Debugging status of current interactive command.\n\
814 Bound each time `call-interactively' is called;\n\
815 may be set by the debugger as a reminder for itself.");
816 Vcommand_debug_status = Qnil;
817
818 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
819 "*Non-nil means you can use the mark even when inactive.\n\
820 This option makes a difference in Transient Mark mode.\n\
821 When the option is non-nil, deactivation of the mark\n\
822 turns off region highlighting, but commands that use the mark\n\
823 behave as if the mark were still active.");
824 Vmark_even_if_inactive = Qnil;
825
826 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
827 "Hook to run when about to switch windows with a mouse command.\n\
828 Its purpose is to give temporary modes such as Isearch mode\n\
829 a way to turn themselves off when a mouse command switches windows.");
830 Vmouse_leave_buffer_hook = Qnil;
831
832 defsubr (&Sinteractive);
833 defsubr (&Scall_interactively);
834 defsubr (&Sprefix_numeric_value);
835 defsubr (&Suniversal_argument);
836 defsubr (&Snegative_argument);
837 defsubr (&Sdigit_argument);
838 }