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

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