X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4746118aca2d5cbdd054b4af4814d56550dfbc79..c3e1d4359ed586fa30ba45e8b9bc8f3a230f130b:/src/callint.c?ds=sidebyside diff --git a/src/callint.c b/src/callint.c index 0075ef721d..a6c5570bb3 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, 1994, 1995 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, @@ -18,7 +18,7 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ -#include "config.h" +#include #include "lisp.h" #include "buffer.h" #include "commands.h" @@ -28,11 +28,21 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ extern char *index (); -Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus; +Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus, Qplus; Lisp_Object Qcall_interactively; Lisp_Object Vcommand_history; Lisp_Object Vcommand_debug_status, Qcommand_debug_status; +Lisp_Object Qenable_recursive_minibuffers; + +/* Non-nil means treat the mark as active + even if mark_active is 0. */ +Lisp_Object Vmark_even_if_inactive; + +Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; + +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,13 +75,15 @@ 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\ +N -- Raw prefix arg, or if none, do like code `n'.\n\ p -- Prefix arg converted to number. Does not do I/O.\n\ P -- Prefix arg in raw form. Does not do I/O.\n\ r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\ @@ -83,10 +95,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, @@ -103,7 +116,7 @@ Lisp_Object quotify_arg (exp) register Lisp_Object exp; { - if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String + if (!INTEGERP (exp) && !STRINGP (exp) && !NILP (exp) && !EQ (exp, Qt)) return Fcons (Qquote, Fcons (exp, Qnil)); @@ -131,9 +144,13 @@ char *callint_argfuns[] static void check_mark () { - Lisp_Object tem = Fmarker_buffer (current_buffer->mark); + Lisp_Object tem; + tem = Fmarker_buffer (current_buffer->mark); if (NILP (tem) || (XBUFFER (tem) != current_buffer)) error ("The mark is not set now"); + if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) + && NILP (current_buffer->mark_active)) + Fsignal (Qmark_inactive, Qnil); } @@ -156,6 +173,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 +197,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 (SYMBOLP (function)) + enable = Fget (function, Qenable_recursive_minibuffers); + + fun = indirect_function (function); specs = Qnil; string = 0; @@ -193,22 +214,22 @@ Otherwise, this is done only if an arg is read using the minibuffer.") or go to `lose' if not interactive, or go to `retry' to specify a different function, or set either STRING or SPECS. */ - if (XTYPE (fun) == Lisp_Subr) + if (SUBRP (fun)) { string = (unsigned char *) XSUBR (fun)->prompt; if (!string) { lose: - function = wrong_type_argument (Qcommandp, function, 0); + function = wrong_type_argument (Qcommandp, function); goto retry; } - if ((int) string == 1) + if ((EMACS_INT) string == 1) /* Let SPECS (which is nil) be used as the args. */ string = 0; } - else if (XTYPE (fun) == Lisp_Compiled) + else if (COMPILEDP (fun)) { - if (XVECTOR (fun)->size <= COMPILED_INTERACTIVE) + if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE) goto lose; specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE]; } @@ -234,27 +255,65 @@ Otherwise, this is done only if an arg is read using the minibuffer.") goto lose; /* If either specs or string is set to a string, use it. */ - if (XTYPE (specs) == Lisp_String) + if (STRINGP (specs)) { /* 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 */ - /* Handle special starting chars `*' and `@'. */ + /* 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 `@'. Also `-'. */ while (1) { if (*string == '*') @@ -263,11 +322,30 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only (); } + /* Ignore this for semi-compatibility with Lucid. */ + else if (*string == '-') + string++; else if (*string == '@') { + Lisp_Object event; + + event = XVECTOR (this_command_keys)->contents[next_event]; + if (EVENT_HAS_PARAMETERS (event) + && (event = XCONS (event)->car, CONSP (event)) + && (event = XCONS (event)->car, CONSP (event)) + && (event = XCONS (event)->car), WINDOWP (event)) + { + if (MINI_WINDOW_P (XWINDOW (event)) + && ! (minibuf_level > 0 && EQ (event, minibuf_window))) + error ("Attempt to select inactive minibuffer window"); + + /* If the current buffer wants to clean up, let it. */ + if (!NILP (Vmouse_leave_buffer_hook)) + call1 (Vrun_hooks, Qmouse_leave_buffer_hook); + + Fselect_window (event); + } string++; - if (!NILP (Vmouse_window)) - Fselect_window (Vmouse_window); } else break; } @@ -304,6 +382,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 +415,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 */ @@ -360,7 +442,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") break; case 'd': /* Value of point. Does not do I/O. */ - XFASTINT (args[i]) = point; + XSETFASTINT (args[i], point); /* visargs[i] = Qnil; */ varies[i] = 1; break; @@ -380,25 +462,39 @@ Otherwise, this is done only if an arg is read using the minibuffer.") Qnil, Qnil, Qnil, Qnil); break; - case 'k': /* Key sequence (string) */ - args[i] = Fread_key_sequence (build_string (prompt), Qnil); + case 'k': /* Key sequence. */ + args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qnil); teml = args[i]; 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.", - (XTYPE (function) == Lisp_Symbol + case 'K': /* Key sequence to be defined. */ + args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qt); + teml = args[i]; + visargs[i] = Fkey_description (teml); + break; + + case 'e': /* The invoking event. */ + if (next_event >= this_command_key_count) + error ("%s must be bound to an event with parameters", + (SYMBOLP (function) ? (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. */ check_mark (); /* visargs[i] = Qnil; */ - XFASTINT (args[i]) = marker_position (current_buffer->mark); + XSETFASTINT (args[i], marker_position (current_buffer->mark)); varies[i] = 2; break; @@ -430,9 +526,9 @@ Otherwise, this is done only if an arg is read using the minibuffer.") /* visargs[i+1] = Qnil; */ foo = marker_position (current_buffer->mark); /* visargs[i] = Qnil; */ - XFASTINT (args[i]) = point < foo ? point : foo; + XSETFASTINT (args[i], point < foo ? point : foo); varies[i] = 3; - XFASTINT (args[++i]) = point > foo ? point : foo; + XSETFASTINT (args[++i], point > foo ? point : foo); varies[i] = 4; break; @@ -441,10 +537,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); @@ -474,13 +567,14 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (varies[i] == 0) arg_from_tty = 1; - if (NILP (visargs[i]) && XTYPE (args[i]) == Lisp_String) + if (NILP (visargs[i]) && STRINGP (args[i])) visargs[i] = args[i]; tem = (unsigned char *) index (tem, '\n'); if (tem) tem++; else tem = (unsigned char *) ""; } + unbind_to (speccount, Qnil); QUIT; @@ -500,7 +594,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); @@ -519,35 +612,49 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") { Lisp_Object val; - /* Tag val as an integer, so the rest of the assignments - may use XSETINT. */ - XFASTINT (val) = 0; - if (NILP (raw)) - XFASTINT (val) = 1; - else if (XTYPE (raw) == Lisp_Symbol) + XSETFASTINT (val, 1); + else if (EQ (raw, Qminus)) XSETINT (val, -1); else if (CONSP (raw)) XSETINT (val, XINT (XCONS (raw)->car)); - else if (XTYPE (raw) == Lisp_Int) + else if (INTEGERP (raw)) val = raw; else - XFASTINT (val) = 1; + XSETFASTINT (val, 1); return val; } 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); + Qplus = intern ("+"); + staticpro (&Qplus); + Qcall_interactively = intern ("call-interactively"); staticpro (&Qcall_interactively); Qcommand_debug_status = intern ("command-debug-status"); staticpro (&Qcommand_debug_status); + Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers"); + staticpro (&Qenable_recursive_minibuffers); + + Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook"); + staticpro (&Qmouse_leave_buffer_hook); + 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\ @@ -579,6 +686,20 @@ Bound each time `call-interactively' is called;\n\ may be set by the debugger as a reminder for itself."); Vcommand_debug_status = Qnil; + DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive, + "*Non-nil means you can use the mark even when inactive.\n\ +This option makes a difference in Transient Mark mode.\n\ +When the option is non-nil, deactivation of the mark\n\ +turns off region highlighting, but commands that use the mark\n\ +behave as if the mark were still active."); + Vmark_even_if_inactive = Qnil; + + DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook, + "Hook to run when about to switch windows with a mouse command.\n\ +Its purpose is to give temporary modes such as Isearch mode\n\ +a way to turn themselves off when a mouse command switches windows."); + Vmouse_leave_buffer_hook = Qnil; + defsubr (&Sinteractive); defsubr (&Scall_interactively); defsubr (&Sprefix_numeric_value);