From xemacs-m  Tue Jun 24 04:54:44 1997
Received: from jagor.srce.hr (hniksic@jagor.srce.hr [161.53.2.130])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id EAA15777
	for <xemacs-beta@xemacs.org>; Tue, 24 Jun 1997 04:54:42 -0500 (CDT)
Received: (from hniksic@localhost)
          by jagor.srce.hr (8.8.5/8.8.4)
	  id LAA27127; Tue, 24 Jun 1997 11:54:42 +0200 (MET DST)
To: XEmacs Developers <xemacs-beta@xemacs.org>
Subject: Re: [PATCH] teach-extended-commands-p change
References: <kiglo41mzd5.fsf@jagor.srce.hr> <QQcvdz08657.199706231054@crystal.WonderWorks.COM> <kigu3ipk27c.fsf@jagor.srce.hr> <m2g1u8yaiz.fsf@altair.xemacs.org>
X-Attribution: Hrv
X-Face: Mie8:rOV<\c/~z{s.X4A{!?vY7{drJ([U]0O=W/<W*SMo/Mv:58:*_y~ki>xDi&N7XG
        KV^$k0m3Oe/)'e%3=$PCR&3ITUXH,cK>]bci&<qQ>Ff%x_>1`T(+M2Gg/fgndU%k*ft
        [(7._6e0n-V%|%'[c|q:;}td$#INd+;?!-V=c8Pqf}3J
From: Hrvoje Niksic <hniksic@srce.hr>
Date: 24 Jun 1997 11:54:41 +0200
In-Reply-To: Steven L Baur's message of "23 Jun 1997 19:55:48 -0700"
Message-ID: <kigafkg72ce.fsf@jagor.srce.hr>
Lines: 147
X-Mailer: Gnus v5.4.59/XEmacs 20.3(beta8) - "Copenhagen"

Steven L Baur <steve@xemacs.org> writes:

> > But if you want me to do it, I can rearrange the code to compute
> > `keys' before the command is executed, and display them
> > afterwards.
> 
> Yes, please.

OK, the patch (against clean Copenhagen cmdloop.el) follows bellow.
For those who would just like to test it, I am adding the whole
function, so you can eval it with `C-x C-e'.  Now it should work like
we want -- the sequence is:

1) compute the keys
2) execute the command
3) wait a second
   show the keys
   wait 2 seconds
   restore the message

Of course, if `teach-extended-commands-p' is nil, or if the function
is not bound to a key, only #1 is executed.

As in the latest GNU Emacs, the command suggestion is not given right
away, so you get a chance to see a message printed by the function (if
any) before the key binding suggestion.  However, the 2-second wait
seemed rather long, and in fact, I am not at all convinced that the
first wait should in any way depend on `teach-extended-commands-timeout'
at all -- so I hardcoded it to a second.  Maybe we should provide
another variable?  It would be going too far, IMHO.

The only (known) problem is that when the new function creates the
frame, the message is printed in the old frame's minibuffer.

Please everyone: test this function and tell me how you like it.  I
think that it is much much better than what we had before.

--- lisp/prim/cmdloop.el.good	Tue Jun 24 00:13:20 1997
+++ lisp/prim/cmdloop.el	Tue Jun 24 11:50:07 1997
@@ -279,20 +279,30 @@
                               (t
                                "M-x ")))))
 
-  (if (and teach-extended-commands-p (interactive-p))
-      (let ((keys (where-is-internal this-command)))
-	(if keys
-	    (progn
-	      (message "M-x %s (bound to key%s: %s)"
-		       this-command
-		       (if (cdr keys) "s" "")
-		       (mapconcat 'key-description
-				  (sort keys #'(lambda (x y)
-						 (< (length x) (length y))))
-				  ", "))
-	      (sit-for teach-extended-commands-timeout)))))
-
-  (command-execute this-command t))
+  (if (and teach-extended-commands-p
+	   (interactive-p))
+      ;; We need to fiddle with keys: remember the keys, run the
+      ;; command, and show the keys (if any).
+      (let ((_execute_command_keys_ (where-is-internal this-command)))
+	(command-execute this-command t)
+	(when (and _execute_command_keys_
+		   ;; Wait for a while, so the user can see a message
+		   ;; printed, if any.
+		   (sit-for 1))
+	  (display-message
+	   'no-log
+	   (format "Command `%s' is bound to key%s: %s"
+		   this-command
+		   (if (cdr _execute_command_keys_) "s" "")
+		   (mapconcat 'key-description
+			      (sort _execute_command_keys_
+				    #'(lambda (x y)
+					(< (length x) (length y))))
+			      ", ")))
+	  (sit-for teach-extended-commands-timeout)
+	  (clear-message 'no-log)))
+    ;; Else, just run the command.
+    (command-execute this-command t)))
 
 
 ;;; C code calls this; the underscores in the variable names are to avoid


The whole function:

(defun execute-extended-command (prefix-arg)
  "Read a command name from the minibuffer using 'completing-read'.
Then call the specified command using 'command-execute' and return its
return value.  If the command asks for a prefix argument, supply the
value of the current raw prefix argument, or the value of PREFIX-ARG
when called from Lisp."
  (interactive "P")
  ;; Note:  This doesn't hack "this-command-keys"
  (let ((prefix-arg prefix-arg))
    (setq this-command (read-command
                        ;; Note: this has the hard-wired
                        ;;  "C-u" and "M-x" string bug in common
                        ;;  with all GNU Emacs's.
			;; (i.e. it prints C-u and M-x regardless of
			;; whether some other keys were actually bound
			;; to `execute-extended-command' and 
			;; `universal-argument'.
                        (cond ((eq prefix-arg '-)
                               "- M-x ")
                              ((equal prefix-arg '(4))
                               "C-u M-x ")
                              ((integerp prefix-arg)
                               (format "%d M-x " prefix-arg))
                              ((and (consp prefix-arg)
                                    (integerp (car prefix-arg)))
                               (format "%d M-x " (car prefix-arg)))
                              (t
                               "M-x ")))))

  (if (and teach-extended-commands-p
	   (interactive-p))
      ;; We need to fiddle with keys: remember the keys, run the
      ;; command, and show the keys (if any).
      (let ((_execute_command_keys_ (where-is-internal this-command)))
	(command-execute this-command t)
	(when (and _execute_command_keys_
		   ;; Wait for a while, so the user can see a message
		   ;; printed, if any.
		   (sit-for 1))
	  (display-message
	   'no-log
	   (format "Command `%s' is bound to key%s: %s"
		   this-command
		   (if (cdr _execute_command_keys_) "s" "")
		   (mapconcat 'key-description
			      (sort _execute_command_keys_
				    #'(lambda (x y)
					(< (length x) (length y))))
			      ", ")))
	  (sit-for teach-extended-commands-timeout)
	  (clear-message 'no-log)))
    ;; Else, just run the command.
    (command-execute this-command t)))

-- 
Hrvoje Niksic <hniksic@srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Unspeakable horrors from outer space paralyze the living and
resurrect the dead!

