X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e8757f091a502b858912a4c267210e009227d6e6..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/callint.c diff --git a/src/callint.c b/src/callint.c index c4c087e83d..a036f44ba9 100644 --- a/src/callint.c +++ b/src/callint.c @@ -1,6 +1,6 @@ /* Call a Lisp function interactively. - Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2012 - Free Software Foundation, Inc. + Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software + Foundation, Inc. This file is part of GNU Emacs. @@ -29,16 +29,17 @@ along with GNU Emacs. If not, see . */ #include "keymap.h" Lisp_Object Qminus, Qplus; -Lisp_Object Qcall_interactively; +static Lisp_Object Qfuncall_interactively; static Lisp_Object Qcommand_debug_status; static Lisp_Object Qenable_recursive_minibuffers; static Lisp_Object Qhandle_shift_selection; +static Lisp_Object Qread_number; Lisp_Object Qmouse_leave_buffer_hook; -static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif; -Lisp_Object Qwhen; +static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif; +Lisp_Object Qwhen, Qprogn; static Lisp_Object preserved_fns; /* Marker used within call-interactively to refer to point. */ @@ -126,7 +127,7 @@ quotify_arg (register Lisp_Object exp) if (CONSP (exp) || (SYMBOLP (exp) && !NILP (exp) && !EQ (exp, Qt))) - return Fcons (Qquote, Fcons (exp, Qnil)); + return list2 (Qquote, exp); return exp; } @@ -232,6 +233,43 @@ fix_command (Lisp_Object input, Lisp_Object values) } } +/* Helper function to call `read-file-name' from C. */ + +static Lisp_Object +read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch, + Lisp_Object initial, Lisp_Object predicate) +{ + struct gcpro gcpro1; + Lisp_Object args[7]; + + GCPRO1 (default_filename); + args[0] = intern ("read-file-name"); + args[1] = callint_message; + args[2] = Qnil; + args[3] = default_filename; + args[4] = mustmatch; + args[5] = initial; + args[6] = predicate; + RETURN_UNGCPRO (Ffuncall (7, args)); +} + +/* BEWARE: Calling this directly from C would defeat the purpose! */ +DEFUN ("funcall-interactively", Ffuncall_interactively, Sfuncall_interactively, + 1, MANY, 0, doc: /* Like `funcall' but marks the call as interactive. +I.e. arrange that within the called function `called-interactively-p' will +return non-nil. +usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + ptrdiff_t speccount = SPECPDL_INDEX (); + temporarily_switch_to_single_kboard (NULL); + + /* Nothing special to do here, all the work is inside + `called-interactively-p'. Which will look for us as a marker in the + backtrace. */ + return unbind_to (speccount, Ffuncall (nargs, args)); +} + DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, doc: /* Call FUNCTION, providing args according to its interactive calling specs. Return the value FUNCTION returns. @@ -250,13 +288,16 @@ invoke it. If KEYS is omitted or nil, the return value of `this-command-keys-vector' is used. */) (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys) { + /* `args' will contain the array of arguments to pass to the function. + `visargs' will contain the same list but in a nicer form, so that if we + pass it to `Fformat' it will be understandable to a human. */ Lisp_Object *args, *visargs; Lisp_Object specs; Lisp_Object filter_specs; Lisp_Object teml; Lisp_Object up_event; Lisp_Object enable; - ptrdiff_t speccount = SPECPDL_INDEX (); + dynwind_begin (); /* The index of the next element of this_command_keys to examine for the 'e' interactive code. */ @@ -304,7 +345,7 @@ invoke it. If KEYS is omitted or nil, the return value of specs = Qnil; string = 0; - /* The idea of FILTER_SPECS is to provide away to + /* The idea of FILTER_SPECS is to provide a way to specify how to represent the arguments in command history. The feature is not fully implemented. */ filter_specs = Qnil; @@ -327,12 +368,9 @@ invoke it. If KEYS is omitted or nil, the return value of /* If SPECS is set to a string, use it as an interactive prompt. */ if (STRINGP (specs)) - { - /* Make a copy of string so that if a GC relocates specs, - `string' will still be valid. */ - string = alloca (SBYTES (specs) + 1); - memcpy (string, SSDATA (specs), SBYTES (specs) + 1); - } + /* Make a copy of string so that if a GC relocates specs, + `string' will still be valid. */ + string = xlispstrdupa (specs); else { Lisp_Object input; @@ -342,8 +380,8 @@ invoke it. If KEYS is omitted or nil, the return value of /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); specs = Feval (specs, - CONSP (funval) && EQ (Qclosure, XCAR (funval)) - ? Qt : Qnil); + CONSP (funval) && EQ (Qclosure, XCAR (funval)) + ? CAR_SAFE (XCDR (funval)) : Qnil); UNGCPRO; if (events != num_input_events || !NILP (record_flag)) { @@ -373,8 +411,15 @@ invoke it. If KEYS is omitted or nil, the return value of Vreal_this_command = save_real_this_command; kset_last_command (current_kboard, save_last_command); - temporarily_switch_to_single_kboard (NULL); - return unbind_to (speccount, apply1 (function, specs)); + { + Lisp_Object tem0, args[3]; + args[0] = Qfuncall_interactively; + args[1] = function; + args[2] = specs; + tem0 = Fapply (3, args); + dynwind_end (); + return tem0; + } } /* Here if function specifies a string to control parsing the defaults. */ @@ -445,10 +490,11 @@ invoke it. If KEYS is omitted or nil, the return value of else break; } - /* Count the number of arguments, which is one plus the number of arguments - the interactive spec would have us give to the function. */ + /* Count the number of arguments, which is two (the function itself and + `funcall-interactively') plus the number of arguments the interactive spec + would have us give to the function. */ tem = string; - for (nargs = 1; *tem; ) + for (nargs = 2; *tem; ) { /* 'r' specifications ("point and mark as 2 numeric args") produce *two* arguments. */ @@ -487,57 +533,57 @@ invoke it. If KEYS is omitted or nil, the return value of specbind (Qenable_recursive_minibuffers, Qt); tem = string; - for (i = 1; *tem; i++) + for (i = 2; *tem; i++) { - visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n")); - if (strchr (SSDATA (visargs[0]), '%')) - callint_message = Fformat (i, visargs); + visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n")); + if (strchr (SSDATA (visargs[1]), '%')) + callint_message = Fformat (i - 1, visargs + 1); else - callint_message = visargs[0]; + callint_message = visargs[1]; switch (*tem) { - case 'a': /* Symbol defined as a function */ + case 'a': /* Symbol defined as a function. */ visargs[i] = Fcompleting_read (callint_message, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil, Qnil); - /* Passing args[i] directly stimulates compiler bug */ + /* Passing args[i] directly stimulates compiler bug. */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; - case 'b': /* Name of existing buffer */ + case 'b': /* Name of existing buffer. */ args[i] = Fcurrent_buffer (); if (EQ (selected_window, minibuf_window)) args[i] = Fother_buffer (args[i], Qnil, Qnil); args[i] = Fread_buffer (callint_message, args[i], Qt); break; - case 'B': /* Name of buffer, possibly nonexistent */ + case 'B': /* Name of buffer, possibly nonexistent. */ args[i] = Fread_buffer (callint_message, Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil); break; - case 'c': /* Character */ + case 'c': /* Character. */ /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_number (0), make_number (SCHARS (callint_message)), Qface, Qminibuffer_prompt, callint_message); args[i] = Fread_char (callint_message, Qnil, Qnil); - message1_nolog ((char *) 0); - /* Passing args[i] directly stimulates compiler bug */ + message1_nolog (0); + /* Passing args[i] directly stimulates compiler bug. */ teml = args[i]; /* See bug#8479. */ if (! CHARACTERP (teml)) error ("Non-character input-event"); visargs[i] = Fchar_to_string (teml); break; - case 'C': /* Command: symbol with interactive function */ + case 'C': /* Command: symbol with interactive function. */ visargs[i] = Fcompleting_read (callint_message, Vobarray, Qcommandp, Qt, Qnil, Qnil, Qnil, Qnil); - /* Passing args[i] directly stimulates compiler bug */ + /* Passing args[i] directly stimulates compiler bug. */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; @@ -549,35 +595,31 @@ invoke it. If KEYS is omitted or nil, the return value of varies[i] = 1; break; - case 'D': /* Directory name. */ - args[i] = Fread_file_name (callint_message, Qnil, - BVAR (current_buffer, directory), Qlambda, Qnil, - Qfile_directory_p); + case 'D': /* Directory name. */ + args[i] = read_file_name (BVAR (current_buffer, directory), Qlambda, Qnil, + Qfile_directory_p); break; - case 'f': /* Existing file name. */ - args[i] = Fread_file_name (callint_message, - Qnil, Qnil, Qlambda, Qnil, Qnil); + case 'f': /* Existing file name. */ + args[i] = read_file_name (Qnil, Qlambda, Qnil, Qnil); break; - case 'F': /* Possibly nonexistent file name. */ - args[i] = Fread_file_name (callint_message, - Qnil, Qnil, Qnil, Qnil, Qnil); + case 'F': /* Possibly nonexistent file name. */ + args[i] = read_file_name (Qnil, Qnil, Qnil, Qnil); break; case 'G': /* Possibly nonexistent file name, - default to directory alone. */ - args[i] = Fread_file_name (callint_message, - Qnil, Qnil, Qnil, empty_unibyte_string, Qnil); + default to directory alone. */ + args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil); break; - case 'i': /* Ignore an argument -- Does not do I/O */ + case 'i': /* Ignore an argument -- Does not do I/O. */ varies[i] = -1; break; - case 'k': /* Key sequence. */ + case 'k': /* Key sequence. */ { - ptrdiff_t speccount1 = SPECPDL_INDEX (); + dynwind_begin (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_number (0), @@ -585,7 +627,7 @@ invoke it. If KEYS is omitted or nil, the return value of Qface, Qminibuffer_prompt, callint_message); args[i] = Fread_key_sequence (callint_message, Qnil, Qnil, Qnil, Qnil); - unbind_to (speccount1, Qnil); + dynwind_end (); teml = args[i]; visargs[i] = Fkey_description (teml, Qnil); @@ -607,19 +649,19 @@ invoke it. If KEYS is omitted or nil, the return value of } break; - case 'K': /* Key sequence to be defined. */ + case 'K': /* Key sequence to be defined. */ { - ptrdiff_t speccount1 = SPECPDL_INDEX (); + dynwind_begin (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_number (0), make_number (SCHARS (callint_message)), Qface, Qminibuffer_prompt, callint_message); - args[i] = Fread_key_sequence (callint_message, - Qnil, Qt, Qnil, Qnil); + args[i] = Fread_key_sequence_vector (callint_message, + Qnil, Qt, Qnil, Qnil); teml = args[i]; visargs[i] = Fkey_description (teml, Qnil); - unbind_to (speccount1, Qnil); + dynwind_end (); /* If the key sequence ends with a down-event, discard the following up-event. */ @@ -639,7 +681,7 @@ invoke it. If KEYS is omitted or nil, the return value of } break; - case 'U': /* Up event from last k or K */ + case 'U': /* Up event from last k or K. */ if (!NILP (up_event)) { args[i] = Fmake_vector (make_number (1), up_event); @@ -679,33 +721,14 @@ invoke it. If KEYS is omitted or nil, the return value of Qnil, Qnil, Qnil, Qt); break; - case 'N': /* Prefix arg as number, else number from minibuffer */ + case 'N': /* Prefix arg as number, else number from minibuffer. */ if (!NILP (prefix_arg)) goto have_prefix_arg; case 'n': /* Read number from minibuffer. */ - { - bool first = 1; - do - { - Lisp_Object str; - if (! first) - { - message ("Please enter a number."); - sit_for (make_number (1), 0, 0); - } - first = 0; - - str = Fread_from_minibuffer (callint_message, - Qnil, Qnil, Qnil, Qnil, Qnil, - Qnil); - if (! STRINGP (str) || SCHARS (str) == 0) - args[i] = Qnil; - else - args[i] = Fread (str); - } - while (! NUMBERP (args[i])); - } - visargs[i] = args[i]; + args[i] = call1 (Qread_number, callint_message); + /* Passing args[i] directly stimulates compiler bug. */ + teml = args[i]; + visargs[i] = Fnumber_to_string (teml); break; case 'P': /* Prefix arg in raw form. Does no I/O. */ @@ -714,14 +737,14 @@ invoke it. If KEYS is omitted or nil, the return value of varies[i] = -1; break; - case 'p': /* Prefix arg converted to number. No I/O. */ + 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. */ + case 'r': /* Region, point and mark as 2 args. */ check_mark (1); set_marker_both (point_marker, Qnil, PT, PT_BYTE); /* visargs[i+1] = Qnil; */ @@ -742,29 +765,29 @@ invoke it. If KEYS is omitted or nil, the return value of case 'S': /* Any symbol. */ visargs[i] = Fread_string (callint_message, Qnil, Qnil, Qnil, Qnil); - /* Passing args[i] directly stimulates compiler bug */ + /* Passing args[i] directly stimulates compiler bug. */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; case 'v': /* Variable name: symbol that is - custom-variable-p. */ + custom-variable-p. */ args[i] = Fread_variable (callint_message, Qnil); visargs[i] = last_minibuf_string; break; - case 'x': /* Lisp expression read but not evaluated */ - args[i] = Fread_minibuffer (callint_message, Qnil); + case 'x': /* Lisp expression read but not evaluated. */ + args[i] = call1 (intern ("read-minibuffer"), callint_message); visargs[i] = last_minibuf_string; break; - case 'X': /* Lisp expression read and evaluated */ - args[i] = Feval_minibuffer (callint_message, Qnil); + case 'X': /* Lisp expression read and evaluated. */ + args[i] = call1 (intern ("eval-minibuffer"), callint_message); visargs[i] = last_minibuf_string; break; case 'Z': /* Coding-system symbol, or ignore the - argument if no prefix */ + argument if no prefix. */ if (NILP (prefix_arg)) { args[i] = Qnil; @@ -778,7 +801,7 @@ invoke it. If KEYS is omitted or nil, the return value of } break; - case 'z': /* Coding-system symbol or nil */ + case 'z': /* Coding-system symbol or nil. */ args[i] = Fread_coding_system (callint_message, Qnil); visargs[i] = last_minibuf_string; break; @@ -803,23 +826,26 @@ invoke it. If KEYS is omitted or nil, the return value of if (tem) tem++; else tem = ""; } - unbind_to (speccount, Qnil); + dynwind_end (); QUIT; - args[0] = function; + args[0] = Qfuncall_interactively; + args[1] = function; if (arg_from_tty || !NILP (record_flag)) { - visargs[0] = function; - for (i = 1; i < nargs; i++) + /* We don't need `visargs' any more, so let's recycle it since we need + an array of just the same size. */ + visargs[1] = function; + for (i = 2; i < nargs; i++) { if (varies[i] > 0) - visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil); + visargs[i] = list1 (intern (callint_argfuns[varies[i]])); else visargs[i] = quotify_arg (args[i]); } - Vcommand_history = Fcons (Flist (nargs, visargs), + Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1), Vcommand_history); /* Don't keep command history around forever. */ if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) @@ -832,7 +858,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* 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 < nargs; i++) + for (i = 2; i < nargs; i++) if (varies[i] >= 1 && varies[i] <= 4) XSETINT (args[i], marker_position (args[i])); @@ -845,13 +871,10 @@ invoke it. If KEYS is omitted or nil, the return value of kset_last_command (current_kboard, save_last_command); { - Lisp_Object val; - specbind (Qcommand_debug_status, Qnil); - - temporarily_switch_to_single_kboard (NULL); - val = Ffuncall (nargs, args); + Lisp_Object val = Ffuncall (nargs, args); UNGCPRO; - return unbind_to (speccount, val); + dynwind_end (); + return val; } } @@ -881,6 +904,8 @@ Its numeric meaning is what you would get from `(interactive "p")'. */) void syms_of_callint (void) { +#include "callint.x" + point_marker = Fmake_marker (); staticpro (&point_marker); @@ -903,7 +928,8 @@ syms_of_callint (void) DEFSYM (Qminus, "-"); DEFSYM (Qplus, "+"); DEFSYM (Qhandle_shift_selection, "handle-shift-selection"); - DEFSYM (Qcall_interactively, "call-interactively"); + DEFSYM (Qread_number, "read-number"); + DEFSYM (Qfuncall_interactively, "funcall-interactively"); DEFSYM (Qcommand_debug_status, "command-debug-status"); DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers"); DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook"); @@ -958,8 +984,4 @@ behave as if the mark were still active. */); 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); }