code.delx.au - gnu-emacs-elpa/blob - company.el

   1 ;;; company.el --- extensible inline text completion mechanism
   2 ;;
   3 ;; Copyright (C) 2009 Nikolaj Schumacher
   4 ;;
   5 ;; Author: Nikolaj Schumacher <bugs * nschum de>
   6 ;; Version: 0.3.1
   7 ;; Keywords: abbrev, convenience, matchis
   8 ;; URL: http://nschum.de/src/emacs/company/
   9 ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
  10 ;;
  11 ;; This file is NOT part of GNU Emacs.
  12 ;;
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License
  15 ;; as published by the Free Software Foundation; either version 2
  16 ;; of the License, or (at your option) any later version.
  17 ;;
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;; Company is a modular completion mechanism.  Modules for retrieving completion
  29 ;; candidates are called back-ends, modules for displaying them are front-ends.
  30 ;;
  31 ;; Company comes with many back-ends, e.g. `company-elisp'.  These are
  32 ;; distributed in individual files and can be used individually.
  33 ;;
  34 ;; Place company.el and the back-ends you want to use in a directory and add the
  35 ;; following to your .emacs:
  36 ;; (add-to-list 'load-path "/path/to/company")
  37 ;; (autoload 'company-mode "company" nil t)
  38 ;;
  39 ;; Enable company-mode with M-x company-mode.  For further information look at
  40 ;; the documentation for `company-mode' (C-h f company-mode RET)
  41 ;;
  42 ;; If you want to start a specific back-end, call it interactively or use
  43 ;; `company-begin-backend'.  For example:
  44 ;; M-x company-abbrev will prompt for and insert an abbrev.
  45 ;;
  46 ;; To write your own back-end, look at the documentation for `company-backends'.
  47 ;; Here is a simple example completing "foo":
  48 ;;
  49 ;; (defun company-my-backend (command &optional arg &rest ignored)
  50 ;;   (case command
  51 ;;     ('prefix (when (looking-back "foo\\>")
  52 ;;                (match-string 0)))
  53 ;;     ('candidates (list "foobar" "foobaz" "foobarbaz"))
  54 ;;     ('meta (format "This value is named %s" arg))))
  55 ;;
  56 ;; Sometimes it is a good idea to mix two back-ends together, for example to
  57 ;; enrich gtags with dabbrev text (to emulate local variables):
  58 ;;
  59 ;; (defun gtags-gtags-dabbrev-backend (command &optional arg &rest ignored)
  60 ;;   (case command
  61 ;;     (prefix (company-gtags 'prefix))
  62 ;;     (candidates (append (company-gtags 'candidates arg)
  63 ;;                         (company-dabbrev 'candidates arg)))))
  64 ;;
  65 ;; Known Issues:
  66 ;; When point is at the very end of the buffer, the pseudo-tooltip appears very
  67 ;; wrong, unless company is allowed to temporarily insert a fake newline.
  68 ;; This behavior is enabled by `company-end-of-buffer-workaround'.
  69 ;;
  70 ;;; Change Log:
  71 ;;
  72 ;;    Added option `company-dabbrev-time-limit'.
  73 ;;    `company-backends' now supports merging back-ends.
  74 ;;    Added back-end `company-dabbrev-code' for generic code.
  75 ;;    Fixed `company-begin-with'.
  76 ;;
  77 ;; 2009-04-15 (0.3.1)
  78 ;;    Added 'stop prefix to prevent dabbrev from completing inside of symbols.
  79 ;;    Fixed issues with tabbar-mode and line-spacing.
  80 ;;    Performance enhancements.
  81 ;;
  82 ;; 2009-04-12 (0.3)
  83 ;;    Added `company-begin-commands' option.
  84 ;;    Added abbrev, tempo and Xcode back-ends.
  85 ;;    Back-ends are now interactive.  You can start them with M-x backend-name.
  86 ;;    Added `company-begin-with' for starting company from elisp-code.
  87 ;;    Added hooks.
  88 ;;    Added `company-require-match' and `company-auto-complete' options.
  89 ;;
  90 ;; 2009-04-05 (0.2.1)
  91 ;;    Improved Emacs Lisp back-end behavior for local variables.
  92 ;;    Added `company-elisp-detect-function-context' option.
  93 ;;    The mouse can now be used for selection.
  94 ;;
  95 ;; 2009-03-22 (0.2)
  96 ;;    Added `company-show-location'.
  97 ;;    Added etags back-end.
  98 ;;    Added work-around for end-of-buffer bug.
  99 ;;    Added `company-filter-candidates'.
 100 ;;    More local Lisp variables are now included in the candidates.
 101 ;;
 102 ;; 2009-03-21 (0.1.5)
 103 ;;    Fixed elisp documentation buffer always showing the same doc.
 104 ;;    Added `company-echo-strip-common-frontend'.
 105 ;;    Added `company-show-numbers' option and M-0 ... M-9 default bindings.
 106 ;;    Don't hide the echo message if it isn't shown.
 107 ;;
 108 ;; 2009-03-20 (0.1)
 109 ;;    Initial release.
 110 ;;
 111 ;;; Code:
 112
 113 (eval-when-compile (require 'cl))
 114
 115 (add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
 116 (add-to-list 'debug-ignored-errors "^Echo area cannot be used twice$")
 117 (add-to-list 'debug-ignored-errors "^No \\(document\\|loc\\)ation available$")
 118 (add-to-list 'debug-ignored-errors "^Company not ")
 119 (add-to-list 'debug-ignored-errors "^No candidate number ")
 120 (add-to-list 'debug-ignored-errors "^Cannot complete at point$")
 121
 122 (defgroup company nil
 123   "Extensible inline text completion mechanism"
 124   :group 'abbrev
 125   :group 'convenience
 126   :group 'maching)
 127
 128 (defface company-tooltip
 129   '((t :background "yellow"
 130        :foreground "black"))
 131   "*Face used for the tool tip."
 132   :group 'company)
 133
 134 (defface company-tooltip-selection
 135   '((default :inherit company-tooltip)
 136     (((class color) (min-colors 88)) (:background "orange1"))
 137     (t (:background "green")))
 138   "*Face used for the selection in the tool tip."
 139   :group 'company)
 140
 141 (defface company-tooltip-mouse
 142   '((default :inherit highlight))
 143   "*Face used for the tool tip item under the mouse."
 144   :group 'company)
 145
 146 (defface company-tooltip-common
 147   '((t :inherit company-tooltip
 148        :foreground "red"))
 149   "*Face used for the common completion in the tool tip."
 150   :group 'company)
 151
 152 (defface company-tooltip-common-selection
 153   '((t :inherit company-tooltip-selection
 154        :foreground "red"))
 155   "*Face used for the selected common completion in the tool tip."
 156   :group 'company)
 157
 158 (defcustom company-tooltip-limit 10
 159   "*The maximum number of candidates in the tool tip"
 160   :group 'company
 161   :type 'integer)
 162
 163 (defface company-preview
 164   '((t :background "blue4"
 165        :foreground "wheat"))
 166   "*Face used for the completion preview."
 167   :group 'company)
 168
 169 (defface company-preview-common
 170   '((t :inherit company-preview
 171        :foreground "red"))
 172   "*Face used for the common part of the completion preview."
 173   :group 'company)
 174
 175 (defface company-preview-search
 176   '((t :inherit company-preview
 177        :background "blue1"))
 178   "*Face used for the search string in the completion preview."
 179   :group 'company)
 180
 181 (defface company-echo nil
 182   "*Face used for completions in the echo area."
 183   :group 'company)
 184
 185 (defface company-echo-common
 186   '((((background dark)) (:foreground "firebrick1"))
 187     (((background light)) (:background "firebrick4")))
 188   "*Face used for the common part of completions in the echo area."
 189   :group 'company)
 190
 191 (defun company-frontends-set (variable value)
 192   ;; uniquify
 193   (let ((remainder value))
 194     (setcdr remainder (delq (car remainder) (cdr remainder))))
 195   (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
 196        (memq 'company-pseudo-tooltip-frontend value)
 197        (error "Pseudo tooltip frontend cannot be used twice"))
 198   (and (memq 'company-preview-if-just-one-frontend value)
 199        (memq 'company-preview-frontend value)
 200        (error "Preview frontend cannot be used twice"))
 201   (and (memq 'company-echo value)
 202        (memq 'company-echo-metadata-frontend value)
 203        (error "Echo area cannot be used twice"))
 204   ;; preview must come last
 205   (dolist (f '(company-preview-if-just-one-frontend company-preview-frontend))
 206     (when (memq f value)
 207       (setq value (append (delq f value) (list f)))))
 208   (set variable value))
 209
 210 (defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
 211                                company-preview-frontend
 212                                company-echo-metadata-frontend)
 213   "*The list of active front-ends (visualizations).
 214 Each front-end is a function that takes one argument.  It is called with
 215 one of the following arguments:
 216
 217 'show: When the visualization should start.
 218
 219 'hide: When the visualization should end.
 220
 221 'update: When the data has been updated.
 222
 223 'pre-command: Before every command that is executed while the
 224 visualization is active.
 225
 226 'post-command: After every command that is executed while the
 227 visualization is active.
 228
 229 The visualized data is stored in `company-prefix', `company-candidates',
 230 `company-common', `company-selection', `company-point' and
 231 `company-search-string'."
 232   :set 'company-frontends-set
 233   :group 'company
 234   :type '(repeat (choice (const :tag "echo" company-echo-frontend)
 235                          (const :tag "echo, strip common"
 236                                 company-echo-strip-common-frontend)
 237                          (const :tag "show echo meta-data in echo"
 238                                 company-echo-metadata-frontend)
 239                          (const :tag "pseudo tooltip"
 240                                 company-pseudo-tooltip-frontend)
 241                          (const :tag "pseudo tooltip, multiple only"
 242                                 company-pseudo-tooltip-unless-just-one-frontend)
 243                          (const :tag "preview" company-preview-frontend)
 244                          (const :tag "preview, unique only"
 245                                 company-preview-if-just-one-frontend)
 246                          (function :tag "custom function" nil))))
 247
 248 (defvar company-safe-backends
 249   '(company-abbrev company-css company-dabbrev-code company-dabbrev
 250     company-elisp company-etags company-files company-gtags company-ispell
 251     company-nxml company-oddmuse company-semantic company-tempo company-xcode))
 252 (put 'company-safe-backends 'risky-local-variable t)
 253
 254 (defun company-safe-backends-p (backends)
 255   (and (consp backends)
 256        (not (dolist (backend backends)
 257               (unless (if (consp backend)
 258                           (company-safe-backends-p backend)
 259                         (memq backend company-safe-backends))
 260                 (return t))))))
 261
 262 (defcustom company-backends '(company-elisp company-nxml company-css
 263                               company-semantic company-xcode
 264                               (company-gtags company-etags company-dabbrev-code)
 265                               company-oddmuse company-files company-dabbrev)
 266   "*The list of active back-ends (completion engines).
 267 Each list elements can itself be a list of back-ends.  In that case their
 268 completions are merged.  Otherwise only the first matching back-end returns
 269 results.
 270
 271 Each back-end is a function that takes a variable number of arguments.
 272 The first argument is the command requested from the back-end.  It is one
 273 of the following:
 274
 275 'prefix: The back-end should return the text to be completed.  It must be
 276 text immediately before `point'.  Returning nil passes control to the next
 277 back-end.  The function should return 'stop if it should complete but cannot
 278 \(e.g. if it is in the middle of a string\).
 279
 280 'candidates: The second argument is the prefix to be completed.  The
 281 return value should be a list of candidates that start with the prefix.
 282
 283 Optional commands:
 284
 285 'sorted: The back-end may return t here to indicate that the candidates
 286 are sorted and will not need to be sorted again.
 287
 288 'duplicates: If non-nil, company will take care of removing duplicates
 289 from the list.
 290
 291 'no-cache: Usually company doesn't ask for candidates again as completion
 292 progresses, unless the back-end returns t for this command.  The second
 293 argument is the latest prefix.
 294
 295 'meta: The second argument is a completion candidate.  The back-end should
 296 return a (short) documentation string for it.
 297
 298 'doc-buffer: The second argument is a completion candidate.  The back-end should
 299 create a buffer (preferably with `company-doc-buffer'), fill it with
 300 documentation and return it.
 301
 302 'location: The second argument is a completion candidate.  The back-end can
 303 return the cons of buffer and buffer location, or of file and line
 304 number where the completion candidate was defined.
 305
 306 'require-match: If this value is t, the user is not allowed to enter anything
 307 not offering as a candidate.  Use with care!  The default value nil gives the
 308 user that choice with `company-require-match'.  Return value 'never overrides
 309 that option the other way around.
 310
 311 The back-end should return nil for all commands it does not support or
 312 does not know about.  It should also be callable interactively and use
 313 `company-begin-backend' to start itself in that case."
 314   :group 'company
 315   :type '(repeat (choice (symbol :tag "Back-end")
 316                          (repeat :tag "Merge"
 317                                  (symbol :tag "Back-end")))))
 318
 319 (put 'company-backends 'safe-local-variable 'company-safe-backend-p)
 320
 321 (defcustom company-completion-started-hook nil
 322   "*Hook run when company starts completing.
 323 The hook is called with one argument that is non-nil if the completion was
 324 started manually."
 325   :group 'company
 326   :type 'hook)
 327
 328 (defcustom company-completion-cancelled-hook nil
 329   "*Hook run when company cancels completing.
 330 The hook is called with one argument that is non-nil if the completion was
 331 aborted manually."
 332   :group 'company
 333   :type 'hook)
 334
 335 (defcustom company-completion-finished-hook nil
 336   "*Hook run when company successfully completes.
 337 The hook is called with the selected candidate as an argument."
 338   :group 'company
 339   :type 'hook)
 340
 341 (defcustom company-minimum-prefix-length 3
 342   "*The minimum prefix length for automatic completion."
 343   :group 'company
 344   :type '(integer :tag "prefix length"))
 345
 346 (defcustom company-require-match 'company-explicit-action-p
 347   "*If enabled, disallow non-matching input.
 348 This can be a function do determine if a match is required.
 349
 350 This can be overridden by the back-end, if it returns t or 'never to
 351 'require-match.  `company-auto-complete' also takes precedence over this."
 352   :group 'company
 353   :type '(choice (const :tag "Off" nil)
 354                  (function :tag "Predicate function")
 355                  (const :tag "On, if user interaction took place"
 356                         'company-explicit-action-p)
 357                  (const :tag "On" t)))
 358
 359 (defcustom company-auto-complete 'company-explicit-action-p
 360   "Determines when to auto-complete.
 361 If this is enabled, all characters from `company-auto-complete-chars' complete
 362 the selected completion.  This can also be a function."
 363   :group 'company
 364   :type '(choice (const :tag "Off" nil)
 365                  (function :tag "Predicate function")
 366                  (const :tag "On, if user interaction took place"
 367                         'company-explicit-action-p)
 368                  (const :tag "On" t)))
 369
 370 (defcustom company-auto-complete-chars '(?\  ?\( ?\) ?. ?\" ?$ ?\' ?< ?| ?!)
 371   "Determines which characters trigger an automatic completion.
 372 See `company-auto-complete'.  If this is a string, each string character causes
 373 completion.  If it is a list of syntax description characters (see
 374 `modify-syntax-entry'), all characters with that syntax auto-complete.
 375
 376 This can also be a function, which is called with the new input and should
 377 return non-nil if company should auto-complete.
 378
 379 A character that is part of a valid candidate never starts auto-completion."
 380   :group 'company
 381   :type '(choice (string :tag "Characters")
 382                  (set :tag "Syntax"
 383                       (const :tag "Whitespace" ?\ )
 384                       (const :tag "Symbol" ?_)
 385                       (const :tag "Opening parentheses" ?\()
 386                       (const :tag "Closing parentheses" ?\))
 387                       (const :tag "Word constituent" ?w)
 388                       (const :tag "Punctuation." ?.)
 389                       (const :tag "String quote." ?\")
 390                       (const :tag "Paired delimiter." ?$)
 391                       (const :tag "Expression quote or prefix operator." ?\')
 392                       (const :tag "Comment starter." ?<)
 393                       (const :tag "Comment ender." ?>)
 394                       (const :tag "Character-quote." ?/)
 395                       (const :tag "Generic string fence." ?|)
 396                       (const :tag "Generic comment fence." ?!))
 397                  (function :tag "Predicate function")))
 398
 399 (defcustom company-idle-delay .7
 400   "*The idle delay in seconds until automatic completions starts.
 401 A value of nil means never complete automatically, t means complete
 402 immediately when a prefix of `company-minimum-prefix-length' is reached."
 403   :group 'company
 404   :type '(choice (const :tag "never (nil)" nil)
 405                  (const :tag "immediate (t)" t)
 406                  (number :tag "seconds")))
 407
 408 (defcustom company-begin-commands t
 409   "*A list of commands following which company will start completing.
 410 If this is t, it will complete after any command.  See `company-idle-delay'.
 411
 412 Alternatively any command with a non-nil 'company-begin property is treated as
 413 if it was on this list."
 414   :group 'company
 415   :type '(choice (const :tag "Any command" t)
 416                  (const :tag "Self insert command" '(self-insert-command))
 417                  (repeat :tag "Commands" function)))
 418
 419 (defcustom company-show-numbers nil
 420   "*If enabled, show quick-access numbers for the first ten candidates."
 421   :group 'company
 422   :type '(choice (const :tag "off" nil)
 423                  (const :tag "on" t)))
 424
 425 (defvar company-end-of-buffer-workaround t
 426   "*Work around a visualization bug when completing at the end of the buffer.
 427 The work-around consists of adding a newline.")
 428
 429 ;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 430
 431 (defvar company-mode-map (make-sparse-keymap)
 432   "Keymap used by `company-mode'.")
 433
 434 (defvar company-active-map
 435   (let ((keymap (make-sparse-keymap)))
 436     (define-key keymap "\e\e\e" 'company-abort)
 437     (define-key keymap "\C-g" 'company-abort)
 438     (define-key keymap (kbd "M-n") 'company-select-next)
 439     (define-key keymap (kbd "M-p") 'company-select-previous)
 440     (define-key keymap (kbd "<down>") 'company-select-next)
 441     (define-key keymap (kbd "<up>") 'company-select-previous)
 442     (define-key keymap [down-mouse-1] 'ignore)
 443     (define-key keymap [down-mouse-3] 'ignore)
 444     (define-key keymap [mouse-1] 'company-complete-mouse)
 445     (define-key keymap [mouse-3] 'company-select-mouse)
 446     (define-key keymap [up-mouse-1] 'ignore)
 447     (define-key keymap [up-mouse-3] 'ignore)
 448     (define-key keymap "\C-m" 'company-complete-selection)
 449     (define-key keymap "\t" 'company-complete-common)
 450     (define-key keymap (kbd "<f1>") 'company-show-doc-buffer)
 451     (define-key keymap "\C-w" 'company-show-location)
 452     (define-key keymap "\C-s" 'company-search-candidates)
 453     (define-key keymap "\C-\M-s" 'company-filter-candidates)
 454     (dotimes (i 10)
 455       (define-key keymap (vector (+ (aref (kbd "M-0") 0) i))
 456         `(lambda () (interactive) (company-complete-number ,i))))
 457
 458     keymap)
 459   "Keymap that is enabled during an active completion.")
 460
 461 (defun company-init-backend (backend)
 462   (and (symbolp backend)
 463        (not (fboundp backend))
 464        (ignore-errors (require backend nil t)))
 465
 466   (if (or (symbolp backend)
 467           (functionp backend))
 468       (if (ignore-errors (funcall backend 'init) t)
 469           (put backend 'company-init t)
 470         (message "Company back-end '%s' could not be initialized"
 471                  backend))
 472     (mapc 'company-init-backend backend)))
 473
 474 ;;;###autoload
 475 (define-minor-mode company-mode
 476   "\"complete anything\"; in in-buffer completion framework.
 477 Completion starts automatically, depending on the values
 478 `company-idle-delay' and `company-minimum-prefix-length'.
 479
 480 Completion can be controlled with the commands:
 481 `company-complete-common', `company-complete-selection', `company-complete',
 482 `company-select-next', `company-select-previous'.  If these commands are
 483 called before `company-idle-delay', completion will also start.
 484
 485 Completions can be searched with `company-search-candidates' or
 486 `company-filter-candidates'.  These can be used while completion is
 487 inactive, as well.
 488
 489 The completion data is retrieved using `company-backends' and displayed using
 490 `company-frontends'.  If you want to start a specific back-end, call it
 491 interactively or use `company-begin-backend'.
 492
 493 regular keymap (`company-mode-map'):
 494
 495 \\{company-mode-map}
 496 keymap during active completions (`company-active-map'):
 497
 498 \\{company-active-map}"
 499   nil " comp" company-mode-map
 500   (if company-mode
 501       (progn
 502         (add-hook 'pre-command-hook 'company-pre-command nil t)
 503         (add-hook 'post-command-hook 'company-post-command nil t)
 504         (mapc 'company-init-backend company-backends))
 505     (remove-hook 'pre-command-hook 'company-pre-command t)
 506     (remove-hook 'post-command-hook 'company-post-command t)
 507     (company-cancel)
 508     (kill-local-variable 'company-point)))
 509
 510 (defsubst company-assert-enabled ()
 511   (unless company-mode
 512     (company-uninstall-map)
 513     (error "Company not enabled")))
 514
 515 ;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 516
 517 (defvar company-overriding-keymap-bound nil)
 518 (make-variable-buffer-local 'company-overriding-keymap-bound)
 519
 520 (defvar company-old-keymap nil)
 521 (make-variable-buffer-local 'company-old-keymap)
 522
 523 (defvar company-my-keymap nil)
 524 (make-variable-buffer-local 'company-my-keymap)
 525
 526 (defsubst company-enable-overriding-keymap (keymap)
 527   (setq company-my-keymap keymap)
 528   (when company-overriding-keymap-bound
 529     (company-uninstall-map)))
 530
 531 (defun company-install-map ()
 532   (unless (or company-overriding-keymap-bound
 533               (null company-my-keymap))
 534     (setq company-old-keymap overriding-terminal-local-map
 535           overriding-terminal-local-map company-my-keymap
 536           company-overriding-keymap-bound t)))
 537
 538 (defun company-uninstall-map ()
 539   (when (eq overriding-terminal-local-map company-my-keymap)
 540     (setq overriding-terminal-local-map company-old-keymap
 541           company-overriding-keymap-bound nil)))
 542
 543 ;; Hack:
 544 ;; Emacs calculates the active keymaps before reading the event.  That means we
 545 ;; cannot change the keymap from a timer.  So we send a bogus command.
 546 (defun company-ignore ()
 547   (interactive))
 548
 549 (global-set-key '[31415926] 'company-ignore)
 550
 551 (defun company-input-noop ()
 552   (push 31415926 unread-command-events))
 553
 554 ;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 555
 556 (defun company-grab (regexp &optional expression limit)
 557   (when (looking-back regexp limit)
 558     (or (match-string-no-properties (or expression 0)) "")))
 559
 560 (defun company-grab-line (regexp &optional expression)
 561   (company-grab regexp expression (point-at-bol)))
 562
 563 (defun company-grab-symbol ()
 564   (if (looking-at "\\_>")
 565       (buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
 566                                                 (point)))
 567     (unless (and (char-after) (memq (char-syntax (char-after)) '(?w ?_)))
 568       "")))
 569
 570 (defun company-grab-word ()
 571   (if (looking-at "\\>")
 572       (buffer-substring (point) (save-excursion (skip-syntax-backward "w")
 573                                                 (point)))
 574     (unless (and (char-after) (eq (char-syntax (char-after)) ?w))
 575       "")))
 576
 577 (defun company-in-string-or-comment ()
 578   (let ((ppss (syntax-ppss)))
 579     (or (car (setq ppss (nthcdr 3 ppss)))
 580         (car (setq ppss (cdr ppss)))
 581         (nth 3 ppss))))
 582
 583 (defun company-call-backend (&rest args)
 584   (if (functionp company-backend)
 585       (apply company-backend args)
 586     (apply 'company--multi-backend-adapter company-backend args)))
 587
 588 (defun company--multi-backend-adapter (backends command &rest args)
 589   (case command
 590     ('candidates
 591      (apply 'append (mapcar (lambda (backend) (apply backend command args))
 592                             backends)))
 593     ('sorted nil)
 594     ('duplicates t)
 595     (otherwise
 596      (let (value)
 597        (dolist (backend backends)
 598          (when (setq value (apply backend command args))
 599            (return value)))))))
 600
 601 ;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 602
 603 (defvar company-backend nil)
 604 (make-variable-buffer-local 'company-backend)
 605
 606 (defvar company-prefix nil)
 607 (make-variable-buffer-local 'company-prefix)
 608
 609 (defvar company-candidates nil)
 610 (make-variable-buffer-local 'company-candidates)
 611
 612 (defvar company-candidates-length nil)
 613 (make-variable-buffer-local 'company-candidates-length)
 614
 615 (defvar company-candidates-cache nil)
 616 (make-variable-buffer-local 'company-candidates-cache)
 617
 618 (defvar company-candidates-predicate nil)
 619 (make-variable-buffer-local 'company-candidates-predicate)
 620
 621 (defvar company-common nil)
 622 (make-variable-buffer-local 'company-common)
 623
 624 (defvar company-selection 0)
 625 (make-variable-buffer-local 'company-selection)
 626
 627 (defvar company-selection-changed nil)
 628 (make-variable-buffer-local 'company-selection-changed)
 629
 630 (defvar company--explicit-action nil
 631   "Non-nil, if explicit completion took place.")
 632 (make-variable-buffer-local 'company--explicit-action)
 633
 634 (defvar company--this-command nil)
 635
 636 (defvar company-point nil)
 637 (make-variable-buffer-local 'company-point)
 638
 639 (defvar company-timer nil)
 640
 641 (defvar company-added-newline nil)
 642 (make-variable-buffer-local 'company-added-newline)
 643
 644 (defsubst company-strip-prefix (str)
 645   (substring str (length company-prefix)))
 646
 647 (defun company-explicit-action-p ()
 648   "Return whether explicit completion action was taken by the user."
 649   (or company--explicit-action
 650       company-selection-changed))
 651
 652 (defsubst company-reformat (candidate)
 653   ;; company-ispell needs this, because the results are always lower-case
 654   ;; It's mory efficient to fix it only when they are displayed.
 655   (concat company-prefix (substring candidate (length company-prefix))))
 656
 657 (defun company--should-complete ()
 658   (and (not (or buffer-read-only overriding-terminal-local-map
 659                 overriding-local-map))
 660        (eq company-idle-delay t)
 661        (or (eq t company-begin-commands)
 662            (memq company--this-command company-begin-commands)
 663            (and (symbolp this-command) (get this-command 'company-begin)))
 664        (not (and transient-mark-mode mark-active))))
 665
 666 (defsubst company-call-frontends (command)
 667   (dolist (frontend company-frontends)
 668     (condition-case err
 669         (funcall frontend command)
 670       (error (error "Company: Front-end %s error \"%s\" on command %s"
 671                     frontend (error-message-string err) command)))))
 672
 673 (defsubst company-set-selection (selection &optional force-update)
 674   (setq selection (max 0 (min (1- company-candidates-length) selection)))
 675   (when (or force-update (not (equal selection company-selection)))
 676     (setq company-selection selection
 677           company-selection-changed t)
 678     (company-call-frontends 'update)))
 679
 680 (defun company-apply-predicate (candidates predicate)
 681   (let (new)
 682     (dolist (c candidates)
 683       (when (funcall predicate c)
 684         (push c new)))
 685     (nreverse new)))
 686
 687 (defun company-update-candidates (candidates)
 688   (setq company-candidates-length (length candidates))
 689   (if (> company-selection 0)
 690       ;; Try to restore the selection
 691       (let ((selected (nth company-selection company-candidates)))
 692         (setq company-selection 0
 693               company-candidates candidates)
 694         (when selected
 695           (while (and candidates (string< (pop candidates) selected))
 696             (incf company-selection))
 697           (unless candidates
 698             ;; Make sure selection isn't out of bounds.
 699             (setq company-selection (min (1- company-candidates-length)
 700                                          company-selection)))))
 701     (setq company-selection 0
 702           company-candidates candidates))
 703   ;; Save in cache:
 704   (push (cons company-prefix company-candidates) company-candidates-cache)
 705   ;; Calculate common.
 706   (let ((completion-ignore-case (company-call-backend 'ignore-case)))
 707     (setq company-common (try-completion company-prefix company-candidates)))
 708   (when (eq company-common t)
 709     (setq company-candidates nil)))
 710
 711 (defun company-calculate-candidates (prefix)
 712   (let ((candidates
 713          (or (cdr (assoc prefix company-candidates-cache))
 714              (when company-candidates-cache
 715                (let ((len (length prefix))
 716                      (completion-ignore-case (company-call-backend
 717                                               'ignore-case))
 718                      prev)
 719                  (dotimes (i (1+ len))
 720                    (when (setq prev (cdr (assoc (substring prefix 0 (- len i))
 721                                                 company-candidates-cache)))
 722                      (return (all-completions prefix prev))))))
 723              (let ((c (company-call-backend 'candidates prefix)))
 724                (when company-candidates-predicate
 725                  (setq c (company-apply-predicate
 726                           c company-candidates-predicate)))
 727                (unless (company-call-backend 'sorted)
 728                  (setq c (sort c 'string<)))
 729                (when (company-call-backend 'duplicates)
 730                  ;; strip duplicates
 731                  (let ((c2 c))
 732                    (while c2
 733                      (setcdr c2 (progn (while (equal (pop c2) (car c2)))
 734                                        c2)))))
 735                c))))
 736     (if (or (cdr candidates)
 737             (not (equal (car candidates) prefix)))
 738         ;; Don't start when already completed and unique.
 739         candidates
 740       ;; Not the right place? maybe when setting?
 741       (and company-candidates t))))
 742
 743 (defun company-idle-begin (buf win tick pos)
 744   (and company-mode
 745        (eq buf (current-buffer))
 746        (eq win (selected-window))
 747        (eq tick (buffer-chars-modified-tick))
 748        (eq pos (point))
 749        (not company-candidates)
 750        (not (equal (point) company-point))
 751        (let ((company-idle-delay t))
 752          (company-begin)
 753          (when company-candidates
 754            (company-input-noop)
 755            (company-post-command)))))
 756
 757 (defun company-manual-begin ()
 758   (interactive)
 759   (company-assert-enabled)
 760   (and company-mode
 761        (not company-candidates)
 762        (let ((company-idle-delay t)
 763              (company-minimum-prefix-length 0)
 764              (company-begin-commands t))
 765          (setq company--explicit-action t)
 766          (company-begin)))
 767   ;; Return non-nil if active.
 768   company-candidates)
 769
 770 (defsubst company-incremental-p (old-prefix new-prefix)
 771   (and (> (length new-prefix) (length old-prefix))
 772        (equal old-prefix (substring new-prefix 0 (length old-prefix)))))
 773
 774 (defun company-require-match-p ()
 775   (let ((backend-value (company-call-backend 'require-match)))
 776     (or (eq backend-value t)
 777         (and (if (functionp company-require-match)
 778                  (funcall company-require-match)
 779                (eq company-require-match t))
 780              (not (eq backend-value 'never))))))
 781
 782 (defun company-punctuation-p (input)
 783   "Return non-nil, if input starts with punctuation or parentheses."
 784   (memq (char-syntax (string-to-char input)) '(?. ?\( ?\))))
 785
 786 (defun company-auto-complete-p (beg end)
 787   "Return non-nil, if input starts with punctuation or parentheses."
 788   (and (> end beg)
 789        (if (functionp company-auto-complete)
 790            (funcall company-auto-complete)
 791          company-auto-complete)
 792        (if (functionp company-auto-complete-chars)
 793            (funcall company-auto-complete-chars (buffer-substring beg end))
 794          (if (consp company-auto-complete-chars)
 795              (memq (char-syntax (char-after beg)) company-auto-complete-chars)
 796            (string-match (buffer-substring beg (1+ beg))
 797                          company-auto-complete-chars)))))
 798
 799 (defun company-continue ()
 800   (when (company-call-backend 'no-cache company-prefix)
 801     ;; Don't complete existing candidates, fetch new ones.
 802     (setq company-candidates-cache nil))
 803   (let ((new-prefix (company-call-backend 'prefix)))
 804     (if (= (- (point) (length new-prefix))
 805            (- company-point (length company-prefix)))
 806         (unless (or (equal company-prefix new-prefix)
 807                     (let ((c (company-calculate-candidates new-prefix)))
 808                       ;; t means complete/unique.
 809                       (if (eq c t)
 810                           (progn (company-cancel new-prefix) t)
 811                         (when (consp c)
 812                           (setq company-prefix new-prefix)
 813                           (company-update-candidates c)
 814                           t))))
 815           (if (not (and (company-incremental-p company-prefix new-prefix)
 816                         (company-require-match-p)))
 817               (progn
 818                 (when (equal company-prefix (car company-candidates))
 819                   ;; cancel, but last input was actually success
 820                   (company-cancel company-prefix))
 821                 (setq company-candidates nil))
 822             (backward-delete-char (length new-prefix))
 823             (insert company-prefix)
 824             (ding)
 825             (message "Matching input is required")))
 826       (when (company-auto-complete-p company-point (point))
 827         (save-excursion
 828           (goto-char company-point)
 829           (company-complete-selection)))
 830       (setq company-candidates nil))
 831     company-candidates))
 832
 833 (defun company-begin ()
 834   (when (and (not (and company-candidates (company-continue)))
 835              (company--should-complete))
 836     (let (prefix)
 837       (dolist (backend (if company-backend
 838                            ;; prefer manual override
 839                            (list company-backend)
 840                          company-backends))
 841         (setq prefix
 842               (if (or (symbolp backend)
 843                       (functionp backend))
 844                   (when (or (not (symbolp backend))
 845                             (get backend 'company-init))
 846                     (funcall backend 'prefix))
 847                 (company--multi-backend-adapter backend 'prefix)))
 848         (when prefix
 849           (when (and (stringp prefix)
 850                      (>= (length prefix) company-minimum-prefix-length))
 851             (setq company-backend backend
 852                   company-prefix prefix)
 853             (let ((c (company-calculate-candidates prefix)))
 854               ;; t means complete/unique.  We don't start, so no hooks.
 855               (when (consp c)
 856                 (company-update-candidates c)
 857                 (run-hook-with-args 'company-completion-started-hook
 858                                     (company-explicit-action-p))
 859                 (company-call-frontends 'show))))
 860           (return prefix)))))
 861   (if company-candidates
 862       (progn
 863         (when (and company-end-of-buffer-workaround (eobp))
 864           (save-excursion (insert "\n"))
 865           (setq company-added-newline (buffer-chars-modified-tick)))
 866         (setq company-point (point))
 867         (company-enable-overriding-keymap company-active-map)
 868         (company-call-frontends 'update))
 869     (company-cancel)))
 870
 871 (defun company-cancel (&optional result)
 872   (and company-added-newline
 873        (> (point-max) (point-min))
 874        (let ((tick (buffer-chars-modified-tick)))
 875          (delete-region (1- (point-max)) (point-max))
 876          (equal tick company-added-newline))
 877        ;; Only set unmodified when tick remained the same since insert.
 878        (set-buffer-modified-p nil))
 879   (when company-prefix
 880     (if (stringp result)
 881         (run-hook-with-args 'company-completion-finished-hook result)
 882       (run-hook-with-args 'company-completion-cancelled-hook result)))
 883   (setq company-added-newline nil
 884         company-backend nil
 885         company-prefix nil
 886         company-candidates nil
 887         company-candidates-length nil
 888         company-candidates-cache nil
 889         company-candidates-predicate nil
 890         company-common nil
 891         company-selection 0
 892         company-selection-changed nil
 893         company--explicit-action nil
 894         company-point nil)
 895   (when company-timer
 896     (cancel-timer company-timer))
 897   (company-search-mode 0)
 898   (company-call-frontends 'hide)
 899   (company-enable-overriding-keymap nil))
 900
 901 (defun company-abort ()
 902   (interactive)
 903   (company-cancel t)
 904   ;; Don't start again, unless started manually.
 905   (setq company-point (point)))
 906
 907 (defun company-finish (result)
 908   (insert (company-strip-prefix result))
 909   (company-cancel result)
 910   ;; Don't start again, unless started manually.
 911   (setq company-point (point)))
 912
 913 (defsubst company-keep (command)
 914   (and (symbolp command) (get command 'company-keep)))
 915
 916 (defun company-pre-command ()
 917   (unless (company-keep this-command)
 918     (condition-case err
 919         (when company-candidates
 920           (company-call-frontends 'pre-command))
 921       (error (message "Company: An error occurred in pre-command")
 922              (message "%s" (error-message-string err))
 923              (company-cancel))))
 924   (when company-timer
 925     (cancel-timer company-timer))
 926   (company-uninstall-map))
 927
 928 (defun company-post-command ()
 929   (unless (company-keep this-command)
 930     (condition-case err
 931         (progn
 932           (setq company--this-command this-command)
 933           (unless (equal (point) company-point)
 934             (company-begin))
 935           (when company-candidates
 936             (company-call-frontends 'post-command))
 937           (when (numberp company-idle-delay)
 938             (setq company-timer
 939                   (run-with-timer company-idle-delay nil 'company-idle-begin
 940                                   (current-buffer) (selected-window)
 941                                   (buffer-chars-modified-tick) (point)))))
 942       (error (message "Company: An error occurred in post-command")
 943              (message "%s" (error-message-string err))
 944              (company-cancel))))
 945   (company-install-map))
 946
 947 ;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 948
 949 (defvar company-search-string nil)
 950 (make-variable-buffer-local 'company-search-string)
 951
 952 (defvar company-search-lighter " Search: \"\"")
 953 (make-variable-buffer-local 'company-search-lighter)
 954
 955 (defvar company-search-old-map nil)
 956 (make-variable-buffer-local 'company-search-old-map)
 957
 958 (defvar company-search-old-selection 0)
 959 (make-variable-buffer-local 'company-search-old-selection)
 960
 961 (defun company-search (text lines)
 962   (let ((quoted (regexp-quote text))
 963         (i 0))
 964     (dolist (line lines)
 965       (when (string-match quoted line (length company-prefix))
 966         (return i))
 967       (incf i))))
 968
 969 (defun company-search-printing-char ()
 970   (interactive)
 971   (company-search-assert-enabled)
 972   (setq company-search-string
 973         (concat (or company-search-string "") (string last-command-event))
 974         company-search-lighter (concat " Search: \"" company-search-string
 975                                         "\""))
 976   (let ((pos (company-search company-search-string
 977                               (nthcdr company-selection company-candidates))))
 978     (if (null pos)
 979         (ding)
 980       (company-set-selection (+ company-selection pos) t))))
 981
 982 (defun company-search-repeat-forward ()
 983   "Repeat the incremental search in completion candidates forward."
 984   (interactive)
 985   (company-search-assert-enabled)
 986   (let ((pos (company-search company-search-string
 987                               (cdr (nthcdr company-selection
 988                                            company-candidates)))))
 989     (if (null pos)
 990         (ding)
 991       (company-set-selection (+ company-selection pos 1) t))))
 992
 993 (defun company-search-repeat-backward ()
 994   "Repeat the incremental search in completion candidates backwards."
 995   (interactive)
 996   (company-search-assert-enabled)
 997   (let ((pos (company-search company-search-string
 998                               (nthcdr (- company-candidates-length
 999                                          company-selection)
1000                                       (reverse company-candidates)))))
1001     (if (null pos)
1002         (ding)
1003       (company-set-selection (- company-selection pos 1) t))))
1004
1005 (defun company-create-match-predicate ()
1006   (setq company-candidates-predicate
1007         `(lambda (candidate)
1008            ,(if company-candidates-predicate
1009                 `(and (string-match ,company-search-string candidate)
1010                       (funcall ,company-candidates-predicate
1011                                candidate))
1012               `(string-match ,company-search-string candidate))))
1013   (company-update-candidates
1014    (company-apply-predicate company-candidates company-candidates-predicate))
1015   ;; Invalidate cache.
1016   (setq company-candidates-cache (cons company-prefix company-candidates)))
1017
1018 (defun company-filter-printing-char ()
1019   (interactive)
1020   (company-search-assert-enabled)
1021   (company-search-printing-char)
1022   (company-create-match-predicate)
1023   (company-call-frontends 'update))
1024
1025 (defun company-search-kill-others ()
1026   "Limit the completion candidates to the ones matching the search string."
1027   (interactive)
1028   (company-search-assert-enabled)
1029   (company-create-match-predicate)
1030   (company-search-mode 0)
1031   (company-call-frontends 'update))
1032
1033 (defun company-search-abort ()
1034   "Abort searching the completion candidates."
1035   (interactive)
1036   (company-search-assert-enabled)
1037   (company-set-selection company-search-old-selection t)
1038   (company-search-mode 0))
1039
1040 (defun company-search-other-char ()
1041   (interactive)
1042   (company-search-assert-enabled)
1043   (company-search-mode 0)
1044   (when last-input-event
1045     (clear-this-command-keys t)
1046     (setq unread-command-events (list last-input-event))))
1047
1048 (defvar company-search-map
1049   (let ((i 0)
1050         (keymap (make-keymap)))
1051     (if (fboundp 'max-char)
1052         (set-char-table-range (nth 1 keymap) (cons #x100 (max-char))
1053                               'company-search-printing-char)
1054       (with-no-warnings
1055         ;; obselete in Emacs 23
1056         (let ((l (generic-character-list))
1057               (table (nth 1 keymap)))
1058           (while l
1059             (set-char-table-default table (car l) 'company-search-printing-char)
1060             (setq l (cdr l))))))
1061     (define-key keymap [t] 'company-search-other-char)
1062     (while (< i ?\s)
1063       (define-key keymap (make-string 1 i) 'company-search-other-char)
1064       (incf i))
1065     (while (< i 256)
1066       (define-key keymap (vector i) 'company-search-printing-char)
1067       (incf i))
1068     (let ((meta-map (make-sparse-keymap)))
1069       (define-key keymap (char-to-string meta-prefix-char) meta-map)
1070       (define-key keymap [escape] meta-map))
1071     (define-key keymap (vector meta-prefix-char t) 'company-search-other-char)
1072     (define-key keymap "\e\e\e" 'company-search-other-char)
1073     (define-key keymap  [escape escape escape] 'company-search-other-char)
1074
1075     (define-key keymap "\C-g" 'company-search-abort)
1076     (define-key keymap "\C-s" 'company-search-repeat-forward)
1077     (define-key keymap "\C-r" 'company-search-repeat-backward)
1078     (define-key keymap "\C-o" 'company-search-kill-others)
1079     keymap)
1080   "Keymap used for incrementally searching the completion candidates.")
1081
1082 (define-minor-mode company-search-mode
1083   "Search mode for completion candidates.
1084 Don't start this directly, use `company-search-candidates' or
1085 `company-filter-candidates'."
1086   nil company-search-lighter nil
1087   (if company-search-mode
1088       (if (company-manual-begin)
1089           (progn
1090             (setq company-search-old-selection company-selection)
1091             (company-call-frontends 'update))
1092         (setq company-search-mode nil))
1093     (kill-local-variable 'company-search-string)
1094     (kill-local-variable 'company-search-lighter)
1095     (kill-local-variable 'company-search-old-selection)
1096     (company-enable-overriding-keymap company-active-map)))
1097
1098 (defsubst company-search-assert-enabled ()
1099   (company-assert-enabled)
1100   (unless company-search-mode
1101     (company-uninstall-map)
1102     (error "Company not in search mode")))
1103
1104 (defun company-search-candidates ()
1105   "Start searching the completion candidates incrementally.
1106
1107 \\<company-search-map>Search can be controlled with the commands:
1108 - `company-search-repeat-forward' (\\[company-search-repeat-forward])
1109 - `company-search-repeat-backward' (\\[company-search-repeat-backward])
1110 - `company-search-abort' (\\[company-search-abort])
1111
1112 Regular characters are appended to the search string.
1113
1114 The command `company-search-kill-others' (\\[company-search-kill-others]) uses
1115  the search string to limit the completion candidates."
1116   (interactive)
1117   (company-search-mode 1)
1118   (company-enable-overriding-keymap company-search-map))
1119
1120 (defvar company-filter-map
1121   (let ((keymap (make-keymap)))
1122     (define-key keymap [remap company-search-printing-char]
1123       'company-filter-printing-char)
1124     (set-keymap-parent keymap company-search-map)
1125     keymap)
1126   "Keymap used for incrementally searching the completion candidates.")
1127
1128 (defun company-filter-candidates ()
1129   "Start filtering the completion candidates incrementally.
1130 This works the same way as `company-search-candidates' immediately
1131 followed by `company-search-kill-others' after each input."
1132   (interactive)
1133   (company-search-mode 1)
1134   (company-enable-overriding-keymap company-filter-map))
1135
1136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1137
1138 (defun company-select-next ()
1139   "Select the next candidate in the list."
1140   (interactive)
1141   (when (company-manual-begin)
1142     (company-set-selection (1+ company-selection))))
1143
1144 (defun company-select-previous ()
1145   "Select the previous candidate in the list."
1146   (interactive)
1147   (when (company-manual-begin)
1148     (company-set-selection (1- company-selection))))
1149
1150 (defun company-select-mouse (event)
1151   "Select the candidate picked by the mouse."
1152   (interactive "e")
1153   (when (nth 4 (event-start event))
1154     (company-set-selection (- (cdr (posn-actual-col-row (event-start event)))
1155                               (cdr (posn-actual-col-row (posn-at-point)))
1156                               1))
1157     t))
1158
1159 (defun company-complete-mouse (event)
1160   "Complete the candidate picked by the mouse."
1161   (interactive "e")
1162   (when (company-select-mouse event)
1163     (company-complete-selection)))
1164
1165 (defun company-complete-selection ()
1166   "Complete the selected candidate."
1167   (interactive)
1168   (when (company-manual-begin)
1169     (company-finish (nth company-selection company-candidates))))
1170
1171 (defun company-complete-common ()
1172   "Complete the common part of all candidates."
1173   (interactive)
1174   (when (company-manual-begin)
1175     (if (and (not (cdr company-candidates))
1176              (equal company-common (car company-candidates)))
1177         (company-complete-selection)
1178       (insert (company-strip-prefix company-common)))))
1179
1180 (defun company-complete ()
1181   "Complete the common part of all candidates or the current selection.
1182 The first time this is called, the common part is completed, the second time, or
1183 when the selection has been changed, the selected candidate is completed."
1184   (interactive)
1185   (when (company-manual-begin)
1186     (if (or company-selection-changed
1187             (eq last-command 'company-complete-common))
1188         (call-interactively 'company-complete-selection)
1189       (call-interactively 'company-complete-common)
1190       (setq this-command 'company-complete-common))))
1191
1192 (defun company-complete-number (n)
1193   "Complete the Nth candidate.
1194 To show the number next to the candidates in some back-ends, enable
1195 `company-show-numbers'."
1196   (when (company-manual-begin)
1197     (and (< n 1) (> n company-candidates-length)
1198          (error "No candidate number %d" n))
1199     (decf n)
1200     (company-finish (nth n company-candidates))))
1201
1202 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1203
1204 (defconst company-space-strings-limit 100)
1205
1206 (defconst company-space-strings
1207   (let (lst)
1208     (dotimes (i company-space-strings-limit)
1209       (push (make-string (- company-space-strings-limit 1 i) ?\  ) lst))
1210     (apply 'vector lst)))
1211
1212 (defsubst company-space-string (len)
1213   (if (< len company-space-strings-limit)
1214       (aref company-space-strings len)
1215     (make-string len ?\ )))
1216
1217 (defsubst company-safe-substring (str from &optional to)
1218   (let ((len (length str)))
1219     (if (> from len)
1220         ""
1221       (if (and to (> to len))
1222           (concat (substring str from)
1223                   (company-space-string (- to len)))
1224         (substring str from to)))))
1225
1226 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1227
1228 (defvar company-last-metadata nil)
1229 (make-variable-buffer-local 'company-last-metadata)
1230
1231 (defun company-fetch-metadata ()
1232   (let ((selected (nth company-selection company-candidates)))
1233     (unless (equal selected (car company-last-metadata))
1234       (setq company-last-metadata
1235             (cons selected (company-call-backend 'meta selected))))
1236     (cdr company-last-metadata)))
1237
1238 (defun company-doc-buffer (&optional string)
1239   (with-current-buffer (get-buffer-create "*Company meta-data*")
1240     (erase-buffer)
1241     (current-buffer)))
1242
1243 (defmacro company-electric (&rest body)
1244   (declare (indent 0) (debug t))
1245   `(when (company-manual-begin)
1246      (save-window-excursion
1247        (let ((height (window-height))
1248              (row (cdr (posn-actual-col-row (posn-at-point)))))
1249          ,@body
1250          (and (< (window-height) height)
1251               (< (- (window-height) row 2) company-tooltip-limit)
1252               (recenter (- (window-height) row 2)))
1253          (while (eq 'scroll-other-window
1254                     (key-binding (vector (list (read-event)))))
1255            (call-interactively 'scroll-other-window))
1256          (when last-input-event
1257            (clear-this-command-keys t)
1258            (setq unread-command-events (list last-input-event)))))))
1259
1260 (defun company-show-doc-buffer ()
1261   "Temporarily show a buffer with the complete documentation for the selection."
1262   (interactive)
1263   (company-electric
1264     (let ((selected (nth company-selection company-candidates)))
1265       (display-buffer (or (company-call-backend 'doc-buffer selected)
1266                           (error "No documentation available")) t))))
1267 (put 'company-show-doc-buffer 'company-keep t)
1268
1269 (defun company-show-location ()
1270   "Temporarily display a buffer showing the selected candidate in context."
1271   (interactive)
1272   (company-electric
1273     (let* ((selected (nth company-selection company-candidates))
1274            (location (company-call-backend 'location selected))
1275            (pos (or (cdr location) (error "No location available")))
1276            (buffer (or (and (bufferp (car location)) (car location))
1277                        (find-file-noselect (car location) t))))
1278       (with-selected-window (display-buffer buffer t)
1279         (if (bufferp (car location))
1280             (goto-char pos)
1281           (goto-line pos))
1282         (set-window-start nil (point))))))
1283 (put 'company-show-location 'company-keep t)
1284
1285 ;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1286
1287 (defvar company-callback nil)
1288 (make-variable-buffer-local 'company-callback)
1289
1290 (defvar company-begin-with-marker nil)
1291 (make-variable-buffer-local 'company-begin-with-marker)
1292
1293 (defun company-remove-callback (&optional ignored)
1294   (remove-hook 'company-completion-finished-hook company-callback t)
1295   (remove-hook 'company-completion-cancelled-hook 'company-remove-callback t)
1296   (remove-hook 'company-completion-finished-hook 'company-remove-callback t)
1297   (set-marker company-begin-with-marker nil))
1298
1299 (defun company-begin-backend (backend &optional callback)
1300   "Start a completion at point using BACKEND."
1301   (interactive (let ((val (completing-read "Company back-end: "
1302                                            obarray
1303                                            'functionp nil "company-")))
1304                  (when val
1305                    (list (intern val)))))
1306   (when (setq company-callback callback)
1307     (add-hook 'company-completion-finished-hook company-callback nil t))
1308   (add-hook 'company-completion-cancelled-hook 'company-remove-callback nil t)
1309   (add-hook 'company-completion-finished-hook 'company-remove-callback nil t)
1310   (setq company-backend backend)
1311   ;; Return non-nil if active.
1312   (or (company-manual-begin)
1313       (error "Cannot complete at point")))
1314
1315 (defun company-begin-with (candidates
1316                            &optional prefix-length require-match callback)
1317   "Start a completion at point.
1318 CANDIDATES is the list of candidates to use and PREFIX-LENGTH is the length of
1319 the prefix that already is in the buffer before point.  It defaults to 0.
1320
1321 CALLBACK is a function called with the selected result if the user successfully
1322 completes the input.
1323
1324 Example:
1325 \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
1326   (company-begin-backend
1327    (let ((start (- (point) (or prefix-length 0))))
1328      (setq company-begin-with-marker (copy-marker (point) t))
1329      `(lambda (command &optional arg &rest ignored)
1330         (case command
1331           ('prefix (when (equal (point)
1332                                 (marker-position company-begin-with-marker))
1333                      (buffer-substring ,start (point))))
1334           ('candidates (all-completions arg ',candidates))
1335           ('require-match ,require-match))))
1336    callback))
1337
1338 ;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1339
1340 (defvar company-pseudo-tooltip-overlay nil)
1341 (make-variable-buffer-local 'company-pseudo-tooltip-overlay)
1342
1343 (defvar company-tooltip-offset 0)
1344 (make-variable-buffer-local 'company-tooltip-offset)
1345
1346 (defun company-pseudo-tooltip-update-offset (selection num-lines limit)
1347
1348   (decf limit 2)
1349   (setq company-tooltip-offset
1350         (max (min selection company-tooltip-offset)
1351              (- selection -1 limit)))
1352
1353   (when (<= company-tooltip-offset 1)
1354     (incf limit)
1355     (setq company-tooltip-offset 0))
1356
1357   (when (>= company-tooltip-offset (- num-lines limit 1))
1358     (incf limit)
1359     (when (= selection (1- num-lines))
1360       (decf company-tooltip-offset)
1361       (when (<= company-tooltip-offset 1)
1362         (setq company-tooltip-offset 0)
1363         (incf limit))))
1364
1365   limit)
1366
1367 ;;; propertize
1368
1369 (defsubst company-round-tab (arg)
1370   (* (/ (+ arg tab-width) tab-width) tab-width))
1371
1372 (defun company-untabify (str)
1373   (let* ((pieces (split-string str "\t"))
1374          (copy pieces))
1375     (while (cdr copy)
1376       (setcar copy (company-safe-substring
1377                     (car copy) 0 (company-round-tab (string-width (car copy)))))
1378       (pop copy))
1379     (apply 'concat pieces)))
1380
1381 (defun company-fill-propertize (line width selected)
1382   (setq line (company-safe-substring line 0 width))
1383   (add-text-properties 0 width '(face company-tooltip
1384                                  mouse-face company-tooltip-mouse)
1385                        line)
1386   (add-text-properties 0 (length company-common)
1387                        '(face company-tooltip-common
1388                          mouse-face company-tooltip-mouse)
1389                        line)
1390   (when selected
1391     (if (and company-search-string
1392              (string-match (regexp-quote company-search-string) line
1393                            (length company-prefix)))
1394         (progn
1395           (add-text-properties (match-beginning 0) (match-end 0)
1396                                '(face company-tooltip-selection)
1397                                line)
1398           (when (< (match-beginning 0) (length company-common))
1399             (add-text-properties (match-beginning 0) (length company-common)
1400                                  '(face company-tooltip-common-selection)
1401                                  line)))
1402       (add-text-properties 0 width '(face company-tooltip-selection
1403                                           mouse-face company-tooltip-selection)
1404                            line)
1405       (add-text-properties 0 (length company-common)
1406                            '(face company-tooltip-common-selection
1407                              mouse-face company-tooltip-selection)
1408                            line)))
1409   line)
1410
1411 ;;; replace
1412
1413 (defun company-buffer-lines (beg end)
1414   (goto-char beg)
1415   (let ((row (cdr (posn-actual-col-row (posn-at-point))))
1416         lines)
1417     (while (and (equal (move-to-window-line (incf row)) row)
1418                 (<= (point) end))
1419       (push (buffer-substring beg (min end (1- (point)))) lines)
1420       (setq beg (point)))
1421     (unless (eq beg end)
1422       (push (buffer-substring beg end) lines))
1423     (nreverse lines)))
1424
1425 (defsubst company-modify-line (old new offset)
1426   (concat (company-safe-substring old 0 offset)
1427           new
1428           (company-safe-substring old (+ offset (length new)))))
1429
1430 (defun company-replacement-string (old lines column nl)
1431   (let (new)
1432     ;; Inject into old lines.
1433     (while old
1434       (push (company-modify-line (pop old) (pop lines) column) new))
1435     ;; Append whole new lines.
1436     (while lines
1437       (push (concat (company-space-string column) (pop lines)) new))
1438     (concat (when nl "\n")
1439             (mapconcat 'identity (nreverse new) "\n")
1440             "\n")))
1441
1442 (defun company-create-lines (column selection limit)
1443
1444   (let ((len company-candidates-length)
1445         (numbered 99999)
1446         lines
1447         width
1448         lines-copy
1449         previous
1450         remainder
1451         new)
1452
1453     ;; Scroll to offset.
1454     (setq limit (company-pseudo-tooltip-update-offset selection len limit))
1455
1456     (when (> company-tooltip-offset 0)
1457       (setq previous (format "...(%d)" company-tooltip-offset)))
1458
1459     (setq remainder (- len limit company-tooltip-offset)
1460           remainder (when (> remainder 0)
1461                       (setq remainder (format "...(%d)" remainder))))
1462
1463     (decf selection company-tooltip-offset)
1464     (setq width (min (length previous) (length remainder))
1465           lines (nthcdr company-tooltip-offset company-candidates)
1466           len (min limit len)
1467           lines-copy lines)
1468
1469     (dotimes (i len)
1470       (setq width (max (length (pop lines-copy)) width)))
1471     (setq width (min width (- (window-width) column)))
1472
1473     (setq lines-copy lines)
1474
1475     ;; number can make tooltip too long
1476     (when company-show-numbers
1477       (setq numbered company-tooltip-offset))
1478
1479     (when previous
1480       (push (propertize (company-safe-substring previous 0 width)
1481                         'face 'company-tooltip)
1482             new))
1483
1484     (dotimes (i len)
1485       (push (company-fill-propertize
1486              (if (>= numbered 10)
1487                  (company-reformat (pop lines))
1488                (incf numbered)
1489                (format "%s %d"
1490                        (company-safe-substring (company-reformat (pop lines))
1491                                                0 (- width 2))
1492                        (mod numbered 10)))
1493              width (equal i selection))
1494             new))
1495
1496     (when remainder
1497       (push (propertize (company-safe-substring remainder 0 width)
1498                         'face 'company-tooltip)
1499             new))
1500
1501     (setq lines (nreverse new))))
1502
1503 ;; show
1504
1505 (defsubst company-pseudo-tooltip-height ()
1506   "Calculate the appropriate tooltip height."
1507   (max 3 (min company-tooltip-limit
1508               (- (window-height) 2
1509                  (count-lines (window-start) (point-at-bol))))))
1510
1511 (defun company-pseudo-tooltip-show (row column selection)
1512   (company-pseudo-tooltip-hide)
1513   (save-excursion
1514
1515     (move-to-column 0)
1516
1517     (let* ((height (company-pseudo-tooltip-height))
1518            (lines (company-create-lines column selection height))
1519            (nl (< (move-to-window-line row) row))
1520            (beg (point))
1521            (end (save-excursion
1522                   (move-to-window-line (+ row height))
1523                   (point)))
1524            (old-string
1525             (mapcar 'company-untabify (company-buffer-lines beg end)))
1526            str)
1527
1528       (setq company-pseudo-tooltip-overlay (make-overlay beg end))
1529
1530       (overlay-put company-pseudo-tooltip-overlay 'company-old old-string)
1531       (overlay-put company-pseudo-tooltip-overlay 'company-column column)
1532       (overlay-put company-pseudo-tooltip-overlay 'company-nl nl)
1533       (overlay-put company-pseudo-tooltip-overlay 'company-before
1534                    (company-replacement-string old-string lines column nl))
1535       (overlay-put company-pseudo-tooltip-overlay 'company-height height)
1536
1537       (overlay-put company-pseudo-tooltip-overlay 'window (selected-window)))))
1538
1539 (defun company-pseudo-tooltip-show-at-point (pos)
1540   (let ((col-row (posn-actual-col-row (posn-at-point pos))))
1541     (when col-row
1542       (company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row)
1543                                    company-selection))))
1544
1545 (defun company-pseudo-tooltip-edit (lines selection)
1546   (let* ((old-string (overlay-get company-pseudo-tooltip-overlay 'company-old))
1547          (column (overlay-get company-pseudo-tooltip-overlay 'company-column))
1548          (nl (overlay-get company-pseudo-tooltip-overlay 'company-nl))
1549          (height (overlay-get company-pseudo-tooltip-overlay 'company-height))
1550          (lines (company-create-lines column selection height)))
1551     (overlay-put company-pseudo-tooltip-overlay 'company-before
1552                  (company-replacement-string old-string lines column nl))))
1553
1554 (defun company-pseudo-tooltip-hide ()
1555   (when company-pseudo-tooltip-overlay
1556     (delete-overlay company-pseudo-tooltip-overlay)
1557     (setq company-pseudo-tooltip-overlay nil)))
1558
1559 (defun company-pseudo-tooltip-hide-temporarily ()
1560   (when (overlayp company-pseudo-tooltip-overlay)
1561     (overlay-put company-pseudo-tooltip-overlay 'invisible nil)
1562     (overlay-put company-pseudo-tooltip-overlay 'before-string nil)))
1563
1564 (defun company-pseudo-tooltip-unhide ()
1565   (when company-pseudo-tooltip-overlay
1566     (overlay-put company-pseudo-tooltip-overlay 'invisible t)
1567     (overlay-put company-pseudo-tooltip-overlay 'before-string
1568                  (overlay-get company-pseudo-tooltip-overlay 'company-before))
1569     (overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))
1570
1571 (defun company-pseudo-tooltip-frontend (command)
1572   "A `company-mode' front-end similar to a tool-tip but based on overlays."
1573   (case command
1574     ('pre-command (company-pseudo-tooltip-hide-temporarily))
1575     ('post-command
1576      (unless (and (overlayp company-pseudo-tooltip-overlay)
1577                   (equal (overlay-get company-pseudo-tooltip-overlay
1578                                       'company-height)
1579                          (company-pseudo-tooltip-height)))
1580        ;; Redraw needed.
1581        (company-pseudo-tooltip-show-at-point (- (point)
1582                                                 (length company-prefix))))
1583      (company-pseudo-tooltip-unhide))
1584     ('hide (company-pseudo-tooltip-hide)
1585            (setq company-tooltip-offset 0))
1586     ('update (when (overlayp company-pseudo-tooltip-overlay)
1587                (company-pseudo-tooltip-edit company-candidates
1588                                             company-selection)))))
1589
1590 (defun company-pseudo-tooltip-unless-just-one-frontend (command)
1591   "`company-pseudo-tooltip-frontend', but not shown for single candidates."
1592   (unless (and (eq command 'post-command)
1593                (not (cdr company-candidates)))
1594     (company-pseudo-tooltip-frontend command)))
1595
1596 ;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1597
1598 (defvar company-preview-overlay nil)
1599 (make-variable-buffer-local 'company-preview-overlay)
1600
1601 (defun company-preview-show-at-point (pos)
1602   (company-preview-hide)
1603
1604   (setq company-preview-overlay (make-overlay pos pos))
1605
1606   (let ((completion(nth company-selection company-candidates)))
1607     (setq completion (propertize completion 'face 'company-preview))
1608     (add-text-properties 0 (length company-common)
1609                          '(face company-preview-common) completion)
1610
1611     ;; Add search string
1612     (and company-search-string
1613          (string-match (regexp-quote company-search-string) completion)
1614          (add-text-properties (match-beginning 0)
1615                               (match-end 0)
1616                               '(face company-preview-search)
1617                               completion))
1618
1619     (setq completion (company-strip-prefix completion))
1620
1621     (and (equal pos (point))
1622          (not (equal completion ""))
1623          (add-text-properties 0 1 '(cursor t) completion))
1624
1625     (overlay-put company-preview-overlay 'after-string completion)
1626     (overlay-put company-preview-overlay 'window (selected-window))))
1627
1628 (defun company-preview-hide ()
1629   (when company-preview-overlay
1630     (delete-overlay company-preview-overlay)
1631     (setq company-preview-overlay nil)))
1632
1633 (defun company-preview-frontend (command)
1634   "A `company-mode' front-end showing the selection as if it had been inserted."
1635   (case command
1636     ('pre-command (company-preview-hide))
1637     ('post-command (company-preview-show-at-point (point)))
1638     ('hide (company-preview-hide))))
1639
1640 (defun company-preview-if-just-one-frontend (command)
1641   "`company-preview-frontend', but only shown for single candidates."
1642   (unless (and (eq command 'post-command)
1643                (cdr company-candidates))
1644     (company-preview-frontend command)))
1645
1646 ;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1647
1648 (defvar company-echo-last-msg nil)
1649 (make-variable-buffer-local 'company-echo-last-msg)
1650
1651 (defvar company-echo-timer nil)
1652
1653 (defvar company-echo-delay .1)
1654
1655 (defun company-echo-show (&optional getter)
1656   (when getter
1657     (setq company-echo-last-msg (funcall getter)))
1658   (let ((message-log-max nil))
1659     (if company-echo-last-msg
1660         (message "%s" company-echo-last-msg)
1661       (message ""))))
1662
1663 (defsubst company-echo-show-soon (&optional getter)
1664   (when company-echo-timer
1665     (cancel-timer company-echo-timer))
1666   (setq company-echo-timer (run-with-timer company-echo-delay nil
1667                                            'company-echo-show getter)))
1668
1669 (defun company-echo-format ()
1670
1671   (let ((limit (window-width (minibuffer-window)))
1672         (len -1)
1673         ;; Roll to selection.
1674         (candidates (nthcdr company-selection company-candidates))
1675         (i (if company-show-numbers company-selection 99999))
1676         comp msg)
1677
1678     (while candidates
1679       (setq comp (company-reformat (pop candidates))
1680             len (+ len 1 (length comp)))
1681       (if (< i 10)
1682           ;; Add number.
1683           (progn
1684             (setq comp (propertize (format "%d: %s" i comp)
1685                                    'face 'company-echo))
1686             (incf len 3)
1687             (incf i)
1688             (add-text-properties 3 (+ 3 (length company-common))
1689                                  '(face company-echo-common) comp))
1690         (setq comp (propertize comp 'face 'company-echo))
1691         (add-text-properties 0 (length company-common)
1692                              '(face company-echo-common) comp))
1693       (if (>= len limit)
1694           (setq candidates nil)
1695         (push comp msg)))
1696
1697     (mapconcat 'identity (nreverse msg) " ")))
1698
1699 (defun company-echo-strip-common-format ()
1700
1701   (let ((limit (window-width (minibuffer-window)))
1702         (len (+ (length company-prefix) 2))
1703         ;; Roll to selection.
1704         (candidates (nthcdr company-selection company-candidates))
1705         (i (if company-show-numbers company-selection 99999))
1706         msg comp)
1707
1708     (while candidates
1709       (setq comp (company-strip-prefix (pop candidates))
1710             len (+ len 2 (length comp)))
1711       (when (< i 10)
1712         ;; Add number.
1713         (setq comp (format "%s (%d)" comp i))
1714         (incf len 4)
1715         (incf i))
1716       (if (>= len limit)
1717           (setq candidates nil)
1718         (push (propertize comp 'face 'company-echo) msg)))
1719
1720     (concat (propertize company-prefix 'face 'company-echo-common) "{"
1721             (mapconcat 'identity (nreverse msg) ", ")
1722             "}")))
1723
1724 (defun company-echo-hide ()
1725   (when company-echo-timer
1726     (cancel-timer company-echo-timer))
1727   (unless (equal company-echo-last-msg "")
1728     (setq company-echo-last-msg "")
1729     (company-echo-show)))
1730
1731 (defun company-echo-frontend (command)
1732   "A `company-mode' front-end showing the candidates in the echo area."
1733   (case command
1734     ('pre-command (company-echo-show-soon))
1735     ('post-command (company-echo-show-soon 'company-echo-format))
1736     ('hide (company-echo-hide))))
1737
1738 (defun company-echo-strip-common-frontend (command)
1739   "A `company-mode' front-end showing the candidates in the echo area."
1740   (case command
1741     ('pre-command (company-echo-show-soon))
1742     ('post-command (company-echo-show-soon 'company-echo-strip-common-format))
1743     ('hide (company-echo-hide))))
1744
1745 (defun company-echo-metadata-frontend (command)
1746   "A `company-mode' front-end showing the documentation in the echo area."
1747   (case command
1748     ('pre-command (company-echo-show-soon))
1749     ('post-command (company-echo-show-soon 'company-fetch-metadata))
1750     ('hide (company-echo-hide))))
1751
1752 (provide 'company)
1753 ;;; company.el ends here