Re: tweak to apropos-command display

[Kim F. Storm]

Richard Stallman <address@hidden> 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 <address@hidden> http://www.cua.dk