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