mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-21 5ddac8bd2392ec5b64392e8750d725029bf5aa79
commit | author | age
5cb5f7 1 ;;; guide-key.el --- Guide the following key bindings automatically and dynamically
C 2
3 ;; Copyright (C) 2012, 2013 Tsunenobu Kai
4
5 ;; Author: Tsunenobu Kai <kai2nenobu@gmail.com>
6 ;; URL: https://github.com/kai2nenobu/guide-key
7 ;; Package-Version: 20150108.635
8 ;; Version: 1.2.5
9 ;; Package-Requires: ((dash "2.10.0") (popwin "0.3.0") (s "1.9.0"))
10 ;; Keywords: help convenience
11
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; Overview:
28 ;;
29 ;; guide-key.el displays the available key bindings automatically and dynamically.
30 ;; guide-key aims to be an alternative of one-key.el.
31 ;;
32 ;; Here are some features of this library.
33 ;; - guide-key automatically pops up the keys following your favorite
34 ;;   prefixes. Moreover, even if you change key bindings, guide-key follows the
35 ;;   change dynamically.
36 ;; - guide-key can highlight particular commands. This makes it easy to find a
37 ;;   command you are looking for, and to learn its key binding.
38 ;; - guide-key doesn't overwrite existing commands and key bindings, so there
39 ;;   is no interference with `describe-key' and `describe-bindings'.
40 ;;
41 ;;
42 ;; Installation:
43 ;;
44 ;; I added guide-key to MELPA. You can install guide-key with package.el.
45 ;; Because guide-key depends on popwin.el, popwin.el is also installed.
46 ;;
47 ;; If you don't have package.el, please download popwin.el and guide-key.el
48 ;; directly from https://github.com/m2ym/popwin-el and
49 ;; https://github.com/kai2nenobu/guide-key, and then put them in your
50 ;; `load-path'.
51 ;;
52 ;;
53 ;; Basic usage:
54 ;;
55 ;; You just add your favorite prefix keys to `guide-key/guide-key-sequence'
56 ;; as below.
57 ;;
58 ;;   (require 'guide-key)
59 ;;   (setq guide-key/guide-key-sequence '("C-x r" "C-x 4"))
60 ;;   (guide-key-mode 1) ; Enable guide-key-mode
61 ;;
62 ;; When you press these prefix keys, key bindings are automatically
63 ;; popped up after a short delay (1 second by default).
64 ;;
65 ;; To activate guide-key for any key sequence instead of just the ones
66 ;; listed above then use:
67 ;;
68 ;;   (setq guide-key/guide-key-sequence t)
69 ;;
70 ;; guide-key can highlight commands which match a specified regular expression.
71 ;; Key bindings following "C-x r" are rectangle family, register family and
72 ;; bookmark family.  If you want to highlight only rectangle family
73 ;; commands, put this setting in your init.el.
74 ;;
75 ;;   (setq guide-key/highlight-command-regexp "rectangle")
76 ;;
77 ;; This feature makes it easy to find commands and learn their key bindings.
78 ;; If you want to highlight all families, you can specify multiple regular
79 ;; expressions and faces as below.
80 ;;
81 ;;   (setq guide-key/highlight-command-regexp
82 ;;         '("rectangle"
83 ;;           ("register" . font-lock-type-face)
84 ;;           ("bookmark" . font-lock-warning-face)))
85 ;;
86 ;; If an element of `guide-key/highlight-command-regexp' is cons, its car
87 ;; means a regular expression to highlight, and its cdr means a face put on
88 ;; command names.
89 ;;
90 ;; Moreover, prefix commands are automatically highlighted.
91 ;;
92 ;; Depending on your level of emacs experience, you may want a shorter or
93 ;; longer delay between pressing a key and the appearance of the guide
94 ;; buffer.  This can be controlled by setting `guide-key/idle-delay':
95 ;;
96 ;;   (setq guide-key/idle-delay 0.1)
97 ;;
98 ;; The guide buffer is displayed only when you pause between keystrokes
99 ;; for longer than this delay, so it will keep out of your way when you
100 ;; are typing key sequences that you already know well.
101 ;;
102 ;; I've confirmed that guide-key works well in these environments.
103 ;; - Emacs 24.2, Ubuntu 12.04 or Windows 7 64bit
104 ;; - Emacs 23.3, Ubuntu 12.04 or Windows 7 64bit
105 ;; - Emacs 22.3, Windows 7 64bit
106 ;; - Emacs 24.3.1, OS X 10.9
107 ;; If popwin works, I think guide-key will work as well. You can use
108 ;; guide-key with Emacs working in terminal.
109 ;;
110 ;;
111 ;; Advanced usage:
112 ;;
113 ;; It is bothering to add many prefixes to `guide-key/guide-key-sequence'.
114 ;; `guide-key/recursive-key-sequence-flag' releases you from this problem.
115 ;; If `guide-key/recursive-key-sequence-flag' is non-nil, guide-key checks a
116 ;; input key sequence recursively. That is, if "C-x 8 ^" is an input key
117 ;; sequence, guide-key checks whether `guide-key/guide-key-sequence' includes
118 ;; "C-x 8" and "C-x".
119 ;;
120 ;; For example, if you configure as below,
121 ;;
122 ;;   (setq guide-key/guide-key-sequence '("C-x"))
123 ;;   (setq guide-key/recursive-key-sequence-flag t)
124 ;;
125 ;; the guide buffer is popped up when you input "C-x r", "C-x 8" and
126 ;; any other prefixes following "C-x".
127 ;;
128 ;;
129 ;; You can add extra settings in a particular mode. Please use
130 ;; `guide-key/add-local-guide-key-sequence',
131 ;; `guide-key/add-local-highlight-command-regexp' and the hook of
132 ;; that mode.
133 ;;
134 ;;
135 ;; This code is a example of org-mode.
136 ;;
137 ;;   (defun guide-key/my-hook-function-for-org-mode ()
138 ;;     (guide-key/add-local-guide-key-sequence "C-c")
139 ;;     (guide-key/add-local-guide-key-sequence "C-c C-x")
140 ;;     (guide-key/add-local-highlight-command-regexp "org-"))
141 ;;   (add-hook 'org-mode-hook 'guide-key/my-hook-function-for-org-mode)
142 ;;
143 ;; In respect of `guide-key/guide-key-sequence', you can add mode specific key
144 ;; sequences without `guide-key/add-local-guide-key-sequence'. For example,
145 ;; configure as below.
146 ;;
147 ;;   (setq guide-key/guide-key-sequence
148 ;;         '("C-x r" "C-x 4"
149 ;;           (org-mode "C-c C-x")
150 ;;           (outline-minor-mode "C-c @")))
151 ;;
152 ;; In this case, if the current major mode is `org-mode', guide key bindings
153 ;; following "C-c C-x".  If `outline-minor-mode' is enabled, guide key bindings
154 ;; following "C-c @".
155 ;;
156 ;;
157 ;; `guide-key' can work with key-chord.el.  If you want to guide key bindings
158 ;; following key chord, you need to execute
159 ;; `guide-key/key-chord-hack-on'.  Then, add your favorite key chord to
160 ;; `guide-key/guide-key-sequence' as below.
161 ;;
162 ;;   (key-chord-define global-map "@4" 'ctl-x-4-prefix)
163 ;;
164 ;;   (guide-key/key-chord-hack-on)
165 ;;   (setq guide-key/guide-key-sequence '("<key-chord> @ 4" "<key-chord> 4 @"))
166 ;;
167 ;; If =guide-key/recursive-key-sequence-flag= is non-nil, more simple.
168 ;;
169 ;;   (guide-key/key-chord-hack-on)
170 ;;   (setq guide-key/recursive-key-sequence-flag t)
171 ;;   (setq guide-key/guide-key-sequence '("<key-chord>"))
172 ;;
173 ;; In this case, key bindings are popped up when you type any of key chords.
174 ;;
175 ;; This hack *may be dangerous* because it advices primitive functions;
176 ;; `this-command-keys' and `this-command-keys-vector'.
177 ;;
178 ;;
179 ;; Here are some functions and variables which control guide-key.
180 ;; - `guide-key-mode':
181 ;;   guide-key-mode is implemented as a minor mode.
182 ;;   Excuting M-x guide-key-mode toggles whether guide-key is enabled or
183 ;;   not.  Because guide-key-mode is a global minor mode, guide-key-mode is
184 ;;   enabled in all buffers or disabled in all buffers.
185 ;; - `guide-key/popup-window-position':
186 ;;   This variable controls where a guide-key buffer is popped up. A value of
187 ;;   this variable is one of `right', `bottom', `left', `top'. The default
188 ;;   value is `right'.
189 ;; - `guide-key/polling-time':
190 ;;   This variable controls a polling time. The default value is 0.1 (in seconds).
191 ;; - `guide-key/idle-delay':
192 ;;   This variable controls the delay between starting a key sequence and
193 ;;   popping up the guide buffer. The default value is 1.0 (in seconds),
194 ;;   which means that guide-key will keep out of your way unless you hesitate
195 ;;   in the middle of a key sequence .  Set this to 0.0 to revert to the old
196 ;;   default behavior.
197 ;; - `guide-key/text-scale-amount':
198 ;;   This variable controls the size of text in guide buffer. The default
199 ;;   value is 0 (it means default size in Emacs). If you want to enlarge
200 ;;   text, set positive number. Otherwise, set negative number.
201 ;;
202 ;; Enjoy!
203
204 ;;; Code:
205
206 (eval-when-compile
207   (require 'cl)
208   (require 'face-remap))
209
210 (require 'dash)
211 (require 'popwin)
212 (require 's)
213
214 ;;; variables
215 (defgroup guide-key nil
216   "Guide key bidings."
217   :group 'help
218   :prefix "guide-key/")
219
220 (defcustom guide-key/guide-key-sequence nil
221   "*Key sequences to guide in `guide-key-mode'.
222 This variable is a list of string representation.
223 Both representations, like \"C-x r\" and \"\\C-xr\",
224 are allowed.
225
226 In addition, an element of this list can be a list whose car is
227 the symbol for a certain mode, and whose cdr is a list of key
228 sequences to consider only if that mode is active.
229
230 Set this variable to `t' to enable for any key sequence."
231   :type '(repeat (choice (string :tag "Prefix key sequence")
232                          (cons :tag "Mode specific sequence"
233                                (symbol :tag "Symbol for mode")
234                                (repeat (string :tag "Prefix key sequence")))))
235   :group 'guide-key)
236
237 (defcustom guide-key/polling-time 0.1
238   "*Polling time to check an input key sequence."
239   :type 'float
240   :group 'guide-key)
241
242 (defcustom guide-key/idle-delay 1.0
243   "*Delay in seconds before guide buffer is displayed."
244   :type 'float
245   :group 'guide-key)
246
247 (defcustom guide-key/highlight-prefix-regexp "prefix"
248   "*Regexp for prefix commands."
249   :type 'regexp
250   :group 'guide-key)
251
252 (defcustom guide-key/highlight-command-regexp nil
253   "*Regexp for commands to highlight.
254 If a command name matches this regexp, it is highlighted with
255 `guide-key/highlight-command-face'.
256
257 This variable can be a list and its element is either a regexp or
258 a cons cell, its car is a regexp and its cdr is face symbol or
259 color name string.  If regexp, commands which match the regexp
260 are highlighted with `guide-key/highlight-command-face'.  If cons
261 cell, commands which match the car regexp are highlighted with
262 the cdr face or color."
263   :type '(choice (regexp :tag "Regexp to highlight")
264                  (repeat (choice (regexp :tag "Regexp to highlight")
265                                  (cons (regexp :tag "Regexp to highlight")
266                                        (choice (face   :tag "Face on command")
267                                                (string :tag "Color name string"))))))
268   :group 'guide-key)
269
270 (defcustom guide-key/align-command-by-space-flag nil
271   "*If non-nil, align guide buffer by space."
272   :type 'boolean
273   :group 'guide-key)
274
275 (defcustom guide-key/popup-window-position 'right
276   "*Position where guide buffer is popped up.
277 This variable must be one of `right', `bottom', `left' and `top'."
278   :type '(radio (const right) (const bottom) (const left) (const top))
279   :group 'guide-key)
280
281 (defcustom guide-key/text-scale-amount 0
282   "*Amount of scaling text in guide buffer.
283
284 If positive number, the text becomes larger.  If negative number,
285 the text becomes smaller.  Scale of the text is detemined by the
286 value of variable `text-scale-mode-step'."
287   :type 'float
288   :group 'guide-key)
289
290 (defcustom guide-key/recursive-key-sequence-flag nil
291   "*If non-nil, check an input key sequence recursively.
292 For example, if `guide-key/guide-key-sequence' includes \"C-x\",
293 guide buffer is popped up when you input \"C-x r\", \"C-x 4\" and
294 any other prefixes following \"C-x\"."
295   :type 'boolean
296   :group 'guide-key)
297
298 (defface guide-key/prefix-command-face
299   '((((class color) (background dark))
300      (:foreground "cyan"))
301     (((class color) (background light))
302      (:foreground "blue")))
303   "Face for prefix commands to highlight"
304   :group 'guide-key)
305
306 (defface guide-key/highlight-command-face
307   '((((class color) (background dark))
308      (:foreground "yellow"))
309     (((class color) (background light))
310      (:foreground "orange red")))
311   "Face for commands to highlight"
312   :group 'guide-key)
313
314 (defface guide-key/key-face
315   '((((class color) (background dark))
316      (:foreground "red"))
317     (((class color) (background light))
318      (:foreground "dark green")))
319   "Face for keys following to a key sequence"
320   :group 'guide-key)
321
322 ;;; internal variables
323 (defvar guide-key/polling-timer nil
324   "Polling timer to check an input key sequence.")
325
326 (defvar guide-key/idle-timer nil
327   "Idle timer to wait before popping up guide buffer.")
328
329 (defvar guide-key/guide-buffer-name " *guide-key*"
330   "Buffer name of guide buffer.")
331
332 (defvar guide-key/last-key-sequence-vector nil
333   "Key sequence input at the last polling operation.")
334
335 ;; or hook
336 ;; (add-hook 'pre-command-hook 'guide-key/hook-command)
337 ;; (setq pre-command-hook nil)
338 ;; (add-hook 'post-command-hook 'guide-key/key-event)
339 ;; (add-hook 'pre-command-hook 'show-this-command)
340
341 ;;; functions
342 ;;;###autoload
343 (define-minor-mode guide-key-mode
344   "Toggle guide key mode.
345
346 In guide key mode, Guide following keys to an input key sequence
347 automatically and dynamically.
348 With a prefix argument ARG, enable guide key mode if ARG is
349 positive, otherwise disable."
350   :global t
351   :lighter " Guide"
352   (funcall (if guide-key-mode
353                'guide-key/turn-on-timer
354              'guide-key/turn-off-timer)))
355
356 (defun guide-key/popup-function (&optional input)
357   "Popup function called after delay of `guide-key/idle-delay' second."
358   (let ((key-seq (or input (this-single-command-keys)))
359         (regexp guide-key/highlight-command-regexp))
360     (let ((dsc-buf (current-buffer))
361       (max-width 0))
362       (with-current-buffer (get-buffer-create guide-key/guide-buffer-name)
363     (unless truncate-lines (setq truncate-lines t))   ; don't fold line
364     (when indent-tabs-mode (setq indent-tabs-mode nil)) ; don't use tab as white space
365     (setq mode-line-format nil)
366     (text-scale-set guide-key/text-scale-amount)
367     (erase-buffer)
368     (describe-buffer-bindings dsc-buf key-seq)
369     (when (> (guide-key/format-guide-buffer key-seq regexp) 0)
370       (guide-key/close-guide-buffer)
371       (guide-key/popup-guide-buffer))))))
372
373
374 ;;; internal functions
375 (defun guide-key/polling-function ()
376   "Polling function executed every `guide-key/polling-time' second."
377   (let ((key-seq (this-single-command-keys)))
378     (if (guide-key/popup-guide-buffer-p key-seq)
379         (when (guide-key/update-guide-buffer-p key-seq)
380           (guide-key/turn-on-idle-timer))
381       (guide-key/close-guide-buffer))
382     (setq guide-key/last-key-sequence-vector key-seq)))
383
384 (defun guide-key/popup-guide-buffer ()
385   "Pop up guide buffer at `guide-key/popup-window-position'."
386   (let ((last-config popwin:popup-last-config))
387     (apply 'popwin:popup-buffer (get-buffer guide-key/guide-buffer-name)
388            :position guide-key/popup-window-position
389            :noselect t
390            (cond ((popwin:position-horizontal-p guide-key/popup-window-position)
391                   `(:width ,(guide-key/popup-window-size 'horizontal)))
392                  ((popwin:position-vertical-p guide-key/popup-window-position)
393                   `(:height ,(guide-key/popup-window-size)))))
394     (setq popwin:popup-last-config last-config)))
395
396 (defun guide-key/popup-window-size (&optional horizontal)
397   "Return an enough height or width of popup window to display
398 all key bindings in guide buffer.
399
400 If HORIZONTAL is omitted or nil, return the height of popup
401 window.  Otherwise, return the width of popup window"
402   (with-current-buffer (get-buffer guide-key/guide-buffer-name)
403     (let ((margin (if horizontal 5 1))
404           (scale (expt text-scale-mode-step text-scale-mode-amount)))
405       (if horizontal
406           (ceiling (* scale (+ (guide-key/buffer-max-width) margin)))
407         (ceiling (* scale (+ (count-lines (point-min) (point-max)) margin))))
408       )))
409
410 (defun guide-key/close-guide-buffer ()
411   "Close guide buffer."
412   (when (eq popwin:popup-buffer (get-buffer guide-key/guide-buffer-name))
413     (popwin:close-popup-window))
414   (guide-key/turn-off-idle-timer)
415   )
416
417 (add-hook 'pre-command-hook 'guide-key/close-guide-buffer)
418
419 (defun guide-key/update-guide-buffer-p (key-seq)
420   "Return t if guide buffer should be updated."
421   (not (equal guide-key/last-key-sequence-vector key-seq)))
422
423 (defun guide-key/popup-guide-buffer-p (key-seq)
424   "Return t if guide buffer should be popped up."
425   (and (> (length key-seq) 0)
426        (or (eq guide-key/guide-key-sequence t)
427            (member key-seq (guide-key/buffer-key-sequences))
428            (and guide-key/recursive-key-sequence-flag
429                 (guide-key/popup-guide-buffer-p (guide-key/vbutlast key-seq))))))
430
431 (defun guide-key/buffer-key-sequences ()
432   "Return a list of key sequences (vector representation) in current buffer."
433   (let (lst)
434     ;; global key sequences
435     (dolist (ks guide-key/guide-key-sequence)
436       (when (stringp ks)
437         (setq lst (cons ks lst))))
438     ;; major-mode specific key sequences
439     (setq lst (append (assoc-default major-mode guide-key/guide-key-sequence) lst))
440     ;; minor-mode specific key sequences
441     (dolist (mmode minor-mode-list)
442       (when (and (boundp mmode) (symbol-value mmode))
443         (setq lst (append (assoc-default mmode guide-key/guide-key-sequence) lst))))
444     ;; convert key sequences to vector representation
445     (mapcar 'guide-key/convert-key-sequence-to-vector lst)))
446
447 (defun guide-key/vbutlast (vec &optional n)
448   "Return a copy of vector VEC with the last N elements removed."
449   (vconcat (butlast (append vec nil) n)))
450
451 (defun guide-key/convert-key-sequence-to-vector (key-seq)
452   "Convert key sequence KEY-SEQ to vector representation.
453 For example, both \"C-x r\" and \"\\C-xr\" are converted to [24 114]"
454   (vconcat (read-kbd-macro key-seq)))
455
456 (defun guide-key/turn-on-idle-timer ()
457   "Turn on an idle timer for popping up guide buffer."
458   (when (null guide-key/idle-timer)
459     (setq guide-key/idle-timer
460           (run-with-idle-timer guide-key/idle-delay t 'guide-key/popup-function))
461     ))
462
463 (defun guide-key/turn-off-idle-timer ()
464   "Turn off the idle timer."
465   (when guide-key/idle-timer
466     (cancel-timer guide-key/idle-timer))
467   (setq guide-key/idle-timer nil))
468
469
470 (defun guide-key/turn-on-timer ()
471   "Turn on a polling timer."
472   (when (null guide-key/polling-timer)
473     (setq guide-key/polling-timer
474           (run-at-time t guide-key/polling-time 'guide-key/polling-function))))
475
476 (defun guide-key/turn-off-timer ()
477   "Turn off a polling timer."
478   (cancel-timer guide-key/polling-timer)
479   (setq guide-key/polling-timer nil))
480
481 (defun guide-key/format-guide-buffer (key-seq &optional regexp)
482   "Format guide buffer. This function returns the number of following keys."
483   (let ((fkey-list nil)      ; list of (following-key space command)
484         (fkey-str-list nil)  ; fontified string of `fkey-list'
485         (fkey-list-len 0)    ; length of above lists
486         (key-dsc (key-description key-seq)))
487     (untabify (point-min) (point-max))  ; replace tab to space
488     (goto-char (point-min))
489     ;; extract following keys from buffer bindings
490     (while (re-search-forward
491             (format "^%s \\([^ \t]+\\)\\([ \t]+\\)\\(\\(?:[^ \t\n]+ ?\\)+\\)$" (regexp-quote key-dsc)) nil t)
492       (add-to-list 'fkey-list
493                    (list (match-string 1) (match-string 2) (match-string 3)) t))
494     (erase-buffer)
495     (when (> (setq fkey-list-len (length fkey-list)) 0)
496       ;; fontify following keys as string
497       (setq fkey-str-list
498             (loop for (key space command) in fkey-list
499                   collect (guide-key/fontified-string key space command regexp)))
500       ;; insert a few following keys per line
501       (guide-key/insert-following-key fkey-str-list
502                                       (popwin:position-horizontal-p guide-key/popup-window-position))
503       (goto-char (point-min)))
504     fkey-list-len))
505
506 (defun guide-key/insert-following-key (fkey-str-list horizontal)
507   "Insert a few following keys per line.
508
509 If HORIZONTAL is omitted or nil, assume that guide buffer is
510 popped up at top or bottom. Otherwise, assume that guide buffer
511 is popped up at left or right."
512   (let* ((scale (expt text-scale-mode-step text-scale-mode-amount))
513          ;; Calculate the number of items per line
514          (columns
515           (if horizontal
516               (ceiling (/ (* (length fkey-str-list) scale)
517                           (- (frame-height) (if tool-bar-mode 2 0) (if menu-bar-mode 1 0))))
518             (floor (/ (frame-width)
519                       (* (apply 'max (mapcar 'length fkey-str-list)) scale))))))
520     ;; Insert following keys by columns per line.
521     (loop for fkey-str in fkey-str-list
522           for column from 1
523           do (insert fkey-str (if (= (mod column columns) 0) "\n" " ")))
524     (align-regexp (point-min) (point-max) "\\(\\s-*\\) \\[" 1 1 t)))
525
526 (defun guide-key/fontified-string (key space command &optional regexp)
527   "Return fontified string of following key"
528   (let ((highlight-face (guide-key/get-highlight-face command regexp)))
529     (concat (propertize "[" 'face 'guide-key/key-face)
530             (if highlight-face (propertize key 'face highlight-face) key)
531             (propertize "]" 'face 'guide-key/key-face)
532             (if guide-key/align-command-by-space-flag space " ") ; white space
533             (if highlight-face (propertize command 'face highlight-face) command))))
534
535 (defun guide-key/get-highlight-face (string &optional regexp)
536   "Return an appropriate face for highlighting STRING according
537 to `guide-key/highlight-prefix-regexp' and
538 `guide-key/highlight-command-regexp'. Return nil if an
539 appropriate face is not found."
540   (let ((regexp (or regexp guide-key/highlight-command-regexp)))
541     ;; `guide-key/highlight-prefix-regexp' has the highest priority
542     (if (string-match guide-key/highlight-prefix-regexp string)
543         'guide-key/prefix-command-face
544       ;; Else look up the first match in `guide-key/highlight-command-regexp'
545       (cond ((stringp regexp)
546              (when (string-match regexp string)
547                'guide-key/highlight-command-face))
548             ((listp regexp)
549              (loop for elm in regexp
550                    if (cond ((stringp elm)
551                              (when (string-match elm string)
552                                'guide-key/highlight-command-face))
553                             ((consp elm)
554                              (when (string-match (car elm) string)
555                                (if (stringp (cdr elm))
556                                    ;; anonymous face, see (info "(elisp)Faces")
557                                    (list :foreground (cdr elm))
558                                  (cdr elm)))))
559                    return it)))
560       )))
561
562 (defun guide-key/buffer-max-width ()
563   "Return max width in current buffer."
564   (let ((buf-str (buffer-substring-no-properties (point-min) (point-max))))
565     (apply 'max (mapcar 'length (split-string buf-str "\n")))))
566
567 (defun guide-key/add-local-guide-key-sequence (key)
568   (add-to-list (make-local-variable 'guide-key/guide-key-sequence) key))
569
570 (defun guide-key/add-local-highlight-command-regexp (regexp)
571   (make-local-variable 'guide-key/highlight-command-regexp)
572   (cond ((stringp guide-key/highlight-command-regexp)
573          (setq guide-key/highlight-command-regexp
574                (list regexp guide-key/highlight-command-regexp)))
575         ((listp guide-key/highlight-command-regexp)
576          (add-to-list 'guide-key/highlight-command-regexp regexp))))
577
578 ;;; key-chord hack
579 (defadvice this-command-keys (after key-chord-hack disable)
580   "Add key chord to the key sequence returned by `this-command-keys'.
581
582 Original `this-command-keys' returns \"[key-chord]\" when you
583 type any of key chords, so it is difficult to know which key
584 chord is pressed.  This advice enables to distinguish pressed key
585 chord."
586   (condition-case nil
587       (if (equal ad-return-value [key-chord])
588           (let ((rkeys (recent-keys)))
589             (setq ad-return-value
590                   (vector 'key-chord (aref rkeys (- (length rkeys) 2))
591                           (aref rkeys (- (length rkeys) 1))))))
592     (error "")))
593
594 (defadvice this-command-keys-vector (after key-chord-hack disable)
595   "Add key chord to the key sequence returned by `this-command-keys-vector'.
596
597 Original `this-command-keys-vector' returns \"[key-chord]\" when you
598 type any of key chords, so it is difficult to know which key
599 chord is pressed.  This advice enables to distinguish pressed key
600 chord."
601   (condition-case nil
602       (if (equal ad-return-value [key-chord])
603           (let ((rkeys (recent-keys)))
604             (setq ad-return-value
605                   (vector 'key-chord (aref rkeys (- (length rkeys) 2))
606                           (aref rkeys (- (length rkeys) 1))))))
607     (error [])))
608
609 (defun guide-key/key-chord-hack-on ()
610   "Turn on key-chord hack of guide-key.
611
612 This hack *may be dangerous* because it advices primitive
613 functions; this-command-keys and this-command-keys-vector."
614   (interactive)
615   (dolist (fn '(this-command-keys this-command-keys-vector))
616     (ad-enable-advice fn 'after 'key-chord-hack)
617     (ad-activate fn))
618   (message "Turn on key-chord hack of guide-key"))
619
620 (defun guide-key/key-chord-hack-off ()
621   "Turn off key-chord hack of guide-key."
622   (interactive)
623   (dolist (fn '(this-command-keys this-command-keys-vector))
624     (ad-disable-advice fn 'after 'key-chord-hack)
625     (ad-activate fn))
626   (message "Turn off key-chord hack of guide-key"))
627
628 ;;; debug
629 (defun guide-key/message-events ()
630   ""
631   (message (format "lce:%S tck:%S tckv:%S tsck:%S lie:%S uce:%S"
632                    last-command-event
633                    (this-command-keys)
634                    (this-command-keys-vector)
635                    (this-single-command-keys)
636                    last-input-event
637                    unread-command-events
638                    )))
639 ;; (setq ttt (run-at-time t 1 'guide-key/message-events))
640 ;; (cancel-timer ttt)
641
642 (provide 'guide-key)
643 ;;; guide-key.el ends here