X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7a22490f14441898e1c4f6679f5924f097f3bb34..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/callint.c diff --git a/src/callint.c b/src/callint.c index f43a5a990d..a036f44ba9 100644 --- a/src/callint.c +++ b/src/callint.c @@ -1,5 +1,5 @@ /* Call a Lisp function interactively. - Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2013 Free Software + Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -29,7 +29,7 @@ along with GNU Emacs. If not, see . */ #include "keymap.h" Lisp_Object Qminus, Qplus; -static Lisp_Object Qcall_interactively; +static Lisp_Object Qfuncall_interactively; static Lisp_Object Qcommand_debug_status; static Lisp_Object Qenable_recursive_minibuffers; @@ -38,8 +38,8 @@ 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. */ @@ -233,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. @@ -260,7 +297,7 @@ invoke it. If KEYS is omitted or nil, the return value of 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. */ @@ -308,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; @@ -331,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; @@ -377,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. */ @@ -449,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. */ @@ -491,13 +533,13 @@ 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) { @@ -554,25 +596,21 @@ invoke it. If KEYS is omitted or nil, the return value of break; case 'D': /* Directory name. */ - args[i] = Fread_file_name (callint_message, Qnil, - BVAR (current_buffer, directory), Qlambda, Qnil, - Qfile_directory_p); + 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); + 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); + 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); + args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil); break; case 'i': /* Ignore an argument -- Does not do I/O. */ @@ -581,7 +619,7 @@ invoke it. If KEYS is omitted or nil, the return value of 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), @@ -589,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); @@ -613,17 +651,17 @@ invoke it. If KEYS is omitted or nil, the return value of 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. */ @@ -788,25 +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)) { /* We don't need `visargs' any more, so let's recycle it since we need an array of just the same size. */ - visargs[0] = function; - for (i = 1; i < nargs; i++) + visargs[1] = function; + for (i = 2; i < nargs; i++) { if (varies[i] > 0) 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) @@ -819,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])); @@ -832,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; } } @@ -868,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); @@ -891,7 +929,7 @@ syms_of_callint (void) DEFSYM (Qplus, "+"); DEFSYM (Qhandle_shift_selection, "handle-shift-selection"); DEFSYM (Qread_number, "read-number"); - DEFSYM (Qcall_interactively, "call-interactively"); + 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"); @@ -946,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); }