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

Chizi123
2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f
commit | author | age
5cb5f7 1 ;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
C 2
3 ;; Copyright (C) 2009, 2011-2013, 2017  Free Software Foundation, Inc.
4
5 ;; Author: Nikolaj Schumacher
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 ;; In newer versions of Emacs, company-capf is used instead.
26
27 ;;; Code:
28
29 (require 'company)
30 (require 'cl-lib)
31 (require 'help-mode)
32 (require 'find-func)
33
34 (defgroup company-elisp nil
35   "Completion backend for Emacs Lisp."
36   :group 'company)
37
38 (defcustom company-elisp-detect-function-context t
39   "If enabled, offer Lisp functions only in appropriate contexts.
40 Functions are offered for completion only after ' and \(."
41   :type '(choice (const :tag "Off" nil)
42                  (const :tag "On" t)))
43
44 (defcustom company-elisp-show-locals-first t
45   "If enabled, locally bound variables and functions are displayed
46 first in the candidates list."
47   :type '(choice (const :tag "Off" nil)
48                  (const :tag "On" t)))
49
50 (defun company-elisp--prefix ()
51   (let ((prefix (company-grab-symbol)))
52     (if prefix
53         (when (if (company-in-string-or-comment)
54                   (= (char-before (- (point) (length prefix))) ?`)
55                 (company-elisp--should-complete))
56           prefix)
57       'stop)))
58
59 (defun company-elisp--predicate (symbol)
60   (or (boundp symbol)
61       (fboundp symbol)
62       (facep symbol)
63       (featurep symbol)))
64
65 (defun company-elisp--fns-regexp (&rest names)
66   (concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
67
68 (defvar company-elisp-parse-limit 30)
69 (defvar company-elisp-parse-depth 100)
70
71 (defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
72
73 (defvar company-elisp-var-binding-regexp
74   (apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
75          company-elisp-defun-names)
76   "Regular expression matching head of a multiple variable bindings form.")
77
78 (defvar company-elisp-var-binding-regexp-1
79   (company-elisp--fns-regexp "dolist" "dotimes")
80   "Regular expression matching head of a form with one variable binding.")
81
82 (defvar company-elisp-fun-binding-regexp
83   (company-elisp--fns-regexp "flet" "labels")
84   "Regular expression matching head of a function bindings form.")
85
86 (defvar company-elisp-defuns-regexp
87   (concat "([ \t\n]*"
88           (apply #'company-elisp--fns-regexp company-elisp-defun-names)))
89
90 (defun company-elisp--should-complete ()
91   (let ((start (point))
92         (depth (car (syntax-ppss))))
93     (not
94      (when (> depth 0)
95        (save-excursion
96          (up-list (- depth))
97          (when (looking-at company-elisp-defuns-regexp)
98            (forward-char)
99            (forward-sexp 1)
100            (unless (= (point) start)
101              (condition-case nil
102                  (let ((args-end (scan-sexps (point) 2)))
103                    (or (null args-end)
104                        (> args-end start)))
105                (scan-error
106                 t)))))))))
107
108 (defun company-elisp--locals (prefix functions-p)
109   (let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
110                         "\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
111         (pos (point))
112         res)
113     (condition-case nil
114         (save-excursion
115           (dotimes (_ company-elisp-parse-depth)
116             (up-list -1)
117             (save-excursion
118               (when (eq (char-after) ?\()
119                 (forward-char 1)
120                 (when (ignore-errors
121                         (save-excursion (forward-list)
122                                         (<= (point) pos)))
123                   (skip-chars-forward " \t\n")
124                   (cond
125                    ((looking-at (if functions-p
126                                     company-elisp-fun-binding-regexp
127                                   company-elisp-var-binding-regexp))
128                     (down-list 1)
129                     (condition-case nil
130                         (dotimes (_ company-elisp-parse-limit)
131                           (save-excursion
132                             (when (looking-at "[ \t\n]*(")
133                               (down-list 1))
134                             (when (looking-at regexp)
135                               (cl-pushnew (match-string-no-properties 1) res)))
136                           (forward-sexp))
137                       (scan-error nil)))
138                    ((unless functions-p
139                       (looking-at company-elisp-var-binding-regexp-1))
140                     (down-list 1)
141                     (when (looking-at regexp)
142                       (cl-pushnew (match-string-no-properties 1) res)))))))))
143       (scan-error nil))
144     res))
145
146 (defun company-elisp-candidates (prefix)
147   (let* ((predicate (company-elisp--candidates-predicate prefix))
148          (locals (company-elisp--locals prefix (eq predicate 'fboundp)))
149          (globals (company-elisp--globals prefix predicate))
150          (locals (cl-loop for local in locals
151                           when (not (member local globals))
152                           collect local)))
153     (if company-elisp-show-locals-first
154         (append (sort locals 'string<)
155                 (sort globals 'string<))
156       (append locals globals))))
157
158 (defun company-elisp--globals (prefix predicate)
159   (all-completions prefix obarray predicate))
160
161 (defun company-elisp--candidates-predicate (prefix)
162   (let* ((completion-ignore-case nil)
163          (beg (- (point) (length prefix)))
164          (before (char-before beg)))
165     (if (and company-elisp-detect-function-context
166              (not (memq before '(?' ?`))))
167         (if (and (eq before ?\()
168                  (not
169                   (save-excursion
170                     (ignore-errors
171                       (goto-char (1- beg))
172                       (or (company-elisp--before-binding-varlist-p)
173                           (progn
174                             (up-list -1)
175                             (company-elisp--before-binding-varlist-p)))))))
176             'fboundp
177           'boundp)
178       'company-elisp--predicate)))
179
180 (defun company-elisp--before-binding-varlist-p ()
181   (save-excursion
182     (and (prog1 (search-backward "(")
183            (forward-char 1))
184          (looking-at company-elisp-var-binding-regexp))))
185
186 (defun company-elisp--doc (symbol)
187   (let* ((symbol (intern symbol))
188          (doc (if (fboundp symbol)
189                   (documentation symbol t)
190                 (documentation-property symbol 'variable-documentation t))))
191     (and (stringp doc)
192          (string-match ".*$" doc)
193          (match-string 0 doc))))
194
195 ;;;###autoload
196 (defun company-elisp (command &optional arg &rest ignored)
197   "`company-mode' completion backend for Emacs Lisp."
198   (interactive (list 'interactive))
199   (cl-case command
200     (interactive (company-begin-backend 'company-elisp))
201     (prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
202                  (company-elisp--prefix)))
203     (candidates (company-elisp-candidates arg))
204     (sorted company-elisp-show-locals-first)
205     (meta (company-elisp--doc arg))
206     (doc-buffer (let ((symbol (intern arg)))
207                   (save-window-excursion
208                     (ignore-errors
209                       (cond
210                        ((fboundp symbol) (describe-function symbol))
211                        ((boundp symbol) (describe-variable symbol))
212                        ((featurep symbol) (describe-package symbol))
213                        ((facep symbol) (describe-face symbol))
214                        (t (signal 'user-error nil)))
215                       (help-buffer)))))
216     (location (let ((sym (intern arg)))
217                 (cond
218                  ((fboundp sym) (find-definition-noselect sym nil))
219                  ((boundp sym) (find-definition-noselect sym 'defvar))
220                  ((featurep sym) (cons (find-file-noselect (find-library-name
221                                                             (symbol-name sym)))
222                                        0))
223                  ((facep sym) (find-definition-noselect sym 'defface)))))))
224
225 (provide 'company-elisp)
226 ;;; company-elisp.el ends here