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

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