tweak to apropos-command display

tweak to apropos-command display

[Chong Yidong]

When apropos-command is displaying the keybindings associated with a
command, it often runs past the edge of the screen (esp. when displaying
M-x COMMAND RET) This makes the output very difficult to read.

A simple way to deal with this problem is to put the keybindings on their
own line. Opinions?

*** apropos.el~	Mon Feb 21 21:59:35 2005
--- apropos.el	Mon Feb 21 22:26:25 2005
***************
*** 824,832 ****
  	  (if apropos-sort-by-scores
  	      (insert " (" (number-to-string (cadr apropos-item)) ") "))
  	  ;; Calculate key-bindings if we want them.
! 	  (and do-keys
! 	       (commandp symbol)
! 	       (indent-to 30 1)
  	       (if (let ((keys
  			  (save-excursion
  			    (set-buffer old-buffer)
--- 824,832 ----
  	  (if apropos-sort-by-scores
  	      (insert " (" (number-to-string (cadr apropos-item)) ") "))
  	  ;; Calculate key-bindings if we want them.
! 	  (when (and do-keys
!                      (commandp symbol))
! 	       (insert "\n  ")
  	       (if (let ((keys
  			  (save-excursion
  			    (set-buffer old-buffer)

Re: tweak to apropos-command display

[Kim F. Storm]

"Chong Yidong" <cyd@stupidchicken.com> writes:

> When apropos-command is displaying the keybindings associated with a
> command, it often runs past the edge of the screen (esp. when displaying
> M-x COMMAND RET) This makes the output very difficult to read.
>
> A simple way to deal with this problem is to put the keybindings on their
> own line. Opinions?
>
> *** apropos.el~	Mon Feb 21 21:59:35 2005
> --- apropos.el	Mon Feb 21 22:26:25 2005
> ***************
> *** 824,832 ****
>   	  (if apropos-sort-by-scores
>   	      (insert " (" (number-to-string (cadr apropos-item)) ") "))
>   	  ;; Calculate key-bindings if we want them.
> ! 	  (and do-keys
> ! 	       (commandp symbol)
> ! 	       (indent-to 30 1)
>   	       (if (let ((keys
>   			  (save-excursion
>   			    (set-buffer old-buffer)
> --- 824,832 ----
>   	  (if apropos-sort-by-scores
>   	      (insert " (" (number-to-string (cadr apropos-item)) ") "))
>   	  ;; Calculate key-bindings if we want them.
> ! 	  (when (and do-keys
> !                      (commandp symbol))
> ! 	       (insert "\n  ")
>   	       (if (let ((keys
>   			  (save-excursion
>   			    (set-buffer old-buffer)


IMO, it would be better if it simply didn't list the M-x binding.


-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: tweak to apropos-command display

[Stefan]

> When apropos-command is displaying the keybindings associated with a
> command, it often runs past the edge of the screen (esp. when displaying
> M-x COMMAND RET) This makes the output very difficult to read.

> A simple way to deal with this problem is to put the keybindings on their
> own line. Opinions?

I rarely care about the keybindings, so rather than waste precious vertical
space with them, I'd rather set truncate-line.


        Stefan

Re: tweak to apropos-command display

[Chong Yidong]

Kim F. Storm <storm@cua.dk> wrote:
>> When apropos-command is displaying the keybindings associated with a
>> command, it often runs past the edge of the screen (esp. when displaying
>> M-x COMMAND RET) This makes the output very difficult to read.
>
> IMO, it would be better if it simply didn't list the M-x binding.

I would support doing that too. `apropos-print' goes out of its way to
insert the M-x binding, so presumably someone once wanted it there; but it
does seem like a misfeature, as it makes the output extremely cluttered.

Re: tweak to apropos-command display

[Chong Yidong]

>> When apropos-command is displaying the keybindings associated with a
>> command, it often runs past the edge of the screen (esp. when displaying
>> M-x COMMAND RET) This makes the output very difficult to read.
>
>> A simple way to deal with this problem is to put the keybindings on
>> their
>> own line. Opinions?
>
> I rarely care about the keybindings, so rather than waste precious
> vertical space with them, I'd rather set truncate-line.

Having compared the two, I think using truncate-line looks very ugly. IMO,
the increased readability from putting the bindings on a new line more
than makes up for the loss of vertical space.

Anyway, if we don't care about the keybindings, we might as well remove
them entirely, and let the user click on the command to find out. With
truncate-line, the bindings will occasionally be truncated, so their
presence is useless.

Re: tweak to apropos-command display

[Richard Stallman]

    When apropos-command is displaying the keybindings associated with a
    command, it often runs past the edge of the screen (esp. when displaying
    M-x COMMAND RET) This makes the output very difficult to read.

How about this change instead?


*** apropos.el	12 Feb 2005 03:38:01 -0500	1.101
--- apropos.el	22 Feb 2005 04:59:34 -0500	
***************
*** 860,872 ****
  					      key))
  		       key)
  		     item ", "))
! 		 (insert "M-x")
! 		 (put-text-property (- (point) 3) (point)
! 				    'face apropos-keybinding-face)
! 		 (insert " " (symbol-name symbol) " ")
! 		 (insert "RET")
! 		 (put-text-property (- (point) 3) (point)
! 				    'face apropos-keybinding-face)))
  	  (terpri)
  	  (apropos-print-doc 2
  			     (if (commandp symbol)
--- 860,866 ----
  					      key))
  		       key)
  		     item ", "))
! 		 (insert "(invoke using M-x)")))
  	  (terpri)
  	  (apropos-print-doc 2
  			     (if (commandp symbol)

Re: tweak to apropos-command display

[Kevin Rodgers]

Richard Stallman wrote:
 >     When apropos-command is displaying the keybindings associated with a
 >     command, it often runs past the edge of the screen (esp. when 
displaying
 >     M-x COMMAND RET) This makes the output very difficult to read.
 >
 > How about this change instead?
 >
 >
 > *** apropos.el	12 Feb 2005 03:38:01 -0500	1.101
 > --- apropos.el	22 Feb 2005 04:59:34 -0500	
 > ***************
 > *** 860,872 ****
 >   					      key))
 >   		       key)
 >   		     item ", "))
 > ! 		 (insert "M-x")
 > ! 		 (put-text-property (- (point) 3) (point)
 > ! 				    'face apropos-keybinding-face)
 > ! 		 (insert " " (symbol-name symbol) " ")
 > ! 		 (insert "RET")
 > ! 		 (put-text-property (- (point) 3) (point)
 > ! 				    'face apropos-keybinding-face)))
 >   	  (terpri)
 >   	  (apropos-print-doc 2
 >   			     (if (commandp symbol)
 > --- 860,866 ----
 >   					      key))
 >   		       key)
 >   		     item ", "))
 > ! 		 (insert "(invoke using M-x)")))
 >   	  (terpri)
 >   	  (apropos-print-doc 2
 >   			     (if (commandp symbol)

(insert (substitute-command-keys
          "(invoke using \\[execute-extended-command])"))

:-)

-- 
Kevin Rodgers

Re: tweak to apropos-command display

[Kim F. Storm]

Richard Stallman <rms@gnu.org> writes:

>     When apropos-command is displaying the keybindings associated with a
>     command, it often runs past the edge of the screen (esp. when displaying
>     M-x COMMAND RET) This makes the output very difficult to read.
>
> How about this change instead?
>
> ! 		 (insert "(invoke using M-x)")))


I like M-x ... RET better.

The following patch does that.

It also improves handling of menu bar entries in two ways:

1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.

2) It pretty prints menu bar entries like this:
    e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"


*** apropos.el	12 Feb 2005 14:46:58 +0100	1.101
--- apropos.el	22 Feb 2005 22:42:30 +0100	
***************
*** 795,801 ****
      (with-output-to-temp-buffer "*Apropos*"
        (let ((p apropos-accumulator)
  	    (old-buffer (current-buffer))
! 	    symbol item)
  	(set-buffer standard-output)
  	(apropos-mode)
  	(if (display-mouse-p)
--- 795,801 ----
      (with-output-to-temp-buffer "*Apropos*"
        (let ((p apropos-accumulator)
  	    (old-buffer (current-buffer))
! 	    symbol item menu-items)
  	(set-buffer standard-output)
  	(apropos-mode)
  	(if (display-mouse-p)
***************
*** 839,848 ****
  			     (i 0)
  			     loser)
  			 (while (< i (length key))
! 			   (if (or (framep (aref key i))
! 				   (bufferp (aref key i)))
  			       (setq loser t))
! 			   (setq i (1+ i)))
  			 (or loser
  			     (setq filtered (cons key filtered))))
  		       (setq keys (cdr keys)))
--- 839,853 ----
  			     (i 0)
  			     loser)
  			 (while (< i (length key))
! 			   (let ((elt (aref key i)))
! 			     (cond
! 			      ((or (framep elt) (bufferp elt))
  			       (setq loser t))
! 			      ((and (= i 0) (eq elt 'menu-bar))
! 			       (if menu-bar-mode
! 				   (setq menu-items (cons key menu-items))
! 				 (setq loser t)))))
! 			   (setq i (if loser (length key) (1+ i))))
  			 (or loser
  			     (setq filtered (cons key filtered))))
  		       (setq keys (cdr keys)))
***************
*** 852,858 ****
  		    (mapconcat
  		     (lambda (key)
  		       (setq key (condition-case ()
! 				     (key-description key)
  				   (error)))
  		       (if apropos-keybinding-face
  			   (put-text-property 0 (length key)
--- 857,871 ----
  		    (mapconcat
  		     (lambda (key)
  		       (setq key (condition-case ()
! 				     (if (and (memq key menu-items)
! 					      (> (length key) 1)
! 					      (symbolp (aref key 1)))
! 					 (let ((m (symbol-name (aref key 1)))
! 					       (case-fold-search t))
! 					   (if (string-match "^\\(.*\\)-menu$" m)
! 					       (setq m (match-string 1 m)))
! 					   (format "%s Menu" (capitalize m)))
! 				       (key-description key))
  				   (error)))
  		       (if apropos-keybinding-face
  			   (put-text-property 0 (length key)
***************
*** 860,872 ****
  					      key))
  		       key)
  		     item ", "))
! 		 (insert "M-x")
! 		 (put-text-property (- (point) 3) (point)
! 				    'face apropos-keybinding-face)
! 		 (insert " " (symbol-name symbol) " ")
! 		 (insert "RET")
! 		 (put-text-property (- (point) 3) (point)
! 				    'face apropos-keybinding-face)))
  	  (terpri)
  	  (apropos-print-doc 2
  			     (if (commandp symbol)
--- 873,884 ----
  					      key))
  		       key)
  		     item ", "))
! 		 (insert "M-x ... RET")
! 		 (when apropos-keybinding-face
! 		   (put-text-property (- (point) 11) (- (point) 8)
! 				      'face apropos-keybinding-face)
! 		   (put-text-property (- (point) 3) (point)
! 				      'face apropos-keybinding-face))))
  	  (terpri)
  	  (apropos-print-doc 2
  			     (if (commandp symbol)

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: tweak to apropos-command display

[David Kastrup]

storm@cua.dk (Kim F. Storm) writes:

> It also improves handling of menu bar entries in two ways:
>
> 1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.
>
> 2) It pretty prints menu bar entries like this:
>     e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"

Uh, how is it an improvement to leave off the "New file" information
from the menu?

-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum

Re: tweak to apropos-command display

[Stefan Monnier]

> I like M-x ... RET better.

I like the empty string even better: these are commands so of course we can
invoke them via M-x (unless they use an "e" in their interactive spec).

> 1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.

I have disabled menu-bar-mode to save some screen real estate, but I still
do use the menus (via C-down-mouse-3).  So I'm not sure it's worth the trouble.

> 2) It pretty prints menu bar entries like this:
>     e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"

Why not "File => New File..." ?

Note that the displayed name of "<menu-bar> <foo>" is not necessarily
"Foo".  You'd really want to look at the menu-item's name string instead of
capitalizing the symbol-name.


        Stefan

Re: tweak to apropos-command display

[Kim F. Storm]

David Kastrup <dak@gnu.org> writes:

> storm@cua.dk (Kim F. Storm) writes:
>
>> It also improves handling of menu bar entries in two ways:
>>
>> 1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.
>>
>> 2) It pretty prints menu bar entries like this:
>>     e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"
>
> Uh, how is it an improvement to leave off the "New file" information
> from the menu?

Because the <new-file> is not always correct, e.g.

  <menu-bar> <options> <cua-mode>

corresponds to

  Options => C-x/C-c/C-v cut and paste (CUA)

It wouldn't be too hard to get this right...

E.g. 

  <menu-bar> <options> <mule> <set-various-coding-system> <revert-buffer-with-coding-system>

could be shown as

  Options => Mule => Set Coding System => For Reverting This Buffer Now


But the initial objection was that the key binding text was too wide.
My aim was to make the text shorter...

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: tweak to apropos-command display

[Kim F. Storm]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> I like M-x ... RET better.
>
> I like the empty string even better: these are commands so of course we can
> invoke them via M-x (unless they use an "e" in their interactive spec).

Me too.

>
>> 1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.
>
> I have disabled menu-bar-mode to save some screen real estate, but I still
> do use the menus (via C-down-mouse-3).  So I'm not sure it's worth the trouble.
>
>> 2) It pretty prints menu bar entries like this:
>>     e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"
>
> Why not "File => New File..." ?
>
> Note that the displayed name of "<menu-bar> <foo>" is not necessarily
> "Foo".  You'd really want to look at the menu-item's name string instead of
> capitalizing the symbol-name.

How do I get that info from lisp ?

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Tweak to key-description for menu bindings (was Re: tweak to apropos-command display)

[Kim F. Storm]

David Kastrup <dak@gnu.org> writes:

> storm@cua.dk (Kim F. Storm) writes:
>
>> It also improves handling of menu bar entries in two ways:
>>
>> 1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.
>>
>> 2) It pretty prints menu bar entries like this:
>>     e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"
>
> Uh, how is it an improvement to leave off the "New file" information
> from the menu?


I have been looking further into "menu binding pretty-printing",
and I agree that my previous approach was too narrow-minded.

I now have a solution where key-description produces a real human
readable text for menu bindings.

For example,

(key-description [menu-bar file new-file])

now prints

 <menu-bar> <file> <new-file>

whereas with my patch to key-description, it will print

 File=>New File...


Since this is implemented in key-description, it will show the new
format in all contexts, e.g. for C-h a, C-h k, C-h w, etc.


Another example:

Old:
<menu-bar> <options> <mule> <set-various-coding-system> <universal-coding-system-argument>

New:
Options=>Mule (Multilingual Environment)=>Set Coding Systems=>For Next Command


Shall I install this?


-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: Tweak to key-description for menu bindings

[David Kastrup]

storm@cua.dk (Kim F. Storm) writes:

> David Kastrup <dak@gnu.org> writes:
>
>> storm@cua.dk (Kim F. Storm) writes:
>>
>>> It also improves handling of menu bar entries in two ways:
>>>
>>> 1) If menu-bar-mode is disabled, it doesn't mention menu bar bindings.
>>>
>>> 2) It pretty prints menu bar entries like this:
>>>     e.g. "File Menu" rather than "<menu-bar> <file> <new-file>"
>>
>> Uh, how is it an improvement to leave off the "New file" information
>> from the menu?
>
> I have been looking further into "menu binding pretty-printing",
> and I agree that my previous approach was too narrow-minded.
>
> I now have a solution where key-description produces a real human
> readable text for menu bindings.
>
> For example,
>
> (key-description [menu-bar file new-file])
>
> now prints
>
>  <menu-bar> <file> <new-file>
>
> whereas with my patch to key-description, it will print
>
>  File=>New File...
>
> New:
> Options=>Mule (Multilingual Environment)=>Set Coding Systems=>For Next Command
>
>
> Shall I install this?

My vote is "yes".  However, I would also want to suggest that such
pretty-printed key sequences can, as some sort of a general principle,
be passed to the kbd macro to make a target for define-key, so that
the developer can be spared having to switch on his brain as often as
possible.  I don't know how feasible this is as kbd is a macro, and
the lookup could depend on the keymaps currently active or something.

But since kbd is a macro, it could also return a substitution that
will do the lookup at runtime depending on the maps then current.

-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum

Re: Tweak to key-description for menu bindings (was Re: tweak to apropos-command display)

[Richard Stallman]

    Since this is implemented in key-description, it will show the new
    format in all contexts, e.g. for C-h a, C-h k, C-h w, etc.


    Another example:

    Old:
    <menu-bar> <options> <mule> <set-various-coding-system> <universal-coding-system-argument>

    New:
    Options=>Mule (Multilingual Environment)=>Set Coding Systems=>For Next Command


    Shall I install this?

It seems like marginally an improvement, but since this isn't fixing a bug,
I'd rather not install this change now.

Re: Tweak to key-description for menu bindings

[Kim F. Storm]

Richard Stallman <rms@gnu.org> writes:

>  Old:
>    <menu-bar> <options> <mule> <set-various-coding-system> <universal-coding-system-argument>
>  New:
>    Options=>Mule (Multilingual Environment)=>Set Coding Systems=>For Next Command

> It seems like marginally an improvement, but since this isn't fixing a bug,
> I'd rather not install this change now.

I'll respect that, although I think this is more than a marginal improvement.
For the non-technical user, the old format is practically nonsense.


In any case, if someone would like to try it out, here is the complete patch,
including a patch to apropos that avoids the underline face on the menu binding.



Index: lisp/apropos.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/apropos.el,v
retrieving revision 1.101
diff -c -r1.101 apropos.el
*** lisp/apropos.el	11 Feb 2005 16:08:49 -0000	1.101
--- lisp/apropos.el	28 Feb 2005 22:41:40 -0000
***************
*** 84,89 ****
--- 84,94 ----
    :group 'apropos
    :type 'face)
  
+ (defcustom apropos-menu-binding-face nil
+   "*Face for lists of menu binding in Apropos output, or nil for none."
+   :group 'apropos
+   :type 'face)
+ 
  (defcustom apropos-label-face 'italic
    "*Face for label (`Command', `Variable' ...) in Apropos output.
  A value of nil means don't use any special font for them, and also
***************
*** 795,801 ****
      (with-output-to-temp-buffer "*Apropos*"
        (let ((p apropos-accumulator)
  	    (old-buffer (current-buffer))
! 	    symbol item)
  	(set-buffer standard-output)
  	(apropos-mode)
  	(if (display-mouse-p)
--- 800,806 ----
      (with-output-to-temp-buffer "*Apropos*"
        (let ((p apropos-accumulator)
  	    (old-buffer (current-buffer))
! 	    symbol item menu-items)
  	(set-buffer standard-output)
  	(apropos-mode)
  	(if (display-mouse-p)
***************
*** 839,848 ****
  			     (i 0)
  			     loser)
  			 (while (< i (length key))
! 			   (if (or (framep (aref key i))
! 				   (bufferp (aref key i)))
  			       (setq loser t))
! 			   (setq i (1+ i)))
  			 (or loser
  			     (setq filtered (cons key filtered))))
  		       (setq keys (cdr keys)))
--- 844,858 ----
  			     (i 0)
  			     loser)
  			 (while (< i (length key))
! 			   (let ((elt (aref key i)))
! 			     (cond
! 			      ((or (framep elt) (bufferp elt))
  			       (setq loser t))
! 			      ((and (= i 0) (eq elt 'menu-bar))
! 			       (if menu-bar-mode
! 				   (setq menu-items (cons key menu-items))
! 				 (setq loser t)))))
! 			   (setq i (if loser (length key) (1+ i))))
  			 (or loser
  			     (setq filtered (cons key filtered))))
  		       (setq keys (cdr keys)))
***************
*** 854,872 ****
  		       (setq key (condition-case ()
  				     (key-description key)
  				   (error)))
! 		       (if apropos-keybinding-face
! 			   (put-text-property 0 (length key)
! 					      'face apropos-keybinding-face
! 					      key))
  		       key)
  		     item ", "))
! 		 (insert "M-x")
! 		 (put-text-property (- (point) 3) (point)
! 				    'face apropos-keybinding-face)
! 		 (insert " " (symbol-name symbol) " ")
! 		 (insert "RET")
! 		 (put-text-property (- (point) 3) (point)
! 				    'face apropos-keybinding-face)))
  	  (terpri)
  	  (apropos-print-doc 2
  			     (if (commandp symbol)
--- 864,883 ----
  		       (setq key (condition-case ()
  				     (key-description key)
  				   (error)))
! 		       (let ((face (if (memq key menu-items)
! 				       apropos-menu-binding-face
! 				     apropos-keybinding-face)))
! 			 (if face
! 			     (put-text-property 0 (length key)
! 						'face face key)))
  		       key)
  		     item ", "))
! 		 (insert "M-x ... RET")
! 		 (when apropos-keybinding-face
! 		   (put-text-property (- (point) 11) (- (point) 8)
! 				      'face apropos-keybinding-face)
! 		   (put-text-property (- (point) 3) (point)
! 				      'face apropos-keybinding-face))))
  	  (terpri)
  	  (apropos-print-doc 2
  			     (if (commandp symbol)

Index: lisp/help-fns.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/help-fns.el,v
retrieving revision 1.64
diff -c -r1.64 help-fns.el
*** lisp/help-fns.el	3 Feb 2005 19:41:14 -0000	1.64
--- lisp/help-fns.el	28 Feb 2005 22:42:22 -0000
***************
*** 289,296 ****
  (defun help-highlight-arguments (usage doc &rest args)
    (when usage
      (with-temp-buffer
!       (insert usage)
!       (goto-char (point-min))
        (let ((case-fold-search nil)
              (next (not (or args (looking-at "\\["))))
              (opt nil))
--- 289,296 ----
  (defun help-highlight-arguments (usage doc &rest args)
    (when usage
      (with-temp-buffer
!       (insert "Lisp: " usage)
!       (goto-char (+ (point-min) 6))
        (let ((case-fold-search nil)
              (next (not (or args (looking-at "\\["))))
              (opt nil))
***************
*** 314,320 ****
    (cons usage doc))
  
  ;;;###autoload
! (defun describe-function-1 (function)
    (let* ((def (if (symbolp function)
  		  (symbol-function function)
  		function))
--- 314,320 ----
    (cons usage doc))
  
  ;;;###autoload
! (defun describe-function-1 (function &optional orig-key)
    (let* ((def (if (symbolp function)
  		  (symbol-function function)
  		function))
***************
*** 400,406 ****
        (let* ((remapped (command-remapping function))
  	     (keys (where-is-internal
  		    (or remapped function) overriding-local-map nil nil))
! 	     non-modified-keys)
  	;; Which non-control non-meta keys run this command?
  	(dolist (key keys)
  	  (if (member (event-modifiers (aref key 0)) '(nil (shift)))
--- 400,424 ----
        (let* ((remapped (command-remapping function))
  	     (keys (where-is-internal
  		    (or remapped function) overriding-local-map nil nil))
! 	     non-modified-keys
! 	     menu-binding
! 	     orig-deleted)
! 	(when orig-key
! 	  (cond
! 	   ((vectorp orig-key)
! 	    (if ;; [menu-bar ...] or [(menu-bar) ...]
! 		(or (eq (aref orig-key 0) 'menu-bar)
! 		    (and (consp (aref orig-key 0))
! 			 (eq (car (aref orig-key 0)) 'menu-bar)
! 			 ;; where-is-internal returns [menu-bar ...]
! 			 (aset orig-key 0 'menu-bar)))
! 		(setq menu-binding t)))
! 	   ((stringp orig-key)
! 	    (setq orig-key (string-to-vector orig-key))))
! 	  (setq orig-deleted (length keys))
! 	  (setq keys (delete orig-key keys))
! 	  (if (= orig-deleted (length keys))
! 	      (setq orig-deleted nil)))
  	;; Which non-control non-meta keys run this command?
  	(dolist (key keys)
  	  (if (member (event-modifiers (aref key 0)) '(nil (shift)))
***************
*** 411,417 ****
  	  (princ "'"))
  
  	(when keys
! 	  (princ (if remapped " which is bound to " "It is bound to "))
  	  ;; FIXME: This list can be very long (f.ex. for self-insert-command).
  	  ;; If there are many, remove them from KEYS.
  	  (if (< (length non-modified-keys) 10)
--- 429,438 ----
  	  (princ "'"))
  
  	(when keys
! 	  (princ (if remapped " which is" "It is"))
! 	  (if (and orig-deleted (< (length non-modified-keys) 10))
! 	      (princ " also"))
! 	  (princ " bound to ")
  	  ;; FIXME: This list can be very long (f.ex. for self-insert-command).
  	  ;; If there are many, remove them from KEYS.
  	  (if (< (length non-modified-keys) 10)
***************
*** 425,430 ****
--- 446,456 ----
  	      (princ "many ordinary text characters"))))
  	(when (or remapped keys non-modified-keys)
  	  (princ ".")
+ 	  (terpri))
+ 	(terpri)
+ 	(when menu-binding
+ 	  (princ "Menu binding: ")
+ 	  (princ (key-description orig-key t))
  	  (terpri))))
      (let* ((arglist (help-function-arglist def))
  	   (doc (documentation function))

Index: lisp/help.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/help.el,v
retrieving revision 1.275
diff -c -r1.275 help.el
*** lisp/help.el	10 Feb 2005 06:46:42 -0000	1.275
--- lisp/help.el	28 Feb 2005 22:43:01 -0000
***************
*** 619,625 ****
  	    (princ " runs the command ")
  	    (prin1 defn)
  	    (princ "\n   which is ")
! 	    (describe-function-1 defn)
  	    (when up-event
  	      (let ((ev (aref up-event 0))
  		    (descr (key-description up-event))
--- 619,625 ----
  	    (princ " runs the command ")
  	    (prin1 defn)
  	    (princ "\n   which is ")
! 	    (describe-function-1 defn key)
  	    (when up-event
  	      (let ((ev (aref up-event 0))
  		    (descr (key-description up-event))

Index: src/keymap.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/keymap.c,v
retrieving revision 1.302
diff -c -r1.302 keymap.c
*** src/keymap.c	15 Feb 2005 06:39:18 -0000	1.302
--- src/keymap.c	28 Feb 2005 22:43:29 -0000
***************
*** 440,446 ****
    /* SUBMAP is a cons that we found as a key binding.
       Discard the other things found in a menu key binding.  */
  
!   submap = get_keymap (get_keyelt (submap, 0), 0, 0);
  
    /* If it isn't a keymap now, there's no work to do.  */
    if (!CONSP (submap))
--- 440,446 ----
    /* SUBMAP is a cons that we found as a key binding.
       Discard the other things found in a menu key binding.  */
  
!   submap = get_keymap (get_keyelt (submap, 0, 0), 0, 0);
  
    /* If it isn't a keymap now, there's no work to do.  */
    if (!CONSP (submap))
***************
*** 634,645 ****
  	/* If we found a binding, clean it up and return it.  */
  	if (!EQ (val, Qunbound))
  	  {
  	    if (EQ (val, Qt))
  	      /* A Qt binding is just like an explicit nil binding
  		 (i.e. it shadows any parent binding but not bindings in
  		 keymaps of lower precedence).  */
  	      val = Qnil;
! 	    val = get_keyelt (val, autoload);
  	    if (KEYMAPP (val))
  	      fix_submap_inheritance (map, idx, val);
  	    RETURN_UNGCPRO (val);
--- 634,648 ----
  	/* If we found a binding, clean it up and return it.  */
  	if (!EQ (val, Qunbound))
  	  {
+ 	    Lisp_Object menu_string = Qnil;
  	    if (EQ (val, Qt))
  	      /* A Qt binding is just like an explicit nil binding
  		 (i.e. it shadows any parent binding but not bindings in
  		 keymaps of lower precedence).  */
  	      val = Qnil;
! 	    val = get_keyelt (val, autoload, &menu_string);
! 	    if (SYMBOLP (idx) && !NILP (menu_string))
! 	      Fput (idx, Qmenu_item, menu_string);
  	    if (KEYMAPP (val))
  	      fix_submap_inheritance (map, idx, val);
  	    RETURN_UNGCPRO (val);
***************
*** 647,653 ****
  	QUIT;
        }
      UNGCPRO;
!     return get_keyelt (t_binding, autoload);
    }
  }
  
--- 650,656 ----
  	QUIT;
        }
      UNGCPRO;
!     return get_keyelt (t_binding, autoload, 0);
    }
  }
  
***************
*** 749,755 ****
      Fsignal (Qinvalid_function, Fcons (function, Qnil));
    if (! NILP (sort_first))
      return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
!       
    map_keymap (keymap, map_keymap_call, function, NULL, 1);
    return Qnil;
  }
--- 752,758 ----
      Fsignal (Qinvalid_function, Fcons (function, Qnil));
    if (! NILP (sort_first))
      return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
! 
    map_keymap (keymap, map_keymap_call, function, NULL, 1);
    return Qnil;
  }
***************
*** 767,775 ****
     that are referred to with indirection.  */
  
  Lisp_Object
! get_keyelt (object, autoload)
       Lisp_Object object;
       int autoload;
  {
    while (1)
      {
--- 770,779 ----
     that are referred to with indirection.  */
  
  Lisp_Object
! get_keyelt (object, autoload, menu_string)
       Lisp_Object object;
       int autoload;
+      Lisp_Object *menu_string;
  {
    while (1)
      {
***************
*** 791,796 ****
--- 795,803 ----
  	    {
  	      Lisp_Object tem;
  
+ 	      if (menu_string)
+ 		*menu_string = XCAR (XCDR (object));
+ 
  	      object = XCDR (XCDR (object));
  	      tem = object;
  	      if (CONSP (object))
***************
*** 819,824 ****
--- 826,834 ----
  	 will be used by HierarKey menus.  */
        else if (STRINGP (XCAR (object)))
  	{
+ 	  if (menu_string)
+ 	    *menu_string = XCAR (object);
+ 
  	  object = XCDR (object);
  	  /* Also remove a menu help string, if any,
  	     following the menu item name.  */
***************
*** 1222,1245 ****
    register int idx;
    register Lisp_Object cmd;
    register Lisp_Object c;
!   int length;
    int t_ok = !NILP (accept_default);
    struct gcpro gcpro1, gcpro2;
  
    GCPRO2 (keymap, key);
    keymap = get_keymap (keymap, 1, 1);
  
    if (!VECTORP (key) && !STRINGP (key))
      key = wrong_type_argument (Qarrayp, key);
  
    length = XFASTINT (Flength (key));
!   if (length == 0)
      RETURN_UNGCPRO (keymap);
  
!   idx = 0;
    while (1)
      {
        c = Faref (key, make_number (idx++));
  
        if (CONSP (c) && lucid_event_type_list_p (c))
  	c = Fevent_convert_list (c);
--- 1232,1267 ----
    register int idx;
    register Lisp_Object cmd;
    register Lisp_Object c;
!   Lisp_Object key2 = Qnil;
!   int length, length2 = 0, consumed = 0;
    int t_ok = !NILP (accept_default);
    struct gcpro gcpro1, gcpro2;
  
    GCPRO2 (keymap, key);
    keymap = get_keymap (keymap, 1, 1);
  
+   /* Hack for passing Fkey_description prefix and keys in one arg.  */
+   if (CONSP (key))
+     {
+       key2 = XCDR (key);
+       key = XCAR (key);
+       if (!VECTORP (key2) && !STRINGP (key2))
+ 	key2 = wrong_type_argument (Qarrayp, key2);
+       length2 = XFASTINT (Flength (key2));
+     }
+ 
    if (!VECTORP (key) && !STRINGP (key))
      key = wrong_type_argument (Qarrayp, key);
  
    length = XFASTINT (Flength (key));
!   if (length + length2 == 0)
      RETURN_UNGCPRO (keymap);
  
!   idx = consumed = 0;
    while (1)
      {
        c = Faref (key, make_number (idx++));
+       consumed++;
  
        if (CONSP (c) && lucid_event_type_list_p (c))
  	c = Fevent_convert_list (c);
***************
*** 1254,1265 ****
  	error ("Key sequence contains invalid event");
  
        cmd = access_keymap (keymap, c, t_ok, 0, 1);
!       if (idx == length)
! 	RETURN_UNGCPRO (cmd);
  
        keymap = get_keymap (cmd, 0, 1);
        if (!CONSP (keymap))
! 	RETURN_UNGCPRO (make_number (idx));
  
        QUIT;
      }
--- 1276,1293 ----
  	error ("Key sequence contains invalid event");
  
        cmd = access_keymap (keymap, c, t_ok, 0, 1);
!       if (idx == length) {
! 	if (NILP (key2))
! 	  RETURN_UNGCPRO (cmd);
! 	key = key2;
! 	key2 = Qnil;
! 	length = length2;
! 	idx = 0;
!       }
  
        keymap = get_keymap (cmd, 0, 1);
        if (!CONSP (keymap))
! 	RETURN_UNGCPRO (make_number (consumed));
  
        QUIT;
      }
***************
*** 1781,1787 ****
  {
    Lisp_Object tem;
  
!   cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
    if (NILP (cmd))
      return;
  
--- 1809,1815 ----
  {
    Lisp_Object tem;
  
!   cmd = get_keymap (get_keyelt (cmd, 0, 0), 0, 0);
    if (NILP (cmd))
      return;
  
***************
*** 1985,1990 ****
--- 2013,2022 ----
    Lisp_Object sep = build_string (" ");
    Lisp_Object key;
    int add_meta = 0;
+   int menu_binding = !EQ (prefix, Qt) ? 0 : -1;
+ 
+   if (menu_binding < 0)
+     prefix = Qnil;
  
    if (!NILP (prefix))
      size += XINT (Flength (prefix));
***************
*** 2065,2070 ****
--- 2097,2135 ----
  	  add_meta = 1;
  	  continue;
  	}
+       if (menu_binding > 0)
+ 	{
+ 	  Lisp_Object head = EVENT_HEAD (key);
+ 	  Lisp_Object menu_string;
+ 
+ 	  if (SYMBOLP (head)
+ 	      && (menu_string = Fget (key, Qmenu_item),
+ 		  STRINGP (menu_string)))
+ 	    {
+ 	      args[len++] = menu_string;
+ 	      args[len++] = sep;
+ 	      continue;
+ 	    }
+ 	}
+       else if (menu_binding == 0)
+ 	{
+ 	  if (EQ (key, Qmenu_bar)
+ 	      || (CONSP (key) && EQ (XCAR (key), Qmenu_bar)))
+ 	    {
+ 	      /* Let Fkey_binding fill menu-item strings.  */
+ 
+ 	      /* Fkey_binding may GC, Fkey_description may not!  */
+ 	      int count = inhibit_garbage_collection ();
+ 	      (void) Fkey_binding (!NILP (keys) ? Fcons (list, keys) : list,
+ 				   Qnil, Qt);
+ 	      unbind_to (count, Qnil);
+ 	      sep = build_string ("=>");
+ 	      menu_binding = 1;
+ 	      continue;
+ 	    }
+ 	  menu_binding = -1;
+ 	}
+ 
        args[len++] = Fsingle_key_description (key, Qnil);
        args[len++] = sep;
      }
***************
*** 2418,2423 ****
--- 2483,2489 ----
    sequences = Qnil;
  
    for (; !NILP (maps); maps = Fcdr (maps))
+ 
      {
        /* Key sequence to reach map, and the map that it reaches */
        register Lisp_Object this, map, tem;
***************
*** 2740,2749 ****
       int nomenus, last_is_meta;
  {
    Lisp_Object sequence;
  
    /* Search through indirections unless that's not wanted.  */
    if (NILP (noindirect))
!     binding = get_keyelt (binding, 0);
  
    /* End this iteration if this element does not match
       the target.  */
--- 2806,2816 ----
       int nomenus, last_is_meta;
  {
    Lisp_Object sequence;
+   Lisp_Object menu_string = Qnil;
  
    /* Search through indirections unless that's not wanted.  */
    if (NILP (noindirect))
!     binding = get_keyelt (binding, 0, &menu_string);
  
    /* End this iteration if this element does not match
       the target.  */
***************
*** 2761,2767 ****
        Faset (sequence, last, make_number (XINT (key) | meta_modifier));
      }
    else
!     sequence = append_key (this, key);
  
    if (!NILP (where_is_cache))
      {
--- 2828,2841 ----
        Faset (sequence, last, make_number (XINT (key) | meta_modifier));
      }
    else
!     {
!       if (SYMBOLP (key) && !NILP (menu_string))
! 	Fput (key, Qmenu_item, menu_string);
!       else if (CONSP (definition) &&
! 	       CONSP (XCDR (definition)) && STRINGP (XCAR (XCDR (definition))))
! 	Fput (key, Qmenu_item, XCAR (XCDR (definition)));
!       sequence = append_key (this, key);
!     }
  
    if (!NILP (where_is_cache))
      {
***************
*** 3195,3201 ****
  	  if (nomenu && EQ (event, Qmenu_bar))
  	    continue;
  
! 	  definition = get_keyelt (XCDR (XCAR (tail)), 0);
  
  	  /* Don't show undefined commands or suppressed commands.  */
  	  if (NILP (definition)) continue;
--- 3269,3275 ----
  	  if (nomenu && EQ (event, Qmenu_bar))
  	    continue;
  
! 	  definition = get_keyelt (XCDR (XCAR (tail)), 0, 0);
  
  	  /* Don't show undefined commands or suppressed commands.  */
  	  if (NILP (definition)) continue;
***************
*** 3434,3443 ****
  	    continue;
  
  	  definition
! 	    = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
  	}
        else
! 	definition = get_keyelt (AREF (vector, i), 0);
  
        if (NILP (definition)) continue;
  
--- 3508,3517 ----
  	    continue;
  
  	  definition
! 	    = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0, 0);
  	}
        else
! 	definition = get_keyelt (AREF (vector, i), 0, 0);
  
        if (NILP (definition)) continue;
  
***************
*** 3582,3595 ****
  	    limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
  
  	  while (i + 1 < limit
! 		 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
  		     !NILP (tem2))
  		 && !NILP (Fequal (tem2, definition)))
  	    i++;
  	}
        else
  	while (i + 1 < to
! 	       && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
  		   !NILP (tem2))
  	       && !NILP (Fequal (tem2, definition)))
  	  i++;
--- 3656,3669 ----
  	    limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
  
  	  while (i + 1 < limit
! 		 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0, 0),
  		     !NILP (tem2))
  		 && !NILP (Fequal (tem2, definition)))
  	    i++;
  	}
        else
  	while (i + 1 < to
! 	       && (tem2 = get_keyelt (AREF (vector, i + 1), 0, 0),
  		   !NILP (tem2))
  	       && !NILP (Fequal (tem2, definition)))
  	  i++;

Index: src/keymap.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/keymap.h,v
retrieving revision 1.11
diff -c -r1.11 keymap.h
*** src/keymap.h	21 Feb 2005 13:39:53 -0000	1.11
--- src/keymap.h	28 Feb 2005 22:43:50 -0000
***************
*** 35,41 ****
  EXFUN (Fwhere_is_internal, 5);
  EXFUN (Fcurrent_active_maps, 1);
  extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, int));
! extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
  extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int));
  extern void describe_map_tree P_ ((Lisp_Object, int, Lisp_Object, Lisp_Object,
  				   char *, int, int, int, int));
--- 35,41 ----
  EXFUN (Fwhere_is_internal, 5);
  EXFUN (Fcurrent_active_maps, 1);
  extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, int));
! extern Lisp_Object get_keyelt P_ ((Lisp_Object, int, Lisp_Object *));
  extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int));
  extern void describe_map_tree P_ ((Lisp_Object, int, Lisp_Object, Lisp_Object,
  				   char *, int, int, int, int));

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: Tweak to key-description for menu bindings

[Kim F. Storm]

David Kastrup <dak@gnu.org> writes:

>> New:
>> Options=>Mule (Multilingual Environment)=>Set Coding Systems=>For Next Command
>>
>>
>> Shall I install this?
>
> My vote is "yes".  

So far, only two votes in favour -- and one against.

>                    However, I would also want to suggest that such
> pretty-printed key sequences can, as some sort of a general principle,
> be passed to the kbd macro 

Would be nice, but it is very hard to do.

Whereas kbd can easily parse <menu-bar> <bla> <bla> <bla> into a
vector [menu-bar bla bla bla], there is no easy way to parse Bla
This=>Bla That=>Bla Bla into the same vector without actually looking
up those strings in the keymaps -- and we don't currently have C-level
functions to do that, so we would have to implement a lot of the
keymap lookup code in Lisp to support that.

>                            to make a target for define-key, so that
> the developer can be spared having to switch on his brain as often as
> possible.  I don't know how feasible this is as kbd is a macro, and
> the lookup could depend on the keymaps currently active or something.

This is addressed in the patch I posted yesterday:

If you enter C-h k <...select a menu item...> to look at a menu entry,
the resulting *Help* buffer contains a line

Menu binding: <menu-bar> <bla> <bla> <bla>

that the user-with-switched-off-brain can copy/paste into a kbd arg.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk