1 ;;; company-elisp.el --- A company-mode completion back-end for emacs-lisp-mode -*- lexical-binding: t -*-
3 ;; Copyright (C) 2009, 2011-2012 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 (defun company-grab-lisp-symbol ()
45 (let ((prefix (company-grab-symbol)))
47 (unless (and (company-in-string-or-comment)
48 (/= (char-before (- (point) (length prefix))) ?`))
52 (defun company-elisp-predicate (symbol)
58 (defvar company-elisp-parse-limit 30)
59 (defvar company-elisp-parse-depth 100)
61 (defvar company-elisp-var-binding-regexp
62 (concat "\\_<" (regexp-opt '("let" "defun" "defmacro" "defsubst"
63 "lambda" "lexical-let"))
65 "Regular expression matching head of a multiple variable bindings form.")
67 (defvar company-elisp-var-binding-regexp-1
68 (concat "\\_<\\(?:cl-\\)?" (regexp-opt '("dolist" "dotimes")) "\\_>")
69 "Regular expression matching head of a form with one variable binding.")
71 (defvar company-elisp-fun-binding-regexp
72 (concat "\\_<\\(?:cl-\\)?" (regexp-opt '("flet" "labels")) "\\_>")
73 "Regular expression matching head of a function bindings form.")
75 (defun company-elisp-locals (prefix functions-p)
76 (let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
77 "\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
82 (dotimes (i company-elisp-parse-depth)
85 (when (eq (char-after) ?\()
88 (save-excursion (forward-list)
90 (skip-chars-forward " \t\n")
92 ((looking-at (if functions-p
93 company-elisp-fun-binding-regexp
94 company-elisp-var-binding-regexp))
97 (dotimes (i company-elisp-parse-limit)
99 (when (looking-at "[ \t\n]*(")
101 (when (looking-at regexp)
102 (pushnew (match-string-no-properties 1) res)))
106 (looking-at company-elisp-var-binding-regexp-1))
108 (when (looking-at regexp)
109 (pushnew (match-string-no-properties 1) res)))))))))
113 (defun company-elisp-candidates (prefix)
114 (let* ((predicate (company-elisp-candidates-predicate prefix))
115 (locals (company-elisp-locals prefix (eq predicate 'fboundp)))
116 (globals (company-elisp-globals prefix predicate))
117 (locals (loop for local in locals
118 when (not (member local globals))
120 (if company-elisp-show-locals-first
121 (append (sort locals 'string<)
122 (sort globals 'string<))
123 (append locals globals))))
125 (defun company-elisp-globals (prefix predicate)
126 (all-completions prefix obarray predicate))
128 (defun company-elisp-candidates-predicate (prefix)
129 (let* ((completion-ignore-case nil)
130 (before (char-before (- (point) (length prefix)))))
131 (if (and company-elisp-detect-function-context
132 (not (eq before ?')))
133 (if (and (eq before ?\()
140 (looking-at "[ \t\n]*("))
141 (prog1 (search-backward "(")
143 (looking-at company-elisp-var-binding-regexp))))))
146 'company-elisp-predicate)))
148 (defun company-elisp-doc (symbol)
149 (let* ((symbol (intern symbol))
150 (doc (if (fboundp symbol)
151 (documentation symbol t)
152 (documentation-property symbol 'variable-documentation t))))
154 (string-match ".*$" doc)
155 (match-string 0 doc))))
158 (defun company-elisp (command &optional arg &rest ignored)
159 "A `company-mode' completion back-end for `emacs-lisp-mode'."
160 (interactive (list 'interactive))
162 (interactive (company-begin-backend 'company-elisp))
163 (prefix (and (eq (derived-mode-p 'emacs-lisp-mode) 'emacs-lisp-mode)
164 (company-grab-lisp-symbol)))
165 (candidates (company-elisp-candidates arg))
166 (sorted company-elisp-show-locals-first)
167 (meta (company-elisp-doc arg))
168 (doc-buffer (let ((symbol (intern arg)))
169 (save-window-excursion
172 ((fboundp symbol) (describe-function symbol))
173 ((boundp symbol) (describe-variable symbol))
174 ((featurep symbol) (describe-package symbol))
175 ((facep symbol) (describe-face symbol))
176 (t (signal 'user-error nil)))
178 (location (let ((sym (intern arg)))
180 ((fboundp sym) (find-definition-noselect sym nil))
181 ((boundp sym) (find-definition-noselect sym 'defvar))
182 ((featurep sym) (cons (find-file-noselect (find-library-name
185 ((facep sym) (find-definition-noselect sym 'defface)))))))
187 (provide 'company-elisp)
188 ;;; company-elisp.el ends here