1 ;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
3 ;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
5 ;; Author: Nikolaj Schumacher
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/>.
33 (defgroup company-elisp nil
34 "Completion backend for Emacs Lisp."
37 (defcustom company-elisp-detect-function-context t
38 "If enabled, offer Lisp functions only in appropriate contexts.
39 Functions are offered for completion only after ' and \(."
40 :type '(choice (const :tag "Off" nil)
43 (defcustom company-elisp-show-locals-first t
44 "If enabled, locally bound variables and functions are displayed
45 first in the candidates list."
46 :type '(choice (const :tag "Off" nil)
49 (defun company-elisp--prefix ()
50 (let ((prefix (company-grab-symbol)))
52 (when (if (company-in-string-or-comment)
53 (= (char-before (- (point) (length prefix))) ?`)
54 (company-elisp--should-complete))
58 (defun company-elisp--predicate (symbol)
64 (defun company-elisp--fns-regexp (&rest names)
65 (concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
67 (defvar company-elisp-parse-limit 30)
68 (defvar company-elisp-parse-depth 100)
70 (defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
72 (defvar company-elisp-var-binding-regexp
73 (apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
74 company-elisp-defun-names)
75 "Regular expression matching head of a multiple variable bindings form.")
77 (defvar company-elisp-var-binding-regexp-1
78 (company-elisp--fns-regexp "dolist" "dotimes")
79 "Regular expression matching head of a form with one variable binding.")
81 (defvar company-elisp-fun-binding-regexp
82 (company-elisp--fns-regexp "flet" "labels")
83 "Regular expression matching head of a function bindings form.")
85 (defvar company-elisp-defuns-regexp
87 (apply #'company-elisp--fns-regexp company-elisp-defun-names)))
89 (defun company-elisp--should-complete ()
91 (depth (car (syntax-ppss))))
96 (when (looking-at company-elisp-defuns-regexp)
99 (unless (= (point) start)
101 (let ((args-end (scan-sexps (point) 2)))
107 (defun company-elisp--locals (prefix functions-p)
108 (let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
109 "\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
114 (dotimes (_ company-elisp-parse-depth)
117 (when (eq (char-after) ?\()
120 (save-excursion (forward-list)
122 (skip-chars-forward " \t\n")
124 ((looking-at (if functions-p
125 company-elisp-fun-binding-regexp
126 company-elisp-var-binding-regexp))
129 (dotimes (_ company-elisp-parse-limit)
131 (when (looking-at "[ \t\n]*(")
133 (when (looking-at regexp)
134 (cl-pushnew (match-string-no-properties 1) res)))
138 (looking-at company-elisp-var-binding-regexp-1))
140 (when (looking-at regexp)
141 (cl-pushnew (match-string-no-properties 1) res)))))))))
145 (defun company-elisp-candidates (prefix)
146 (let* ((predicate (company-elisp--candidates-predicate prefix))
147 (locals (company-elisp--locals prefix (eq predicate 'fboundp)))
148 (globals (company-elisp--globals prefix predicate))
149 (locals (cl-loop for local in locals
150 when (not (member local globals))
152 (if company-elisp-show-locals-first
153 (append (sort locals 'string<)
154 (sort globals 'string<))
155 (append locals globals))))
157 (defun company-elisp--globals (prefix predicate)
158 (all-completions prefix obarray predicate))
160 (defun company-elisp--candidates-predicate (prefix)
161 (let* ((completion-ignore-case nil)
162 (beg (- (point) (length prefix)))
163 (before (char-before beg)))
164 (if (and company-elisp-detect-function-context
165 (not (memq before '(?' ?`))))
166 (if (and (eq before ?\()
171 (or (company-elisp--before-binding-varlist-p)
174 (company-elisp--before-binding-varlist-p)))))))
177 'company-elisp--predicate)))
179 (defun company-elisp--before-binding-varlist-p ()
181 (and (prog1 (search-backward "(")
183 (looking-at company-elisp-var-binding-regexp))))
185 (defun company-elisp--doc (symbol)
186 (let* ((symbol (intern symbol))
187 (doc (if (fboundp symbol)
188 (documentation symbol t)
189 (documentation-property symbol 'variable-documentation t))))
191 (string-match ".*$" doc)
192 (match-string 0 doc))))
195 (defun company-elisp (command &optional arg &rest ignored)
196 "`company-mode' completion backend for Emacs Lisp."
197 (interactive (list 'interactive))
199 (interactive (company-begin-backend 'company-elisp))
200 (prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
201 (company-elisp--prefix)))
202 (candidates (company-elisp-candidates arg))
203 (sorted company-elisp-show-locals-first)
204 (meta (company-elisp--doc arg))
205 (doc-buffer (let ((symbol (intern arg)))
206 (save-window-excursion
209 ((fboundp symbol) (describe-function symbol))
210 ((boundp symbol) (describe-variable symbol))
211 ((featurep symbol) (describe-package symbol))
212 ((facep symbol) (describe-face symbol))
213 (t (signal 'user-error nil)))
215 (location (let ((sym (intern arg)))
217 ((fboundp sym) (find-definition-noselect sym nil))
218 ((boundp sym) (find-definition-noselect sym 'defvar))
219 ((featurep sym) (cons (find-file-noselect (find-library-name
222 ((facep sym) (find-definition-noselect sym 'defface)))))))
224 (provide 'company-elisp)
225 ;;; company-elisp.el ends here