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