1 ;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*-
3 ;; Copyright (C) 2013-2014 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-local company--capf-data nil)
33 (defun company--capf-clear-data (&optional _ignore)
34 (setq company--capf-data nil)
35 (remove-hook 'company-completion-cancelled-hook 'company--capf-clear-data t)
36 (remove-hook 'company-completion-finished-hook 'company--capf-clear-data t))
38 (defun company--capf-data ()
39 (cl-letf* (((default-value 'completion-at-point-functions)
40 ;; Ignore tags-completion-at-point-function because it subverts
41 ;; company-etags in the default value of company-backends, where
42 ;; the latter comes later.
43 (remove 'tags-completion-at-point-function
44 (default-value 'completion-at-point-functions)))
45 (data (run-hook-wrapped 'completion-at-point-functions
46 ;; Ignore misbehaving functions.
47 #'completion--capf-wrapper 'optimist)))
48 (when (and (consp (cdr data)) (numberp (nth 1 data))) data)))
50 (defun company-capf (command &optional arg &rest _args)
51 "`company-mode' back-end using `completion-at-point-functions'."
52 (interactive (list 'interactive))
54 (`interactive (company-begin-backend 'company-capf))
56 (let ((res (company--capf-data)))
58 (if (> (nth 2 res) (point))
60 (setq company--capf-data res)
61 (add-hook 'company-completion-cancelled-hook 'company--capf-clear-data nil t)
62 (add-hook 'company-completion-finished-hook 'company--capf-clear-data nil t)
63 (buffer-substring-no-properties (nth 1 res) (point))))))
65 (let ((res company--capf-data))
67 (let* ((table (nth 3 res))
68 (pred (plist-get (nthcdr 4 res) :predicate))
69 (meta (completion-metadata
70 (buffer-substring (nth 1 res) (nth 2 res))
72 (sortfun (cdr (assq 'display-sort-function meta)))
73 (candidates (completion-all-completions arg table pred (length arg)))
74 (last (last candidates))
75 (base-size (and (numberp (cdr last)) (cdr last))))
79 (setq candidates (funcall sortfun candidates)))
80 (if (not (zerop (or base-size 0)))
81 (let ((before (substring arg 0 base-size)))
82 (mapcar (lambda (candidate)
83 (concat before candidate))
87 (let ((res company--capf-data))
89 (let ((meta (completion-metadata
90 (buffer-substring (nth 1 res) (nth 2 res))
91 (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
92 (cdr (assq 'display-sort-function meta))))))
94 ;; Can't just use 0 when base-size (see above) is non-zero.
95 (let ((start (if (get-text-property 0 'font-lock-face arg)
97 (next-single-property-change 0 'font-lock-face arg))))
99 ;; completions-common-part comes first, but we can't just look for this
100 ;; value because it can be in a list.
102 (let ((value (get-text-property start 'font-lock-face arg)))
103 (text-property-not-all start (length arg)
104 'font-lock-face value arg))
107 (`no-cache t) ;Not much can be done here, as long as we handle
110 (let ((f (plist-get (nthcdr 4 company--capf-data) :company-docsig)))
111 (when f (funcall f arg))))
113 (let ((f (plist-get (nthcdr 4 company--capf-data) :company-doc-buffer)))
114 (when f (funcall f arg))))
116 (let ((f (plist-get (nthcdr 4 company--capf-data) :company-location)))
117 (when f (funcall f arg))))
120 ;; FIXME: `company-begin' sets `company-point' after calling
121 ;; `company--begin-new'. We shouldn't rely on `company-point' here,
122 ;; better to cache the capf-data value instead.
124 (goto-char company-point))
125 (let ((f (plist-get (nthcdr 4 company--capf-data) :annotation-function)))
126 (when f (funcall f arg)))))
128 (plist-get (nthcdr 4 company--capf-data) :company-require-match))
129 (`init nil) ;Don't bother: plenty of other ways to initialize the code.
131 (let* ((res company--capf-data)
132 (exit-function (plist-get (nthcdr 4 res) :exit-function)))
134 (funcall exit-function arg 'finished))))
137 (provide 'company-capf)
139 ;;; company-capf.el ends here