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