X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7f78e619abe65576d8b012eb20e945df1b22d77f..db95369be096960245dd38678f68464627698678:/src/callint.c diff --git a/src/callint.c b/src/callint.c index 84270ff0c2..4552b2274b 100644 --- a/src/callint.c +++ b/src/callint.c @@ -1,5 +1,6 @@ /* Call a Lisp function interactively. - Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 2002 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,24 +16,32 @@ 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 + #include "lisp.h" #include "buffer.h" #include "commands.h" #include "keyboard.h" #include "window.h" -#include "mocklisp.h" +#include "keymap.h" + +#ifdef HAVE_INDEX +extern char *index P_ ((const char *, int)); +#endif -extern char *index (); +extern Lisp_Object Qcursor_in_echo_area; +extern Lisp_Object Qfile_directory_p; -int current_prefix_partial; -Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus, Qplus; +Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus; Lisp_Object Qcall_interactively; Lisp_Object Vcommand_history; +extern Lisp_Object Vhistory_length; + Lisp_Object Vcommand_debug_status, Qcommand_debug_status; Lisp_Object Qenable_recursive_minibuffers; @@ -42,114 +51,79 @@ Lisp_Object Vmark_even_if_inactive; Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; -Lisp_Object Qlist; +Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn; 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; -void -clear_prefix_arg () -{ - Vprefix_arg = Qnil; - if (!current_prefix_partial) - { - current_perdisplay->prefix_factor = Qnil; - current_perdisplay->prefix_value = Qnil; - current_perdisplay->prefix_sign = 1; - current_perdisplay->prefix_partial = 0; - } -} - -void -finalize_prefix_arg () -{ - if (!NILP (current_perdisplay->prefix_factor)) - Vprefix_arg = Fcons (current_perdisplay->prefix_factor, Qnil); - else if (NILP (current_perdisplay->prefix_value)) - Vprefix_arg = (current_perdisplay->prefix_sign > 0 ? Qnil : Qminus); - else if (current_perdisplay->prefix_sign > 0) - Vprefix_arg = current_perdisplay->prefix_value; - else - XSETINT (Vprefix_arg, -XINT (current_perdisplay->prefix_value)); - current_perdisplay->prefix_partial = 0; -} - -static void -describe_prefix_arg () -{ - if (INTEGERP (Vprefix_arg)) - message ("Arg: %d", Vprefix_arg); - else if (CONSP (Vprefix_arg)) - message ("Arg: [%d]", XCONS (Vprefix_arg)->car); - else if (EQ (Vprefix_arg, Qminus)) - message ("Arg: -"); -} - - -/* This comment supplies the doc string for interactive, - for make-docfile to see. We cannot put this in the real DEFUN - due to limits in the Unix cpp. - -DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0, - "Specify a way of parsing arguments for interactive use of a function.\n\ -For example, write\n\ - (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\ -to make ARG be the prefix argument when `foo' is called as a command.\n\ -The \"call\" to `interactive' is actually a declaration rather than a function;\n\ - it tells `call-interactively' how to read arguments\n\ - to pass to the function.\n\ -When actually called, `interactive' just returns nil.\n\ -\n\ -The argument of `interactive' is usually a string containing a code letter\n\ - followed by a prompt. (Some code letters do not use I/O to get\n\ - the argument and do not need prompts.) To prompt for multiple arguments,\n\ - give a code letter, its prompt, a newline, and another code letter, etc.\n\ - Prompts are passed to format, and may use % escapes to print the\n\ - arguments that have already been read.\n\ -If the argument is not a string, it is evaluated to get a list of\n\ - arguments to pass to the function.\n\ -Just `(interactive)' means pass no args when calling interactively.\n\ -\nCode letters available are:\n\ -a -- Function name: symbol with a function definition.\n\ -b -- Name of existing buffer.\n\ -B -- Name of buffer, possibly nonexistent.\n\ -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 (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\ -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\ -s -- Any string.\n\ -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\ -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 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." */ +/* Allocated length of that buffer. */ +static int callint_message_size; /* ARGSUSED */ DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, - 0 /* See immediately above */) - (args) + doc: /* Specify a way of parsing arguments for interactive use of a function. +For example, write + (defun foo (arg) "Doc string" (interactive "p") ...use arg...) +to make ARG be the prefix argument when `foo' is called as a command. +The "call" to `interactive' is actually a declaration rather than a function; + it tells `call-interactively' how to read arguments + to pass to the function. +When actually called, `interactive' just returns nil. + +The argument of `interactive' is usually a string containing a code letter + followed by a prompt. (Some code letters do not use I/O to get + the argument and do not need prompts.) To prompt for multiple arguments, + give a code letter, its prompt, a newline, and another code letter, etc. + Prompts are passed to format, and may use % escapes to print the + arguments that have already been read. +If the argument is not a string, it is evaluated to get a list of + arguments to pass to the function. +Just `(interactive)' means pass no args when calling interactively. + +Code letters available are: +a -- Function name: symbol with a function definition. +b -- Name of existing buffer. +B -- Name of buffer, possibly nonexistent. +c -- Character (no input method is used). +C -- Command name: symbol with interactive function definition. +d -- Value of point as number. Does not do I/O. +D -- Directory name. +e -- Parametrized event (i.e., one that's a list) that invoked this command. + If used more than once, the Nth `e' returns the Nth parameterized event. + This skips events that are integers or symbols. +f -- Existing file name. +F -- Possibly nonexistent file name. +i -- Ignored, i.e. always nil. Does not do I/O. +k -- Key sequence (downcase the last event if needed to get a definition). +K -- Key sequence to be redefined (do not downcase the last event). +m -- Value of mark as number. Does not do I/O. +M -- Any string. Inherits the current input method. +n -- Number read using minibuffer. +N -- Raw prefix arg, or if none, do like code `n'. +p -- Prefix arg converted to number. Does not do I/O. +P -- Prefix arg in raw form. Does not do I/O. +r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O. +s -- Any string. Does not inherit the current input method. +S -- Any symbol. +v -- Variable name: symbol that is user-variable-p. +x -- Lisp expression read but not evaluated. +X -- Lisp expression read and evaluated. +z -- Coding system. +Z -- Coding system, nil if no prefix arg. +In addition, if the string begins with `*' + then an error is signaled if the buffer is read-only. + This happens before reading any arguments. +If the string begins with `@', then Emacs searches the key sequence + which invoked the command for its first mouse click (or any other + event which specifies a window), and selects that window before + reading any arguments. You may use both `@' and `*'; they are + processed in the order that they appear. +usage: (interactive ARGS) */) + (args) Lisp_Object args; { return Qnil; @@ -174,11 +148,11 @@ quotify_args (exp) Lisp_Object exp; { register Lisp_Object tail; - register struct Lisp_Cons *ptr; - for (tail = exp; CONSP (tail); tail = ptr->cdr) + Lisp_Object next; + for (tail = exp; CONSP (tail); tail = next) { - ptr = XCONS (tail); - ptr->car = quotify_arg (ptr->car); + next = XCDR (tail); + XSETCAR (tail, quotify_arg (XCAR (tail))); } return exp; } @@ -187,39 +161,45 @@ char *callint_argfuns[] = {"", "point", "mark", "region-beginning", "region-end"}; static void -check_mark () +check_mark (for_region) + int for_region; { Lisp_Object tem; tem = Fmarker_buffer (current_buffer->mark); if (NILP (tem) || (XBUFFER (tem) != current_buffer)) - error ("The mark is not set now"); + error (for_region ? "The mark is not set now, so there is no region" + : "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); } -DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0, - "Call FUNCTION, reading args according to its interactive calling specs.\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\ -See `interactive'.\n\ -\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; +DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, + doc: /* Call FUNCTION, reading args according to its interactive calling specs. +Return the value FUNCTION returns. +The function contains a specification of how to do the argument reading. +In the case of user-defined functions, this is specified by placing a call +to the function `interactive' at the top level of the function body. +See `interactive'. + +Optional second arg RECORD-FLAG non-nil +means unconditionally put this command in the command-history. +Otherwise, this is done only if an arg is read using the minibuffer. +Optional third arg KEYS, if given, specifies the sequence of events to +supply if the command inquires which events were used to invoke it. */) + (function, record_flag, keys) + Lisp_Object function, record_flag, keys; { Lisp_Object *args, *visargs; unsigned char **argstrings; Lisp_Object fun; Lisp_Object funcar; Lisp_Object specs; + Lisp_Object filter_specs; Lisp_Object teml; Lisp_Object enable; - int speccount = specpdl_ptr - specpdl; + int speccount = SPECPDL_INDEX (); /* The index of the next element of this_command_keys to examine for the 'e' interactive code. */ @@ -236,11 +216,20 @@ 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; + int record_then_fail = 0; + + if (NILP (keys)) + keys = this_command_keys, key_count = this_command_key_count; + else + { + CHECK_VECTOR (keys); + key_count = XVECTOR (keys)->size; + } /* Save this now, since use of minibuffer will clobber it. */ prefix_arg = Vcurrent_prefix_arg; @@ -249,11 +238,17 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (SYMBOLP (function)) enable = Fget (function, Qenable_recursive_minibuffers); + else + enable = Qnil; fun = indirect_function (function); specs = Qnil; string = 0; + /* The idea of FILTER_SPECS is to provide away to + specify how to represent the arguments in command history. + The feature is not fully implemented. */ + filter_specs = Qnil; /* Decode the kind of function. Either handle it and return, or go to `lose' if not interactive, or go to `retry' @@ -268,9 +263,6 @@ Otherwise, this is done only if an arg is read using the minibuffer.") function = wrong_type_argument (Qcommandp, function); goto retry; } - if ((EMACS_INT) string == 1) - /* Let SPECS (which is nil) be used as the args. */ - string = 0; } else if (COMPILEDP (fun)) { @@ -280,7 +272,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") } else if (!CONSP (fun)) goto lose; - else if (funcar = Fcar (fun), EQ (funcar, Qautoload)) + else if (funcar = XCAR (fun), EQ (funcar, Qautoload)) { GCPRO2 (function, prefix_arg); do_autoload (fun, function); @@ -289,37 +281,34 @@ Otherwise, this is done only if an arg is read using the minibuffer.") } else if (EQ (funcar, Qlambda)) { - specs = Fassq (Qinteractive, Fcdr (Fcdr (fun))); + specs = Fassq (Qinteractive, Fcdr (XCDR (fun))); if (NILP (specs)) goto lose; + filter_specs = Fnth (make_number (1), specs); specs = Fcar (Fcdr (specs)); } - else if (EQ (funcar, Qmocklisp)) - { -#ifdef MULTI_PERDISPLAY - display_locked = 1; -#endif - return ml_apply (fun, Qinteractive); - } else goto lose; - /* If either specs or string is set to a string, use it. */ + /* If either SPECS or STRING is set to a string, use it. */ if (STRINGP (specs)) { /* Make a copy of string so that if a GC relocates specs, `string' will still be valid. */ - string = (unsigned char *) alloca (XSTRING (specs)->size + 1); - bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1); + string = (unsigned char *) alloca (SBYTES (specs) + 1); + bcopy (SDATA (specs), string, + SBYTES (specs) + 1); } 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. */ + GCPRO2 (input, filter_specs); specs = Feval (specs); - if (i != num_input_chars || !NILP (record)) + UNGCPRO; + if (i != num_input_events || !NILP (record_flag)) { /* We should record this command on the command history. */ Lisp_Object values, car; @@ -330,50 +319,88 @@ 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 = XCAR (input); + /* Skip through certain special forms. */ + while (EQ (car, Qlet) || EQ (car, Qletx) + || EQ (car, Qsave_excursion) + || EQ (car, Qprogn)) { - Lisp_Object elt; - elt = Fcar (intail); - if (CONSP (elt)) + while (CONSP (XCDR (input))) + input = XCDR (input); + input = XCAR (input); + if (!CONSP (input)) + break; + car = XCAR (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 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); + + /* Don't keep command history around forever. */ + if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) + { + teml = Fnthcdr (Vhistory_length, Vcommand_history); + if (CONSP (teml)) + XSETCDR (teml, Qnil); + } } -#ifdef MULTI_PERDISPLAY - display_locked = 1; -#endif + 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)) - Fbarf_if_buffer_read_only (); + { + if (!NILP (record_flag)) + { + unsigned char *p = string; + while (*p) + { + if (! (*p == 'r' || *p == 'p' || *p == 'P' + || *p == '\n')) + Fbarf_if_buffer_read_only (); + p++; + } + record_then_fail = 1; + } + else + Fbarf_if_buffer_read_only (); + } } /* Ignore this for semi-compatibility with Lucid. */ else if (*string == '-') @@ -382,11 +409,13 @@ 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 = (next_event < key_count + ? XVECTOR (keys)->contents[next_event] + : Qnil); if (EVENT_HAS_PARAMETERS (event) - && (event = XCONS (event)->car, CONSP (event)) - && (event = XCONS (event)->car, CONSP (event)) - && (event = XCONS (event)->car), WINDOWP (event)) + && (event = XCDR (event), CONSP (event)) + && (event = XCAR (event), CONSP (event)) + && (event = XCAR (event), WINDOWP (event))) { if (MINI_WINDOW_P (XWINDOW (event)) && ! (minibuf_level > 0 && EQ (event, minibuf_window))) @@ -443,23 +472,38 @@ Otherwise, this is done only if an arg is read using the minibuffer.") { strncpy (prompt1, tem + 1, sizeof prompt1 - 1); prompt1[sizeof prompt1 - 1] = 0; - tem1 = index (prompt1, '\n'); + tem1 = (char *) index (prompt1, '\n'); if (tem1) *tem1 = 0; /* Fill argstrings with a vector of C strings corresponding to the Lisp strings in visargs. */ for (j = 1; j < i; j++) argstrings[j] - = EQ (visargs[j], Qnil) - ? (unsigned char *) "" - : XSTRING (visargs[j])->data; - - doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1); + = (EQ (visargs[j], Qnil) + ? (unsigned char *) "" + : SDATA (visargs[j])); + + /* 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, (char **) argstrings + 1); + if (nchars < callint_message_size - 1) + 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, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -468,131 +512,209 @@ 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], Qnil); - args[i] = Fread_buffer (build_string (prompt), args[i], Qt); + args[i] = Fother_buffer (args[i], Qnil, Qnil); + 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), - Fother_buffer (Fcurrent_buffer (), Qnil), + args[i] = Fread_buffer (build_string (callint_message), + Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil); break; case 'c': /* Character */ - message1 (prompt); - args[i] = Fread_char (); + args[i] = Fread_char (build_string (callint_message), Qnil); + 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, 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. */ - Fset_marker (point_marker, make_number (PT), Qnil); + set_marker_both (point_marker, Qnil, PT, PT_BYTE); args[i] = point_marker; /* visargs[i] = Qnil; */ varies[i] = 1; break; case 'D': /* Directory name. */ - args[i] = Fread_file_name (build_string (prompt), Qnil, - current_buffer->directory, Qlambda, Qnil); + args[i] = Fread_file_name (build_string (callint_message), Qnil, + current_buffer->directory, Qlambda, Qnil, + Qfile_directory_p); break; case 'f': /* Existing file name. */ - args[i] = Fread_file_name (build_string (prompt), - Qnil, Qnil, Qlambda, Qnil); + args[i] = Fread_file_name (build_string (callint_message), + Qnil, Qnil, Qlambda, Qnil, Qnil); break; case 'F': /* Possibly nonexistent file name. */ - args[i] = Fread_file_name (build_string (prompt), - Qnil, Qnil, Qnil, Qnil); + args[i] = Fread_file_name (build_string (callint_message), + Qnil, 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, Qnil); - teml = args[i]; - visargs[i] = Fkey_description (teml); + { + int speccount1 = SPECPDL_INDEX (); + specbind (Qcursor_in_echo_area, Qt); + args[i] = Fread_key_sequence (build_string (callint_message), + Qnil, Qnil, Qnil, Qnil); + unbind_to (speccount1, Qnil); + teml = args[i]; + visargs[i] = Fkey_description (teml); + + /* If the key sequence ends with a down-event, + discard the following up-event. */ + teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1)); + if (CONSP (teml)) + teml = XCAR (teml); + if (SYMBOLP (teml)) + { + Lisp_Object tem2; + + teml = Fget (teml, intern ("event-symbol-elements")); + /* Ignore first element, which is the base key. */ + tem2 = Fmemq (intern ("down"), Fcdr (teml)); + if (! NILP (tem2)) + Fread_event (Qnil, Qnil); + } + } break; case 'K': /* Key sequence to be defined. */ - args[i] = Fread_key_sequence (build_string (prompt), Qnil, Qt, Qnil); - teml = args[i]; - visargs[i] = Fkey_description (teml); + { + int speccount1 = SPECPDL_INDEX (); + specbind (Qcursor_in_echo_area, Qt); + args[i] = Fread_key_sequence (build_string (callint_message), + Qnil, Qt, Qnil, Qnil); + teml = args[i]; + visargs[i] = Fkey_description (teml); + unbind_to (speccount1, Qnil); + + /* If the key sequence ends with a down-event, + discard the following up-event. */ + teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1)); + if (CONSP (teml)) + teml = XCAR (teml); + if (SYMBOLP (teml)) + { + Lisp_Object tem2; + + teml = Fget (teml, intern ("event-symbol-elements")); + /* Ignore first element, which is the base key. */ + tem2 = Fmemq (intern ("down"), Fcdr (teml)); + if (! NILP (tem2)) + Fread_event (Qnil, 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 + ? (char *) SDATA (SYMBOL_NAME (function)) : "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; case 'm': /* Value of mark. Does not do I/O. */ - check_mark (); + check_mark (0); /* visargs[i] = Qnil; */ args[i] = current_buffer->mark; varies[i] = 2; break; + case 'M': /* String read via minibuffer with + inheriting the current input method. */ + args[i] = Fread_string (build_string (callint_message), + Qnil, Qnil, Qnil, Qt); + break; + case 'N': /* Prefix arg, else number from 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, 0); + } + first = 0; + + tem = Fread_from_minibuffer (build_string (callint_message), + Qnil, Qnil, Qnil, Qnil, Qnil, + Qnil); + if (! STRINGP (tem) || SCHARS (tem) == 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; break; case 'r': /* Region, point and mark as 2 args. */ - check_mark (); - Fset_marker (point_marker, make_number (PT), Qnil); + check_mark (1); + set_marker_both (point_marker, Qnil, PT, PT_BYTE); /* visargs[i+1] = Qnil; */ foo = marker_position (current_buffer->mark); /* visargs[i] = Qnil; */ - args[i] = point < foo ? point_marker : current_buffer->mark; + args[i] = PT < foo ? point_marker : current_buffer->mark; varies[i] = 3; - args[++i] = point > foo ? point_marker : current_buffer->mark; + 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); + case 's': /* String read via minibuffer without + inheriting the current input method. */ + args[i] = Fread_string (build_string (callint_message), + Qnil, 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, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -600,22 +722,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), Qnil); + 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); } @@ -635,7 +780,7 @@ 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++) @@ -647,6 +792,13 @@ Otherwise, this is done only if an arg is read using the minibuffer.") } Vcommand_history = Fcons (Flist (count + 1, visargs), Vcommand_history); + /* Don't keep command history around forever. */ + if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) + { + teml = Fnthcdr (Vhistory_length, Vcommand_history); + if (CONSP (teml)) + XSETCDR (teml, Qnil); + } } /* If we used a marker to hold point, mark, or an end of the region, @@ -655,9 +807,10 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (varies[i] >= 1 && varies[i] <= 4) XSETINT (args[i], marker_position (args[i])); -#ifdef MULTI_PERDISPLAY - display_locked = 1; -#endif + if (record_then_fail) + Fbarf_if_buffer_read_only (); + + single_kboard_state (); { Lisp_Object val; @@ -670,11 +823,11 @@ 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\ -A raw prefix argument is what you get from `(interactive \"P\")'.\n\ -Its numeric meaning is what you would get from `(interactive \"p\")'.") - (raw) + 1, 1, 0, + doc: /* Return numeric meaning of raw prefix argument RAW. +A raw prefix argument is what you get from `(interactive "P")'. +Its numeric meaning is what you would get from `(interactive "p")'. */) + (raw) Lisp_Object raw; { Lisp_Object val; @@ -683,8 +836,8 @@ 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)) - XSETINT (val, XINT (XCONS (raw)->car)); + else if (CONSP (raw) && INTEGERP (XCAR (raw))) + XSETINT (val, XINT (XCAR (raw))); else if (INTEGERP (raw)) val = raw; else @@ -693,65 +846,7 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") return val; } -DEFUN ("universal-argument", Funiversal_argument, Suniversal_argument, 0, 0, "", - "Begin a numeric argument for the following command.\n\ -Digits or minus sign following \\[universal-argument] make up the numeric argument.\n\ -\\[universal-argument] following the digits or minus sign ends the argument.\n\ -\\[universal-argument] without digits or minus sign provides 4 as argument.\n\ -Repeating \\[universal-argument] without digits or minus sign\n\ - multiplies the argument by 4 each time.") - () -{ - if (!current_prefix_partial) - { - /* First C-u */ - XSETFASTINT (current_perdisplay->prefix_factor, 4); - current_perdisplay->prefix_value = Qnil; - current_perdisplay->prefix_sign = 1; - current_perdisplay->prefix_partial = 1; - } - else if (!NILP (current_perdisplay->prefix_factor)) - { - /* Subsequent C-u */ - XSETINT (current_perdisplay->prefix_factor, - XINT (current_perdisplay->prefix_factor) * 4); - current_perdisplay->prefix_partial = 1; - } - else - { - /* Terminating C-u */ - finalize_prefix_arg (); - describe_prefix_arg (); - } -} - -DEFUN ("negative-argument", Fnegative_argument, Snegative_argument, 0, 0, "", - "Begin a negative numeric argument for the next command.\n\ -\\[universal-argument] following digits or minus sign ends the argument.") - () -{ - current_perdisplay->prefix_factor = Qnil; - current_perdisplay->prefix_sign *= -1; - current_perdisplay->prefix_partial = 1; -} - -DEFUN ("digit-argument", Fdigit_argument, Sdigit_argument, 0, 0, "", - "Part of the numeric argument for the next command.\n\ -\\[universal-argument] following digits or minus sign ends the argument.") - () -{ - int c; - if (!(INTEGERP (last_command_char) - && (c = (XINT (last_command_char) & 0177)) >= '0' && c <= '9')) - error("digit-argument must be bound to a digit key"); - current_perdisplay->prefix_factor = Qnil; - if (NILP (current_perdisplay->prefix_value)) - XSETFASTINT (current_perdisplay->prefix_value, 0); - XSETINT (current_perdisplay->prefix_value, - XINT (current_perdisplay->prefix_value) * 10 + (c - '0')); - current_perdisplay->prefix_partial = 1; -} - +void syms_of_callint () { point_marker = Fmake_marker (); @@ -765,6 +860,14 @@ 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); + Qprogn = intern ("progn"); + staticpro (&Qprogn); Qminus = intern ("-"); staticpro (&Qminus); @@ -784,55 +887,59 @@ syms_of_callint () 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\ -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\")."); - Vprefix_arg = Qnil; + callint_message_size = 100; + callint_message = (char *) xmalloc (callint_message_size); + + + DEFVAR_KBOARD ("prefix-arg", Vprefix_arg, + doc: /* The value of the prefix argument for the next editing command. +It may be a number, or the symbol `-' for just a minus sign as arg, +or a list whose car is a number for just one or more C-u's +or nil if no argument has been specified. + +You cannot examine this variable to find the argument for this command +since it has been set to nil by the time you can look. +Instead, you should use the variable `current-prefix-arg', although +normally commands can get this prefix argument with (interactive "P"). */); + + DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg, + doc: /* The value of the prefix argument for the previous editing command. +See `prefix-arg' for the meaning of the value. */); 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."); + doc: /* The value of the prefix argument for this editing command. +It may be a number, or the symbol `-' for just a minus sign as arg, +or a list whose car is a number for just one or more C-u's +or nil if no argument has been specified. +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."); + doc: /* List of recent commands that read arguments from terminal. +Each command is represented as a form to evaluate. */); Vcommand_history = Qnil; DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status, - "Debugging status of current interactive command.\n\ -Bound each time `call-interactively' is called;\n\ -may be set by the debugger as a reminder for itself."); + doc: /* Debugging status of current interactive command. +Bound each time `call-interactively' is called; +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."); + doc: /* *Non-nil means you can use the mark even when inactive. +This option makes a difference in Transient Mark mode. +When the option is non-nil, deactivation of the mark +turns off region highlighting, but commands that use the mark +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."); + doc: /* Hook to run when about to switch windows with a mouse command. +Its purpose is to give temporary modes such as Isearch mode +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); - defsubr (&Suniversal_argument); - defsubr (&Snegative_argument); - defsubr (&Sdigit_argument); }