1 ;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*-
3 ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
31 (defvar company--capf-cache nil)
33 (defun company--capf-data ()
34 (let ((cache company--capf-cache))
35 (if (and (equal (current-buffer) (car cache))
36 (equal (point) (car (setq cache (cdr cache))))
37 (equal (buffer-chars-modified-tick) (car (setq cache (cdr cache)))))
39 (let ((data (company--capf-data-real)))
40 (setq company--capf-cache
41 (list (current-buffer) (point) (buffer-chars-modified-tick) data))
44 (defun company--capf-data-real ()
45 (cl-letf* (((default-value 'completion-at-point-functions)
46 ;; Ignore tags-completion-at-point-function because it subverts
47 ;; company-etags in the default value of company-backends, where
48 ;; the latter comes later.
49 (remove 'tags-completion-at-point-function
50 (default-value 'completion-at-point-functions)))
51 (completion-at-point-functions (company--capf-workaround))
52 (data (run-hook-wrapped 'completion-at-point-functions
53 ;; Ignore misbehaving functions.
54 #'completion--capf-wrapper 'optimist)))
55 (when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
57 (declare-function python-shell-get-process "python")
59 (defun company--capf-workaround ()
60 ;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
61 (if (or (not (listp completion-at-point-functions))
62 (not (memq 'python-completion-complete-at-point completion-at-point-functions))
63 (python-shell-get-process))
64 completion-at-point-functions
65 (remq 'python-completion-complete-at-point completion-at-point-functions)))
67 (defun company-capf (command &optional arg &rest _args)
68 "`company-mode' backend using `completion-at-point-functions'."
69 (interactive (list 'interactive))
71 (`interactive (company-begin-backend 'company-capf))
73 (let ((res (company--capf-data)))
75 (let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
76 (prefix (buffer-substring-no-properties (nth 1 res) (point))))
78 ((> (nth 2 res) (point)) 'stop)
79 (length (cons prefix length))
82 (let ((res (company--capf-data)))
84 (let* ((table (nth 3 res))
85 (pred (plist-get (nthcdr 4 res) :predicate))
86 (meta (completion-metadata
87 (buffer-substring (nth 1 res) (nth 2 res))
89 (sortfun (cdr (assq 'display-sort-function meta)))
90 (candidates (completion-all-completions arg table pred (length arg)))
91 (last (last candidates))
92 (base-size (and (numberp (cdr last)) (cdr last))))
96 (setq candidates (funcall sortfun candidates)))
97 (if (not (zerop (or base-size 0)))
98 (let ((before (substring arg 0 base-size)))
99 (mapcar (lambda (candidate)
100 (concat before candidate))
104 (let ((res (company--capf-data)))
106 (let ((meta (completion-metadata
107 (buffer-substring (nth 1 res) (nth 2 res))
108 (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
109 (cdr (assq 'display-sort-function meta))))))
111 ;; Can't just use 0 when base-size (see above) is non-zero.
112 (let ((start (if (get-text-property 0 'face arg)
114 (next-single-property-change 0 'face arg))))
116 ;; completions-common-part comes first, but we can't just look for this
117 ;; value because it can be in a list.
119 (let ((value (get-text-property start 'face arg)))
120 (text-property-not-all start (length arg)
124 (`no-cache t) ;Not much can be done here, as long as we handle
127 (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
128 (when f (funcall f arg))))
130 (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
131 (when f (funcall f arg))))
133 (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
134 (when f (funcall f arg))))
137 ;; FIXME: `company-begin' sets `company-point' after calling
138 ;; `company--begin-new'. We shouldn't rely on `company-point' here,
139 ;; better to cache the capf-data value instead. However: we can't just
140 ;; save the last capf-data value in `prefix', because that command can
141 ;; get called more often than `candidates', and at any point in the
142 ;; buffer (https://github.com/company-mode/company-mode/issues/153).
143 ;; We could try propertizing the returned prefix string, but it's not
144 ;; passed to `annotation', and `company-prefix' is set only after
145 ;; `company--strip-duplicates' is called.
147 (goto-char company-point))
148 (let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function)))
149 (when f (funcall f arg)))))
151 (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
152 (`init nil) ;Don't bother: plenty of other ways to initialize the code.
154 (let* ((res (company--capf-data))
155 (exit-function (plist-get (nthcdr 4 res) :exit-function))
157 (pred (plist-get (nthcdr 4 res) :predicate)))
159 ;; Follow the example of `completion--done'.
160 (funcall exit-function arg
161 (if (eq (try-completion arg table pred) t)
165 (provide 'company-capf)
167 ;;; company-capf.el ends here