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