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

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