X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/7578184a7c8628633fa825d3e8c2faa295102ead..bc1b047226164ef40834b4e30f7767dcd2e56c39:/company.el

diff --git a/company.el b/company.el
index 27343fadf..24b00cb21 100644
--- a/company.el
+++ b/company.el
@@ -1,13 +1,13 @@
-;;; company.el --- Modular in-buffer completion framework  -*- lexical-binding: t -*-
+;;; company.el --- Modular text completion framework  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2009-2014  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
-;; Version: 0.6.13
-;; Keywords: abbrev, convenience, matching
 ;; URL: http://company-mode.github.io/
-;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x
+;; Version: 0.8.0-snapshot
+;; Keywords: abbrev, convenience, matching
+;; Package-Requires: ((emacs "24.1"))
 
 ;; This file is part of GNU Emacs.
 
@@ -48,11 +48,11 @@
 ;; Here is a simple example completing "foo":
 ;;
 ;; (defun company-my-backend (command &optional arg &rest ignored)
-;;   (case command
-;;     (prefix (when (looking-back "foo\\>")
+;;   (pcase command
+;;     (`prefix (when (looking-back "foo\\>")
 ;;               (match-string 0)))
-;;     (candidates (list "foobar" "foobaz" "foobarbaz"))
-;;     (meta (format "This value is named %s" arg))))
+;;     (`candidates (list "foobar" "foobaz" "foobarbaz"))
+;;     (`meta (format "This value is named %s" arg))))
 ;;
 ;; Sometimes it is a good idea to mix several back-ends together, for example to
 ;; enrich gtags with dabbrev-code results (to emulate local variables).
@@ -70,6 +70,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(require 'newcomment)
 
 ;; FIXME: Use `user-error'.
 (add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
@@ -123,19 +124,51 @@
      :foreground "red"))
   "Face used for the selected common completion in the tooltip.")
 
+(defface company-tooltip-annotation
+  '((default :inherit company-tooltip)
+    (((background light))
+     :foreground "firebrick4")
+    (((background dark))
+     :foreground "red4"))
+  "Face used for the annotation in the tooltip.")
+
+(defface company-scrollbar-fg
+  '((((background light))
+     :background "darkred")
+    (((background dark))
+     :background "red"))
+  "Face used for the tooltip scrollbar thumb.")
+
+(defface company-scrollbar-bg
+  '((default :inherit company-tooltip)
+    (((background light))
+     :background "wheat")
+    (((background dark))
+     :background "gold"))
+  "Face used for the tooltip scrollbar background.")
+
 (defface company-preview
-  '((t :background "blue4"
-       :foreground "wheat"))
+  '((((background light))
+     :inherit company-tooltip-selection)
+    (((background dark))
+     :background "blue4"
+     :foreground "wheat"))
   "Face used for the completion preview.")
 
 (defface company-preview-common
-  '((t :inherit company-preview
-       :foreground "red"))
+  '((((background light))
+     :inherit company-tooltip-selection)
+    (((background dark))
+     :inherit company-preview
+     :foreground "red"))
   "Face used for the common part of the completion preview.")
 
 (defface company-preview-search
-  '((t :inherit company-preview
-       :background "blue1"))
+  '((((background light))
+     :inherit company-tooltip-common-selection)
+    (((background dark))
+     :inherit company-preview
+     :background "blue1"))
   "Face used for the search string in the completion preview.")
 
 (defface company-echo nil
@@ -215,8 +248,20 @@ If this many lines are not available, prefer to display the tooltip above."
   "Width of margin columns to show around the toolip."
   :type 'integer)
 
+(defcustom company-tooltip-offset-display 'scrollbar
+  "Method using which the tooltip displays scrolling position.
+`scrollbar' means draw a scrollbar to the right of the items.
+`lines' means wrap items in lines with \"before\" and \"after\" counters."
+  :type '(choice (const :tag "Scrollbar" scrollbar)
+                 (const :tag "Two lines" lines)))
+
+(defcustom company-tooltip-align-annotations nil
+  "When non-nil, align annotations to the right tooltip border."
+  :type 'boolean)
+
 (defvar company-safe-backends
   '((company-abbrev . "Abbrev")
+    (company-bbdb . "BBDB")
     (company-capf . "completion-at-point-functions")
     (company-clang . "Clang")
     (company-cmake . "CMake")
@@ -251,18 +296,16 @@ If this many lines are not available, prefer to display the tooltip above."
 
 (defcustom company-backends `(,@(unless company--include-capf
                                   (list 'company-elisp))
+                              company-bbdb
                               company-nxml company-css
                               company-eclim company-semantic company-clang
                               company-xcode company-ropemacs company-cmake
                               ,@(when company--include-capf
                                   (list 'company-capf))
-                              (company-gtags company-etags company-dabbrev-code
+                              (company-dabbrev-code company-gtags company-etags
                                company-keywords)
                               company-oddmuse company-files company-dabbrev)
   "The list of active back-ends (completion engines).
-Each list elements can itself be a list of back-ends.  In that case their
-completions are merged.  Otherwise only the first matching back-end returns
-results.
 
 `company-begin-backend' can be used to start a specific back-end,
 `company-other-backend' will skip to the next matching back-end in the list.
@@ -276,11 +319,16 @@ text immediately before point.  Returning nil passes control to the next
 back-end.  The function should return `stop' if it should complete but
 cannot \(e.g. if it is in the middle of a string\).  Instead of a string,
 the back-end may return a cons where car is the prefix and cdr is used in
-`company-minimum-prefix-length' test. It's either number or t, in which
-case the test automatically succeeds.
+`company-minimum-prefix-length' test.  It must be either number or t, and
+in the latter case the test automatically succeeds.
 
 `candidates': The second argument is the prefix to be completed.  The
-return value should be a list of candidates that start with the prefix.
+return value should be a list of candidates that match the prefix.
+
+Non-prefix matches are also supported (candidates that don't start with the
+prefix, but match it in some backend-defined way).  Backends that use this
+feature must disable cache (return t to `no-cache') and should also respond
+to `match'.
 
 Optional commands:
 
@@ -304,6 +352,18 @@ buffer with documentation for it.  Preferably use `company-doc-buffer',
 of buffer and buffer location, or of file and line number where the
 completion candidate was defined.
 
+`annotation': The second argument is a completion candidate.  Return a
+string to be displayed inline with the candidate in the popup.  If
+duplicates are removed by company, candidates with equal string values will
+be kept if they have different annotations.  For that to work properly,
+backends should store the related information on candidates using text
+properties.
+
+`match': The second argument is a completion candidate.  Backends that
+provide non-prefix completions should return the position of the end of
+text in the candidate that matches `prefix'.  It will be used when
+rendering the popup.
+
 `require-match': If this returns t, the user is not allowed to enter
 anything not offered as a candidate.  Use with care!  The default value nil
 gives the user that choice with `company-require-match'.  Return value
@@ -320,7 +380,33 @@ modify it, e.g. to expand a snippet.
 
 The back-end should return nil for all commands it does not support or
 does not know about.  It should also be callable interactively and use
-`company-begin-backend' to start itself in that case."
+`company-begin-backend' to start itself in that case.
+
+Grouped back-ends:
+
+An element of `company-backends' can also itself be a list of back-ends,
+then it's considered to be a \"grouped\" back-end.
+
+When possible, commands taking a candidate as an argument are dispatched to
+the back-end it came from.  In other cases, the first non-nil value among
+all the back-ends is returned.
+
+The latter is the case for the `prefix' command.  But if the group contains
+the keyword `:with', the back-ends after it are ignored for this command.
+
+The completions from back-ends in a group are merged (but only from those
+that return the same `prefix').
+
+Asynchronous back-ends:
+
+The return value of each command can also be a cons (:async . FETCHER)
+where FETCHER is a function of one argument, CALLBACK.  When the data
+arrives, FETCHER must call CALLBACK and pass it the appropriate return
+value, as described above.
+
+True asynchronous operation is only supported for command `candidates', and
+only during idle completion.  Other commands will block the user interface,
+even if the back-end uses the asynchronous calling convention."
   :type `(repeat
           (choice
            :tag "Back-end"
@@ -332,10 +418,20 @@ does not know about.  It should also be callable interactively and use
                            ,@(mapcar (lambda (b)
                                        `(const :tag ,(cdr b) ,(car b)))
                                      company-safe-backends)
+                           (const :tag "With" :with)
                            (symbol :tag "User defined"))))))
 
 (put 'company-backends 'safe-local-variable 'company-safe-backends-p)
 
+(defcustom company-transformers nil
+  "Functions to change the list of candidates received from backends,
+after sorting and removal of duplicates (if appropriate).
+Each function gets called with the return value of the previous one."
+  :type '(choice
+          (const :tag "None" nil)
+          (const :tag "Sort by occurrence" (company-sort-by-occurrence))
+          (repeat :tag "User defined" (function))))
+
 (defcustom company-completion-started-hook nil
   "Hook run when company starts completing.
 The hook is called with one argument that is non-nil if the completion was
@@ -360,6 +456,12 @@ back-end, consider using the `post-completion' command instead."
   "The minimum prefix length for idle completion."
   :type '(integer :tag "prefix length"))
 
+(defcustom company-abort-manual-when-too-short nil
+  "If enabled, cancel a manually started completion when the prefix gets
+shorter than both `company-minimum-prefix-length' and the length of the
+prefix it was started from."
+  :type 'boolean)
+
 (defcustom company-require-match 'company-explicit-action-p
   "If enabled, disallow non-matching input.
 This can be a function do determine if a match is required.
@@ -419,7 +521,7 @@ immediately when a prefix of `company-minimum-prefix-length' is reached."
                  (const :tag "immediate (t)" t)
                  (number :tag "seconds")))
 
-(defcustom company-begin-commands '(self-insert-command)
+(defcustom company-begin-commands '(self-insert-command org-self-insert-command)
   "A list of commands after which idle completion is allowed.
 If this is t, it can show completions after any command.  See
 `company-idle-delay'.
@@ -430,6 +532,21 @@ treated as if it was on this list."
                  (const :tag "Self insert command" '(self-insert-command))
                  (repeat :tag "Commands" function)))
 
+(defcustom company-continue-commands '(not save-buffer save-some-buffers
+                                           save-buffers-kill-terminal
+                                           save-buffers-kill-emacs)
+  "A list of commands that are allowed during completion.
+If this is t, or if `company-begin-commands' is t, any command is allowed.
+Otherwise, the value must be a list of symbols.  If it starts with `not',
+the cdr is the list of commands that abort completion.  Otherwise, all
+commands except those in that list, or in `company-begin-commands', or
+commands in the `company-' namespace, abort completion."
+  :type '(choice (const :tag "Any command" t)
+                 (cons  :tag "Any except"
+                        (const not)
+                        (repeat :tag "Commands" function))
+                 (repeat :tag "Commands" function)))
+
 (defcustom company-show-numbers nil
   "If enabled, show quick-access numbers for the first ten candidates."
   :type '(choice (const :tag "off" nil)
@@ -444,6 +561,13 @@ treated as if it was on this list."
   "Work around a visualization bug when completing at the end of the buffer.
 The work-around consists of adding a newline.")
 
+(defvar company-async-wait 0.03
+  "Pause between checks to see if the value's been set when turning an
+asynchronous call into synchronous.")
+
+(defvar company-async-timeout 2
+  "Maximum wait time for a value to be set during asynchronous call.")
+
 ;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar company-mode-map (make-sparse-keymap)
@@ -484,21 +608,25 @@ The work-around consists of adding a newline.")
   (and (symbolp backend)
        (not (fboundp backend))
        (ignore-errors (require backend nil t)))
-
-  (if (or (symbolp backend)
-          (functionp backend))
-      (condition-case err
-          (progn
-            (funcall backend 'init)
-            (put backend 'company-init t))
-        (error
-         (put backend 'company-init 'failed)
-         (unless (memq backend company--disabled-backends)
-           (message "Company back-end '%s' could not be initialized:\n%s"
-                    backend (error-message-string err)))
-         (pushnew backend company--disabled-backends)
-         nil))
-    (mapc 'company-init-backend backend)))
+  (cond
+   ((symbolp backend)
+    (condition-case err
+        (progn
+          (funcall backend 'init)
+          (put backend 'company-init t))
+      (error
+       (put backend 'company-init 'failed)
+       (unless (memq backend company--disabled-backends)
+         (message "Company back-end '%s' could not be initialized:\n%s"
+                  backend (error-message-string err)))
+       (pushnew backend company--disabled-backends)
+       nil)))
+   ;; No initialization for lambdas.
+   ((functionp backend) t)
+   (t ;; Must be a list.
+    (dolist (b backend)
+      (unless (keywordp b)
+        (company-init-backend b))))))
 
 (defvar company-default-lighter " company")
 
@@ -603,6 +731,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
 ;; Hack:
 ;; Emacs calculates the active keymaps before reading the event.  That means we
 ;; cannot change the keymap from a timer.  So we send a bogus command.
+;; XXX: Seems not to be needed anymore in Emacs 24.4
 (defun company-ignore ()
   (interactive)
   (setq this-command last-command))
@@ -655,47 +784,125 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
     (unless (and (char-after) (eq (char-syntax (char-after)) ?w))
       "")))
 
+(defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
+  (let ((symbol (company-grab-symbol)))
+    (when symbol
+      (save-excursion
+        (forward-char (- (length symbol)))
+        (if (looking-back idle-begin-after-re (if max-len
+                                                  (- (point) max-len)
+                                                (line-beginning-position)))
+            (cons symbol t)
+          symbol)))))
+
 (defun company-in-string-or-comment ()
   (let ((ppss (syntax-ppss)))
     (or (car (setq ppss (nthcdr 3 ppss)))
         (car (setq ppss (cdr ppss)))
         (nth 3 ppss))))
 
-(if (fboundp 'locate-dominating-file)
-    (defalias 'company-locate-dominating-file 'locate-dominating-file)
-  (defun company-locate-dominating-file (file name)
-    (catch 'root
-      (let ((dir (file-name-directory file))
-            (prev-dir nil))
-        (while (not (equal dir prev-dir))
-          (when (file-exists-p (expand-file-name name dir))
-            (throw 'root dir))
-          (setq prev-dir dir
-                dir (file-name-directory (directory-file-name dir))))))))
-
 (defun company-call-backend (&rest args)
-  (if (functionp company-backend)
-      (apply company-backend args)
-    (apply 'company--multi-backend-adapter company-backend args)))
+  (company--force-sync #'company-call-backend-raw args company-backend))
+
+(defun company--force-sync (fun args backend)
+  (let ((value (apply fun args)))
+    (if (not (eq (car-safe value) :async))
+        value
+      (let ((res 'trash)
+            (start (time-to-seconds)))
+        (funcall (cdr value)
+                 (lambda (result) (setq res result)))
+        (while (eq res 'trash)
+          (if (> (- (time-to-seconds) start) company-async-timeout)
+              (error "Company: Back-end %s async timeout with args %s"
+                     backend args)
+            (sleep-for company-async-wait)))
+        res))))
+
+(defun company-call-backend-raw (&rest args)
+  (condition-case err
+      (if (functionp company-backend)
+          (apply company-backend args)
+        (apply #'company--multi-backend-adapter company-backend args))
+    (error (error "Company: Back-end %s error \"%s\" with args %s"
+                  company-backend (error-message-string err) args))))
 
 (defun company--multi-backend-adapter (backends command &rest args)
   (let ((backends (loop for b in backends
                         when (not (and (symbolp b)
                                        (eq 'failed (get b 'company-init))))
                         collect b)))
-    (case command
-      (candidates
-       (loop for backend in backends
-             when (equal (funcall backend 'prefix)
-                         (car args))
-             append (apply backend 'candidates args)))
-      (sorted nil)
-      (duplicates t)
-      (otherwise
+    (setq backends
+          (if (eq command 'prefix)
+              (butlast backends (length (member :with backends)))
+            (delq :with backends)))
+    (pcase command
+      (`candidates
+       (company--multi-backend-adapter-candidates backends (car args)))
+      (`sorted nil)
+      (`duplicates t)
+      ((or `prefix `ignore-case `no-cache `require-match)
        (let (value)
          (dolist (backend backends)
-           (when (setq value (apply backend command args))
-             (return value))))))))
+           (when (setq value (company--force-sync
+                              backend (cons command args) backend))
+             (return value)))))
+      (_
+       (let ((arg (car args)))
+         (when (> (length arg) 0)
+           (let ((backend (or (get-text-property 0 'company-backend arg)
+                              (car backends))))
+             (apply backend command args))))))))
+
+(defun company--multi-backend-adapter-candidates (backends prefix)
+  (let ((pairs (loop for backend in (cdr backends)
+                     when (equal (funcall backend 'prefix)
+                                 prefix)
+                     collect (cons (funcall backend 'candidates prefix)
+                                   (lambda (candidates)
+                                     (mapcar
+                                      (lambda (str)
+                                        (propertize str 'company-backend
+                                                    backend))
+                                      candidates))))))
+    (when (equal (funcall (car backends) 'prefix) prefix)
+      ;; Small perf optimization: don't tag the candidates received
+      ;; from the first backend in the group.
+      (push (cons (funcall (car backends) 'candidates prefix)
+                  'identity)
+            pairs))
+    (company--merge-async pairs (lambda (values) (apply #'append values)))))
+
+(defun company--merge-async (pairs merger)
+  (let ((async (loop for pair in pairs
+                     thereis
+                     (eq :async (car-safe (car pair))))))
+    (if (not async)
+        (funcall merger (loop for (val . mapper) in pairs
+                              collect (funcall mapper val)))
+      (cons
+       :async
+       (lambda (callback)
+         (let* (lst pending
+                (finisher (lambda ()
+                            (unless pending
+                              (funcall callback
+                                       (funcall merger
+                                                (nreverse lst)))))))
+           (dolist (pair pairs)
+             (let ((val (car pair))
+                   (mapper (cdr pair)))
+               (if (not (eq :async (car-safe val)))
+                   (push (funcall mapper val) lst)
+                 (push nil lst)
+                 (let ((cell lst)
+                       (fetcher (cdr val)))
+                   (push fetcher pending)
+                   (funcall fetcher
+                            (lambda (res)
+                              (setq pending (delq fetcher pending))
+                              (setcar cell (funcall mapper res))
+                              (funcall finisher)))))))))))))
 
 ;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -723,9 +930,12 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
 (defvar company-selection-changed nil)
 (make-variable-buffer-local 'company-selection-changed)
 
-(defvar company--explicit-action nil
-  "Non-nil, if explicit completion took place.")
-(make-variable-buffer-local 'company--explicit-action)
+(defvar company--manual-action nil
+  "Non-nil, if manual completion took place.")
+(make-variable-buffer-local 'company--manual-action)
+
+(defvar company--manual-prefix nil)
+(make-variable-buffer-local 'company--manual-prefix)
 
 (defvar company--auto-completion nil
   "Non-nil when current candidate is being inserted automatically.
@@ -746,8 +956,8 @@ Controlled by `company-auto-complete'.")
   (substring str (length company-prefix)))
 
 (defun company--insert-candidate (candidate)
+  (setq candidate (substring-no-properties candidate))
   ;; XXX: Return value we check here is subject to change.
-  (set-text-properties 0 (length candidate) nil candidate)
   (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
       (insert (company-strip-prefix candidate))
     (delete-region (- (point) (length company-prefix)) (point))
@@ -768,7 +978,7 @@ can retrieve meta-data for them."
 
 (defun company-explicit-action-p ()
   "Return whether explicit completion action was taken by the user."
-  (or company--explicit-action
+  (or company--manual-action
       company-selection-changed))
 
 (defun company-reformat (candidate)
@@ -791,6 +1001,15 @@ can retrieve meta-data for them."
            (and (symbolp this-command) (get this-command 'company-begin)))
        (not (and transient-mark-mode mark-active))))
 
+(defun company--should-continue ()
+  (or (eq t company-begin-commands)
+      (eq t company-continue-commands)
+      (if (eq 'not (car company-continue-commands))
+          (not (memq this-command (cdr company-continue-commands)))
+        (or (memq this-command company-begin-commands)
+            (memq this-command company-continue-commands)
+            (string-match-p "\\`company-" (symbol-name this-command))))))
+
 (defun company-call-frontends (command)
   (dolist (frontend company-frontends)
     (condition-case err
@@ -841,14 +1060,14 @@ can retrieve meta-data for them."
     ;; `company-complete-common'.
     (setq company-common
           (if (cdr company-candidates)
-              (company--safe-candidate
-               (try-completion company-prefix company-candidates))
+              (let ((common (try-completion company-prefix company-candidates)))
+                (if (eq common t)
+                    ;; Mulple equal strings, probably with different
+                    ;; annotations.
+                    company-prefix
+                  common))
             (car company-candidates)))))
 
-(defun company--safe-candidate (str)
-  (or (company-call-backend 'crop str)
-      str))
-
 (defun company-calculate-candidates (prefix)
   (let ((candidates (cdr (assoc prefix company-candidates-cache)))
         (ignore-case (company-call-backend 'ignore-case)))
@@ -863,20 +1082,10 @@ can retrieve meta-data for them."
                 (setq candidates (all-completions prefix prev))
                 (return t)))))
         ;; no cache match, call back-end
-        (progn
-          (setq candidates (company-call-backend 'candidates prefix))
-          (when company-candidates-predicate
-            (setq candidates
-                  (company-apply-predicate candidates
-                                           company-candidates-predicate)))
-          (unless (company-call-backend 'sorted)
-            (setq candidates (sort candidates 'string<)))
-          (when (company-call-backend 'duplicates)
-            ;; strip duplicates
-            (let ((c2 candidates))
-              (while c2
-                (setcdr c2 (progn (while (equal (pop c2) (car c2)))
-                                  c2)))))))
+        (setq candidates
+              (company--process-candidates
+               (company--fetch-candidates prefix))))
+    (setq candidates (company--transform-candidates candidates))
     (when candidates
       (if (or (cdr candidates)
               (not (eq t (compare-strings (car candidates) nil nil
@@ -885,39 +1094,144 @@ can retrieve meta-data for them."
         ;; Already completed and unique; don't start.
         t))))
 
+(defun company--fetch-candidates (prefix)
+  (let ((c (if company--manual-action
+               (company-call-backend 'candidates prefix)
+             (company-call-backend-raw 'candidates prefix)))
+        res)
+    (if (not (eq (car c) :async))
+        c
+      (let ((buf (current-buffer))
+            (win (selected-window))
+            (tick (buffer-chars-modified-tick))
+            (pt (point))
+            (backend company-backend))
+        (funcall
+         (cdr c)
+         (lambda (candidates)
+           (if (not (and candidates (eq res 'done)))
+               ;; Fetcher called us right back.
+               (setq res candidates)
+             (setq company-backend backend
+                   company-candidates-cache
+                   (list (cons prefix
+                               (company--process-candidates
+                                candidates))))
+             (company-idle-begin buf win tick pt)))))
+      ;; FIXME: Relying on the fact that the callers
+      ;; will interpret nil as "do nothing" is shaky.
+      ;; A throw-catch would be one possible improvement.
+      (or res
+          (progn (setq res 'done) nil)))))
+
+(defun company--process-candidates (candidates)
+  (when company-candidates-predicate
+    (setq candidates
+          (company-apply-predicate candidates
+                                   company-candidates-predicate)))
+  (unless (company-call-backend 'sorted)
+    (setq candidates (sort candidates 'string<)))
+  (when (company-call-backend 'duplicates)
+    (company--strip-duplicates candidates))
+  candidates)
+
+(defun company--strip-duplicates (candidates)
+  (let ((c2 candidates))
+    (while c2
+      (setcdr c2
+              (let ((str (car c2))
+                    (anno 'unk))
+                (pop c2)
+                (while (let ((str2 (car c2)))
+                         (if (not (equal str str2))
+                             nil
+                           (when (eq anno 'unk)
+                             (setq anno (company-call-backend
+                                         'annotation str)))
+                           (equal anno
+                                  (company-call-backend
+                                   'annotation str2))))
+                  (pop c2))
+                c2)))))
+
+(defun company--transform-candidates (candidates)
+  (let ((c candidates))
+    (dolist (tr company-transformers)
+      (setq c (funcall tr c)))
+    c))
+
+(defun company-sort-by-occurrence (candidates)
+  "Sort CANDIDATES according to their occurrences.
+Searches for each in the currently visible part of the current buffer and
+gives priority to the closest ones above point, then closest ones below
+point. The rest of the list is appended unchanged.
+Keywords and function definition names are ignored."
+  (let* (occurs
+         (noccurs
+          (delete-if
+           (lambda (candidate)
+             (when (or
+                    (save-excursion
+                      (progn (forward-line 0)
+                             (search-backward candidate (window-start) t)))
+                    (save-excursion
+                      (search-forward candidate (window-end) t)))
+               (let ((beg (match-beginning 0))
+                     (end (match-end 0)))
+                 (when (save-excursion
+                         (goto-char end)
+                         (and (not (memq (get-text-property (point) 'face)
+                                         '(font-lock-function-name-face
+                                           font-lock-keyword-face)))
+                              (let* ((prefix (company-call-backend 'prefix))
+                                     (prefix (or (car-safe prefix) prefix)))
+                                (and (stringp prefix)
+                                     (= (length prefix) (- end beg))))))
+                   (push (cons candidate (if (< beg (point))
+                                             (- (point) end)
+                                           (- beg (window-start))))
+                         occurs)
+                   t))))
+           candidates)))
+    (nconc
+     (mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
+     noccurs)))
+
 (defun company-idle-begin (buf win tick pos)
-  (and company-mode
-       (eq buf (current-buffer))
+  (and (eq buf (current-buffer))
        (eq win (selected-window))
        (eq tick (buffer-chars-modified-tick))
        (eq pos (point))
-       (not company-candidates)
-       (not (equal (point) company-point))
-       (let ((company-idle-delay t)
-             (company-begin-commands t))
-         (company-begin)
-         (when company-candidates
-           (company-input-noop)
-           (company-post-command)))))
+       (when (company-auto-begin)
+         (when (version< emacs-version "24.3.50")
+           (company-input-noop))
+         (company-post-command))))
 
 (defun company-auto-begin ()
-  (company-assert-enabled)
   (and company-mode
        (not company-candidates)
        (let ((company-idle-delay t)
-             (company-minimum-prefix-length 0)
              (company-begin-commands t))
-         (company-begin)))
+         (condition-case-unless-debug err
+             (company-begin)
+           (error (message "Company: An error occurred in auto-begin")
+                  (message "%s" (error-message-string err))
+                  (company-cancel))
+           (quit (company-cancel)))))
+  (unless company-candidates
+    (setq company-backend nil))
   ;; Return non-nil if active.
   company-candidates)
 
 (defun company-manual-begin ()
   (interactive)
-  (setq company--explicit-action t)
+  (company-assert-enabled)
+  (setq company--manual-action t)
   (unwind-protect
-      (company-auto-begin)
+      (let ((company-minimum-prefix-length 0))
+        (company-auto-begin))
     (unless company-candidates
-      (setq company--explicit-action nil))))
+      (setq company--manual-action nil))))
 
 (defun company-other-backend (&optional backward)
   (interactive (list current-prefix-arg))
@@ -964,40 +1278,37 @@ can retrieve meta-data for them."
                                 company-point)
               company-prefix)))
 
-(defsubst company--string-incremental-p (old-prefix new-prefix)
-  (and (> (length new-prefix) (length old-prefix))
-       (equal old-prefix (substring new-prefix 0 (length old-prefix)))))
-
-(defun company--continue-failed (new-prefix)
-  (when (company--incremental-p)
-    (let ((input (buffer-substring-no-properties (point) company-point)))
-      (cond
-       ((company-auto-complete-p input)
-        ;; auto-complete
-        (save-excursion
-          (goto-char company-point)
-          (let ((company--auto-completion t))
-            (company-complete-selection))
-          nil))
-       ((and (company--string-incremental-p company-prefix new-prefix)
-             (company-require-match-p))
-        ;; wrong incremental input, but required match
-        (delete-char (- (length input)))
-        (ding)
-        (message "Matching input is required")
-        company-candidates)
-       ((equal company-prefix (car company-candidates))
-        ;; last input was actually success
-        (company-cancel company-prefix)
-        nil)))))
+(defun company--continue-failed ()
+  (let ((input (buffer-substring-no-properties (point) company-point)))
+    (cond
+     ((company-auto-complete-p input)
+      ;; auto-complete
+      (save-excursion
+        (goto-char company-point)
+        (let ((company--auto-completion t))
+          (company-complete-selection))
+        nil))
+     ((company-require-match-p)
+      ;; wrong incremental input, but required match
+      (delete-char (- (length input)))
+      (ding)
+      (message "Matching input is required")
+      company-candidates)
+     ((equal company-prefix (car company-candidates))
+      ;; last input was actually success
+      (company-cancel company-prefix))
+     (t (company-cancel)))))
 
 (defun company--good-prefix-p (prefix)
-  (and (or (company-explicit-action-p)
-           (unless (eq prefix 'stop)
-             (or (eq (cdr-safe prefix) t)
-                 (>= (or (cdr-safe prefix) (length prefix))
-                     company-minimum-prefix-length))))
-       (stringp (or (car-safe prefix) prefix))))
+  (and (stringp (or (car-safe prefix) prefix)) ;excludes 'stop
+       (or (eq (cdr-safe prefix) t)
+           (let ((len (or (cdr-safe prefix) (length prefix))))
+             (if company--manual-prefix
+                 (or (not company-abort-manual-when-too-short)
+                     ;; Must not be less than minimum or initial length.
+                     (>= len (min company-minimum-prefix-length
+                                  (length company--manual-prefix))))
+               (>= len company-minimum-prefix-length))))))
 
 (defun company--continue ()
   (when (company-call-backend 'no-cache company-prefix)
@@ -1008,20 +1319,19 @@ can retrieve meta-data for them."
                        (setq new-prefix (or (car-safe new-prefix) new-prefix))
                        (= (- (point) (length new-prefix))
                           (- company-point (length company-prefix))))
-              (setq new-prefix (or (car-safe new-prefix) new-prefix))
               (company-calculate-candidates new-prefix))))
-    (or (cond
-         ((eq c t)
-          ;; t means complete/unique.
-          (company-cancel new-prefix)
-          nil)
-         ((consp c)
-          ;; incremental match
-          (setq company-prefix new-prefix)
-          (company-update-candidates c)
-          c)
-         (t (company--continue-failed new-prefix)))
-        (company-cancel))))
+    (cond
+     ((eq c t)
+      ;; t means complete/unique.
+      (company-cancel new-prefix))
+     ((consp c)
+      ;; incremental match
+      (setq company-prefix new-prefix)
+      (company-update-candidates c)
+      c)
+     ((not (company--incremental-p))
+      (company-cancel))
+     (t (company--continue-failed)))))
 
 (defun company--begin-new ()
   (let (prefix c)
@@ -1045,9 +1355,11 @@ can retrieve meta-data for them."
                 c (company-calculate-candidates prefix))
           ;; t means complete/unique.  We don't start, so no hooks.
           (if (not (consp c))
-              (when company--explicit-action
+              (when company--manual-action
                 (message "No completion found"))
             (setq company-prefix prefix)
+            (when company--manual-action
+              (setq company--manual-prefix prefix))
             (when (symbolp backend)
               (setq company-lighter (concat " " (symbol-name backend))))
             (company-update-candidates c)
@@ -1060,9 +1372,11 @@ can retrieve meta-data for them."
   (or (and company-candidates (company--continue))
       (and (company--should-complete) (company--begin-new)))
   (when company-candidates
-    (when (and company-end-of-buffer-workaround (eobp))
-      (save-excursion (insert "\n"))
-      (setq company-added-newline (buffer-chars-modified-tick)))
+    (let ((modified (buffer-modified-p)))
+      (when (and company-end-of-buffer-workaround (eobp))
+        (save-excursion (insert "\n"))
+        (setq company-added-newline
+              (or modified (buffer-chars-modified-tick)))))
     (setq company-point (point)
           company--point-max (point-max))
     (company-ensure-emulation-alist)
@@ -1075,7 +1389,8 @@ can retrieve meta-data for them."
        (let ((tick (buffer-chars-modified-tick)))
          (delete-region (1- (point-max)) (point-max))
          (equal tick company-added-newline))
-       ;; Only set unmodified when tick remained the same since insert.
+       ;; Only set unmodified when tick remained the same since insert,
+       ;; and the buffer wasn't modified before.
        (set-buffer-modified-p nil))
   (when company-prefix
     (if (stringp result)
@@ -1094,7 +1409,8 @@ can retrieve meta-data for them."
         company-common nil
         company-selection 0
         company-selection-changed nil
-        company--explicit-action nil
+        company--manual-action nil
+        company--manual-prefix nil
         company-lighter company-default-lighter
         company--point-max nil
         company-point nil)
@@ -1102,7 +1418,9 @@ can retrieve meta-data for them."
     (cancel-timer company-timer))
   (company-search-mode 0)
   (company-call-frontends 'hide)
-  (company-enable-overriding-keymap nil))
+  (company-enable-overriding-keymap nil)
+  ;; Make return value explicit.
+  nil)
 
 (defun company-abort ()
   (interactive)
@@ -1123,7 +1441,9 @@ can retrieve meta-data for them."
   (unless (company-keep this-command)
     (condition-case err
         (when company-candidates
-          (company-call-frontends 'pre-command))
+          (company-call-frontends 'pre-command)
+          (unless (company--should-continue)
+            (company-abort)))
       (error (message "Company: An error occurred in pre-command")
              (message "%s" (error-message-string err))
              (company-cancel))))
@@ -1143,6 +1463,7 @@ can retrieve meta-data for them."
             (and (numberp company-idle-delay)
                  (or (eq t company-begin-commands)
                      (memq this-command company-begin-commands))
+                 (not (equal (point) company-point))
                  (setq company-timer
                        (run-with-timer company-idle-delay nil
                                        'company-idle-begin
@@ -1413,9 +1734,10 @@ and invoke the normal binding."
              (company--inside-tooltip-p event-col-row ovl-row ovl-height))
         (progn
           (company-set-selection (+ (cdr event-col-row)
-                                    (if (zerop company-tooltip-offset)
-                                        -1
-                                      (- company-tooltip-offset 2))
+                                    (1- company-tooltip-offset)
+                                    (if (and (eq company-tooltip-offset-display 'lines)
+                                             (not (zerop company-tooltip-offset)))
+                                        -1 0)
                                     (- ovl-row)
                                     (if (< ovl-height 0)
                                         (- 1 ovl-height)
@@ -1436,8 +1758,6 @@ and invoke the normal binding."
   (interactive)
   (when (company-manual-begin)
     (let ((result (nth company-selection company-candidates)))
-      (when company--auto-completion
-        (setq result (company--safe-candidate result)))
       (company-finish result))))
 
 (defun company-complete-common ()
@@ -1511,7 +1831,7 @@ To show the number next to the candidates in some back-ends, enable
 
 (defun company-fetch-metadata ()
   (let ((selected (nth company-selection company-candidates)))
-    (unless (equal selected (car company-last-metadata))
+    (unless (eq selected (car company-last-metadata))
       (setq company-last-metadata
             (cons selected (company-call-backend 'meta selected))))
     (cdr company-last-metadata)))
@@ -1585,15 +1905,10 @@ To show the number next to the candidates in some back-ends, enable
 (defvar company-callback nil)
 (make-variable-buffer-local 'company-callback)
 
-(defvar company-begin-with-marker nil)
-(make-variable-buffer-local 'company-begin-with-marker)
-
 (defun company-remove-callback (&optional ignored)
   (remove-hook 'company-completion-finished-hook company-callback t)
   (remove-hook 'company-completion-cancelled-hook 'company-remove-callback t)
-  (remove-hook 'company-completion-finished-hook 'company-remove-callback t)
-  (when company-begin-with-marker
-    (set-marker company-begin-with-marker nil)))
+  (remove-hook 'company-completion-finished-hook 'company-remove-callback t))
 
 (defun company-begin-backend (backend &optional callback)
   "Start a completion at point using BACKEND."
@@ -1609,9 +1924,7 @@ To show the number next to the candidates in some back-ends, enable
   (setq company-backend backend)
   ;; Return non-nil if active.
   (or (company-manual-begin)
-      (progn
-        (setq company-backend nil)
-        (error "Cannot complete at point"))))
+      (error "Cannot complete at point")))
 
 (defun company-begin-with (candidates
                            &optional prefix-length require-match callback)
@@ -1624,20 +1937,30 @@ CALLBACK is a function called with the selected result if the user
 successfully completes the input.
 
 Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
-  ;; FIXME: When Emacs 23 is no longer a concern, replace
-  ;; `company-begin-with-marker' with a lexical variable; use a lexical closure.
-  (setq company-begin-with-marker (copy-marker (point) t))
-  (company-begin-backend
-   `(lambda (command &optional arg &rest ignored)
-      (cond
-       ((eq command 'prefix)
-        (when (equal (point) (marker-position company-begin-with-marker))
-          (buffer-substring ,(- (point) (or prefix-length 0)) (point))))
-       ((eq command 'candidates)
-        (all-completions arg ',candidates))
-       ((eq command 'require-match)
-        ,require-match)))
-   callback))
+  (let ((begin-marker (copy-marker (point) t)))
+    (company-begin-backend
+     (lambda (command &optional arg &rest ignored)
+       (pcase command
+        (`prefix
+         (when (equal (point) (marker-position begin-marker))
+           (buffer-substring (- (point) (or prefix-length 0)) (point))))
+        (`candidates
+         (all-completions arg candidates))
+        (`require-match
+         require-match)))
+     callback)))
+
+(defun company-version (&optional show-version)
+  "Get the Company version as string.
+
+If SHOW-VERSION is non-nil, show the version in the echo area."
+  (interactive (list t))
+  (with-temp-buffer
+    (insert-file-contents (find-library-name "company"))
+    (require 'lisp-mnt)
+    (if show-version
+        (message "Company version: %s" (lm-version))
+      (lm-version))))
 
 ;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -1647,8 +1970,7 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
 (defvar company-tooltip-offset 0)
 (make-variable-buffer-local 'company-tooltip-offset)
 
-(defun company-pseudo-tooltip-update-offset (selection num-lines limit)
-
+(defun company-tooltip--lines-update-offset (selection num-lines limit)
   (decf limit 2)
   (setq company-tooltip-offset
         (max (min selection company-tooltip-offset)
@@ -1668,6 +1990,13 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
 
   limit)
 
+(defun company-tooltip--simple-update-offset (selection num-lines limit)
+  (setq company-tooltip-offset
+        (if (< selection company-tooltip-offset)
+            selection
+          (max company-tooltip-offset
+               (- selection limit -1)))))
+
 ;;; propertize
 
 (defsubst company-round-tab (arg)
@@ -1686,20 +2015,34 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
       (pop copy))
     (apply 'concat pieces)))
 
-(defun company--highlight-common (line properties)
-  ;; XXX: Subject to change.
-  (let ((common (or (company-call-backend 'common-part line)
-                    (length company-common))))
-    (add-text-properties 0 common properties line)))
-
-(defun company-fill-propertize (line width selected)
-  (let* ((margin company-tooltip-margin)
-         (common (+ (or (company-call-backend 'common-part line)
-                        (length company-common)) margin)))
-    (setq line (concat (company-space-string company-tooltip-margin)
-                       (company-safe-substring
-                        line 0 (+ width company-tooltip-margin)))
-          width (+ width (* 2 margin)))
+(defun company-fill-propertize (value annotation width selected left right)
+  (let* ((margin (length left))
+         (common (+ (or (company-call-backend 'match value)
+                        (length company-common)) margin))
+         (ann-ralign company-tooltip-align-annotations)
+         (ann-truncate (< width
+                          (+ (length value) (length annotation)
+                             (if ann-ralign 1 0))))
+         (ann-start (+ margin
+                       (if ann-ralign
+                           (if ann-truncate
+                               (1+ (length value))
+                             (- width (length annotation)))
+                         (length value))))
+         (ann-end (min (+ ann-start (length annotation)) (+ margin width)))
+         (line (concat left
+                       (if (or ann-truncate (not ann-ralign))
+                           (company-safe-substring
+                            (concat value
+                                    (when (and annotation ann-ralign) " ")
+                                    annotation)
+                            0 width)
+                         (concat
+                          (company-safe-substring value 0
+                                                  (- width (length annotation)))
+                          annotation))
+                       right)))
+    (setq width (+ width margin (length right)))
 
     (add-text-properties 0 width '(face company-tooltip
                                    mouse-face company-tooltip-mouse)
@@ -1708,16 +2051,21 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
                          '(face company-tooltip-common
                            mouse-face company-tooltip-mouse)
                          line)
+    (when (< ann-start ann-end)
+      (add-text-properties ann-start ann-end
+                           '(face company-tooltip-annotation
+                             mouse-face company-tooltip-mouse)
+                           line))
     (when selected
       (if (and company-search-string
-               (string-match (regexp-quote company-search-string) line
+               (string-match (regexp-quote company-search-string) value
                              (length company-prefix)))
-          (progn
-            (add-text-properties (match-beginning 0) (match-end 0)
-                                 '(face company-tooltip-selection)
+          (let ((beg (+ margin (match-beginning 0)))
+                (end (+ margin (match-end 0))))
+            (add-text-properties beg end '(face company-tooltip-selection)
                                  line)
-            (when (< (match-beginning 0) common)
-              (add-text-properties (match-beginning 0) common
+            (when (< beg common)
+              (add-text-properties beg common
                                    '(face company-tooltip-common-selection)
                                    line)))
         (add-text-properties 0 width '(face company-tooltip-selection
@@ -1726,8 +2074,8 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
         (add-text-properties margin common
                              '(face company-tooltip-common-selection
                                mouse-face company-tooltip-selection)
-                             line))))
-  line)
+                             line)))
+    line))
 
 ;;; replace
 
@@ -1800,26 +2148,36 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
     line))
 
 (defun company--create-lines (selection limit)
-
   (let ((len company-candidates-length)
         (numbered 99999)
         (window-width (company--window-width))
         lines
         width
         lines-copy
+        items
         previous
         remainder
-        new)
+        scrollbar-bounds)
 
-    ;; Scroll to offset.
-    (setq limit (company-pseudo-tooltip-update-offset selection len limit))
+    ;; Maybe clear old offset.
+    (when (< len (+ company-tooltip-offset limit))
+      (setq company-tooltip-offset 0))
 
-    (when (> company-tooltip-offset 0)
-      (setq previous (format "...(%d)" company-tooltip-offset)))
-
-    (setq remainder (- len limit company-tooltip-offset)
-          remainder (when (> remainder 0)
-                      (setq remainder (format "...(%d)" remainder))))
+    ;; Scroll to offset.
+    (if (eq company-tooltip-offset-display 'lines)
+        (setq limit (company-tooltip--lines-update-offset selection len limit))
+      (company-tooltip--simple-update-offset selection len limit))
+
+    (cond
+     ((eq company-tooltip-offset-display 'scrollbar)
+      (setq scrollbar-bounds (company--scrollbar-bounds company-tooltip-offset
+                                                        limit len)))
+     ((eq company-tooltip-offset-display 'lines)
+      (when (> company-tooltip-offset 0)
+        (setq previous (format "...(%d)" company-tooltip-offset)))
+      (setq remainder (- len limit company-tooltip-offset)
+            remainder (when (> remainder 0)
+                        (setq remainder (format "...(%d)" remainder))))))
 
     (decf selection company-tooltip-offset)
     (setq width (max (length previous) (length remainder))
@@ -1828,40 +2186,74 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
           lines-copy lines)
 
     (decf window-width (* 2 company-tooltip-margin))
+    (when scrollbar-bounds (decf window-width))
 
     (dotimes (_ len)
-      (setq width (max (length (pop lines-copy)) width)))
+      (let* ((value (pop lines-copy))
+             (annotation (company-call-backend 'annotation value)))
+        (when (and annotation company-tooltip-align-annotations)
+          ;; `lisp-completion-at-point' adds a space.
+          (setq annotation (comment-string-strip annotation t nil)))
+        (push (cons value annotation) items)
+        (setq width (max (+ (length value)
+                            (if (and annotation company-tooltip-align-annotations)
+                                (1+ (length annotation))
+                              (length annotation)))
+                         width))))
+
     (setq width (min window-width
-                     (if company-show-numbers
+                     (if (and company-show-numbers
+                              (< company-tooltip-offset 10))
                          (+ 2 width)
                        width)))
-    (setq lines-copy lines)
 
     ;; number can make tooltip too long
     (when company-show-numbers
       (setq numbered company-tooltip-offset))
 
-    (when previous
-      (push (company--position-line previous width) new))
-
-    (dotimes (i len)
-      (push (company-fill-propertize
-             (if (>= numbered 10)
-                 (company-reformat (pop lines))
-               (incf numbered)
-               (format "%s %d"
-                       (company-safe-substring (company-reformat (pop lines))
-                                               0 (- width 2))
-                       (mod numbered 10)))
-             width (equal i selection))
-            new))
-
-    (when remainder
-      (push (company--position-line remainder width) new))
-
-    (setq lines (nreverse new))))
-
-(defun company--position-line (text width)
+    (let ((items (nreverse items)) new)
+      (when previous
+        (push (company--scrollpos-line previous width) new))
+
+      (dotimes (i len)
+        (let* ((item (pop items))
+               (str (company-reformat (car item)))
+               (annotation (cdr item))
+               (right (company-space-string company-tooltip-margin))
+               (width width))
+          (when (< numbered 10)
+            (decf width 2)
+            (incf numbered)
+            (setq right (concat (format " %d" (mod numbered 10)) right)))
+          (push (concat
+                 (company-fill-propertize str annotation
+                                          width (equal i selection)
+                                          (company-space-string
+                                           company-tooltip-margin)
+                                          right)
+                 (when scrollbar-bounds
+                   (company--scrollbar i scrollbar-bounds)))
+                new)))
+
+      (when remainder
+        (push (company--scrollpos-line remainder width) new))
+
+      (nreverse new))))
+
+(defun company--scrollbar-bounds (offset limit length)
+  (when (> length limit)
+    (let* ((size (ceiling (* limit (float limit)) length))
+           (lower (floor (* limit (float offset)) length))
+           (upper (+ lower size -1)))
+      (cons lower upper))))
+
+(defun company--scrollbar (i bounds)
+  (propertize " " 'face
+              (if (and (>= i (car bounds)) (<= i (cdr bounds)))
+                  'company-scrollbar-fg
+                'company-scrollbar-bg)))
+
+(defun company--scrollpos-line (text width)
   (propertize (concat (company-space-string company-tooltip-margin)
                       (company-safe-substring text 0 width)
                       (company-space-string company-tooltip-margin))
@@ -2006,9 +2398,9 @@ Returns a negative number if the tooltip should be displayed above point."
 (defun company-preview-show-at-point (pos)
   (company-preview-hide)
 
-  (setq company-preview-overlay (make-overlay pos pos))
+  (setq company-preview-overlay (make-overlay pos (1+ pos)))
 
-  (let ((completion(nth company-selection company-candidates)))
+  (let ((completion (nth company-selection company-candidates)))
     (setq completion (propertize completion 'face 'company-preview))
     (add-text-properties 0 (length company-common)
                          '(face company-preview-common) completion)
@@ -2027,7 +2419,9 @@ Returns a negative number if the tooltip should be displayed above point."
          (not (equal completion ""))
          (add-text-properties 0 1 '(cursor t) completion))
 
-    (overlay-put company-preview-overlay 'after-string completion)
+    (overlay-put company-preview-overlay 'display
+                 (concat completion (unless (eq pos (point-max))
+                                      (buffer-substring pos (1+ pos)))))
     (overlay-put company-preview-overlay 'window (selected-window))))
 
 (defun company-preview-hide ()
@@ -2037,10 +2431,10 @@ Returns a negative number if the tooltip should be displayed above point."
 
 (defun company-preview-frontend (command)
   "`company-mode' front-end showing the selection as if it had been inserted."
-  (case command
-    (pre-command (company-preview-hide))
-    (post-command (company-preview-show-at-point (point)))
-    (hide (company-preview-hide))))
+  (pcase command
+    (`pre-command (company-preview-hide))
+    (`post-command (company-preview-show-at-point (point)))
+    (`hide (company-preview-hide))))
 
 (defun company-preview-if-just-one-frontend (command)
   "`company-preview-frontend', but only shown for single candidates."
@@ -2142,21 +2536,21 @@ Returns a negative number if the tooltip should be displayed above point."
 
 (defun company-echo-frontend (command)
   "`company-mode' front-end showing the candidates in the echo area."
-  (case command
-    (post-command (company-echo-show-soon 'company-echo-format))
-    (hide (company-echo-hide))))
+  (pcase command
+    (`post-command (company-echo-show-soon 'company-echo-format))
+    (`hide (company-echo-hide))))
 
 (defun company-echo-strip-common-frontend (command)
   "`company-mode' front-end showing the candidates in the echo area."
-  (case command
-    (post-command (company-echo-show-soon 'company-echo-strip-common-format))
-    (hide (company-echo-hide))))
+  (pcase command
+    (`post-command (company-echo-show-soon 'company-echo-strip-common-format))
+    (`hide (company-echo-hide))))
 
 (defun company-echo-metadata-frontend (command)
   "`company-mode' front-end showing the documentation in the echo area."
-  (case command
-    (post-command (company-echo-show-when-idle 'company-fetch-metadata))
-    (hide (company-echo-hide))))
+  (pcase command
+    (`post-command (company-echo-show-when-idle 'company-fetch-metadata))
+    (`hide (company-echo-hide))))
 
 (provide 'company)
 ;;; company.el ends here