├── README.md └── one-key.el /README.md: -------------------------------------------------------------------------------- 1 | # One-Key 2 | 3 | We have installed too many Emacs plugins, if you bind a global key for each command, we have no global key can be used in a short time. 4 | 5 | The goal of one-key.el is to call a set of commands with a global key, to save the resources of the global key. 6 | 7 | # Install 8 | Add the full path of one-key.el to your Emacs ```load-path```, then add the following to `init.el`: 9 | 10 | ```Elisp 11 | (add-to-list 'load-path "~/.emacs.d/site-lisp/one-key/") 12 | (require 'one-key) 13 | ``` 14 | 15 | # Define one-key menu 16 | 17 | Define one-key function ```one-key-menu-magit```: 18 | 19 | ```Elisp 20 | (one-key-create-menu 21 | "MAGIT" 22 | '( 23 | (("s" . "Magit status") . magit-status+) 24 | (("c" . "Magit checkout") . magit-checkout) 25 | (("C" . "Magit commit") . magit-commit) 26 | (("u" . "Magit push to remote") . magit-push-current-to-pushremote) 27 | (("p" . "Magit delete remote branch") . magit-delete-remote-branch) 28 | (("i" . "Magit pull") . magit-pull-from-upstream) 29 | (("r" . "Magit rebase") . magit-rebase) 30 | (("e" . "Magit merge") . magit-merge) 31 | (("l" . "Magit log") . magit-log-all) 32 | (("L" . "Magit blame") . magit-blame+) 33 | (("b" . "Magit branch") . magit-branch) 34 | (("B" . "Magit buffer") . magit-process-buffer) 35 | (("D" . "Magit discarded") . magit-discard) 36 | (("," . "Magit init") . magit-init) 37 | (("." . "Magit add remote") . magit-remote-add) 38 | ) 39 | t) 40 | ``` 41 | 42 | Then binding function ```one-key-menu-magit``` with one global key to call it. 43 | -------------------------------------------------------------------------------- /one-key.el: -------------------------------------------------------------------------------- 1 | ;;; one-key.el --- One key 2 | 3 | ;; Filename: one-key.el 4 | ;; Description: One key 5 | ;; Author: Andy Stewart 6 | ;; rubikitch 7 | ;; Maintainer: Andy Stewart 8 | ;; Copyright (C) 2008 ~ 2021, Andy Stewart, all rights reserved. 9 | ;; Copyright (C) 2009, rubikitch, all rights reserved. 10 | ;; Created: 2008-12-22 21:54:30 11 | ;; Version: 0.8.0 12 | ;; Last-Updated: 2021-05-28 22:41:14 13 | ;; By: Andy Stewart 14 | ;; URL: http://www.emacswiki.org/emacs/download/one-key.el 15 | ;; Keywords: one-key 16 | ;; Compatibility: GNU Emacs 22 ~ 28 17 | ;; 18 | ;; Features that might be required by this library: 19 | ;; 20 | ;; `cl' 21 | ;; 22 | 23 | ;;; This file is NOT part of GNU Emacs 24 | 25 | ;;; License 26 | ;; 27 | ;; This program is free software; you can redistribute it and/or modify 28 | ;; it under the terms of the GNU General Public License as published by 29 | ;; the Free Software Foundation; either version 3, or (at your option) 30 | ;; any later version. 31 | 32 | ;; This program is distributed in the hope that it will be useful, 33 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | ;; GNU General Public License for more details. 36 | 37 | ;; You should have received a copy of the GNU General Public License 38 | ;; along with this program; see the file COPYING. If not, write to 39 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 40 | ;; Floor, Boston, MA 02110-1301, USA. 41 | 42 | ;;; Commentary: 43 | ;; 44 | ;; Along with many extensions into Emacs, have many keystroke is 45 | ;; used, and always forget the keystroke when have too many. 46 | ;; 47 | ;; This package is for fix above problems. 48 | ;; 49 | ;; One Key provide a handle with TOP keystroke, and then when you 50 | ;; type TOP keystroke, you will get a keystroke menu with pop-up 51 | ;; window, and will show a group keystroke in pop-up window. 52 | ;; 53 | ;; Then you just type keystroke in window show, you can execute 54 | ;; command corresponding. 55 | ;; 56 | ;; So you need just remember the TOP keystroke with group command. 57 | ;; Others keystroke notify will display in pop-up window. 58 | ;; 59 | ;; * Quick use: 60 | ;; 61 | ;; When type "C-c p" will popup window and list keystroke menu. 62 | ;; Then you just type special keystroke that list in menu, 63 | ;; you will execute corresponding command. 64 | ;; 65 | ;; That's all. 66 | ;; 67 | ;; And now you don't need remember so many keystrokes, just remember 68 | ;; TOP keystroke is enough. 69 | ;; 70 | ;; * Advanced use: 71 | ;; 72 | ;; ** The format of menu list: 73 | ;; 74 | ;; (("KEYSTROKE" . "DESCRIBE") . COMMAND) 75 | ;; 76 | ;; Example: 77 | ;; 78 | ;; Define one-key function `one-key-menu-foo' 79 | ;; 80 | ;; (one-key-create-menu 81 | ;; "FOO" 82 | ;; '( 83 | ;; (("Keystroke-A" . "Describe-A") . Command-A) 84 | ;; (("Keystroke-B" . "Describe-B") . Command-B) 85 | ;; (("Keystroke-C" . "Describe-C") . Command-C)) 86 | ;; t) 87 | ;; 88 | ;; Then call `one-key-menu-foo' for test. 89 | ;; 90 | ;; ** The argument of function `one-key-create-menu': 91 | ;; 92 | ;; `title' is the title of menu, any string you like. 93 | ;; `info-alist' is a special list that contain KEY, DESCRIBE 94 | ;; and COMMAND. see above describe about `example-menu-alist'. 95 | ;; `miss-match-exit-p' is mean popup window will exit when you 96 | ;; type a KEY that can't match in menu. 97 | ;; `recursion-p' is whether recursion execute `one-key-menu' self 98 | ;; when no KEY match in menu. 99 | ;; `protect-function' is a protect function call last in `one-key-menu', 100 | ;; make sure this function is a `interactive' function. 101 | ;; `alternate-function' is alternate function execute at last. 102 | ;; `execute-last-command-when-miss-match' whether execute last input command 103 | ;; when keystroke is miss match. 104 | ;; 105 | 106 | ;;; Installation: 107 | ;; 108 | ;; Put one-key.el to your load-path. 109 | ;; The load-path is usually ~/elisp/. 110 | ;; It's set in your ~/.emacs like this: 111 | ;; (add-to-list 'load-path (expand-file-name "~/elisp")) 112 | ;; 113 | ;; And the following to your ~/.emacs startup file. 114 | ;; 115 | ;; (require 'one-key) 116 | ;; 117 | ;; Because this library use special implement method, 118 | ;; can occur `max-lisp-eval-depth' or `max-specpdl-size' error. 119 | ;; 120 | ;; So i think setup above two variables larger 121 | ;; will minish probability that error occur. 122 | ;; 123 | ;; Example I set below: 124 | ;; 125 | ;; (setq max-lisp-eval-depth 10000) 126 | ;; (setq max-specpdl-size 10000) 127 | ;; 128 | 129 | ;;; Customize: 130 | ;; 131 | ;; `one-key-popup-window' Whether popup window when first time run, 132 | ;; default is `t'. 133 | ;; `one-key-buffer-name' The buffer name of popup menu. 134 | ;; `one-key-template-buffer-name' The buffer name of template code. 135 | ;; `one-key-items-per-line' Number of items in one line, 136 | ;; if this option is `nil', will calculated by `window-width'. 137 | ;; `one-key-help-window-max-height' The maximal height use in popup window. 138 | ;; 139 | ;; All above can customize easy through: 140 | ;; M-x customize-group RET one-key RET 141 | ;; 142 | 143 | ;;; Change log: 144 | ;; 145 | ;; 2009/05/23 146 | ;; * Andy Stewart: 147 | ;; * Fix bug of option `one-key-popup-window'. 148 | ;; 149 | ;; 2009/03/09 150 | ;; * Andy Stewart: 151 | ;; * Add `char-valid-p' for compatibility Emacs 22. 152 | ;; 153 | ;; 2009/02/25 154 | ;; * Andy Stewart: 155 | ;; * Fix a bug of `one-key-menu'. 156 | ;; 157 | ;; 2009/02/19 158 | ;; * Andy Stewart: 159 | ;; * Just show help message when first call function `one-key-menu', 160 | ;; don't overwritten message from command. 161 | ;; * Remove function `one-key-menu-quit' and 162 | ;; option `one-key-show-quit-message', unnecessary now. 163 | ;; 164 | ;; 2009/02/10 165 | ;; * rubikitch 166 | ;; * Fix bug. 167 | ;; * PageUp and PageDown are scroll page keys now. 168 | ;; * Add new option `one-key-show-quit-message'. 169 | ;; 170 | ;; 2009/01/28 171 | ;; * Andy Stewart: 172 | ;; * Capitalize describe in variable `one-key-menu-*-alist'. 173 | ;; 174 | ;; 2009/01/27 175 | ;; * rubikitch 176 | ;; * Fix doc. 177 | ;; 178 | ;; 2009/01/26 179 | ;; * rubikitch 180 | ;; * Improve code. 181 | ;; 182 | ;; 2009/01/25 183 | ;; * Andy Stewart: 184 | ;; * Applied rubikitch's patch for generate 185 | ;; template code automatically, very nice! 186 | ;; 187 | ;; 2009/01/22 188 | ;; * rubikitch: 189 | ;; * Add new option `one-key-items-per-line'. 190 | ;; * Refactory code make it more clear. 191 | ;; * Fix bug. 192 | ;; * Andy Stewart: 193 | ;; * Applied rubikitch's patch. Thanks! 194 | ;; * Modified code make build-in keystroke 195 | ;; can be overridden. 196 | ;; * Fix doc. 197 | ;; 198 | ;; 2009/01/20 199 | ;; * Andy Stewart: 200 | ;; * Add new option `execute-last-command-when-miss-match' 201 | ;; to function `one-key-menu', make user can execute 202 | ;; last input command when miss match key alist. 203 | ;; 204 | ;; 2009/01/15 205 | ;; * rubikitch: 206 | ;; * Fix bug of `one-key-menu'. 207 | ;; * Add recursion execute support for `one-key-menu'.* 208 | ;; Thanks rubikitch patched for this! ;) 209 | ;; 210 | ;; 2009/01/04 211 | ;; * Andy Stewart: 212 | ;; * Add `alternate-function' argument with function `one-key-menu'. 213 | ;; 214 | ;; 2008/12/22 215 | ;; * Andy Stewart: 216 | ;; * First released. 217 | ;; 218 | 219 | ;;; Acknowledgements: 220 | ;; 221 | ;; rubikitch 222 | ;; For send many patches. 223 | ;; 224 | 225 | ;;; TODO 226 | ;; 227 | ;; 228 | ;; 229 | 230 | ;;; Require 231 | (eval-when-compile (require 'cl-lib)) 232 | 233 | ;;; Code: 234 | 235 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 236 | (defgroup one-key nil 237 | "One key." 238 | :group 'editing) 239 | 240 | (defcustom one-key-popup-window nil 241 | "Whether popup window when first time run `one-key-menu'." 242 | :type 'boolean 243 | :group 'one-key) 244 | 245 | (defcustom one-key-buffer-name "*One-Key*" 246 | "The buffer name of popup help window." 247 | :type 'string 248 | :group 'one-key) 249 | 250 | (defcustom one-key-template-buffer-name "*One-Key-Template*" 251 | "The name of template buffer." 252 | :type 'string 253 | :group 'one-key) 254 | 255 | (defcustom one-key-items-per-line nil 256 | "Number of items in one line. 257 | If nil, it is calculated by `window-width'." 258 | :type 'int 259 | :group 'one-key) 260 | 261 | (defcustom one-key-help-window-max-height nil 262 | "The max height of popup help window." 263 | :type 'int 264 | :set (lambda (symbol value) 265 | (set symbol value) 266 | ;; Default is half height of frame. 267 | (unless value 268 | (set symbol (/ (frame-height) 2)))) 269 | :group 'one-key) 270 | 271 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 272 | (defface one-key-title 273 | '((t (:foreground "Gold"))) 274 | "Face for highlighting title." 275 | :group 'one-key) 276 | 277 | (defface one-key-keystroke 278 | '((t (:foreground "DarkRed"))) 279 | "Face for highlighting keystroke." 280 | :group 'one-key) 281 | 282 | (defface one-key-prompt 283 | '((t (:foreground "khaki3"))) 284 | "Face for highlighting prompt." 285 | :group 'one-key) 286 | 287 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Variable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 288 | (defvar one-key-help-window-configuration nil 289 | "The window configuration that record current window configuration before popup help window.") 290 | 291 | (defvar one-key-menu-call-first-time t 292 | "The first time call function `one-key-menu'.") 293 | 294 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 295 | (defun one-key-show-template (keystroke title) 296 | "Show template code in buffer `one-key-template-buffer-name'. 297 | KEYSTROKE is bind keymap that you want generate. 298 | TITLE is title name that any string you like." 299 | (interactive "sKeymap to One-Key (keystroke or keymap name): \nsTitle: ") 300 | (let ((keymap (one-key-read-keymap keystroke))) 301 | (with-current-buffer (get-buffer-create one-key-template-buffer-name) 302 | ;; Insert template. 303 | (erase-buffer) 304 | (insert (one-key-make-template keymap title)) 305 | ;; Load `emacs-lisp' syntax highlight. 306 | (set-syntax-table emacs-lisp-mode-syntax-table) 307 | (lisp-mode-variables) 308 | (setq font-lock-mode t) 309 | (font-lock-fontify-buffer) 310 | ;; Pop to buffer. 311 | (switch-to-buffer (current-buffer)) 312 | ;; Move to last argument position of function define. 313 | (backward-char 3)))) 314 | 315 | (defun one-key-insert-template (keystroke title) 316 | "Insert template code. 317 | KEYSTROKE is bind keymap that you want generate. 318 | TITLE is title name that any string you like." 319 | (interactive "sKeymap to One-Key (keystroke or keymap name): \nsTitle: ") 320 | (let ((keymap (one-key-read-keymap keystroke))) 321 | ;; Insert. 322 | (insert (one-key-make-template keymap title)) 323 | ;; Move to last argument position of function define. 324 | (backward-char 3))) 325 | 326 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 327 | (defun one-key-highlight (msg msg-regexp msg-face) 328 | "Highlight special `MSG' with regular expression `MSG-REGEXP'. 329 | Will highlight this `MSG' with face `MSG-FACE'." 330 | (with-temp-buffer 331 | (insert msg) 332 | (goto-char (point-min)) 333 | (while (re-search-forward msg-regexp nil t) 334 | (add-text-properties (match-beginning 0) 335 | (match-end 0) 336 | msg-face)) 337 | (buffer-string))) 338 | 339 | (defun one-key-highlight-prompt (prompt) 340 | "Highlight PROMPT information." 341 | (let ((msg (format "The keystroke menu of <%s> type '?' for help." prompt))) 342 | (message (one-key-highlight msg 343 | " \\(<[^<>]*>\\|'[^']*'\\) " 344 | '(face one-key-prompt))))) 345 | 346 | (defun one-key-highlight-help (title keystroke) 347 | "Highlight TITLE help information with KEYSTROKE." 348 | (setq title (one-key-highlight (format "Here is a list of <%s> keystrokes. Type '?' for hide. Type 'q' for exit.\n\n" title) 349 | "\\(<[^<>]*>\\|'[^']*'\\)" 350 | '(face one-key-title))) 351 | (setq keystroke (one-key-highlight keystroke 352 | "\\[\\([^\\[\\]\\)*\\]" 353 | '(face one-key-keystroke))) 354 | (concat title keystroke)) 355 | 356 | (defun one-key-menu (title 357 | info-alist 358 | &optional 359 | miss-match-exit-p 360 | recursion-p 361 | protect-function 362 | alternate-function 363 | execute-last-command-when-miss-match) 364 | "One key menu. 365 | 366 | `TITLE' is the title of men, any string can use. 367 | `INFO-ALIST' is a special alist 368 | that contain KEY, DESCRIBE and COMMAND. 369 | `MISS-MATCH-EXIT-P' whether hide popup help window 370 | when keystroke can't match in menu. 371 | `RECURSION-P' whether recursion execute self 372 | when keystroke can't match in menu. 373 | `PROTECT-FUNCTION' the protect function 374 | that call in `unwind-protect'. 375 | `ALTERNATE-FUNCTION' the alternate function execute at last. 376 | `EXECUTE-LAST-COMMAND-WHEN-MISS-MATCH' whether execute 377 | last command when it miss match in key alist." 378 | (let ((self (function 379 | (lambda () 380 | (one-key-menu 381 | title info-alist miss-match-exit-p 382 | recursion-p 383 | protect-function 384 | alternate-function 385 | execute-last-command-when-miss-match)))) 386 | (command-executed this-command) 387 | last-key) 388 | ;; Popup help window when first time call 389 | ;; and option `one-key-popup-window' is `non-nil'. 390 | (when (and one-key-menu-call-first-time 391 | one-key-popup-window) 392 | (one-key-help-window-toggle title info-alist)) 393 | ;; Execute. 394 | (unwind-protect 395 | (let* ((event (read-event 396 | ;; Just show help message when first call, 397 | ;; don't overwritten message from command. 398 | (if one-key-menu-call-first-time 399 | (progn 400 | (one-key-highlight-prompt title) 401 | (setq one-key-menu-call-first-time nil)) 402 | ""))) 403 | (key (if (if (<= emacs-major-version 22) 404 | (with-no-warnings 405 | (char-valid-p event)) ;for compatibility Emacs 22 406 | (characterp event)) 407 | ;; Transform to string when event is char. 408 | (char-to-string event) 409 | ;; Otherwise return vector. 410 | (make-vector 1 event))) 411 | match-key) 412 | (cond 413 | ;; Match user keystrokes. 414 | ((catch 'match 415 | (when (stringp key) (setq key (read-kbd-macro key))) 416 | (cl-loop for ((k . desc) . command) in info-alist do 417 | ;; Get match key. 418 | (setq match-key k) 419 | ;; Call function when match keystroke. 420 | (when (one-key-match-keystroke key match-key) 421 | ;; Close help window first. 422 | (one-key-help-window-close) 423 | ;; Set `one-key-menu-call-first-time' with "t" for recursion execute. 424 | (setq one-key-menu-call-first-time t) 425 | ;; Execute. 426 | (call-interactively command) 427 | (setq command-executed command) 428 | ;; Set `one-key-menu-call-first-time' with "nil". 429 | (setq one-key-menu-call-first-time nil) 430 | (throw 'match t))) 431 | nil) 432 | ;; Handle last. 433 | (one-key-handle-last alternate-function self recursion-p)) 434 | ;; Match build-in keystroke. 435 | ((one-key-match-keystroke key "q") 436 | ;; quit 437 | (keyboard-quit)) 438 | ((one-key-match-keystroke key "?") 439 | ;; toggle help window 440 | (one-key-help-window-toggle title info-alist) 441 | (funcall self)) 442 | ((one-key-match-keystroke key "C-n") 443 | ;; scroll up one line 444 | (one-key-help-window-scroll-up-line) 445 | (funcall self)) 446 | ((one-key-match-keystroke key "C-p") 447 | ;; scroll down one line 448 | (one-key-help-window-scroll-down-line) 449 | (funcall self)) 450 | ((or (one-key-match-keystroke key "C-j") 451 | (one-key-match-keystroke key [next])) 452 | ;; scroll up one screen 453 | (one-key-help-window-scroll-up) 454 | (funcall self)) 455 | ((or (one-key-match-keystroke key "C-k") 456 | (one-key-match-keystroke key [prior])) 457 | ;; scroll down one screen 458 | (one-key-help-window-scroll-down) 459 | (funcall self)) 460 | ;; Not match any keystrokes. 461 | (t 462 | ;; Close help window first. 463 | (one-key-help-window-close) 464 | ;; Quit when keystroke not match 465 | ;; and argument `miss-match-exit-p' is `non-nil'. 466 | (when miss-match-exit-p 467 | ;; Record last key. 468 | (setq last-key key) 469 | ;; Abort. 470 | (keyboard-quit)) 471 | ;; Handle last. 472 | (one-key-handle-last alternate-function self recursion-p)))) 473 | ;; Restore value of `one-key-call-first-time'. 474 | (setq one-key-menu-call-first-time t) 475 | ;; Close help window. 476 | (one-key-help-window-close) 477 | ;; Run protect function 478 | ;; when `protect-function' is valid function. 479 | (if (and protect-function 480 | (functionp protect-function)) 481 | (call-interactively protect-function)) 482 | ;; Execute last command when miss match 483 | ;; user key alist. 484 | (when (and execute-last-command-when-miss-match 485 | last-key) 486 | ;; Execute command corresponding last input key. 487 | (one-key-execute-binding-command last-key)) 488 | 489 | ;; Make sure this-command is the real command executed 490 | (setq this-command command-executed)))) 491 | 492 | (defun one-key-execute-binding-command (key) 493 | "Execute the command binding KEY." 494 | (let (;; Try to get function corresponding `KEY'. 495 | (function (key-binding key))) 496 | ;; Execute corresponding command, except `keyboard-quit'. 497 | (when (and (not (eq function 'keyboard-quit)) 498 | (functionp function)) 499 | ;; Make sure `last-command-event' equal `last-input-event'. 500 | (setq last-command-event last-input-event) 501 | ;; Run function. 502 | (call-interactively function)))) 503 | 504 | (defun one-key-match-keystroke (key match-key) 505 | "Return `non-nil' if `KEY' match `MATCH-KEY'. 506 | Otherwise, return nil." 507 | (cond ((stringp match-key) (setq match-key (read-kbd-macro match-key))) 508 | ((vectorp match-key) nil) 509 | (t (signal 'wrong-type-argument (list 'array match-key)))) 510 | (equal key match-key)) 511 | 512 | (defun one-key-read-keymap (keystroke) 513 | "Read keymap. 514 | If KEYSTROKE is a name of keymap, use the keymap. 515 | Otherwise it is interpreted as a key stroke." 516 | (let ((v (intern-soft keystroke))) 517 | (if (and (boundp v) (keymapp (symbol-value v))) 518 | (symbol-value v) 519 | (key-binding (read-kbd-macro keystroke))))) 520 | 521 | (defun one-key-handle-last (alternate-function recursion-function recursion-p) 522 | "The last process when match user keystroke or not match. 523 | ALTERNATE-FUNCTION is the alternate function to be execute. 524 | RECURSION-FUNCTION is the recursion function to be execute 525 | when option RECURSION-P is non-nil." 526 | ;; Execute alternate function. 527 | (when (and alternate-function 528 | (functionp alternate-function)) 529 | (call-interactively alternate-function)) 530 | ;; Recursion execute when argument 531 | ;; `recursion-p' is `non-nil'. 532 | (if recursion-p 533 | (funcall recursion-function))) 534 | 535 | (defun one-key-help-window-exist-p () 536 | "Return `non-nil' if `one-key' help window exist. 537 | Otherwise, return nil." 538 | (and (get-buffer one-key-buffer-name) 539 | (window-live-p (get-buffer-window (get-buffer one-key-buffer-name))))) 540 | 541 | (defun one-key-help-window-toggle (title info-alist) 542 | "Toggle the help window. 543 | Argument TITLE is title name for help information. 544 | Argument INFO-ALIST is help information as format ((key . describe) . command)." 545 | (if (one-key-help-window-exist-p) 546 | ;; Close help window. 547 | (one-key-help-window-close) 548 | ;; Open help window. 549 | (one-key-help-window-open title info-alist))) 550 | 551 | (defun one-key-help-window-open (title info-alist) 552 | "Open the help window. 553 | Argument TITLE is title name for help information. 554 | Argument INFO-ALIST is help information as format ((key . describe) . command)." 555 | ;; Save current window configuration. 556 | (or one-key-help-window-configuration 557 | (setq one-key-help-window-configuration (current-window-configuration))) 558 | ;; Generate buffer information. 559 | (unless (get-buffer one-key-buffer-name) 560 | (with-current-buffer (get-buffer-create one-key-buffer-name) 561 | (goto-char (point-min)) 562 | (save-excursion 563 | (insert (one-key-highlight-help 564 | title 565 | (one-key-help-format info-alist)))))) 566 | ;; Pop `one-key' buffer. 567 | (pop-to-buffer one-key-buffer-name) 568 | (set-buffer one-key-buffer-name) 569 | ;; Adjust height of help window 570 | ;; to display buffer's contents exactly. 571 | (fit-window-to-buffer nil one-key-help-window-max-height)) 572 | 573 | (defun one-key-help-window-close () 574 | "Close the help window." 575 | ;; Kill help buffer. 576 | (when (bufferp (get-buffer one-key-buffer-name)) 577 | (kill-buffer one-key-buffer-name)) 578 | ;; Restore window layout if 579 | ;; `one-key-help-window-configuration' is valid value. 580 | (when (and one-key-help-window-configuration 581 | (boundp 'one-key-help-window-configuration)) 582 | (set-window-configuration one-key-help-window-configuration) 583 | (setq one-key-help-window-configuration nil))) 584 | 585 | (defun one-key-help-window-scroll-up () 586 | "Scroll up one screen `one-key' help window." 587 | (if (one-key-help-window-exist-p) 588 | (ignore-errors 589 | (with-current-buffer one-key-buffer-name 590 | (scroll-up))))) 591 | 592 | (defun one-key-help-window-scroll-down () 593 | "Scroll down one screen `one-key' help window." 594 | (if (one-key-help-window-exist-p) 595 | (ignore-errors 596 | (with-current-buffer one-key-buffer-name 597 | (scroll-down))))) 598 | 599 | (defun one-key-help-window-scroll-up-line () 600 | "Scroll up one line `one-key' help window." 601 | (if (one-key-help-window-exist-p) 602 | (ignore-errors 603 | (with-current-buffer one-key-buffer-name 604 | (scroll-up 1))))) 605 | 606 | (defun one-key-help-window-scroll-down-line () 607 | "Scroll down one line `one-key' help window." 608 | (if (one-key-help-window-exist-p) 609 | (ignore-errors 610 | (with-current-buffer one-key-buffer-name 611 | (scroll-down 1))))) 612 | 613 | (defun one-key-help-format (info-alist) 614 | "Format `one-key' help information. 615 | Argument INFO-ALIST is help information as format ((key . describe) . command)." 616 | (let* ((max-length (cl-loop for ((key . desc) . command) in info-alist 617 | maximize (+ (string-width key) (string-width desc)))) 618 | (current-length 0) 619 | (items-per-line (or one-key-items-per-line 620 | (floor (/ (- (window-width) 3) 621 | (+ max-length 4))))) 622 | keystroke-msg) 623 | (cl-loop for ((key . desc) . command) in info-alist 624 | for counter from 1 do 625 | (push (format "[%s] %s " key desc) keystroke-msg) 626 | (setq current-length (+ (string-width key) (string-width desc))) 627 | (push (if (zerop (% counter items-per-line)) 628 | "\n" 629 | (make-string (- max-length current-length) ? )) 630 | keystroke-msg)) 631 | (mapconcat 'identity (nreverse keystroke-msg) ""))) 632 | 633 | (defun one-key-make-template (keymap title) 634 | "Generate template code. 635 | KEYMAP is keymap you want generate. 636 | TITLE is title name that any string you like." 637 | (with-temp-buffer 638 | (let ((indent-tabs-mode t) 639 | (funcname (replace-regexp-in-string " " "-" title))) 640 | (insert (substitute-command-keys "\\\\{keymap}")) 641 | ;; Remove header/footer 642 | (goto-char (point-min)) 643 | (forward-line 3) 644 | (delete-region 1 (point)) 645 | (goto-char (point-max)) 646 | (backward-delete-char 1) 647 | ;; Insert. 648 | (goto-char (point-min)) 649 | ;; Insert alist variable. 650 | (insert (format "(defvar one-key-menu-%s-alist nil\n\"The `one-key' menu alist for %s.\")\n\n" 651 | funcname title) 652 | (format "(setq one-key-menu-%s-alist\n'(\n" funcname)) 653 | ;; Insert (("key" . "desc") . command). 654 | (while (not (eobp)) 655 | (unless (eq (point-at-bol) (point-at-eol)) 656 | (cl-destructuring-bind (key cmd) 657 | (split-string (buffer-substring (point-at-bol) (point-at-eol)) "\t+") 658 | (delete-region (point-at-bol) (point-at-eol)) 659 | (insert (format "((\"%s\" . \"%s\") . %s)" 660 | (replace-regexp-in-string 661 | "\\\"" "\\\\\"" 662 | (replace-regexp-in-string "\\\\" "\\\\\\\\" key)) 663 | (capitalize (replace-regexp-in-string "-" " " cmd)) 664 | cmd)) 665 | (when (and cmd 666 | (string-match " " (concat key cmd))) 667 | (forward-sexp -1) 668 | (insert ";; ")))) 669 | (forward-line 1)) 670 | (goto-char (point-max)) 671 | (insert "))\n\n") 672 | ;; Insert function. 673 | (insert (format "(defun one-key-menu-%s ()\n\"The `one-key' menu for %s\"\n(interactive)\n(one-key-menu \"%s\" one-key-menu-%s-alist))\n" 674 | funcname title title funcname)) 675 | ;; Indent. 676 | (emacs-lisp-mode) 677 | (indent-region (point-min) (point-max)) 678 | ;; Result. 679 | (buffer-string) 680 | ))) 681 | 682 | (cl-defmacro one-key-create-menu (title 683 | info-alist 684 | &optional 685 | miss-match-exit-p 686 | recursion-p 687 | protect-function 688 | alternate-function 689 | execute-last-command-when-miss-match) 690 | (let* ((one-key-function (intern (format "one-key-menu-%s" (downcase title))))) 691 | `(progn 692 | (defun ,one-key-function() 693 | (interactive) 694 | (one-key-menu 695 | ,title 696 | ,info-alist 697 | ,miss-match-exit-p 698 | ,recursion-p 699 | ,protect-function 700 | ,alternate-function 701 | ,execute-last-command-when-miss-match) 702 | )))) 703 | 704 | (provide 'one-key) 705 | 706 | ;;; one-key.el ends here 707 | 708 | ;;; LocalWords: specpdl minish DarkRed msg FUNCITN num str decf elt args 709 | ;;; LocalWords: rubikitch's desc SPC bmenu sKeymap nsTitle fontify funcname 710 | ;;; LocalWords: bol eol destructuring cmd PageUp PageDown 711 | --------------------------------------------------------------------------------