| commit | author | age | ||
| 5cb5f7 | 1 | ;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2013-2018 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | |
| 6 | ||
| 7 | ;; This file is part of GNU Emacs. | |
| 8 | ||
| 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. | |
| 13 | ||
| 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. | |
| 18 | ||
| 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/>. | |
| 21 | ||
| 22 | ||
| 23 | ;;; Commentary: | |
| 24 | ;; | |
| 25 | ;; The CAPF back-end provides a bridge to the standard | |
| 26 | ;; completion-at-point-functions facility, and thus can support any major mode | |
| 27 | ;; that defines a proper completion function, including emacs-lisp-mode, | |
| 28 | ;; css-mode and nxml-mode. | |
| 29 | ||
| 30 | ;;; Code: | |
| 31 | ||
| 32 | (require 'company) | |
| 33 | (require 'cl-lib) | |
| 34 | ||
| 35 | (defvar company--capf-cache nil) | |
| 36 | ||
| 37 | (defun company--capf-data () | |
| 38 | (let ((cache company--capf-cache)) | |
| 39 | (if (and (equal (current-buffer) (car cache)) | |
| 40 | (equal (point) (car (setq cache (cdr cache)))) | |
| 41 | (equal (buffer-chars-modified-tick) (car (setq cache (cdr cache))))) | |
| 42 | (cadr cache) | |
| 43 | (let ((data (company--capf-data-real))) | |
| 44 | (setq company--capf-cache | |
| 45 | (list (current-buffer) (point) (buffer-chars-modified-tick) data)) | |
| 46 | data)))) | |
| 47 | ||
| 48 | (defun company--capf-data-real () | |
| 49 | (cl-letf* (((default-value 'completion-at-point-functions) | |
| 50 | ;; Ignore tags-completion-at-point-function because it subverts | |
| 51 | ;; company-etags in the default value of company-backends, where | |
| 52 | ;; the latter comes later. | |
| 53 | (remove 'tags-completion-at-point-function | |
| 54 | (default-value 'completion-at-point-functions))) | |
| 55 | (completion-at-point-functions (company--capf-workaround)) | |
| 56 | (data (run-hook-wrapped 'completion-at-point-functions | |
| 57 | ;; Ignore misbehaving functions. | |
| 58 | #'completion--capf-wrapper 'optimist))) | |
| 59 | (when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data))) | |
| 60 | ||
| 61 | (declare-function python-shell-get-process "python") | |
| 62 | ||
| 63 | (defun company--capf-workaround () | |
| 64 | ;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067 | |
| 65 | (if (or (not (listp completion-at-point-functions)) | |
| 66 | (not (memq 'python-completion-complete-at-point completion-at-point-functions)) | |
| 67 | (python-shell-get-process)) | |
| 68 | completion-at-point-functions | |
| 69 | (remq 'python-completion-complete-at-point completion-at-point-functions))) | |
| 70 | ||
| 71 | (defun company-capf (command &optional arg &rest _args) | |
| 72 | "`company-mode' backend using `completion-at-point-functions'." | |
| 73 | (interactive (list 'interactive)) | |
| 74 | (pcase command | |
| 75 | (`interactive (company-begin-backend 'company-capf)) | |
| 76 | (`prefix | |
| 77 | (let ((res (company--capf-data))) | |
| 78 | (when res | |
| 79 | (let ((length (plist-get (nthcdr 4 res) :company-prefix-length)) | |
| 80 | (prefix (buffer-substring-no-properties (nth 1 res) (point)))) | |
| 81 | (cond | |
| 82 | ((> (nth 2 res) (point)) 'stop) | |
| 83 | (length (cons prefix length)) | |
| 84 | (t prefix)))))) | |
| 85 | (`candidates | |
| 86 | (let ((res (company--capf-data))) | |
| 87 | (when res | |
| 88 | (let* ((table (nth 3 res)) | |
| 89 | (pred (plist-get (nthcdr 4 res) :predicate)) | |
| 90 | (meta (completion-metadata | |
| 91 | (buffer-substring (nth 1 res) (nth 2 res)) | |
| 92 | table pred)) | |
| 93 | (sortfun (cdr (assq 'display-sort-function meta))) | |
| 94 | (candidates (completion-all-completions arg table pred (length arg))) | |
| 95 | (last (last candidates)) | |
| 96 | (base-size (and (numberp (cdr last)) (cdr last)))) | |
| 97 | (when base-size | |
| 98 | (setcdr last nil)) | |
| 99 | (when sortfun | |
| 100 | (setq candidates (funcall sortfun candidates))) | |
| 101 | (if (not (zerop (or base-size 0))) | |
| 102 | (let ((before (substring arg 0 base-size))) | |
| 103 | (mapcar (lambda (candidate) | |
| 104 | (concat before candidate)) | |
| 105 | candidates)) | |
| 106 | candidates))))) | |
| 107 | (`sorted | |
| 108 | (let ((res (company--capf-data))) | |
| 109 | (when res | |
| 110 | (let ((meta (completion-metadata | |
| 111 | (buffer-substring (nth 1 res) (nth 2 res)) | |
| 112 | (nth 3 res) (plist-get (nthcdr 4 res) :predicate)))) | |
| 113 | (cdr (assq 'display-sort-function meta)))))) | |
| 114 | (`match | |
| 115 | ;; Ask the for the `:company-match' function. If that doesn't help, | |
| 116 | ;; fallback to sniffing for face changes to get a suitable value. | |
| 117 | (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-match))) | |
| 118 | (if f (funcall f arg) | |
| 119 | (let* ((match-start nil) (pos -1) | |
| 120 | (prop-value nil) (faces nil) | |
| 121 | (has-face-p nil) chunks | |
| 122 | (limit (length arg))) | |
| 123 | (while (< pos limit) | |
| 124 | (setq pos | |
| 125 | (if (< pos 0) 0 (next-property-change pos arg limit))) | |
| 126 | (setq prop-value (or | |
| 127 | (get-text-property pos 'face arg) | |
| 128 | (get-text-property pos 'font-lock-face arg)) | |
| 129 | faces (if (listp prop-value) prop-value (list prop-value)) | |
| 130 | has-face-p (memq 'completions-common-part faces)) | |
| 131 | (cond ((and (not match-start) has-face-p) | |
| 132 | (setq match-start pos)) | |
| 133 | ((and match-start (not has-face-p)) | |
| 134 | (push (cons match-start pos) chunks) | |
| 135 | (setq match-start nil)))) | |
| 136 | (nreverse chunks))))) | |
| 137 | (`duplicates t) | |
| 138 | (`no-cache t) ;Not much can be done here, as long as we handle | |
| 139 | ;non-prefix matches. | |
| 140 | (`meta | |
| 141 | (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig))) | |
| 142 | (when f (funcall f arg)))) | |
| 143 | (`doc-buffer | |
| 144 | (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer))) | |
| 145 | (when f (funcall f arg)))) | |
| 146 | (`location | |
| 147 | (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location))) | |
| 148 | (when f (funcall f arg)))) | |
| 149 | (`annotation | |
| 150 | (save-excursion | |
| 151 | ;; FIXME: `company-begin' sets `company-point' after calling | |
| 152 | ;; `company--begin-new'. We shouldn't rely on `company-point' here, | |
| 153 | ;; better to cache the capf-data value instead. However: we can't just | |
| 154 | ;; save the last capf-data value in `prefix', because that command can | |
| 155 | ;; get called more often than `candidates', and at any point in the | |
| 156 | ;; buffer (https://github.com/company-mode/company-mode/issues/153). | |
| 157 | ;; We could try propertizing the returned prefix string, but it's not | |
| 158 | ;; passed to `annotation', and `company-prefix' is set only after | |
| 159 | ;; `company--strip-duplicates' is called. | |
| 160 | (when company-point | |
| 161 | (goto-char company-point)) | |
| 162 | (let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function))) | |
| 163 | (when f (funcall f arg))))) | |
| 164 | (`require-match | |
| 165 | (plist-get (nthcdr 4 (company--capf-data)) :company-require-match)) | |
| 166 | (`init nil) ;Don't bother: plenty of other ways to initialize the code. | |
| 167 | (`post-completion | |
| 168 | (company--capf-post-completion arg)) | |
| 169 | )) | |
| 170 | ||
| 171 | (defun company--capf-post-completion (arg) | |
| 172 | (let* ((res (company--capf-data)) | |
| 173 | (exit-function (plist-get (nthcdr 4 res) :exit-function)) | |
| 174 | (table (nth 3 res)) | |
| 175 | (pred (plist-get (nthcdr 4 res) :predicate))) | |
| 176 | (if exit-function | |
| 177 | ;; Follow the example of `completion--done'. | |
| 178 | (funcall exit-function arg | |
| 179 | ;; FIXME: Should probably use an additional heuristic: | |
| 180 | ;; completion-at-point doesn't know when the user picked a | |
| 181 | ;; particular candidate explicitly (it only checks whether | |
| 182 | ;; futher completions exist). Whereas company user can press | |
| 183 | ;; RET (or use implicit completion with company-tng). | |
| 184 | (if (eq (try-completion arg table pred) t) | |
| 185 | 'finished 'sole))))) | |
| 186 | ||
| 187 | (provide 'company-capf) | |
| 188 | ||
| 189 | ;;; company-capf.el ends here | |
