X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b78265036088d5d0eac2a03b929adb50aa59b45c..27540e81513199d5d4ec300b4cffd0ae1db74af1:/src/callint.c diff --git a/src/callint.c b/src/callint.c index f84d004887..da88693cd7 100644 --- a/src/callint.c +++ b/src/callint.c @@ -1,5 +1,5 @@ /* Call a Lisp function interactively. - Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000 + Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 02, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -27,7 +27,6 @@ Boston, MA 02111-1307, USA. */ #include "commands.h" #include "keyboard.h" #include "window.h" -#include "mocklisp.h" #include "keymap.h" #ifdef HAVE_INDEX @@ -35,12 +34,14 @@ extern char *index P_ ((const char *, int)); #endif extern Lisp_Object Qcursor_in_echo_area; +extern Lisp_Object Qfile_directory_p; Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus; Lisp_Object Qcall_interactively; Lisp_Object Vcommand_history; extern Lisp_Object Vhistory_length; +extern Lisp_Object Vthis_original_command, real_this_command; Lisp_Object Vcommand_debug_status, Qcommand_debug_status; Lisp_Object Qenable_recursive_minibuffers; @@ -51,7 +52,7 @@ Lisp_Object Vmark_even_if_inactive; Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; -Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion; +Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen; static Lisp_Object preserved_fns; /* Marker used within call-interactively to refer to point. */ @@ -109,6 +110,7 @@ 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. +U -- Mouse up event discarded by a previous k or K argument. v -- Variable name: symbol that is user-variable-p. x -- Lisp expression read but not evaluated. X -- Lisp expression read and evaluated. @@ -161,17 +163,87 @@ 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); } +/* If the list of args INPUT 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. + + This function doesn't return a value because it modifies elements + of VALUES to do its job. */ + +static void +fix_command (input, values) + Lisp_Object input, values; +{ + if (CONSP (input)) + { + Lisp_Object car; + + car = XCAR (input); + /* Skip through certain special forms. */ + while (EQ (car, Qlet) || EQ (car, Qletx) + || EQ (car, Qsave_excursion) + || EQ (car, Qprogn)) + { + 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 = XCDR (valtail)) + { + Lisp_Object elt; + elt = Fcar (intail); + if (CONSP (elt)) + { + Lisp_Object presflag, carelt; + carelt = Fcar (elt); + /* If it is (if X Y), look at Y. */ + if (EQ (carelt, Qif) + && EQ (Fnthcdr (make_number (3), elt), Qnil)) + elt = Fnth (make_number (2), elt); + /* If it is (when ... Y), look at Y. */ + else if (EQ (carelt, Qwhen)) + { + while (CONSP (XCDR (elt))) + elt = XCDR (elt); + elt = Fcar (elt); + } + + /* If the function call we're looking at + is a special preserved one, copy the + whole expression for this argument. */ + if (CONSP (elt)) + { + presflag = Fmemq (Fcar (elt), preserved_fns); + if (!NILP (presflag)) + Fsetcar (valtail, Fcar (intail)); + } + } + } + } + } +} DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, doc: /* Call FUNCTION, reading args according to its interactive calling specs. @@ -185,7 +257,8 @@ 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. */) +supply if the command inquires which events were used to invoke it. +If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) (function, record_flag, keys) Lisp_Object function, record_flag, keys; { @@ -194,9 +267,11 @@ supply if the command inquires which events were used to invoke it. */) Lisp_Object fun; Lisp_Object funcar; Lisp_Object specs; + Lisp_Object filter_specs; Lisp_Object teml; + Lisp_Object up_event; 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. */ @@ -216,8 +291,17 @@ supply if the command inquires which events were used to invoke it. */) char prompt1[100]; char *tem1; int arg_from_tty = 0; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; int key_count; + int record_then_fail = 0; + + Lisp_Object save_this_command, save_last_command; + Lisp_Object save_this_original_command, save_real_this_command; + + save_this_command = Vthis_command; + save_this_original_command = Vthis_original_command; + save_real_this_command = real_this_command; + save_last_command = current_kboard->Vlast_command; if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; @@ -241,6 +325,13 @@ supply if the command inquires which events were used to invoke it. */) 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; + + /* If k or K discard an up-event, save it here so it can be retrieved with U */ + up_event = Qnil; /* Decode the kind of function. Either handle it and return, or go to `lose' if not interactive, or go to `retry' @@ -262,38 +353,26 @@ supply if the command inquires which events were used to invoke it. */) goto lose; specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE]; } - else if (!CONSP (fun)) - goto lose; - else if (funcar = XCAR (fun), EQ (funcar, Qautoload)) + else { + Lisp_Object form; GCPRO2 (function, prefix_arg); - do_autoload (fun, function); + form = Finteractive_form (function); UNGCPRO; - goto retry; - } - else if (EQ (funcar, Qlambda)) - { - specs = Fassq (Qinteractive, Fcdr (XCDR (fun))); - if (NILP (specs)) + if (CONSP (form)) + specs = filter_specs = Fcar (XCDR (form)); + else goto lose; - specs = Fcar (Fcdr (specs)); - } - else if (EQ (funcar, Qmocklisp)) - { - single_kboard_state (); - 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 (STRING_BYTES (XSTRING (specs)) + 1); - bcopy (XSTRING (specs)->data, string, - STRING_BYTES (XSTRING (specs)) + 1); + string = (unsigned char *) alloca (SBYTES (specs) + 1); + bcopy (SDATA (specs), string, + SBYTES (specs) + 1); } else if (string == 0) { @@ -301,62 +380,34 @@ supply if the command inquires which events were used to invoke it. */) i = num_input_events; input = specs; /* Compute the arg values using the user's expression. */ + GCPRO2 (input, filter_specs); specs = Feval (specs); + UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { /* We should record this command on the command history. */ - Lisp_Object values, car; + Lisp_Object values; /* 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. */ - if (CONSP (input)) - { - car = XCAR (input); - /* Skip through certain special forms. */ - while (EQ (car, Qlet) || EQ (car, Qletx) - || EQ (car, Qsave_excursion)) - { - 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 elt; - elt = Fcar (intail); - if (CONSP (elt)) - { - Lisp_Object presflag; - presflag = Fmemq (Fcar (elt), preserved_fns); - if (!NILP (presflag)) - Fsetcar (valtail, Fcar (intail)); - } - } - } - } + fix_command (input, values); Vcommand_history = Fcons (Fcons (function, values), Vcommand_history); /* Don't keep command history around forever. */ - if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0) + if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) { teml = Fnthcdr (Vhistory_length, Vcommand_history); if (CONSP (teml)) XSETCDR (teml, Qnil); } } + + Vthis_command = save_this_command; + Vthis_original_command = save_this_original_command; + real_this_command= save_real_this_command; + current_kboard->Vlast_command = save_last_command; + single_kboard_state (); return apply1 (function, specs); } @@ -367,7 +418,7 @@ supply if the command inquires which events were used to invoke it. */) 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) @@ -378,7 +429,22 @@ supply if the command inquires which events were used to invoke it. */) { 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 == '-') @@ -387,7 +453,9 @@ supply if the command inquires which events were used to invoke it. */) { Lisp_Object event; - event = XVECTOR (keys)->contents[next_event]; + event = (next_event < key_count + ? XVECTOR (keys)->contents[next_event] + : Qnil); if (EVENT_HAS_PARAMETERS (event) && (event = XCDR (event), CONSP (event)) && (event = XCAR (event), CONSP (event)) @@ -401,7 +469,7 @@ supply if the command inquires which events were used to invoke it. */) if (!NILP (Vmouse_leave_buffer_hook)) call1 (Vrun_hooks, Qmouse_leave_buffer_hook); - Fselect_window (event); + Fselect_window (event, Qnil); } string++; } @@ -436,7 +504,7 @@ supply if the command inquires which events were used to invoke it. */) varies[i] = 0; } - GCPRO4 (prefix_arg, function, *args, *visargs); + GCPRO5 (prefix_arg, function, *args, *visargs, up_event); gcpro3.nvars = (count + 1); gcpro4.nvars = (count + 1); @@ -456,7 +524,7 @@ supply if the command inquires which events were used to invoke it. */) argstrings[j] = (EQ (visargs[j], Qnil) ? (unsigned char *) "" - : XSTRING (visargs[j])->data); + : SDATA (visargs[j])); /* Process the format-string in prompt1, putting the output into callint_message. Make callint_message bigger if necessary. @@ -467,7 +535,7 @@ supply if the command inquires which events were used to invoke it. */) int nchars = doprnt (callint_message, callint_message_size, prompt1, (char *)0, j - 1, (char **) argstrings + 1); - if (nchars < callint_message_size) + if (nchars < callint_message_size - 1) break; callint_message_size *= 2; callint_message @@ -524,17 +592,18 @@ supply if the command inquires which events were used to invoke it. */) case 'D': /* Directory name. */ args[i] = Fread_file_name (build_string (callint_message), Qnil, - current_buffer->directory, Qlambda, Qnil); + current_buffer->directory, Qlambda, Qnil, + Qfile_directory_p); break; case 'f': /* Existing file name. */ args[i] = Fread_file_name (build_string (callint_message), - Qnil, Qnil, Qlambda, Qnil); + Qnil, Qnil, Qlambda, Qnil, Qnil); break; case 'F': /* Possibly nonexistent file name. */ args[i] = Fread_file_name (build_string (callint_message), - Qnil, Qnil, Qnil, Qnil); + Qnil, Qnil, Qnil, Qnil, Qnil); break; case 'i': /* Ignore an argument -- Does not do I/O */ @@ -543,13 +612,13 @@ supply if the command inquires which events were used to invoke it. */) case 'k': /* Key sequence. */ { - int speccount1 = specpdl_ptr - specpdl; + 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); + visargs[i] = Fkey_description (teml, Qnil); /* If the key sequence ends with a down-event, discard the following up-event. */ @@ -564,19 +633,19 @@ supply if the command inquires which events were used to invoke it. */) /* Ignore first element, which is the base key. */ tem2 = Fmemq (intern ("down"), Fcdr (teml)); if (! NILP (tem2)) - Fread_event (Qnil, Qnil); + up_event = Fread_event (Qnil, Qnil); } } break; case 'K': /* Key sequence to be defined. */ { - int speccount1 = specpdl_ptr - specpdl; + 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); + visargs[i] = Fkey_description (teml, Qnil); unbind_to (speccount1, Qnil); /* If the key sequence ends with a down-event, @@ -592,16 +661,26 @@ supply if the command inquires which events were used to invoke it. */) /* Ignore first element, which is the base key. */ tem2 = Fmemq (intern ("down"), Fcdr (teml)); if (! NILP (tem2)) - Fread_event (Qnil, Qnil); + up_event = Fread_event (Qnil, Qnil); } } break; + case 'U': /* Up event from last k or K */ + if (!NILP (up_event)) + { + args[i] = Fmake_vector (make_number (1), up_event); + up_event = Qnil; + teml = args[i]; + visargs[i] = Fkey_description (teml, Qnil); + } + break; + case 'e': /* The invoking event. */ 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 (keys)->contents[next_event++]; varies[i] = -1; @@ -615,7 +694,7 @@ supply if the command inquires which events were used to invoke it. */) 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; @@ -646,7 +725,7 @@ supply if the command inquires which events were used to invoke it. */) tem = Fread_from_minibuffer (build_string (callint_message), Qnil, Qnil, Qnil, Qnil, Qnil, Qnil); - if (! STRINGP (tem) || XSTRING (tem)->size == 0) + if (! STRINGP (tem) || SCHARS (tem) == 0) args[i] = Qnil; else args[i] = Fread (tem); @@ -670,7 +749,7 @@ supply if the command inquires which events were used to invoke it. */) break; case 'r': /* Region, point and mark as 2 args. */ - check_mark (); + check_mark (1); set_marker_both (point_marker, Qnil, PT, PT_BYTE); /* visargs[i+1] = Qnil; */ foo = marker_position (current_buffer->mark); @@ -718,7 +797,7 @@ supply if the command inquires which events were used to invoke it. */) args[i] = Qnil; varies[i] = -1; } - else + else { args[i] = Fread_non_nil_coding_system (build_string (callint_message)); @@ -768,7 +847,7 @@ supply if the command inquires which events were used to invoke it. */) Vcommand_history = Fcons (Flist (count + 1, visargs), Vcommand_history); /* Don't keep command history around forever. */ - if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0) + if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) { teml = Fnthcdr (Vhistory_length, Vcommand_history); if (CONSP (teml)) @@ -782,6 +861,14 @@ supply if the command inquires which events were used to invoke it. */) if (varies[i] >= 1 && varies[i] <= 4) XSETINT (args[i], marker_position (args[i])); + if (record_then_fail) + Fbarf_if_buffer_read_only (); + + Vthis_command = save_this_command; + Vthis_original_command = save_this_original_command; + real_this_command= save_real_this_command; + current_kboard->Vlast_command = save_last_command; + single_kboard_state (); { @@ -792,7 +879,7 @@ supply if the command inquires which events were used to invoke it. */) UNGCPRO; return unbind_to (speccount, val); } -} +} DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, 1, 1, 0, @@ -803,7 +890,7 @@ Its numeric meaning is what you would get from `(interactive "p")'. */) Lisp_Object raw; { Lisp_Object val; - + if (NILP (raw)) XSETFASTINT (val, 1); else if (EQ (raw, Qminus)) @@ -834,10 +921,16 @@ syms_of_callint () staticpro (&Qlist); Qlet = intern ("let"); staticpro (&Qlet); + Qif = intern ("if"); + staticpro (&Qif); + Qwhen = intern ("when"); + staticpro (&Qwhen); Qletx = intern ("let*"); staticpro (&Qletx); Qsave_excursion = intern ("save-excursion"); staticpro (&Qsave_excursion); + Qprogn = intern ("progn"); + staticpro (&Qprogn); Qminus = intern ("-"); staticpro (&Qminus); @@ -913,3 +1006,6 @@ a way to turn themselves off when a mouse command switches windows. */); defsubr (&Scall_interactively); defsubr (&Sprefix_numeric_value); } + +/* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37 + (do not change this comment) */