1 ;;; key-cat.el --- List key bindings by category
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: Sat Jan 28 2006
6 ;; Last-Updated: 2009-05-09 Sat
12 ;; Features that might be required by this library:
16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20 ;; Display help that looks like a reference sheet for common
23 ;; To use this in your .emacs put
27 ;; Then use the command
31 ;; For more information see that command.
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40 ;; This program is free software; you can redistribute it and/or modify
41 ;; it under the terms of the GNU General Public License as published by
42 ;; the Free Software Foundation; either version 2, or (at your option)
45 ;; This program is distributed in the hope that it will be useful,
46 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
47 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
48 ;; GNU General Public License for more details.
50 ;; You should have received a copy of the GNU General Public License
51 ;; along with this program; see the file COPYING. If not, write to the
52 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
53 ;; Boston, MA 02111-1307, USA.
55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
59 (eval-when-compile (require 'cl))
61 (defconst key-cat-cmd-list
76 ("Special Functions and Keys"
77 ;; For similar functions that are most often bound to a specific key
83 ("Files, Buffers and Windows"
88 split-window-vertically
89 split-window-horizontally
99 isearch-forward-regexp
100 isearch-backward-regexp
108 move-beginning-of-line
134 (and (featurep 'viper)
145 viper-next-line-at-bol
146 viper-previous-line-at-bol
147 viper-command-argument
151 "List with common commands to display by `key-cat-help'.
152 The elements of this list corresponds to sections to show in the
153 help. Each element consists of sublists beginning with the
154 keyword 'commands. The sublists may after 'command contain the
155 keyword :visible which takes a variable or function as argument.
156 If the argument evaluates to non-nil the list is shown."
160 (defvar key-cat-cmd-list-1 nil)
162 (defun key-cat-help()
163 "Display reference sheet style help for common commands.
164 See also `key-cat-cmd-list'."
166 (if (> 22 emacs-major-version)
167 (message "Sorry, this requires Emacs 22 or later")
168 ;; Delay to get correct bindings when running through M-x
169 (setq key-cat-cmd-list-1 key-cat-cmd-list)
170 (run-with-timer 0.1 nil 'key-cat-help-internal)))
172 (defun key-cat-help-internal() ;(category)
173 (message "Please wait ...")
175 (save-match-data ;; runs in timer
177 (help-setup-xref (list #'key-cat-help)
179 ;; (push (list "Changing commands"
182 ;; indent-line-function
184 ;; key-cat-cmd-list-1)
185 (dolist (catentry key-cat-cmd-list-1)
186 (let ((category (car catentry))
187 (commands (cdr catentry))
194 (dolist (cmdlist commands)
195 (setq cmdlist (cdr cmdlist))
197 (while (keywordp (setq keyw (car cmdlist)))
198 (setq cmdlist (cdr cmdlist))
200 (:visible (setq visible-fun (pop cmdlist))
201 (setq visible (if (symbolp visible-fun)
203 (symbol-value visible-fun))
204 (funcall visible-fun)))
208 (dolist (cmd cmdlist)
209 (setq cmds (cons cmd cmds)))))
211 (push (format "\n%s:\n"
212 (let ((s (format "%s" category)))
213 (put-text-property 0 (length s)
220 (setq cmds (reverse cmds))
223 (let ((s "Where to find it:" ))
224 (put-text-property 0 (length s)
225 'face '(:slant italic
226 :background "RGB:dd/dd/ff"
228 (if (not (functionp cmd))
230 ((eq 'key-cat-tab cmd)
231 (let ((s "Indent line"))
232 (put-text-property 0 (length s) 'face '(:foreground "blue") s)
237 "Indent current line (done by specific major mode function).\n")
239 (push (format " %17s %s\n" cmdstr (key-description [tab])) result)
241 ((eq 'key-cat-complete cmd)
242 (let ((s "Completion"))
243 (put-text-property 0 (length s) 'face '(:foreground "blue") s)
248 "Performe completion at point (done by specific major mode function).\n")
250 (push (format " %17s %s\n" cmdstr (key-description [meta tab])) result)
253 (let ((s (format "`%s': (not a function)\n" cmd)))
254 (put-text-property 0 (length s) 'face '(:foreground "red") s)
256 (let ((keys (key-cat-where-is cmd)))
257 (push (format "`%s':\n" cmd) result)
258 (setq doc (documentation cmd t))
263 (substring doc 0 (string-match "\n" doc))
268 (if (interactive-form cmd)
269 (push (format " %17s M-x %s\n" cmdstr cmd) result)
270 (let ((s "(not an interactive command)"))
271 (put-text-property 0 (length s) 'face '(:foreground "red") s)
272 (push (format " %17s %s\n" cmdstr s) result)))
274 (push (format " %17s " cmdstr) result)
276 (if (eq (elt key 0) 'xmenu-bar)
278 (key-description key)))
280 (setq cmdstr ""))))))))
282 (with-current-buffer (help-buffer)
283 (with-output-to-temp-buffer (help-buffer)
285 (let ((s "Some important commands\n"))
286 (put-text-property 0 (length s)
289 :foreground "RGB:00/00/66") s)
291 (setq result (reverse result))
296 (error (message "%s" (error-message-string err)))))
298 ;; Mostly copied from `where-is':
299 (defun key-cat-where-is (definition)
300 "Return key sequences that invoke the command DEFINITION.
301 Argument is a command definition, usually a symbol with a function definition."
302 (let ((func (indirect-function definition))
305 ;; In DEFS, find all symbols that are aliases for DEFINITION.
306 (mapatoms (lambda (symbol)
307 (and (fboundp symbol)
308 (not (eq symbol definition))
309 (eq func (condition-case ()
310 (indirect-function symbol)
312 (push symbol defs))))
313 ;; Look at all the symbols--first DEFINITION,
315 (dolist (symbol (cons definition defs))
316 (let* ((remapped (command-remapping symbol))
317 (keys (where-is-internal
318 ;;symbol overriding-local-map nil nil remapped)))
319 symbol nil nil nil remapped)))
322 (setq all-keys (cons key all-keys))))))
328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
329 ;;; key-cat.el ends here