X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/eebf4ec9ce15b03c7dcae4d69206925b130097d1..eddd51c2807805e47aa70008234111b601e9a050:/src/callint.c diff --git a/src/callint.c b/src/callint.c index 357f4b9aa8..b0e0e3c145 100644 --- a/src/callint.c +++ b/src/callint.c @@ -15,7 +15,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #include @@ -28,7 +29,9 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ extern char *index (); -Lisp_Object Qminus, Qplus; +extern Lisp_Object Qcursor_in_echo_area; + +Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus; Lisp_Object Qcall_interactively; Lisp_Object Vcommand_history; @@ -41,8 +44,17 @@ Lisp_Object Vmark_even_if_inactive; Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; -Lisp_Object Qlist; -Lisp_Object preserved_fns; +Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion; +static Lisp_Object preserved_fns; + +/* Marker used within call-interactively to refer to point. */ +static Lisp_Object point_marker; + +/* Buffer for the prompt text used in Fcall_interactively. */ +static char *callint_message; + +/* Allocated length of that buffer. */ +static int callint_message_size; /* This comment supplies the doc string for interactive, for make-docfile to see. We cannot put this in the real DEFUN @@ -80,7 +92,9 @@ e -- Parametrized event (i.e., one that's a list) that invoked this command.\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\ +i -- Ignored, i.e. always nil. Does not do I/O.\n\ +k -- Key sequence (downcase the last event if needed to get a definition).\n\ +K -- Key sequence to be redefined (do not downcase the last event).\n\ m -- Value of mark as number. Does not do I/O.\n\ n -- Number read using minibuffer.\n\ N -- Raw prefix arg, or if none, do like code `n'.\n\ @@ -92,6 +106,8 @@ S -- Any symbol.\n\ v -- Variable name: symbol that is user-variable-p.\n\ x -- Lisp expression read but not evaluated.\n\ X -- Lisp expression read and evaluated.\n\ +z -- Coding system.\n\ +Z -- Coding system, nil if no prefix arg.\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\ @@ -154,8 +170,9 @@ check_mark () } -DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0, +DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, "Call FUNCTION, reading args according to its interactive calling specs.\n\ +Return the value FUNCTION returns.\n\ The function contains a specification of how to do the argument reading.\n\ In the case of user-defined functions, this is specified by placing a call\n\ to the function `interactive' at the top level of the function body.\n\ @@ -164,8 +181,8 @@ See `interactive'.\n\ Optional second arg RECORD-FLAG non-nil\n\ means unconditionally put this command in the command-history.\n\ Otherwise, this is done only if an arg is read using the minibuffer.") - (function, record) - Lisp_Object function, record; + (function, record_flag, keys) + Lisp_Object function, record_flag, keys; { Lisp_Object *args, *visargs; unsigned char **argstrings; @@ -191,14 +208,22 @@ Otherwise, this is done only if an arg is read using the minibuffer.") register int i, j; int count, foo; - char prompt[100]; char prompt1[100]; char *tem1; int arg_from_tty = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + int key_count; + + if (NILP (keys)) + keys = this_command_keys, key_count = this_command_key_count; + else + { + CHECK_VECTOR (keys, 3); + key_count = XVECTOR (keys)->size; + } /* Save this now, since use of minibuffer will clobber it. */ - prefix_arg = current_perdisplay->Vcurrent_prefix_arg; + prefix_arg = Vcurrent_prefix_arg; retry: @@ -250,7 +275,10 @@ Otherwise, this is done only if an arg is read using the minibuffer.") specs = Fcar (Fcdr (specs)); } else if (EQ (funcar, Qmocklisp)) - return ml_apply (fun, Qinteractive); + { + single_kboard_state (); + return ml_apply (fun, Qinteractive); + } else goto lose; @@ -265,11 +293,11 @@ Otherwise, this is done only if an arg is read using the minibuffer.") else if (string == 0) { Lisp_Object input; - i = num_input_chars; + i = num_input_events; input = specs; /* Compute the arg values using the user's expression. */ specs = Feval (specs); - if (i != num_input_chars || !NILP (record)) + if (i != num_input_events || !NILP (record_flag)) { /* We should record this command on the command history. */ Lisp_Object values, car; @@ -280,43 +308,60 @@ Otherwise, this is done only if an arg is read using the minibuffer.") 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)) + if (CONSP (input)) { - Lisp_Object intail, valtail; - for (intail = Fcdr (input), valtail = values; - CONSP (valtail); - intail = Fcdr (intail), valtail = Fcdr (valtail)) + car = XCONS (input)->car; + /* Skip through certain special forms. */ + while (EQ (car, Qlet) || EQ (car, Qletx) + || EQ (car, Qsave_excursion)) { - Lisp_Object elt; - elt = Fcar (intail); - if (CONSP (elt)) + while (CONSP (XCONS (input)->cdr)) + input = XCONS (input)->cdr; + input = XCONS (input)->car; + if (!CONSP (input)) + break; + car = XCONS (input)->car; + } + if (EQ (car, Qlist)) + { + Lisp_Object intail, valtail; + for (intail = Fcdr (input), valtail = values; + CONSP (valtail); + intail = Fcdr (intail), valtail = Fcdr (valtail)) { - Lisp_Object presflag; - presflag = Fmemq (Fcar (elt), preserved_fns); - if (!NILP (presflag)) - Fsetcar (valtail, Fcar (intail)); + 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); } + single_kboard_state (); 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])) + for (next_event = 0; next_event < key_count; next_event++) + if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event])) break; /* Handle special starting chars `*' and `@'. Also `-'. */ + /* Note that `+' is reserved for user extensions. */ while (1) { - if (*string == '*') + if (*string == '+') + error ("`+' is not used in `interactive' for ordinary commands"); + else if (*string == '*') { string++; if (!NILP (current_buffer->read_only)) @@ -329,11 +374,11 @@ Otherwise, this is done only if an arg is read using the minibuffer.") { Lisp_Object event; - event = XVECTOR (this_command_keys)->contents[next_event]; + event = XVECTOR (keys)->contents[next_event]; if (EVENT_HAS_PARAMETERS (event) + && (event = XCONS (event)->cdr, CONSP (event)) && (event = XCONS (event)->car, CONSP (event)) - && (event = XCONS (event)->car, CONSP (event)) - && (event = XCONS (event)->car), WINDOWP (event)) + && (event = XCONS (event)->car, WINDOWP (event))) { if (MINI_WINDOW_P (XWINDOW (event)) && ! (minibuf_level > 0 && EQ (event, minibuf_window))) @@ -400,13 +445,28 @@ Otherwise, this is done only if an arg is read using the minibuffer.") ? (unsigned char *) "" : XSTRING (visargs[j])->data; - doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1); + /* Process the format-string in prompt1, putting the output + into callint_message. Make callint_message bigger if necessary. + We don't use a buffer on the stack, because the contents + need to stay stable for a while. */ + while (1) + { + int nchars = doprnt (callint_message, callint_message_size, + prompt1, (char *)0, + j - 1, argstrings + 1); + if (nchars < callint_message_size) + break; + callint_message_size *= 2; + callint_message + = (char *) xrealloc (callint_message, callint_message_size); + } switch (*tem) { case 'a': /* Symbol defined as a function */ - visargs[i] = Fcompleting_read (build_string (prompt), - Vobarray, Qfboundp, Qt, Qnil, Qnil); + visargs[i] = Fcompleting_read (build_string (callint_message), + Vobarray, Qfboundp, Qt, + Qnil, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -416,77 +476,99 @@ Otherwise, this is done only if an arg is read using the minibuffer.") args[i] = Fcurrent_buffer (); if (EQ (selected_window, minibuf_window)) args[i] = Fother_buffer (args[i], Qnil); - args[i] = Fread_buffer (build_string (prompt), args[i], Qt); + args[i] = Fread_buffer (build_string (callint_message), args[i], Qt); break; case 'B': /* Name of buffer, possibly nonexistent */ - args[i] = Fread_buffer (build_string (prompt), + args[i] = Fread_buffer (build_string (callint_message), Fother_buffer (Fcurrent_buffer (), Qnil), Qnil); break; case 'c': /* Character */ - message1 (prompt); + /* Use message_nolog rather than message1_nolog here, + so that nothing bad happens if callint_message is changed + within Fread_char (by a timer, for example). */ + message_nolog ("%s", callint_message); args[i] = Fread_char (); + message1_nolog ((char *) 0); /* Passing args[i] directly stimulates compiler bug */ teml = args[i]; visargs[i] = Fchar_to_string (teml); break; case 'C': /* Command: symbol with interactive function */ - visargs[i] = Fcompleting_read (build_string (prompt), - Vobarray, Qcommandp, Qt, Qnil, Qnil); + visargs[i] = Fcompleting_read (build_string (callint_message), + Vobarray, Qcommandp, + Qt, Qnil, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; case 'd': /* Value of point. Does not do I/O. */ - XSETFASTINT (args[i], point); + Fset_marker (point_marker, make_number (PT), Qnil); + args[i] = point_marker; /* visargs[i] = Qnil; */ varies[i] = 1; break; case 'D': /* Directory name. */ - args[i] = Fread_file_name (build_string (prompt), Qnil, + args[i] = Fread_file_name (build_string (callint_message), Qnil, current_buffer->directory, Qlambda, Qnil); break; case 'f': /* Existing file name. */ - args[i] = Fread_file_name (build_string (prompt), + args[i] = Fread_file_name (build_string (callint_message), Qnil, Qnil, Qlambda, Qnil); break; case 'F': /* Possibly nonexistent file name. */ - args[i] = Fread_file_name (build_string (prompt), + args[i] = Fread_file_name (build_string (callint_message), Qnil, Qnil, Qnil, Qnil); break; + case 'i': /* Ignore an argument -- Does not do I/O */ + varies[i] = -1; + break; + case 'k': /* Key sequence. */ - args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qnil); - teml = args[i]; - visargs[i] = Fkey_description (teml); + { + int speccount1 = specpdl_ptr - specpdl; + specbind (Qcursor_in_echo_area, Qt); + args[i] = Fread_key_sequence (build_string (callint_message), + Qnil, Qnil, Qnil); + unbind_to (speccount1, Qnil); + teml = args[i]; + visargs[i] = Fkey_description (teml); + } break; 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); + { + int speccount1 = specpdl_ptr - specpdl; + specbind (Qcursor_in_echo_area, Qt); + args[i] = Fread_key_sequence (build_string (callint_message), + Qnil, Qt, Qnil); + teml = args[i]; + visargs[i] = Fkey_description (teml); + unbind_to (speccount1, Qnil); + } break; case 'e': /* The invoking event. */ - if (next_event >= this_command_key_count) + if (next_event >= key_count) error ("%s must be bound to an event with parameters", (SYMBOLP (function) ? (char *) XSYMBOL (function)->name->data : "command")); - args[i] = XVECTOR (this_command_keys)->contents[next_event++]; + args[i] = XVECTOR (keys)->contents[next_event++]; varies[i] = -1; /* Find the next parameterized event. */ - while (next_event < this_command_key_count + while (next_event < key_count && ! (EVENT_HAS_PARAMETERS - (XVECTOR (this_command_keys)->contents[next_event]))) + (XVECTOR (keys)->contents[next_event]))) next_event++; break; @@ -494,7 +576,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") case 'm': /* Value of mark. Does not do I/O. */ check_mark (); /* visargs[i] = Qnil; */ - XSETFASTINT (args[i], marker_position (current_buffer->mark)); + args[i] = current_buffer->mark; varies[i] = 2; break; @@ -502,20 +584,38 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (!NILP (prefix_arg)) goto have_prefix_arg; case 'n': /* Read number from minibuffer. */ - do - args[i] = Fread_minibuffer (build_string (prompt), Qnil); - while (! NUMBERP (args[i])); + { + int first = 1; + do + { + Lisp_Object tem; + if (! first) + { + message ("Please enter a number."); + sit_for (1, 0, 0, 0); + } + first = 0; + + tem = Fread_from_minibuffer (build_string (callint_message), + Qnil, Qnil, Qnil, Qnil, Qnil); + if (! STRINGP (tem) || XSTRING (tem)->size == 0) + args[i] = Qnil; + else + args[i] = Fread (tem); + } + while (! NUMBERP (args[i])); + } visargs[i] = last_minibuf_string; break; case 'P': /* Prefix arg in raw form. Does no I/O. */ - have_prefix_arg: args[i] = prefix_arg; /* visargs[i] = Qnil; */ varies[i] = -1; break; case 'p': /* Prefix arg converted to number. No I/O. */ + have_prefix_arg: args[i] = Fprefix_numeric_value (prefix_arg); /* visargs[i] = Qnil; */ varies[i] = -1; @@ -523,21 +623,24 @@ Otherwise, this is done only if an arg is read using the minibuffer.") case 'r': /* Region, point and mark as 2 args. */ check_mark (); + Fset_marker (point_marker, make_number (PT), Qnil); /* visargs[i+1] = Qnil; */ foo = marker_position (current_buffer->mark); /* visargs[i] = Qnil; */ - XSETFASTINT (args[i], point < foo ? point : foo); + args[i] = PT < foo ? point_marker : current_buffer->mark; varies[i] = 3; - XSETFASTINT (args[++i], point > foo ? point : foo); + args[++i] = PT > foo ? point_marker : current_buffer->mark; varies[i] = 4; break; case 's': /* String read via minibuffer. */ - args[i] = Fread_string (build_string (prompt), Qnil, Qnil); + args[i] = Fread_string (build_string (callint_message), + Qnil, Qnil, Qnil); break; case 'S': /* Any symbol. */ - visargs[i] = Fread_string (build_string (prompt), Qnil, Qnil); + visargs[i] = Fread_string (build_string (callint_message), + Qnil, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -545,22 +648,45 @@ Otherwise, this is done only if an arg is read using the minibuffer.") case 'v': /* Variable name: symbol that is user-variable-p. */ - args[i] = Fread_variable (build_string (prompt)); + args[i] = Fread_variable (build_string (callint_message), Qnil); visargs[i] = last_minibuf_string; break; case 'x': /* Lisp expression read but not evaluated */ - args[i] = Fread_minibuffer (build_string (prompt), Qnil); + args[i] = Fread_minibuffer (build_string (callint_message), Qnil); visargs[i] = last_minibuf_string; break; case 'X': /* Lisp expression read and evaluated */ - args[i] = Feval_minibuffer (build_string (prompt), Qnil); + args[i] = Feval_minibuffer (build_string (callint_message), Qnil); visargs[i] = last_minibuf_string; break; + case 'Z': /* Coding-system symbol, or ignore the + argument if no prefix */ + if (NILP (prefix_arg)) + { + args[i] = Qnil; + varies[i] = -1; + } + else + { + args[i] + = Fread_non_nil_coding_system (build_string (callint_message)); + visargs[i] = last_minibuf_string; + } + break; + + case 'z': /* Coding-system symbol or nil */ + args[i] = Fread_coding_system (build_string (callint_message)); + visargs[i] = last_minibuf_string; + break; + + /* We have a case for `+' so we get an error + if anyone tries to define one here. */ + case '+': default: - error ("Invalid control letter \"%c\" (%03o) in interactive calling string", + error ("Invalid control letter `%c' (%03o) in interactive calling string", *tem, *tem); } @@ -580,18 +706,28 @@ Otherwise, this is done only if an arg is read using the minibuffer.") args[0] = function; - if (arg_from_tty || !NILP (record)) + if (arg_from_tty || !NILP (record_flag)) { visargs[0] = function; for (i = 1; i < count + 1; i++) - if (varies[i] > 0) - visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil); - else - visargs[i] = quotify_arg (args[i]); + { + if (varies[i] > 0) + visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil); + else + visargs[i] = quotify_arg (args[i]); + } Vcommand_history = Fcons (Flist (count + 1, visargs), Vcommand_history); } + /* If we used a marker to hold point, mark, or an end of the region, + temporarily, convert it to an integer now. */ + for (i = 1; i <= count; i++) + if (varies[i] >= 1 && varies[i] <= 4) + XSETINT (args[i], marker_position (args[i])); + + single_kboard_state (); + { Lisp_Object val; specbind (Qcommand_debug_status, Qnil); @@ -604,7 +740,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, 1, 1, 0, - "Return numeric meaning of raw prefix argument ARG.\n\ + "Return numeric meaning of raw prefix argument RAW.\n\ A raw prefix argument is what you get from `(interactive \"P\")'.\n\ Its numeric meaning is what you would get from `(interactive \"p\")'.") (raw) @@ -616,7 +752,7 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") XSETFASTINT (val, 1); else if (EQ (raw, Qminus)) XSETINT (val, -1); - else if (CONSP (raw)) + else if (CONSP (raw) && INTEGERP (XCONS (raw)->car)) XSETINT (val, XINT (XCONS (raw)->car)); else if (INTEGERP (raw)) val = raw; @@ -628,6 +764,9 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") syms_of_callint () { + point_marker = Fmake_marker (); + staticpro (&point_marker); + preserved_fns = Fcons (intern ("region-beginning"), Fcons (intern ("region-end"), Fcons (intern ("point"), @@ -636,6 +775,12 @@ syms_of_callint () Qlist = intern ("list"); staticpro (&Qlist); + Qlet = intern ("let"); + staticpro (&Qlet); + Qletx = intern ("let*"); + staticpro (&Qletx); + Qsave_excursion = intern ("save-excursion"); + staticpro (&Qsave_excursion); Qminus = intern ("-"); staticpro (&Qminus); @@ -655,6 +800,29 @@ syms_of_callint () Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook"); staticpro (&Qmouse_leave_buffer_hook); + callint_message_size = 100; + callint_message = (char *) xmalloc (callint_message_size); + + + DEFVAR_KBOARD ("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\ +or a list whose car is a number for just one or more C-U's\n\ +or nil if no argument has been specified.\n\ +\n\ +You cannot examine this variable to find the argument for this command\n\ +since it has been set to nil by the time you can look.\n\ +Instead, you should use the variable `current-prefix-arg', although\n\ +normally commands can get this prefix argument with (interactive \"P\")."); + + DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg, + "The value of the prefix argument for this editing command.\n\ +It may be a number, or the symbol `-' for just a minus sign as arg,\n\ +or a list whose car is a number for just one or more C-U's\n\ +or nil if no argument has been specified.\n\ +This is what `(interactive \"P\")' returns."); + Vcurrent_prefix_arg = Qnil; + DEFVAR_LISP ("command-history", &Vcommand_history, "List of recent commands that read arguments from terminal.\n\ Each command is represented as a form to evaluate.");