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