| 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 | |
