X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/ca6579bf94d7c05584f97cc1bc2d7a8ae01a6906..2d44e7fef7e7388759518cba1a424495119679d1:/packages/company/company-capf.el diff --git a/packages/company/company-capf.el b/packages/company/company-capf.el index 2d20bee72..cc075df20 100644 --- a/packages/company/company-capf.el +++ b/packages/company/company-capf.el @@ -1,6 +1,6 @@ ;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*- -;; Copyright (C) 2013 Free Software Foundation, Inc. +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier @@ -25,15 +25,30 @@ ;;; Code: +(require 'company) +(require 'cl-lib) + +(defvar-local company--capf-data nil) + +(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)) + (defun company--capf-data () - (let ((data (run-hook-wrapped 'completion-at-point-functions - ;; Ignore misbehaving functions. - #'completion--capf-wrapper 'optimist))) - (when (consp data) data))) + (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))) (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' back-end using `completion-at-point-functions'." (interactive (list 'interactive)) (pcase command (`interactive (company-begin-backend 'company-capf)) @@ -42,9 +57,12 @@ 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)) @@ -52,31 +70,65 @@ Requires Emacs 24.1 or newer." (buffer-substring (nth 1 res) (nth 2 res)) table pred)) (sortfun (cdr (assq 'display-sort-function meta))) - (candidates (all-completions arg table pred))) - (if sortfun (funcall sortfun candidates) candidates))))) + (candidates (completion-all-completions arg table pred (length arg))) + (last (last candidates)) + (base-size (and (numberp (cdr last)) (cdr last)))) + (when base-size + (setcdr last nil)) + (when sortfun + (setq candidates (funcall sortfun candidates))) + (if (not (zerop (or base-size 0))) + (let ((before (substring arg 0 base-size))) + (mapcar (lambda (candidate) + (concat before candidate)) + 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)) (nth 3 res) (plist-get (nthcdr 4 res) :predicate)))) (cdr (assq 'display-sort-function meta)))))) - (`duplicates nil) ;Don't bother. - (`no-cache t) ;FIXME: Improve! + (`match + ;; Can't just use 0 when base-size (see above) is non-zero. + (let ((start (if (get-text-property 0 'font-lock-face arg) + 0 + (next-single-property-change 0 'font-lock-face arg)))) + (when start + ;; completions-common-part comes first, but we can't just look for this + ;; value because it can be in a list. + (or + (let ((value (get-text-property start 'font-lock-face arg))) + (text-property-not-all start (length arg) + 'font-lock-face value arg)) + (length arg))))) + (`duplicates t) + (`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. + (when company-point + (goto-char company-point)) + (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)) + (let* ((res company--capf-data) (exit-function (plist-get (nthcdr 4 res) :exit-function))) (if exit-function (funcall exit-function arg 'finished))))