home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / execcmd.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  4.5 KB  |  116 lines
  1. ;From ark1!nap1!ames!xanth!talos!kjones Tue Jan  2 13:09:19 1990
  2. ;Article 1108 of comp.emacs:
  3. ;Xref: ark1 comp.emacs:1108 gnu.emacs:884
  4. ;Path: ark1!nap1!ames!xanth!talos!kjones
  5. ;>From kjones@talos.uu.net (Kyle Jones)
  6. ;Newsgroups: comp.emacs,gnu.emacs,alt.sources
  7. ;Subject: execcmd.el for GNU Emacs
  8. ;Message-ID: <1989Dec29.141023.28538@talos.uu.net>
  9. ;Date: 29 Dec 89 14:10:23 GMT
  10. ;Reply-To: kjones@talos.uu.net
  11. ;Followup-To: comp.emacs
  12. ;Lines: 101
  13. ;
  14. ;execcmd.el is a drop-in replacement execute-extended-command that tries
  15. ;to discover what key sequence invoked it (instead of just printing
  16. ;"M-x"), and reports the keys to which the subsequently executed command
  17. ;is bound.  Installation instructions are in the comments at the top of
  18. ;the file.
  19. ;
  20. ;----------------
  21. ;;; Replacement for execute-extended-command in GNU Emacs
  22. ;;; Copyright (C) 1989 Kyle E. Jones
  23. ;;;
  24. ;;; This program is free software; you can redistribute it and/or modify
  25. ;;; it under the terms of the GNU General Public License as published by
  26. ;;; the Free Software Foundation; either version 1, or (at your option)
  27. ;;; any later version.
  28. ;;;
  29. ;;; This program is distributed in the hope that it will be useful,
  30. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  31. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  32. ;;; GNU General Public License for more details.
  33. ;;;
  34. ;;; A copy of the GNU General Public License can be obtained from this
  35. ;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
  36. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  37. ;;; 02139, USA.
  38. ;;;
  39. ;;; Send bug reports to kyle@cs.odu.edu.
  40.  
  41. ;; Save this file as "execcmd.el" in a Lisp directory that Emacs knows about
  42. ;; (i.e. via load-path).  Byte-compile it.
  43. ;;
  44. ;; This package is autoloadable.  Use
  45. ;;    (fmakunbound 'execute-extended-command)
  46. ;;    (autoload 'execute-extended-command "execcmd" nil t)
  47. ;; in your .emacs file.
  48. ;;
  49. ;; Thanks go to Evan Bigall (evan@plx.UUCP) for the neat idea of having
  50. ;; execute-extended-command report the key bindings of the commands it
  51. ;; executes.
  52.  
  53. (defun execute-extended-command (command &optional prefix-argument)
  54.   "Reads an interactive command name, and then calls the command interactively.
  55. If a prefix argument is supplied to this function, it will be passed
  56. appropriately to the command being called.
  57.  
  58. After the command call returns, the current keymaps are searched for this
  59. command.  If the command is bound to any keys, these are reported in the
  60. echo area."
  61.   (interactive
  62.    (let ((prompt (this-command-keys)))
  63.      (if current-prefix-arg
  64.      (let* ((i (length prompt))
  65.         (key (substring prompt i)))
  66.        (while (and (/= i 0) (not (eq (key-binding key) this-command)))
  67.          (setq i (1- i) key (substring prompt i)))
  68.        (setq prompt
  69.          (if (zerop i)
  70.              (where-is-internal this-command (current-local-map) t)
  71.            key )
  72.          prompt (or prompt ":")
  73.          prompt (concat (meta-key-description prompt) " ")
  74.          prompt
  75.          (cond ((consp current-prefix-arg)
  76.             (concat "(" (int-to-string (car current-prefix-arg))
  77.                 ") " prompt))
  78.                ((symbolp current-prefix-arg)
  79.             (concat (symbol-name current-prefix-arg) " " prompt))
  80.                (t
  81.             (concat (int-to-string current-prefix-arg)
  82.                 " " prompt)))))
  83.        (if (not (eq (key-binding prompt) this-command))
  84.        (setq prompt (where-is-internal this-command (current-local-map)
  85.                        t )))
  86.        (setq prompt (concat (meta-key-description prompt) " ")))
  87.      (list (read-command prompt) current-prefix-arg)))
  88.   (setq this-command command)
  89.   (and (interactive-p) (setq command-history (cdr command-history)))
  90.   (let ((prefix-arg prefix-argument)
  91.     (keys (append (where-is-internal command (current-local-map)))))
  92.     (command-execute command t)
  93.     (if (and (interactive-p) (sit-for 1) keys)
  94.     (message "%s is on %s" command
  95.          (mapconcat 'meta-key-description keys " , ")))))
  96.  
  97. (defun meta-key-description (keys)
  98.   "Works like key-description except that sequences containing
  99. meta-prefix-char that can be expressed meta sequences, are.
  100. E.g. `\"\\ea\" becomes \"M-a\".
  101.  
  102. If the ambient value of meta-flag in nil, this function is equivalent to
  103. key-description."
  104.   (if (not (and meta-flag (numberp meta-prefix-char)))
  105.       (key-description keys)
  106.     (let (pattern start)
  107.       (setq pattern (concat (char-to-string meta-prefix-char) "[\000-\177]"))
  108.       (while (string-match pattern keys start)
  109.     (setq keys
  110.           (concat
  111.            (substring keys 0 (match-beginning 0))
  112.            (char-to-string (logior (aref keys (1- (match-end 0))) 128))
  113.            (substring keys (match-end 0)))
  114.           start (match-beginning 0)))
  115.       (key-description keys))))
  116.