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

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