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