1 ;;; company-elisp.el --- A company-mode completion back-end for emacs-lisp-mode -*- 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/>.
29 (eval-when-compile (require 'cl))
33 (defcustom company-elisp-detect-function-context t
34 "If enabled, offer Lisp functions only in appropriate contexts.
35 Functions are offered for completion only after ' and \(."
37 :type '(choice (const :tag "Off" nil)
40 (defcustom company-elisp-show-locals-first t
41 "If enabled, locally bound variables and functions are displayed
42 first in the candidates list."
44 :type '(choice (const :tag "Off" nil)
47 (defun company-elisp--prefix ()
48 (let ((prefix (company-grab-symbol)))
50 (when (if (company-in-string-or-comment)
51 (= (char-before (- (point) (length prefix))) ?`)
52 (company-elisp--should-complete))
56 (defun company-elisp--predicate (symbol)
62 (defun company-elisp--fns-regexp (&rest names)
63 (concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
65 (defvar company-elisp-parse-limit 30)
66 (defvar company-elisp-parse-depth 100)
68 (defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
70 (defvar company-elisp-var-binding-regexp
71 (apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
72 company-elisp-defun-names)
73 "Regular expression matching head of a multiple variable bindings form.")
75 (defvar company-elisp-var-binding-regexp-1
76 (company-elisp--fns-regexp "dolist" "dotimes")
77 "Regular expression matching head of a form with one variable binding.")
79 (defvar company-elisp-fun-binding-regexp
80 (company-elisp--fns-regexp "flet" "labels")
81 "Regular expression matching head of a function bindings form.")
83 (defvar company-elisp-defuns-regexp
85 (apply #'company-elisp--fns-regexp company-elisp-defun-names)))
87 (defun company-elisp--should-complete ()
89 (depth (car (syntax-ppss))))
94 (when (looking-at company-elisp-defuns-regexp)
97 (unless (= (point) start)
99 (let ((args-end (scan-sexps (point) 2)))
105 (defun company-elisp--locals (prefix functions-p)
106 (let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
107 "\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
112 (dotimes (i company-elisp-parse-depth)
115 (when (eq (char-after) ?\()
118 (save-excursion (forward-list)
120 (skip-chars-forward " \t\n")
122 ((looking-at (if functions-p
123 company-elisp-fun-binding-regexp
124 company-elisp-var-binding-regexp))
127 (dotimes (i company-elisp-parse-limit)
129 (when (looking-at "[ \t\n]*(")
131 (when (looking-at regexp)
132 (pushnew (match-string-no-properties 1) res)))
136 (looking-at company-elisp-var-binding-regexp-1))
138 (when (looking-at regexp)
139 (pushnew (match-string-no-properties 1) res)))))))))
143 (defun company-elisp-candidates (prefix)
144 (let* ((predicate (company-elisp--candidates-predicate prefix))
145 (locals (company-elisp--locals prefix (eq predicate 'fboundp)))
146 (globals (company-elisp--globals prefix predicate))
147 (locals (loop for local in locals
148 when (not (member local globals))
150 (if company-elisp-show-locals-first
151 (append (sort locals 'string<)
152 (sort globals 'string<))
153 (append locals globals))))
155 (defun company-elisp--globals (prefix predicate)
156 (all-completions prefix obarray predicate))
158 (defun company-elisp--candidates-predicate (prefix)
159 (let* ((completion-ignore-case nil)
160 (before (char-before (- (point) (length prefix)))))
161 (if (and company-elisp-detect-function-context
162 (not (eq before ?')))
163 (if (and (eq before ?\()
170 (looking-at "[ \t\n]*("))
171 (prog1 (search-backward "(")
173 (looking-at company-elisp-var-binding-regexp))))))
176 'company-elisp--predicate)))
178 (defun company-elisp--doc (symbol)
179 (let* ((symbol (intern symbol))
180 (doc (if (fboundp symbol)
181 (documentation symbol t)
182 (documentation-property symbol 'variable-documentation t))))
184 (string-match ".*$" doc)
185 (match-string 0 doc))))
188 (defun company-elisp (command &optional arg &rest ignored)
189 "A `company-mode' completion back-end for `emacs-lisp-mode'."
190 (interactive (list 'interactive))
192 (interactive (company-begin-backend 'company-elisp))
193 (prefix (and (eq (derived-mode-p 'emacs-lisp-mode) 'emacs-lisp-mode)
194 (company-elisp--prefix)))
195 (candidates (company-elisp-candidates arg))
196 (sorted company-elisp-show-locals-first)
197 (meta (company-elisp--doc arg))
198 (doc-buffer (let ((symbol (intern arg)))
199 (save-window-excursion
202 ((fboundp symbol) (describe-function symbol))
203 ((boundp symbol) (describe-variable symbol))
204 ((featurep symbol) (describe-package symbol))
205 ((facep symbol) (describe-face symbol))
206 (t (signal 'user-error nil)))
208 (location (let ((sym (intern arg)))
210 ((fboundp sym) (find-definition-noselect sym nil))
211 ((boundp sym) (find-definition-noselect sym 'defvar))
212 ((featurep sym) (cons (find-file-noselect (find-library-name
215 ((facep sym) (find-definition-noselect sym 'defface)))))))
217 (provide 'company-elisp)
218 ;;; company-elisp.el ends here