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.

4 files changed, 75 insertions, 161 deletions

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  <aaron.s.hawley@gmail.com>
+            Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * simple.el (suggest-key-bindings, execute-extended-command):
+        Move from keyboard.c.
+
 2012-05-01  Chong Yidong  <cyd@gnu.org>
 
         * 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  <rgm@gnu.org>
 
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 <aaron.s.hawley(at)gmail.com> 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  <monnier@iro.umontreal.ca>
+
+        * keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings):
+        Move to simple.el.
+
 2012-05-01  Glenn Morris  <rgm@gnu.org>
 
         * syssignal.h: Remove reference to BROKEN_SIGINFO (last used in
@@ -52,8 +57,8 @@
 
 2012-04-27  Eli Zaretskii  <eliz@gnu.org>
 
-        * 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  <eliz@gnu.org>
 
@@ -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  <eggert@cs.ucla.edu>
 
@@ -219,8 +224,8 @@
 
 2012-04-21  Eduard Wiebe  <usenet@pusto.de>
 
-        * 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  <schwab@linux-m68k.org>
 
diff --git a/src/keyboard.c b/src/keyboard.c
index 48b31d8b564..a1ad1fed325 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10341,146 +10341,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.  */
 
 int
@@ -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;