Re: find-aliases, where-did-you-go-little-command

[Juanma Barranquero]

On Mon, 21 Oct 2002 23:13:38 -0400, Richard Stallman <address@hidden> wrote:

> This seems like a useful feature for where-is.

Here's a first cut at an implementation.

Points to take into account:

1.- I've put a variable `where-is-show-aliases' to activate the new
behavior. In the code below it is set to t, but perhaps nil would be a
better default.

2.- The output format is not very elaborated. Better suggestions very
welcome.

3.- Same, and more so, for the "insert" behavior of `where-is'.

Comments?

Thanks,

                                                           /L/e/k/t/u




(eval-when-compile
 (require 'cl))

(defcustom where-is-show-aliases t
  "*Whether `where-is' must also show keybindings for aliases."
  :type 'boolean
  :group 'help
  :version "21.4")

(defun where-is (definition &optional insert)
  "Print message listing key sequences that invoke the command DEFINITION.
Argument is a command definition, usually a symbol with a function definition.
If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
If `where-is-show-aliases is non-nil, show also keybindings for aliases of 
DEFINITION."
  (interactive
   (let ((fn (function-called-at-point))
         (enable-recursive-minibuffers t)
         val)
     (setq val (completing-read (if fn
                                    (format "Where is command (default %s): " 
fn)
                                  "Where is command: ")
                                obarray 'commandp t))
     (list (if (equal val "")
               fn (intern val))
           current-prefix-arg)))
  (let ((func (indirect-function definition))
        (map nil)
        (standard-output (if insert (current-buffer) t)))
    (when where-is-show-aliases
      (mapatoms #'(lambda (symbol)
                    (when (and (not (eq symbol definition))
                               (eq func (ignore-errors (indirect-function 
symbol))))
                      (setq map (cons symbol map))))))
    (princ (mapconcat #'(lambda (symbol)
                          (let* ((remapped (remap-command symbol))
                                 (keys (mapconcat 'key-description
                                                  (where-is-internal symbol 
overriding-local-map nil nil remapped)
                                                  ", ")))
                            (if insert
                                (if (> (length keys) 0)
                                    (if remapped
                                        (format "%s (%s) (remapped from %s)" 
keys remapped symbol)
                                      (format "%s (%s)" keys symbol))
                                  (format "M-x %s RET" symbol))
                              (if (> (length keys) 0)
                                  (if remapped
                                      (format "%s is remapped to %s which is on 
%s" definition symbol keys)
                                    (format "%s is on %s" symbol keys))
                                (format "%s is not on any key" symbol)))))
                      (cons definition map)
                      ";\nand "))))