]> code.delx.au - gnu-emacs-elpa/blobdiff - company.el
Added Windows root dir compatibility fixes.
[gnu-emacs-elpa] / company.el
index c4bd200e641c963e452cdfbc19df1939ab5cb5cf..d3caee658486db3773ad76dd6d1ddd748c7348aa 100644 (file)
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2009 Nikolaj Schumacher
 ;;
 ;; Author: Nikolaj Schumacher <bugs * nschum de>
-;; Version: 0.3
+;; Version: 0.4.1
 ;; Keywords: abbrev, convenience, matchis
 ;; URL: http://nschum.de/src/emacs/company/
 ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
 ;;
 ;;; Change Log:
 ;;
+;;    Windows compatibility fixes.
+;;
+;; 2009-04-19 (0.4.1)
+;;    Added `global-company-mode'.
+;;    Performance enhancements.
+;;    Added `company-eclim' back-end.
+;;    Added safer workaround for Emacs `posn-col-row' bug.
+;;
+;; 2009-04-18 (0.4)
+;;    Automatic completion is now aborted if the prefix gets too short.
+;;    Added option `company-dabbrev-time-limit'.
+;;    `company-backends' now supports merging back-ends.
+;;    Added back-end `company-dabbrev-code' for generic code.
+;;    Fixed `company-begin-with'.
+;;
+;; 2009-04-15 (0.3.1)
 ;;    Added 'stop prefix to prevent dabbrev from completing inside of symbols.
 ;;    Fixed issues with tabbar-mode and line-spacing.
 ;;    Performance enhancements.
@@ -239,11 +255,43 @@ The visualized data is stored in `company-prefix', `company-candidates',
                                 company-preview-if-just-one-frontend)
                          (function :tag "custom function" nil))))
 
+(defvar company-safe-backends
+  '((company-abbrev . "Abbrev")
+    (company-css . "CSS")
+    (company-dabbrev . "dabbrev for plain text")
+    (company-dabbrev-code . "dabbrev for code")
+    (company-eclim . "eclim (an Eclipse interace)")
+    (company-elisp . "Emacs Lisp")
+    (company-etags . "etags")
+    (company-files . "Files")
+    (company-gtags . "GNU Global")
+    (company-ispell . "ispell")
+    (company-keywords . "Programming language keywords")
+    (company-nxml . "nxml")
+    (company-oddmuse . "Oddmuse")
+    (company-semantic . "CEDET Semantic")
+    (company-tempo . "Tempo templates")
+    (company-xcode . "Xcode")))
+(put 'company-safe-backends 'risky-local-variable t)
+
+(defun company-safe-backends-p (backends)
+  (and (consp backends)
+       (not (dolist (backend backends)
+              (unless (if (consp backend)
+                          (company-safe-backends-p backend)
+                        (assq backend company-safe-backends))
+                (return t))))))
+
 (defcustom company-backends '(company-elisp company-nxml company-css
-                              company-semantic company-xcode company-gtags
-                              company-etags company-oddmuse company-files
-                              company-dabbrev)
+                              company-eclim company-semantic company-xcode
+                              (company-gtags company-etags company-dabbrev-code
+                               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.
+
 Each back-end is a function that takes a variable number of arguments.
 The first argument is the command requested from the back-end.  It is one
 of the following:
@@ -251,7 +299,7 @@ of the following:
 'prefix: The back-end should return the text to be completed.  It must be
 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).
+\(e.g. if it is in the middle of a string\).
 
 'candidates: The second argument is the prefix to be completed.  The
 return value should be a list of candidates that start with the prefix.
@@ -261,6 +309,9 @@ Optional commands:
 'sorted: The back-end may return t here to indicate that the candidates
 are sorted and will not need to be sorted again.
 
+'duplicates: If non-nil, company will take care of removing duplicates
+from the list.
+
 'no-cache: Usually company doesn't ask for candidates again as completion
 progresses, unless the back-end returns t for this command.  The second
 argument is the latest prefix.
@@ -285,9 +336,20 @@ 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."
   :group 'company
-  :type '(repeat (function :tag "function" nil)))
-
-(defvar start-count 0)
+  :type `(repeat
+          (choice
+           :tag "Back-end"
+           ,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b)))
+                     company-safe-backends)
+           (symbol :tag "User defined")
+           (repeat :tag "Merged Back-ends"
+                   (choice :tag "Back-end"
+                           ,@(mapcar (lambda (b)
+                                       `(const :tag ,(cdr b) ,(car b)))
+                                     company-safe-backends)
+                           (symbol :tag "User defined"))))))
+
+(put 'company-backends 'safe-local-variable 'company-safe-backend-p)
 
 (defcustom company-completion-started-hook nil
   "*Hook run when company starts completing.
@@ -429,6 +491,25 @@ The work-around consists of adding a newline.")
     keymap)
   "Keymap that is enabled during an active completion.")
 
+(defvar company--disabled-backends nil)
+
+(defun company-init-backend (backend)
+  (and (symbolp backend)
+       (not (fboundp backend))
+       (ignore-errors (require backend nil t)))
+
+  (if (or (symbolp backend)
+          (functionp backend))
+      (if (ignore-errors (funcall backend 'init) t)
+          (put backend 'company-init t)
+        (put backend 'company-init 'failed)
+        (unless (memq backend company--disabled-backends)
+          (message "Company back-end '%s' could not be initialized"
+                   backend)
+          (push backend company--disabled-backends))
+        nil)
+    (mapc 'company-init-backend backend)))
+
 ;;;###autoload
 (define-minor-mode company-mode
   "\"complete anything\"; in in-buffer completion framework.
@@ -459,18 +540,15 @@ keymap during active completions (`company-active-map'):
       (progn
         (add-hook 'pre-command-hook 'company-pre-command nil t)
         (add-hook 'post-command-hook 'company-post-command nil t)
-        (dolist (backend company-backends)
-          (when (symbolp backend)
-            (unless (fboundp backend)
-              (ignore-errors (require backend nil t)))
-            (unless (fboundp backend)
-              (message "Company back-end '%s' could not be initialized"
-                       backend)))))
+        (mapc 'company-init-backend company-backends))
     (remove-hook 'pre-command-hook 'company-pre-command t)
     (remove-hook 'post-command-hook 'company-post-command t)
     (company-cancel)
     (kill-local-variable 'company-point)))
 
+(define-globalized-minor-mode global-company-mode company-mode
+  (lambda () (company-mode 1)))
+
 (defsubst company-assert-enabled ()
   (unless company-mode
     (company-uninstall-map)
@@ -508,13 +586,26 @@ keymap during active completions (`company-active-map'):
 ;; 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.
 (defun company-ignore ()
-  (interactive))
+  (interactive)
+  (setq this-command last-command))
 
 (global-set-key '[31415926] 'company-ignore)
 
 (defun company-input-noop ()
   (push 31415926 unread-command-events))
 
+;; Hack:
+;; posn-col-row is incorrect in older Emacsen when line-spacing is set
+(defun company--col-row (&optional pos)
+  (let ((posn (posn-at-point pos)))
+    (cons (car (posn-col-row posn)) (cdr (posn-actual-col-row posn)))))
+
+(defsubst company--column (&optional pos)
+  (car (posn-col-row (posn-at-point pos))))
+
+(defsubst company--row (&optional pos)
+  (cdr (posn-actual-col-row (posn-at-point pos))))
+
 ;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun company-grab (regexp &optional expression limit)
@@ -540,7 +631,39 @@ keymap during active completions (`company-active-map'):
 
 (defun company-in-string-or-comment ()
   (let ((ppss (syntax-ppss)))
-    (or (nth 3 ppss) (nth 4 ppss) (nth 7 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)))
+
+(defun company--multi-backend-adapter (backends command &rest args)
+  (case command
+    ('candidates
+     (apply 'append (mapcar (lambda (backend) (apply backend command args))
+                            backends)))
+    ('sorted nil)
+    ('duplicates t)
+    (otherwise
+     (let (value)
+       (dolist (backend backends)
+         (when (setq value (apply backend command args))
+           (return value)))))))
 
 ;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -575,7 +698,8 @@ keymap during active completions (`company-active-map'):
   "Non-nil, if explicit completion took place.")
 (make-variable-buffer-local 'company--explicit-action)
 
-(defvar company--this-command nil)
+(defvar company--point-max nil)
+(make-variable-buffer-local 'company--point-max)
 
 (defvar company-point nil)
 (make-variable-buffer-local 'company-point)
@@ -603,7 +727,7 @@ keymap during active completions (`company-active-map'):
                 overriding-local-map))
        (eq company-idle-delay t)
        (or (eq t company-begin-commands)
-           (memq company--this-command company-begin-commands)
+           (memq this-command company-begin-commands)
            (and (symbolp this-command) (get this-command 'company-begin)))
        (not (and transient-mark-mode mark-active))))
 
@@ -647,30 +771,38 @@ keymap during active completions (`company-active-map'):
   ;; Save in cache:
   (push (cons company-prefix company-candidates) company-candidates-cache)
   ;; Calculate common.
-  (let ((completion-ignore-case (funcall company-backend 'ignore-case)))
+  (let ((completion-ignore-case (company-call-backend 'ignore-case)))
     (setq company-common (try-completion company-prefix company-candidates)))
   (when (eq company-common t)
     (setq company-candidates nil)))
 
 (defun company-calculate-candidates (prefix)
-  (let ((candidates
-         (or (cdr (assoc prefix company-candidates-cache))
-             (when company-candidates-cache
-               (let ((len (length prefix))
-                     (completion-ignore-case (funcall company-backend
-                                                      'ignore-case))
-                     prev)
-                 (dotimes (i len)
-                   (when (setq prev (cdr (assoc (substring prefix 0 (- len i))
-                                                company-candidates-cache)))
-                     (return (all-completions prefix prev))))))
-             (let ((c (funcall company-backend 'candidates prefix)))
-               (when company-candidates-predicate
-                 (setq c (company-apply-predicate
-                          c company-candidates-predicate)))
-               (unless (funcall company-backend 'sorted)
-                 (setq c (sort c 'string<)))
-               c))))
+  (let ((candidates (cdr (assoc prefix company-candidates-cache))))
+    (or candidates
+        (when company-candidates-cache
+          (let ((len (length prefix))
+                (completion-ignore-case (company-call-backend 'ignore-case))
+                prev)
+            (dotimes (i (1+ len))
+              (when (setq prev (cdr (assoc (substring prefix 0 (- len i))
+                                           company-candidates-cache)))
+                (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)))))))
     (if (or (cdr candidates)
             (not (equal (car candidates) prefix)))
         ;; Don't start when already completed and unique.
@@ -686,31 +818,31 @@ keymap during active completions (`company-active-map'):
        (eq pos (point))
        (not company-candidates)
        (not (equal (point) company-point))
-       (let ((company-idle-delay t))
+       (let ((company-idle-delay t)
+             (company-begin-commands t))
          (company-begin)
          (when company-candidates
            (company-input-noop)
            (company-post-command)))))
 
-(defun company-manual-begin ()
-  (interactive)
+(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))
-         (setq company--explicit-action t)
          (company-begin)))
   ;; Return non-nil if active.
   company-candidates)
 
-(defsubst company-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-manual-begin ()
+  (interactive)
+  (setq company--explicit-action t)
+  (company-auto-begin))
 
 (defun company-require-match-p ()
-  (let ((backend-value (funcall company-backend 'require-match)))
+  (let ((backend-value (company-call-backend 'require-match)))
     (or (eq backend-value t)
         (and (if (functionp company-require-match)
                  (funcall company-require-match)
@@ -721,85 +853,118 @@ keymap during active completions (`company-active-map'):
   "Return non-nil, if input starts with punctuation or parentheses."
   (memq (char-syntax (string-to-char input)) '(?. ?\( ?\))))
 
-(defun company-auto-complete-p (beg end)
+(defun company-auto-complete-p (input)
   "Return non-nil, if input starts with punctuation or parentheses."
-  (and (> end beg)
-       (if (functionp company-auto-complete)
+  (and (if (functionp company-auto-complete)
            (funcall company-auto-complete)
          company-auto-complete)
        (if (functionp company-auto-complete-chars)
-           (funcall company-auto-complete-chars (buffer-substring beg end))
+           (funcall company-auto-complete-chars input)
          (if (consp company-auto-complete-chars)
-             (memq (char-syntax (char-after beg)) company-auto-complete-chars)
-           (string-match (buffer-substring beg (1+ beg))
-                         company-auto-complete-chars)))))
+             (memq (char-syntax (string-to-char input))
+                   company-auto-complete-chars)
+           (string-match (substring input 0 1) company-auto-complete-chars)))))
+
+(defun company--incremental-p ()
+  (and (> (point) company-point)
+       (> (point-max) company--point-max)
+       (not (eq this-command 'backward-delete-char-untabify))
+       (equal (buffer-substring (- company-point (length company-prefix))
+                                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 ()
-  (when (funcall company-backend 'no-cache company-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)
+          (company-complete-selection)
+          nil))
+       ((and (company--string-incremental-p company-prefix new-prefix)
+             (company-require-match-p))
+        ;; wrong incremental input, but required match
+        (backward-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 ()
+  (when (company-call-backend 'no-cache company-prefix)
     ;; Don't complete existing candidates, fetch new ones.
     (setq company-candidates-cache nil))
-  (let ((new-prefix (funcall company-backend 'prefix)))
-    (unless (and (= (- (point) (length new-prefix))
-                    (- company-point (length company-prefix)))
-                 (or (equal company-prefix new-prefix)
-                     (let ((c (company-calculate-candidates new-prefix)))
-                       ;; t means complete/unique.
-                       (if (eq c t)
-                           (progn (company-cancel new-prefix) t)
-                         (when (consp c)
-                           (setq company-prefix new-prefix)
-                           (company-update-candidates c)
-                           t)))))
-      (if (company-auto-complete-p company-point (point))
-          (save-excursion
-            (goto-char company-point)
-            (company-complete-selection)
-            (setq company-candidates nil))
-        (if (not (and (company-incremental-p company-prefix new-prefix)
-                      (company-require-match-p)))
-            (progn
-              (when (equal company-prefix (car company-candidates))
-                ;; cancel, but last input was actually success
-                (company-cancel company-prefix))
-              (setq company-candidates nil))
-          (backward-delete-char (length new-prefix))
-          (insert company-prefix)
-          (ding)
-          (message "Matching input is required")))
-      company-candidates)))
+  (let* ((new-prefix (company-call-backend 'prefix))
+         (c (when (and (stringp new-prefix)
+                       (or (company-explicit-action-p)
+                           (>= (length new-prefix)
+                               company-minimum-prefix-length))
+                       (= (- (point) (length new-prefix))
+                          (- company-point (length company-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))))
+
+(defun company--begin-new ()
+  (let (prefix c)
+    (dolist (backend (if company-backend
+                         ;; prefer manual override
+                         (list company-backend)
+                       company-backends))
+      (setq prefix
+            (if (or (symbolp backend)
+                    (functionp backend))
+                (when (or (not (symbolp backend))
+                          (eq t (get backend 'company-init))
+                          (unless (get backend 'company-init)
+                            (company-init-backend backend)))
+                  (funcall backend 'prefix))
+              (company--multi-backend-adapter backend 'prefix)))
+      (when prefix
+        (when (and (stringp prefix)
+                   (>= (length prefix) company-minimum-prefix-length))
+          (setq company-backend backend
+                c (company-calculate-candidates prefix))
+          ;; t means complete/unique.  We don't start, so no hooks.
+          (when (consp c)
+            (setq company-prefix prefix)
+            (company-update-candidates c)
+            (run-hook-with-args 'company-completion-started-hook
+                                (company-explicit-action-p))
+            (company-call-frontends 'show)))
+        (return c)))))
 
 (defun company-begin ()
-  (when (if company-candidates
-            (not (company-continue))
-          (company--should-complete))
-    (let (prefix)
-      (dolist (backend (if company-backend
-                           ;; prefer manual override
-                           (list company-backend)
-                         company-backends))
-        (when (and (functionp backend)
-                   (setq prefix (funcall backend 'prefix)))
-          (when (and (stringp prefix)
-                     (>= (length prefix) company-minimum-prefix-length))
-            (setq company-backend backend
-                  company-prefix prefix)
-            (let ((c (company-calculate-candidates prefix)))
-              ;; t means complete/unique.  We don't start, so no hooks.
-              (when (consp c)
-                (company-update-candidates c)
-                (run-hook-with-args 'company-completion-started-hook
-                                    (company-explicit-action-p))
-                (company-call-frontends 'show))))
-          (return prefix)))))
-  (if company-candidates
-      (progn
-        (when (and company-end-of-buffer-workaround (eobp))
-          (save-excursion (insert "\n"))
-          (setq company-added-newline (buffer-chars-modified-tick)))
-        (setq company-point (point))
-        (company-enable-overriding-keymap company-active-map)
-        (company-call-frontends 'update))
-    (company-cancel)))
+  (setq company-candidates
+        (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)))
+    (setq company-point (point)
+          company--point-max (point-max))
+    (company-enable-overriding-keymap company-active-map)
+    (company-call-frontends 'update)))
 
 (defun company-cancel (&optional result)
   (and company-added-newline
@@ -824,6 +989,7 @@ keymap during active completions (`company-active-map'):
         company-selection 0
         company-selection-changed nil
         company--explicit-action nil
+        company--point-max nil
         company-point nil)
   (when company-timer
     (cancel-timer company-timer))
@@ -855,23 +1021,26 @@ keymap during active completions (`company-active-map'):
              (message "%s" (error-message-string err))
              (company-cancel))))
   (when company-timer
-    (cancel-timer company-timer))
+    (cancel-timer company-timer)
+    (setq company-timer nil))
   (company-uninstall-map))
 
 (defun company-post-command ()
   (unless (company-keep this-command)
     (condition-case err
         (progn
-          (setq company--this-command this-command)
           (unless (equal (point) company-point)
             (company-begin))
-          (when company-candidates
-            (company-call-frontends 'post-command))
-          (when (numberp company-idle-delay)
-            (setq company-timer
-                  (run-with-timer company-idle-delay nil 'company-idle-begin
-                                  (current-buffer) (selected-window)
-                                  (buffer-chars-modified-tick) (point)))))
+          (if company-candidates
+              (company-call-frontends 'post-command)
+            (and (numberp company-idle-delay)
+                 (or (eq t company-begin-commands)
+                     (memq this-command company-begin-commands))
+                 (setq company-timer
+                       (run-with-timer company-idle-delay nil
+                                       'company-idle-begin
+                                       (current-buffer) (selected-window)
+                                       (buffer-chars-modified-tick) (point))))))
       (error (message "Company: An error occurred in post-command")
              (message "%s" (error-message-string err))
              (company-cancel))))
@@ -1085,7 +1254,7 @@ followed by `company-search-kill-others' after each input."
   (interactive "e")
   (when (nth 4 (event-start event))
     (company-set-selection (- (cdr (posn-actual-col-row (event-start event)))
-                              (cdr (posn-actual-col-row (posn-at-point)))
+                              (company--row)
                               1))
     t))
 
@@ -1165,7 +1334,7 @@ To show the number next to the candidates in some back-ends, enable
   (let ((selected (nth company-selection company-candidates)))
     (unless (equal selected (car company-last-metadata))
       (setq company-last-metadata
-            (cons selected (funcall company-backend 'meta selected))))
+            (cons selected (company-call-backend 'meta selected))))
     (cdr company-last-metadata)))
 
 (defun company-doc-buffer (&optional string)
@@ -1178,7 +1347,7 @@ To show the number next to the candidates in some back-ends, enable
   `(when (company-manual-begin)
      (save-window-excursion
        (let ((height (window-height))
-             (row (cdr (posn-actual-col-row (posn-at-point)))))
+             (row (company--row)))
          ,@body
          (and (< (window-height) height)
               (< (- (window-height) row 2) company-tooltip-limit)
@@ -1195,7 +1364,7 @@ To show the number next to the candidates in some back-ends, enable
   (interactive)
   (company-electric
     (let ((selected (nth company-selection company-candidates)))
-      (display-buffer (or (funcall company-backend 'doc-buffer selected)
+      (display-buffer (or (company-call-backend 'doc-buffer selected)
                           (error "No documentation available")) t))))
 (put 'company-show-doc-buffer 'company-keep t)
 
@@ -1204,7 +1373,7 @@ To show the number next to the candidates in some back-ends, enable
   (interactive)
   (company-electric
     (let* ((selected (nth company-selection company-candidates))
-           (location (funcall company-backend 'location selected))
+           (location (company-call-backend 'location selected))
            (pos (or (cdr location) (error "No location available")))
            (buffer (or (and (bufferp (car location)) (car location))
                        (find-file-noselect (car location) t))))
@@ -1220,9 +1389,14 @@ 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-cancelled-hook 'company-remove-callback t)
+  (remove-hook 'company-completion-finished-hook 'company-remove-callback t)
+  (set-marker company-begin-with-marker nil))
 
 (defun company-begin-backend (backend &optional callback)
   "Start a completion at point using BACKEND."
@@ -1231,13 +1405,10 @@ To show the number next to the candidates in some back-ends, enable
                                            'functionp nil "company-")))
                  (when val
                    (list (intern val)))))
-  (when callback
-    (setq company-callback
-          `(lambda (completion)
-             (funcall ',callback completion)
-             (company-remove-callback)))
-    (add-hook 'company-completion-cancelled-hook 'company-remove-callback nil t)
+  (when (setq company-callback callback)
     (add-hook 'company-completion-finished-hook company-callback nil t))
+  (add-hook 'company-completion-cancelled-hook 'company-remove-callback nil t)
+  (add-hook 'company-completion-finished-hook 'company-remove-callback nil t)
   (setq company-backend backend)
   ;; Return non-nil if active.
   (or (company-manual-begin)
@@ -1254,15 +1425,17 @@ completes the input.
 
 Example:
 \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
+  (setq company-begin-with-marker (copy-marker (point) t))
   (company-begin-backend
-   (let ((start (- (point) (or prefix-length 0))))
-     `(lambda (command &optional arg &rest ignored)
-        (case command-history
-          ('prefix (message "prefix %s" (buffer-substring ,start (point)))
-                   (when (>= (point) ,start)
-                     (buffer-substring ,start (point))))
-          ('candidates (all-completions arg ',candidates))
-          ('require-match ,require-match))))
+   `(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))
 
 ;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1342,7 +1515,7 @@ Example:
 
 (defun company-buffer-lines (beg end)
   (goto-char beg)
-  (let ((row (cdr (posn-actual-col-row (posn-at-point))))
+  (let ((row (company--row))
         lines)
     (while (and (equal (move-to-window-line (incf row)) row)
                 (<= (point) end))
@@ -1391,7 +1564,7 @@ Example:
                       (setq remainder (format "...(%d)" remainder))))
 
     (decf selection company-tooltip-offset)
-    (setq width (min (length previous) (length remainder))
+    (setq width (max (length previous) (length remainder))
           lines (nthcdr company-tooltip-offset company-candidates)
           len (min limit len)
           lines-copy lines)
@@ -1467,7 +1640,7 @@ Example:
       (overlay-put company-pseudo-tooltip-overlay 'window (selected-window)))))
 
 (defun company-pseudo-tooltip-show-at-point (pos)
-  (let ((col-row (posn-actual-col-row (posn-at-point pos))))
+  (let ((col-row (company--col-row pos)))
     (when col-row
       (company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row)
                                    company-selection))))