X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f0490a0bf2ee3707994b6f62b6f9ad501b57099c..9e571f494c4dc89dca613aff9d7518f3a4ad5fef:/src/callint.c diff --git a/src/callint.c b/src/callint.c index 14f34f3b5f..df3ada4f04 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 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -27,12 +28,18 @@ Boston, MA 02111-1307, USA. */ #include "window.h" #include "mocklisp.h" -extern char *index (); +#ifdef HAVE_INDEX +extern char *index P_ ((const char *, int)); +#endif + +extern Lisp_Object Qcursor_in_echo_area; 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; @@ -81,7 +88,7 @@ Just `(interactive)' means pass no args when calling interactively.\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 -- Character (no input method is used).\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\ @@ -90,19 +97,23 @@ 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\ +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\ +M -- Any string. Inherits the current input method.\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 string. Does not inherit the current input method.\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\ +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\ @@ -140,11 +151,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); + XCAR (tail) = quotify_arg (XCAR (tail)); } return exp; } @@ -175,7 +186,9 @@ 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.") +Otherwise, this is done only if an arg is read using the minibuffer.\n\ +Optional third arg KEYS, if given, specifies the sequence of events to\n\ +supply if the command inquires which events were used to invoke it.") (function, record_flag, keys) Lisp_Object function, record_flag, keys; { @@ -224,6 +237,8 @@ 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); @@ -282,17 +297,18 @@ 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 = (unsigned char *) alloca (XSTRING (specs)->size + 1); - bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1); + string = (unsigned char *) alloca (STRING_BYTES (XSTRING (specs)) + 1); + bcopy (XSTRING (specs)->data, string, + STRING_BYTES (XSTRING (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. */ specs = Feval (specs); - if (i != num_input_chars || !NILP (record_flag)) + if (i != num_input_events || !NILP (record_flag)) { /* We should record this command on the command history. */ Lisp_Object values, car; @@ -305,17 +321,17 @@ Otherwise, this is done only if an arg is read using the minibuffer.") instead of the present values. */ if (CONSP (input)) { - car = XCONS (input)->car; + car = XCAR (input); /* Skip through certain special forms. */ while (EQ (car, Qlet) || EQ (car, Qletx) || EQ (car, Qsave_excursion)) { - while (CONSP (XCONS (input)->cdr)) - input = XCONS (input)->cdr; - input = XCONS (input)->car; + while (CONSP (XCDR (input))) + input = XCDR (input); + input = XCAR (input); if (!CONSP (input)) break; - car = XCONS (input)->car; + car = XCAR (input); } if (EQ (car, Qlist)) { @@ -338,6 +354,14 @@ Otherwise, this is done only if an arg is read using the minibuffer.") } Vcommand_history = Fcons (Fcons (function, values), Vcommand_history); + + /* Don't keep command history around forever. */ + if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0) + { + teml = Fnthcdr (Vhistory_length, Vcommand_history); + if (CONSP (teml)) + XCDR (teml) = Qnil; + } } single_kboard_state (); return apply1 (function, specs); @@ -371,9 +395,9 @@ Otherwise, this is done only if an arg is read using the minibuffer.") 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, 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))) @@ -430,15 +454,15 @@ 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; + = (EQ (visargs[j], Qnil) + ? (unsigned char *) "" + : XSTRING (visargs[j])->data); /* Process the format-string in prompt1, putting the output into callint_message. Make callint_message bigger if necessary. @@ -448,7 +472,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") { int nchars = doprnt (callint_message, callint_message_size, prompt1, (char *)0, - j - 1, argstrings + 1); + j - 1, (char **) argstrings + 1); if (nchars < callint_message_size) break; callint_message_size *= 2; @@ -460,7 +484,8 @@ Otherwise, this is done only if an arg is read using the minibuffer.") { case 'a': /* Symbol defined as a function */ visargs[i] = Fcompleting_read (build_string (callint_message), - Vobarray, Qfboundp, Qt, Qnil, Qnil); + Vobarray, Qfboundp, Qt, + Qnil, Qnil, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -469,22 +494,18 @@ 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] = 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 (callint_message), - Fother_buffer (Fcurrent_buffer (), Qnil), + Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil); break; case 'c': /* Character */ - /* 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 (); + args[i] = Fread_char (build_string (callint_message), Qnil); message1_nolog ((char *) 0); /* Passing args[i] directly stimulates compiler bug */ teml = args[i]; @@ -493,14 +514,15 @@ Otherwise, this is done only if an arg is read using the minibuffer.") case 'C': /* Command: symbol with interactive function */ visargs[i] = Fcompleting_read (build_string (callint_message), - Vobarray, Qcommandp, Qt, Qnil, Qnil); + 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; @@ -521,18 +543,64 @@ Otherwise, this is done only if an arg is read using the minibuffer.") 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 (callint_message), - Qnil, 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, 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 (callint_message), - Qnil, Qt, 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, 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. */ @@ -559,6 +627,12 @@ Otherwise, this is done only if an arg is read using the minibuffer.") 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; @@ -571,12 +645,13 @@ Otherwise, this is done only if an arg is read using the minibuffer.") if (! first) { message ("Please enter a number."); - sit_for (1, 0, 0, 0); + sit_for (1, 0, 0, 0, 0); } first = 0; tem = Fread_from_minibuffer (build_string (callint_message), - Qnil, Qnil, Qnil, Qnil); + Qnil, Qnil, Qnil, Qnil, Qnil, + Qnil); if (! STRINGP (tem) || XSTRING (tem)->size == 0) args[i] = Qnil; else @@ -602,23 +677,25 @@ 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); + 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 (callint_message), 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 (callint_message), - Qnil, Qnil); + Qnil, Qnil, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); @@ -626,7 +703,7 @@ 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 (callint_message)); + args[i] = Fread_variable (build_string (callint_message), Qnil); visargs[i] = last_minibuf_string; break; @@ -640,6 +717,26 @@ Otherwise, this is done only if an arg is read using the minibuffer.") 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 '+': @@ -676,6 +773,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 (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0) + { + teml = Fnthcdr (Vhistory_length, Vcommand_history); + if (CONSP (teml)) + XCDR (teml) = Qnil; + } } /* If we used a marker to hold point, mark, or an end of the region, @@ -710,8 +814,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) && INTEGERP (XCONS (raw)->car)) - 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 @@ -720,6 +824,7 @@ Its numeric meaning is what you would get from `(interactive \"p\")'.") return val; } +void syms_of_callint () { point_marker = Fmake_marker (); @@ -773,6 +878,10 @@ 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_KBOARD ("last-prefix-arg", Vlast_prefix_arg, + "The value of the prefix argument for the previous editing command.\n\ +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\