X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/8f2c03248b5517d82588a05f357805cbb0f384ed..c845c43aaa6cfc42e8b4a8eeaa370aa85caf02f2:/company-capf.el diff --git a/company-capf.el b/company-capf.el index 04f8413ed..0b88e2ba4 100644 --- a/company-capf.el +++ b/company-capf.el @@ -1,6 +1,6 @@ -;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*- +;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*- -;; Copyright (C) 2013-2014 Free Software Foundation, Inc. +;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; Author: Stefan Monnier @@ -25,28 +25,36 @@ ;;; Code: +(require 'company) (require 'cl-lib) -(defvar company--capf-data nil) -(make-variable-buffer-local 'company--capf-data) - -(defun company--capf-clear-data (&optional _ignore) - (setq company--capf-data nil) - (remove-hook 'company-completion-cancelled-hook 'company--capf-clear-data t) - (remove-hook 'company-completion-finished-hook 'company--capf-clear-data t)) +(defvar company--capf-cache nil) (defun company--capf-data () - ;; Ignore tags-completion-at-point-function because it subverts company-etags - ;; in the default value of company-backends, where the latter comes later. - (cl-letf* (((default-value 'completion-at-point-functions) nil) + (let ((cache company--capf-cache)) + (if (and (equal (current-buffer) (car cache)) + (equal (point) (car (setq cache (cdr cache)))) + (equal (buffer-chars-modified-tick) (car (setq cache (cdr cache))))) + (cadr cache) + (let ((data (company--capf-data-real))) + (setq company--capf-cache + (list (current-buffer) (point) (buffer-chars-modified-tick) data)) + data)))) + +(defun company--capf-data-real () + (cl-letf* (((default-value 'completion-at-point-functions) + ;; Ignore tags-completion-at-point-function because it subverts + ;; company-etags in the default value of company-backends, where + ;; the latter comes later. + (remove 'tags-completion-at-point-function + (default-value 'completion-at-point-functions))) (data (run-hook-wrapped 'completion-at-point-functions ;; Ignore misbehaving functions. #'completion--capf-wrapper 'optimist))) - (when (and (consp (cdr data)) (numberp (nth 1 data))) data))) + (when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data))) (defun company-capf (command &optional arg &rest _args) - "`company-mode' back-end using `completion-at-point-functions'. -Requires Emacs 24.1 or newer." + "`company-mode' backend using `completion-at-point-functions'." (interactive (list 'interactive)) (pcase command (`interactive (company-begin-backend 'company-capf)) @@ -55,12 +63,9 @@ Requires Emacs 24.1 or newer." (when res (if (> (nth 2 res) (point)) 'stop - (setq company--capf-data res) - (add-hook 'company-completion-cancelled-hook 'company--capf-clear-data nil t) - (add-hook 'company-completion-finished-hook 'company--capf-clear-data nil t) (buffer-substring-no-properties (nth 1 res) (point)))))) (`candidates - (let ((res company--capf-data)) + (let ((res (company--capf-data))) (when res (let* ((table (nth 3 res)) (pred (plist-get (nthcdr 4 res) :predicate)) @@ -82,7 +87,7 @@ Requires Emacs 24.1 or newer." candidates)) candidates))))) (`sorted - (let ((res company--capf-data)) + (let ((res (company--capf-data))) (when res (let ((meta (completion-metadata (buffer-substring (nth 1 res) (nth 2 res)) @@ -105,31 +110,42 @@ Requires Emacs 24.1 or newer." (`no-cache t) ;Not much can be done here, as long as we handle ;non-prefix matches. (`meta - (let ((f (plist-get (nthcdr 4 company--capf-data) :company-docsig))) + (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig))) (when f (funcall f arg)))) (`doc-buffer - (let ((f (plist-get (nthcdr 4 company--capf-data) :company-doc-buffer))) + (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer))) (when f (funcall f arg)))) (`location - (let ((f (plist-get (nthcdr 4 company--capf-data) :company-location))) + (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location))) (when f (funcall f arg)))) (`annotation (save-excursion ;; FIXME: `company-begin' sets `company-point' after calling ;; `company--begin-new'. We shouldn't rely on `company-point' here, - ;; better to cache the capf-data value instead. + ;; better to cache the capf-data value instead. However: we can't just + ;; save the last capf-data value in `prefix', because that command can + ;; get called more often than `candidates', and at any point in the + ;; buffer (https://github.com/company-mode/company-mode/issues/153). + ;; We could try propertizing the returned prefix string, but it's not + ;; passed to `annotation', and `company-prefix' is set only after + ;; `company--strip-duplicates' is called. (when company-point (goto-char company-point)) - (let ((f (plist-get (nthcdr 4 company--capf-data) :annotation-function))) + (let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function))) (when f (funcall f arg))))) (`require-match - (plist-get (nthcdr 4 company--capf-data) :company-require-match)) + (plist-get (nthcdr 4 (company--capf-data)) :company-require-match)) (`init nil) ;Don't bother: plenty of other ways to initialize the code. (`post-completion - (let* ((res company--capf-data) - (exit-function (plist-get (nthcdr 4 res) :exit-function))) + (let* ((res (company--capf-data)) + (exit-function (plist-get (nthcdr 4 res) :exit-function)) + (table (nth 3 res)) + (pred (plist-get (nthcdr 4 res) :predicate))) (if exit-function - (funcall exit-function arg 'finished)))) + ;; Follow the example of `completion--done'. + (funcall exit-function arg + (if (eq (try-completion arg table pred) t) + 'finished 'sole))))) )) (provide 'company-capf)