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