X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ba2aa08420b82f869eda698eb0b72f6e829f9be7..752a043ffa37cb8a652f6913ff94d1e1c8923358:/src/callint.c diff --git a/src/callint.c b/src/callint.c index 88c1672111..0528fe78f2 100644 --- a/src/callint.c +++ b/src/callint.c @@ -1,11 +1,11 @@ /* Call a Lisp function interactively. - Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -33,6 +33,10 @@ Lisp_Object Qcall_interactively; Lisp_Object Vcommand_history; Lisp_Object Vcommand_debug_status, Qcommand_debug_status; +Lisp_Object Qenable_recursive_minibuffers; + +Lisp_Object Qlist; +Lisp_Object preserved_fns; /* This comment supplies the doc string for interactive, for make-docfile to see. We cannot put this in the real DEFUN @@ -65,10 +69,12 @@ c -- Character.\n\ C -- Command name: symbol with interactive function definition.\n\ d -- Value of point as number. Does not do I/O.\n\ D -- Directory name.\n\ +e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\ + If used more than once, the Nth `e' returns the Nth parameterized event.\n\ + This skips events that are integers or symbols.\n\ f -- Existing file name.\n\ F -- Possibly nonexistent file name.\n\ k -- Key sequence (string).\n\ -K -- Mouse click that invoked this command - last-command-char.\n\ m -- Value of mark as number. Does not do I/O.\n\ n -- Number read using minibuffer.\n\ N -- Prefix arg converted to number, or if none, do like code `n'.\n\ @@ -83,10 +89,11 @@ X -- Lisp expression read and evaluated.\n\ In addition, if the string begins with `*'\n\ then an error is signaled if the buffer is read-only.\n\ This happens before reading any arguments.\n\ -If the string begins with `@', then the window the mouse is over is selected\n\ - before anything else is done. You may use both `@' and `*';\n\ -they are processed in the order that they appear." -*/ +If the string begins with `@', then Emacs searches the key sequence\n\ + which invoked the command for its first mouse click (or any other\n\ + event which specifies a window), and selects that window before\n\ + reading any arguments. You may use both `@' and `*'; they are\n\ + processed in the order that they appear." */ /* ARGSUSED */ DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, @@ -134,6 +141,8 @@ check_mark () Lisp_Object tem = Fmarker_buffer (current_buffer->mark); if (NILP (tem) || (XBUFFER (tem) != current_buffer)) error ("The mark is not set now"); + if (NILP (current_buffer->mark_active)) + error ("The mark is not active now"); } @@ -156,6 +165,12 @@ Otherwise, this is done only if an arg is read using the minibuffer.") Lisp_Object funcar; Lisp_Object specs; Lisp_Object teml; + Lisp_Object enable; + int speccount = specpdl_ptr - specpdl; + + /* The index of the next element of this_command_keys to examine for + the 'e' interactive code. */ + int next_event; Lisp_Object prefix_arg; unsigned char *string; @@ -174,17 +189,15 @@ Otherwise, this is done only if an arg is read using the minibuffer.") int arg_from_tty = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - /* Save this now, since use ofminibuffer will clobber it. */ + /* Save this now, since use of minibuffer will clobber it. */ prefix_arg = Vcurrent_prefix_arg; retry: - for (fun = function; - XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound); - fun = XSYMBOL (fun)->function) - { - QUIT; - } + if (XTYPE (function) == Lisp_Symbol) + enable = Fget (function, Qenable_recursive_minibuffers); + + fun = indirect_function (function); specs = Qnil; string = 0; @@ -199,7 +212,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (!string) { lose: - function = wrong_type_argument (Qcommandp, function, 0); + function = wrong_type_argument (Qcommandp, function); goto retry; } if ((int) string == 1) @@ -238,22 +251,60 @@ Otherwise, this is done only if an arg is read using the minibuffer.") { /* Make a copy of string so that if a GC relocates specs, `string' will still be valid. */ - string = (char *) alloca (XSTRING (specs)->size + 1); + string = (unsigned char *) alloca (XSTRING (specs)->size + 1); bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1); } else if (string == 0) { + Lisp_Object input; i = num_input_chars; + input = specs; + /* Compute the arg values using the user's expression. */ specs = Feval (specs); if (i != num_input_chars || !NILP (record)) - Vcommand_history - = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))), - Vcommand_history); + { + /* We should record this command on the command history. */ + Lisp_Object values, car; + /* Make a copy of the list of values, for the command history, + and turn them into things we can eval. */ + values = quotify_args (Fcopy_sequence (specs)); + /* If the list of args was produced with an explicit call to `list', + look for elements that were computed with (region-beginning) + or (region-end), and put those expressions into VALUES + instead of the present values. */ + car = Fcar (input); + if (EQ (car, Qlist)) + { + Lisp_Object intail, valtail; + for (intail = Fcdr (input), valtail = values; + CONSP (valtail); + intail = Fcdr (intail), valtail = Fcdr (valtail)) + { + Lisp_Object elt; + elt = Fcar (intail); + if (CONSP (elt)) + { + Lisp_Object presflag; + presflag = Fmemq (Fcar (elt), preserved_fns); + if (!NILP (presflag)) + Fsetcar (valtail, Fcar (intail)); + } + } + } + Vcommand_history + = Fcons (Fcons (function, values), Vcommand_history); + } return apply1 (function, specs); } /* Here if function specifies a string to control parsing the defaults */ + /* Set next_event to point to the first event with parameters. */ + for (next_event = 0; next_event < this_command_key_count; next_event++) + if (EVENT_HAS_PARAMETERS + (XVECTOR (this_command_keys)->contents[next_event])) + break; + /* Handle special starting chars `*' and `@'. */ while (1) { @@ -265,9 +316,15 @@ Otherwise, this is done only if an arg is read using the minibuffer.") } else if (*string == '@') { + Lisp_Object event = + XVECTOR (this_command_keys)->contents[next_event]; + + if (EVENT_HAS_PARAMETERS (event) + && XTYPE (event = XCONS (event)->cdr) == Lisp_Cons + && XTYPE (event = XCONS (event)->car) == Lisp_Cons + && XTYPE (event = XCONS (event)->car) == Lisp_Window) + Fselect_window (event); string++; - if (!NILP (Vmouse_window)) - Fselect_window (Vmouse_window); } else break; } @@ -304,6 +361,9 @@ Otherwise, this is done only if an arg is read using the minibuffer.") gcpro3.nvars = (count + 1); gcpro4.nvars = (count + 1); + if (!NILP (enable)) + specbind (Qenable_recursive_minibuffers, Qt); + tem = string; for (i = 1; *tem; i++) { @@ -334,13 +394,14 @@ Otherwise, this is done only if an arg is read using the minibuffer.") case 'b': /* Name of existing buffer */ args[i] = Fcurrent_buffer (); if (EQ (selected_window, minibuf_window)) - args[i] = Fother_buffer (args[i]); + args[i] = Fother_buffer (args[i], Qnil); args[i] = Fread_buffer (build_string (prompt), args[i], Qt); break; case 'B': /* Name of buffer, possibly nonexistent */ args[i] = Fread_buffer (build_string (prompt), - Fother_buffer (Fcurrent_buffer ()), Qnil); + Fother_buffer (Fcurrent_buffer (), Qnil), + Qnil); break; case 'c': /* Character */ @@ -386,13 +447,21 @@ Otherwise, this is done only if an arg is read using the minibuffer.") visargs[i] = Fkey_description (teml); break; - case 'K': /* Mouse click. */ - args[i] = last_command_char; - if (NILP (Fmouse_click_p (args[i]))) - error ("%s must be bound to a mouse click.", + case 'e': /* The invoking event. */ + if (next_event >= this_command_key_count) + error ("%s must be bound to an event with parameters", (XTYPE (function) == Lisp_Symbol ? (char *) XSYMBOL (function)->name->data - : "Command")); + : "command")); + args[i] = XVECTOR (this_command_keys)->contents[next_event++]; + varies[i] = -1; + + /* Find the next parameterized event. */ + while (next_event < this_command_key_count + && ! (EVENT_HAS_PARAMETERS + (XVECTOR (this_command_keys)->contents[next_event]))) + next_event++; + break; case 'm': /* Value of mark. Does not do I/O. */ @@ -441,10 +510,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") break; case 'S': /* Any symbol. */ - visargs[i] = read_minibuf (Vminibuffer_local_ns_map, - Qnil, - build_string (prompt), - 0); + visargs[i] = Fread_string (build_string (prompt), Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -481,6 +547,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (tem) tem++; else tem = (unsigned char *) ""; } + unbind_to (speccount, Qnil); QUIT; @@ -500,7 +567,6 @@ Otherwise, this is done only if an arg is read using the minibuffer.") { Lisp_Object val; - int speccount = specpdl_ptr - specpdl; specbind (Qcommand_debug_status, Qnil); val = Ffuncall (count + 1, args); @@ -525,7 +591,7 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") if (NILP (raw)) XFASTINT (val) = 1; - else if (EQ (val, Qminus)) + else if (EQ (raw, Qminus)) XSETINT (val, -1); else if (CONSP (raw)) XSETINT (val, XINT (XCONS (raw)->car)); @@ -539,6 +605,15 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") syms_of_callint () { + preserved_fns = Fcons (intern ("region-beginning"), + Fcons (intern ("region-end"), + Fcons (intern ("point"), + Fcons (intern ("mark"), Qnil)))); + staticpro (&preserved_fns); + + Qlist = intern ("list"); + staticpro (&Qlist); + Qminus = intern ("-"); staticpro (&Qminus); @@ -548,6 +623,9 @@ syms_of_callint () Qcommand_debug_status = intern ("command-debug-status"); staticpro (&Qcommand_debug_status); + Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers"); + staticpro (&Qenable_recursive_minibuffers); + DEFVAR_LISP ("prefix-arg", &Vprefix_arg, "The value of the prefix argument for the next editing command.\n\ It may be a number, or the symbol `-' for just a minus sign as arg,\n\