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