mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957
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