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