From: Aaron S. Hawley Date: Tue, 1 May 2012 16:10:02 +0000 (-0400) Subject: Reimplement execute-extended-command in Elisp. X-Git-Tag: emacs-24.2.90~471^2~227 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b593d6a999b21dfee6939b24866a5ec6fbe7d11b;p=emacs.git Reimplement execute-extended-command in Elisp. * src/keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings): Move to simple.el. * lisp/simple.el (suggest-key-bindings, execute-extended-command): Move from keyboard.c. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cb7e1377c92..cfc40bc01a8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,10 +1,16 @@ +2012-05-01 Aaron S. Hawley + Stefan Monnier + + * simple.el (suggest-key-bindings, execute-extended-command): + Move from keyboard.c. + 2012-05-01 Chong Yidong * follow.el: Eliminate advice. (set-process-filter, process-filter, sit-for): Advice deleted. (follow-mode-off-hook): Obsolete hook removed. - (follow-avoid-tail-recenter-p, follow-process-filter-alist): Vars - deleted. + (follow-avoid-tail-recenter-p, follow-process-filter-alist): + Vars deleted. (follow-auto): Use a :set function. (follow-mode): Rewritten. Don't advise process filters. (follow-switch-to-current-buffer-all, follow-scroll-up) @@ -25,13 +31,13 @@ (follow-stop-intercept-process-output, follow-generic-filter): Functions deleted. (follow-scroll-bar-toolkit-scroll, follow-scroll-bar-drag) - (follow-scroll-bar-scroll-up, follow-scroll-bar-scroll-down): New - functions, replacing advice on scroll-bar-* commands. + (follow-scroll-bar-scroll-up, follow-scroll-bar-scroll-down): + New functions, replacing advice on scroll-bar-* commands. (follow-mwheel-scroll): New function (Bug#4112). * comint.el (comint-adjust-point): New function. - (comint-postoutput-scroll-to-bottom): Use it. Call - follow-comint-scroll-to-bottom for Follow mode buffers. + (comint-postoutput-scroll-to-bottom): Use it. + Call follow-comint-scroll-to-bottom for Follow mode buffers. 2012-05-01 Glenn Morris diff --git a/lisp/simple.el b/lisp/simple.el index 55f7d1261ee..3d8a3a38dbd 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1354,6 +1354,56 @@ to get different commands to edit and resubmit." "M-x ") obarray 'commandp t nil 'extended-command-history))) +(defcustom suggest-key-bindings t + "Non-nil means show the equivalent key-binding when M-x command has one. +The value can be a length of time to show the message for. +If the value is non-nil and not a number, we wait 2 seconds." + :group 'keyboard + :type '(choice (const :tag "off" nil) + (integer :tag "time" 2) + (other :tag "on"))) + +(defun execute-extended-command (prefixarg &optional command-name) + ;; Based on Fexecute_extended_command in keyboard.c of Emacs. + ;; Aaron S. Hawley 2009-08-24 + "Read function name, then read its arguments and call it. + +To pass a numeric argument to the command you are invoking with, specify +the numeric argument to this command. + +Noninteractively, the argument PREFIXARG is the prefix argument to +give to the command you invoke, if it asks for an argument." + (interactive (list current-prefix-arg (read-extended-command))) + ;; Emacs<24 calling-convention was with a single `prefixarg' argument. + (if (null command-name) (setq command-name (read-extended-command))) + (let* ((function (and (stringp command-name) (intern-soft command-name))) + (binding (and suggest-key-bindings + (not executing-kbd-macro) + (where-is-internal function overriding-local-map t)))) + (unless (commandp function) + (error "`%s' is not a valid command name" command-name)) + ;; Set this_command_keys to the concatenation of saved-keys and + ;; function, followed by a RET. + (setq this-command function) + (let ((prefix-arg prefixarg)) + (command-execute function 'record)) + ;; If enabled, show which key runs this command. + (when binding + ;; But first wait, and skip the message if there is input. + (let* ((waited + ;; If this command displayed something in the echo area; + ;; wait a few seconds, then display our suggestion message. + (sit-for (cond + ((zerop (length (current-message))) 0) + ((numberp suggest-key-bindings) suggest-key-bindings) + (t 2))))) + (when (and waited (not (consp unread-command-events))) + (with-temp-message + (format "You can run the command `%s' with %s" + function (key-description binding)) + (sit-for (if (numberp suggest-key-bindings) + suggest-key-bindings + 2)))))))) (defvar minibuffer-history nil "Default minibuffer history list. diff --git a/src/ChangeLog b/src/ChangeLog index 0e17d5dd345..f624517efb2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-05-01 Stefan Monnier + + * keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings): + Move to simple.el. + 2012-05-01 Glenn Morris * syssignal.h: Remove reference to BROKEN_SIGINFO (last used in @@ -52,8 +57,8 @@ 2012-04-27 Eli Zaretskii - * dispnew.c (swap_glyph_pointers, copy_row_except_pointers): Don't - overrun array limits of glyph row's used[] array. (Bug#11288) + * dispnew.c (swap_glyph_pointers, copy_row_except_pointers): + Don't overrun array limits of glyph row's used[] array. (Bug#11288) 2012-04-26 Eli Zaretskii @@ -169,8 +174,8 @@ (XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL. (xd_signature, xd_append_arg): Allow float for integer types. (xd_get_connection_references): New function. - (xd_get_connection_address): Rename from xd_initialize. Return - cached address. + (xd_get_connection_address): Rename from xd_initialize. + Return cached address. (xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS. (xd_close_bus): Rename from Fdbus_close_bus. Not needed on Lisp level. @@ -188,8 +193,8 @@ (Vdbus_message_type_invalid, Vdbus_message_type_method_call) (Vdbus_message_type_method_return, Vdbus_message_type_error) (Vdbus_message_type_signal): New defvars. - (Vdbus_registered_buses, Vdbus_registered_objects_table): Adapt - docstring. + (Vdbus_registered_buses, Vdbus_registered_objects_table): + Adapt docstring. 2012-04-22 Paul Eggert @@ -219,8 +224,8 @@ 2012-04-21 Eduard Wiebe - * sysdep.c (list_system_processes, system_process_attributes): Add - implementation for FreeBSD (Bug#5243). + * sysdep.c (list_system_processes, system_process_attributes): + Add implementation for FreeBSD (Bug#5243). 2012-04-21 Andreas Schwab diff --git a/src/keyboard.c b/src/keyboard.c index 48b31d8b564..a1ad1fed325 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10340,146 +10340,6 @@ a special event, so ignore the prefix argument and don't clear it. */) } - -DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, - 1, 1, "P", - doc: /* Read function name, then read its arguments and call it. - -To pass a numeric argument to the command you are invoking with, specify -the numeric argument to this command. - -Noninteractively, the argument PREFIXARG is the prefix argument to -give to the command you invoke, if it asks for an argument. */) - (Lisp_Object prefixarg) -{ - Lisp_Object function; - EMACS_INT saved_last_point_position; - Lisp_Object saved_keys, saved_last_point_position_buffer; - Lisp_Object bindings, value; - struct gcpro gcpro1, gcpro2, gcpro3; -#ifdef HAVE_WINDOW_SYSTEM - /* The call to Fcompleting_read will start and cancel the hourglass, - but if the hourglass was already scheduled, this means that no - hourglass will be shown for the actual M-x command itself. - So we restart it if it is already scheduled. Note that checking - hourglass_shown_p is not enough, normally the hourglass is not shown, - just scheduled to be shown. */ - int hstarted = hourglass_started (); -#endif - - saved_keys = Fvector (this_command_key_count, - XVECTOR (this_command_keys)->contents); - saved_last_point_position_buffer = last_point_position_buffer; - saved_last_point_position = last_point_position; - GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer); - - function = call0 (intern ("read-extended-command")); - -#ifdef HAVE_WINDOW_SYSTEM - if (hstarted) start_hourglass (); -#endif - - if (STRINGP (function) && SCHARS (function) == 0) - error ("No command name given"); - - /* Set this_command_keys to the concatenation of saved_keys and - function, followed by a RET. */ - { - Lisp_Object *keys; - int i; - - this_command_key_count = 0; - this_command_key_count_reset = 0; - this_single_command_key_start = 0; - - keys = XVECTOR (saved_keys)->contents; - for (i = 0; i < ASIZE (saved_keys); i++) - add_command_key (keys[i]); - - for (i = 0; i < SCHARS (function); i++) - add_command_key (Faref (function, make_number (i))); - - add_command_key (make_number ('\015')); - } - - last_point_position = saved_last_point_position; - last_point_position_buffer = saved_last_point_position_buffer; - - UNGCPRO; - - function = Fintern (function, Qnil); - KVAR (current_kboard, Vprefix_arg) = prefixarg; - Vthis_command = function; - real_this_command = function; - - /* If enabled, show which key runs this command. */ - if (!NILP (Vsuggest_key_bindings) - && NILP (Vexecuting_kbd_macro) - && SYMBOLP (function)) - bindings = Fwhere_is_internal (function, Voverriding_local_map, - Qt, Qnil, Qnil); - else - bindings = Qnil; - - value = Qnil; - GCPRO3 (bindings, value, function); - value = Fcommand_execute (function, Qt, Qnil, Qnil); - - /* If the command has a key binding, print it now. */ - if (!NILP (bindings) - && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)), - Qmouse_movement))) - { - /* But first wait, and skip the message if there is input. */ - Lisp_Object waited; - - /* If this command displayed something in the echo area; - wait a few seconds, then display our suggestion message. */ - if (NILP (echo_area_buffer[0])) - waited = sit_for (make_number (0), 0, 2); - else if (NUMBERP (Vsuggest_key_bindings)) - waited = sit_for (Vsuggest_key_bindings, 0, 2); - else - waited = sit_for (make_number (2), 0, 2); - - if (!NILP (waited) && ! CONSP (Vunread_command_events)) - { - Lisp_Object binding; - char *newmessage; - int message_p = push_message (); - int count = SPECPDL_INDEX (); - ptrdiff_t newmessage_len, newmessage_alloc; - USE_SAFE_ALLOCA; - - record_unwind_protect (pop_message_unwind, Qnil); - binding = Fkey_description (bindings, Qnil); - newmessage_alloc = - (sizeof "You can run the command `' with " - + SBYTES (SYMBOL_NAME (function)) + SBYTES (binding)); - SAFE_ALLOCA (newmessage, char *, newmessage_alloc); - newmessage_len = - esprintf (newmessage, "You can run the command `%s' with %s", - SDATA (SYMBOL_NAME (function)), - SDATA (binding)); - message2 (newmessage, - newmessage_len, - STRING_MULTIBYTE (binding)); - if (NUMBERP (Vsuggest_key_bindings)) - waited = sit_for (Vsuggest_key_bindings, 0, 2); - else - waited = sit_for (make_number (2), 0, 2); - - if (!NILP (waited) && message_p) - restore_message (); - - SAFE_FREE (); - unbind_to (count, Qnil); - } - } - - RETURN_UNGCPRO (value); -} - /* Return nonzero if input events are pending. */ @@ -11791,7 +11651,6 @@ syms_of_keyboard (void) defsubr (&Sset_quit_char); defsubr (&Sset_input_mode); defsubr (&Scurrent_input_mode); - defsubr (&Sexecute_extended_command); defsubr (&Sposn_at_point); defsubr (&Sposn_at_x_y); @@ -12195,12 +12054,6 @@ If this variable is non-nil, `delayed-warnings-hook' will be run immediately after running `post-command-hook'. */); Vdelayed_warnings_list = Qnil; - DEFVAR_LISP ("suggest-key-bindings", Vsuggest_key_bindings, - doc: /* Non-nil means show the equivalent key-binding when M-x command has one. -The value can be a length of time to show the message for. -If the value is non-nil and not a number, we wait 2 seconds. */); - Vsuggest_key_bindings = Qt; - DEFVAR_LISP ("timer-list", Vtimer_list, doc: /* List of active absolute time timers in order of increasing time. */); Vtimer_list = Qnil;