X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ba3189039adc8ec5eba5ed3e21d42019a4616b7c..59c414b1d0a01acff2bdc5e8ee6b76b0ee5aac3d:/src/callint.c diff --git a/src/callint.c b/src/callint.c index aedb363980..0c6c03036c 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-2014 Free Software + Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -28,18 +28,6 @@ along with GNU Emacs. If not, see . */ #include "window.h" #include "keymap.h" -Lisp_Object Qminus, Qplus; -static Lisp_Object Qcall_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 preserved_fns; /* Marker used within call-interactively to refer to point. */ @@ -113,7 +101,8 @@ If the string begins with `^' and `shift-select-mode' is non-nil, Emacs first calls the function `handle-shift-selection'. You may use `@', `*', and `^' together. They are processed in the order that they appear, before reading any arguments. -usage: (interactive &optional ARGS) */) +usage: (interactive &optional ARGS) */ + attributes: const) (Lisp_Object args) { return Qnil; @@ -233,6 +222,36 @@ 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; + GCPRO1 (default_filename); + RETURN_UNGCPRO (CALLN (Ffuncall, intern ("read-file-name"), + callint_message, Qnil, default_filename, + mustmatch, initial, predicate)); +} + +/* 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,6 +279,7 @@ invoke it. If KEYS is omitted or nil, the return value of Lisp_Object teml; Lisp_Object up_event; Lisp_Object enable; + USE_SAFE_ALLOCA; ptrdiff_t speccount = SPECPDL_INDEX (); /* The index of the next element of this_command_keys to examine for @@ -308,7 +328,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; @@ -329,12 +349,8 @@ invoke it. If KEYS is omitted or nil, the return value of wrong_type_argument (Qcommandp, function); } - /* 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 = xlispstrdupa (specs); - else + /* If SPECS is not a string, invent one. */ + if (! STRINGP (specs)) { Lisp_Object input; Lisp_Object funval = Findirect_function (function, Qt); @@ -374,10 +390,17 @@ 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 result + = unbind_to (speccount, CALLN (Fapply, Qfuncall_interactively, + function, specs)); + SAFE_FREE (); + return result; } + /* SPECS is set to a string; use it as an interactive prompt. + Copy it so that STRING will be valid even if a GC relocates SPECS. */ + SAFE_ALLOCA_STRING (string, specs); + /* Here if function specifies a string to control parsing the defaults. */ /* Set next_event to point to the first event with parameters. */ @@ -403,13 +426,13 @@ invoke it. If KEYS is omitted or nil, the return value of { if (! (*p == 'r' || *p == 'p' || *p == 'P' || *p == '\n')) - Fbarf_if_buffer_read_only (); + Fbarf_if_buffer_read_only (Qnil); p++; } record_then_fail = 1; } else - Fbarf_if_buffer_read_only (); + Fbarf_if_buffer_read_only (Qnil); } } /* Ignore this for semi-compatibility with Lucid. */ @@ -432,7 +455,7 @@ invoke it. If KEYS is omitted or nil, the return value of error ("Attempt to select inactive minibuffer window"); /* If the current buffer wants to clean up, let it. */ - Frun_hooks (1, &Qmouse_leave_buffer_hook); + run_hook (Qmouse_leave_buffer_hook); Fselect_window (w, Qnil); } @@ -446,10 +469,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. */ @@ -464,21 +488,17 @@ invoke it. If KEYS is omitted or nil, the return value of break; } - if (min (MOST_POSITIVE_FIXNUM, - min (PTRDIFF_MAX, SIZE_MAX) / word_size) - < nargs) + if (MOST_POSITIVE_FIXNUM < min (PTRDIFF_MAX, SIZE_MAX) / word_size + && MOST_POSITIVE_FIXNUM < nargs) memory_full (SIZE_MAX); - args = alloca (nargs * sizeof *args); - visargs = alloca (nargs * sizeof *visargs); - varies = alloca (nargs * sizeof *varies); + /* Allocate them all at one go. This wastes a bit of memory, but + it's OK to trade space for speed. */ + SAFE_NALLOCA (args, 3, nargs); + visargs = args + nargs; + varies = (signed char *) (visargs + nargs); - for (i = 0; i < nargs; i++) - { - args[i] = Qnil; - visargs[i] = Qnil; - varies[i] = 0; - } + memclear (args, nargs * (2 * word_size + 1)); GCPRO5 (prefix_arg, function, *args, *visargs, up_event); gcpro3.nvars = nargs; @@ -488,13 +508,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) { @@ -551,25 +571,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. */ @@ -599,9 +615,9 @@ invoke it. If KEYS is omitted or nil, the return value of { Lisp_Object tem2; - teml = Fget (teml, intern ("event-symbol-elements")); + teml = Fget (teml, Qevent_symbol_elements); /* Ignore first element, which is the base key. */ - tem2 = Fmemq (intern ("down"), Fcdr (teml)); + tem2 = Fmemq (Qdown, Fcdr (teml)); if (! NILP (tem2)) up_event = Fread_event (Qnil, Qnil, Qnil); } @@ -631,9 +647,9 @@ invoke it. If KEYS is omitted or nil, the return value of { Lisp_Object tem2; - teml = Fget (teml, intern ("event-symbol-elements")); + teml = Fget (teml, Qevent_symbol_elements); /* Ignore first element, which is the base key. */ - tem2 = Fmemq (intern ("down"), Fcdr (teml)); + tem2 = Fmemq (Qdown, Fcdr (teml)); if (! NILP (tem2)) up_event = Fread_event (Qnil, Qnil, Qnil); } @@ -749,7 +765,7 @@ invoke it. If KEYS is omitted or nil, the return value of argument if no prefix. */ if (NILP (prefix_arg)) { - args[i] = Qnil; + /* args[i] = Qnil; */ varies[i] = -1; } else @@ -789,21 +805,22 @@ invoke it. If KEYS is omitted or nil, the return value of 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) @@ -816,12 +833,12 @@ 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])); if (record_then_fail) - Fbarf_if_buffer_read_only (); + Fbarf_if_buffer_read_only (Qnil); Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; @@ -829,13 +846,11 @@ 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); + val = unbind_to (speccount, val); + SAFE_FREE (); + return val; } } @@ -888,7 +903,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,5 +961,6 @@ a way to turn themselves off when a mouse command switches windows. */); defsubr (&Sinteractive); defsubr (&Scall_interactively); + defsubr (&Sfuncall_interactively); defsubr (&Sprefix_numeric_value); }