| commit | author | age | ||
| 5cb5f7 | 1 | ;;; company-tng.el --- company-mode configuration for single-button interaction |
| C | 2 | |
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Nikita Leshenko | |
| 6 | ||
| 7 | ;; This file is part of GNU Emacs. | |
| 8 | ||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 10 | ;; it under the terms of the GNU General Public License as published by | |
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 12 | ;; (at your option) any later version. | |
| 13 | ||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 17 | ;; GNU General Public License for more details. | |
| 18 | ||
| 19 | ;; You should have received a copy of the GNU General Public License | |
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
| 21 | ||
| 22 | ||
| 23 | ;;; Commentary: | |
| 24 | ;; | |
| 25 | ;; company-tng (Tab and Go) allows you to perform completion using just TAB. | |
| 26 | ;; Pressing it will both select the next completion candidate in the list and | |
| 27 | ;; insert it into the buffer (or make it look like it's inserted, in fact). | |
| 28 | ;; | |
| 29 | ;; It cycles the candidates like `yank-pop' or `dabbrev-expand' or Vim: | |
| 30 | ;; Pressing TAB selects the first item in the completion menu and inserts it in | |
| 31 | ;; the buffer. Pressing TAB again selects the second item and replaces the | |
| 32 | ;; "inserted" item with the second one. This can continue as long as the user | |
| 33 | ;; wishes to cycle through the menu. You can also press S-TAB to select the | |
| 34 | ;; previous candidate, of course. | |
| 35 | ;; | |
| 36 | ;; The benefits are that you only have to use one shortcut key and there is no | |
| 37 | ;; need to confirm the entry. | |
| 38 | ;; | |
| 39 | ;; Usage: | |
| 40 | ;; | |
| 41 | ;; To apply the default configuration for company-tng call | |
| 42 | ;; `company-tng-configure-default' from your init script. | |
| 43 | ;; | |
| 44 | ;; You can also configure company-tng manually: | |
| 45 | ;; | |
| 46 | ;; Add `company-tng-frontend' to `company-frontends': | |
| 47 | ;; | |
| 48 | ;; (add-to-list 'company-frontends 'company-tng-frontend) | |
| 49 | ;; | |
| 50 | ;; We recommend to bind TAB to `company-select-next', S-TAB to | |
| 51 | ;; `company-select-previous', and unbind RET and other now-unnecessary | |
| 52 | ;; keys from `company-active-map': | |
| 53 | ;; | |
| 54 | ;; (define-key company-active-map (kbd "TAB") 'company-select-next) | |
| 55 | ;; (define-key company-active-map (kbd "<backtab>") 'company-select-previous) | |
| 56 | ;; (define-key company-active-map (kbd "RET") nil) | |
| 57 | ;; | |
| 58 | ;; Note that it's not necessary to rebind keys to use this frontend, | |
| 59 | ;; you can use the arrow keys or M-n/M-p to select and insert | |
| 60 | ;; candidates. You also need to decide which keys to unbind, depending | |
| 61 | ;; on whether you want them to do the Company action or the default | |
| 62 | ;; Emacs action (for example C-s or C-w). | |
| 63 | ;; | |
| 64 | ;; We recommend to disable `company-require-match' to allow free typing at any | |
| 65 | ;; point. | |
| 66 | ||
| 67 | ;;; Code: | |
| 68 | ||
| 69 | (require 'company) | |
| 70 | (require 'cl-lib) | |
| 71 | ||
| 72 | (defvar-local company-tng--overlay nil) | |
| 73 | ||
| 74 | ;;;###autoload | |
| 75 | (defun company-tng-frontend (command) | |
| 76 | "When the user changes the selection at least once, this | |
| 77 | frontend will display the candidate in the buffer as if it's | |
| 78 | already there and any key outside of `company-active-map' will | |
| 79 | confirm the selection and finish the completion." | |
| 80 | (cl-case command | |
| 81 | (show | |
| 82 | (let ((ov (make-overlay (point) (point)))) | |
| 83 | (setq company-tng--overlay ov) | |
| 84 | (overlay-put ov 'priority 2)) | |
| 85 | (advice-add 'company-select-next :before-until 'company-tng--allow-unselected) | |
| 86 | (advice-add 'company-fill-propertize :filter-args 'company-tng--adjust-tooltip-highlight)) | |
| 87 | (update | |
| 88 | (let ((ov company-tng--overlay) | |
| 89 | (selected (nth company-selection company-candidates)) | |
| 90 | (prefix (length company-prefix))) | |
| 91 | (move-overlay ov (- (point) prefix) (point)) | |
| 92 | (overlay-put ov | |
| 93 | (if (= prefix 0) 'after-string 'display) | |
| 94 | (and company-selection-changed selected)))) | |
| 95 | (hide | |
| 96 | (when company-tng--overlay | |
| 97 | (delete-overlay company-tng--overlay) | |
| 98 | (kill-local-variable 'company-tng--overlay)) | |
| 99 | (advice-remove 'company-select-next 'company-tng--allow-unselected) | |
| 100 | (advice-remove 'company-fill-propertize 'company-tng--adjust-tooltip-highlight)) | |
| 101 | (pre-command | |
| 102 | (when (and company-selection-changed | |
| 103 | (not (company--company-command-p (this-command-keys)))) | |
| 104 | (company--unread-this-command-keys) | |
| 105 | (setq this-command 'company-complete-selection) | |
| 106 | (advice-add 'company-call-backend :before-until 'company-tng--supress-post-completion))))) | |
| 107 | ||
| 108 | ;;;###autoload | |
| 109 | (defun company-tng-configure-default () | |
| 110 | "Applies the default configuration to enable company-tng." | |
| 111 | (setq company-require-match nil) | |
| 112 | (setq company-frontends '(company-tng-frontend | |
| 113 | company-pseudo-tooltip-frontend | |
| 114 | company-echo-metadata-frontend)) | |
| 115 | (let ((keymap company-active-map)) | |
| 116 | (define-key keymap [return] nil) | |
| 117 | (define-key keymap (kbd "RET") nil) | |
| 118 | (define-key keymap [tab] 'company-select-next) | |
| 119 | (define-key keymap (kbd "TAB") 'company-select-next) | |
| 120 | (define-key keymap [backtab] 'company-select-previous) | |
| 121 | (define-key keymap (kbd "S-TAB") 'company-select-previous))) | |
| 122 | ||
| 123 | (defun company-tng--allow-unselected (&optional arg) | |
| 124 | "Advice `company-select-next' to allow for an 'unselected' | |
| 125 | state. Unselected means that no user interaction took place on the | |
| 126 | completion candidates and it's marked by setting | |
| 127 | `company-selection-changed' to nil. This advice will call the underlying | |
| 128 | `company-select-next' unless we need to transition to or from an unselected | |
| 129 | state. | |
| 130 | ||
| 131 | Possible state transitions: | |
| 132 | - (arg > 0) unselected -> first candidate selected | |
| 133 | - (arg < 0) first candidate selected -> unselected | |
| 134 | - (arg < 0 wrap-round) unselected -> last candidate selected | |
| 135 | - (arg < 0 no wrap-round) unselected -> unselected | |
| 136 | ||
| 137 | There is no need to advice `company-select-previous' because it calls | |
| 138 | `company-select-next' internally." | |
| 139 | (cond | |
| 140 | ;; Selecting next | |
| 141 | ((or (not arg) (> arg 0)) | |
| 142 | (unless company-selection-changed | |
| 143 | (company-set-selection (1- (or arg 1)) 'force-update) | |
| 144 | t)) | |
| 145 | ;; Selecting previous | |
| 146 | ((< arg 0) | |
| 147 | (when (and company-selection-changed | |
| 148 | (< (+ company-selection arg) 0)) | |
| 149 | (company-set-selection 0) | |
| 150 | (setq company-selection-changed nil) | |
| 151 | (company-call-frontends 'update) | |
| 152 | t) | |
| 153 | ))) | |
| 154 | ||
| 155 | (defun company-tng--adjust-tooltip-highlight (args) | |
| 156 | "Prevent the tooltip from highlighting the current selection if it wasn't | |
| 157 | made explicitly (i.e. `company-selection-changed' is true)" | |
| 158 | (unless company-selection-changed | |
| 159 | ;; The 4th arg of `company-fill-propertize' is selected | |
| 160 | (setf (nth 3 args) nil)) | |
| 161 | args) | |
| 162 | ||
| 163 | (defun company-tng--supress-post-completion (command &rest args) | |
| 164 | "Installed as a :before-until advice on `company-call-backend' and | |
| 165 | prevents the 'post-completion command from being delivered to the backend | |
| 166 | for the next iteration. post-completion do things like expand snippets | |
| 167 | which are undesirable because completions are implicit in company-tng and | |
| 168 | visible side-effects after the completion are surprising." | |
| 169 | (when (eq command 'post-completion) | |
| 170 | (advice-remove 'company-call-backend 'company-tng--supress-post-completion) | |
| 171 | t)) | |
| 172 | ||
| 173 | (provide 'company-tng) | |
| 174 | ;;; company-tng.el ends here | |
