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

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