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