[Emacs-diffs] /srv/bzr/emacs/trunk r108080: Reimplement execute-extended-command in Elisp.

[Stefan Monnier]

------------------------------------------------------------
revno: 108080
author: Aaron S. Hawley <address@hidden>
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2012-05-01 12:10:02 -0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/simple.el
  src/ChangeLog
  src/keyboard.c

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-05-01 14:00:16 +0000
+++ b/lisp/ChangeLog    2012-05-01 16:10:02 +0000
@@ -1,10 +1,16 @@
+2012-05-01  Aaron S. Hawley  <address@hidden>
+            Stefan Monnier  <address@hidden>
+
+       * simple.el (suggest-key-bindings, execute-extended-command):
+       Move from keyboard.c.
+
 2012-05-01  Chong Yidong  <address@hidden>
 
        * 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  <address@hidden>
 

=== modified file 'lisp/simple.el'
--- a/lisp/simple.el    2012-04-27 03:10:38 +0000
+++ b/lisp/simple.el    2012-05-01 16:10:02 +0000
@@ -1354,6 +1354,56 @@
             "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.

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2012-05-01 03:45:39 +0000
+++ b/src/ChangeLog     2012-05-01 16:10:02 +0000
@@ -1,3 +1,8 @@
+2012-05-01  Stefan Monnier  <address@hidden>
+
+       * keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings):
+       Move to simple.el.
+
 2012-05-01  Glenn Morris  <address@hidden>
 
        * syssignal.h: Remove reference to BROKEN_SIGINFO (last used in
@@ -52,8 +57,8 @@
 
 2012-04-27  Eli Zaretskii  <address@hidden>
 
-       * 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  <address@hidden>
 
@@ -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  <address@hidden>
 
@@ -219,8 +224,8 @@
 
 2012-04-21  Eduard Wiebe  <address@hidden>
 
-       * 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  <address@hidden>
 

=== modified file 'src/keyboard.c'
--- a/src/keyboard.c    2012-04-24 08:56:31 +0000
+++ b/src/keyboard.c    2012-05-01 16:10:02 +0000
@@ -10341,146 +10341,6 @@
 
 
 
-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 @@
   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 @@
 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;