company-elisp.el

   1 ;;; company-elisp.el --- company-mode completion back-end for Emacs Lisp -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2009, 2011-2013  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
  26 ;;; Code:
  27
  28 (require 'company)
  29 (eval-when-compile (require 'cl))
  30 (require 'help-mode)
  31 (require 'find-func)
  32
  33 (defgroup company-elisp nil
  34   "Completion back-end for Emacs Lisp."
  35   :group 'company)
  36
  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)
  41                  (const :tag "On" t)))
  42
  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)
  47                  (const :tag "On" t)))
  48
  49 (defun company-elisp--prefix ()
  50   (let ((prefix (company-grab-symbol)))
  51     (if prefix
  52         (when (if (company-in-string-or-comment)
  53                   (= (char-before (- (point) (length prefix))) ?`)
  54                 (company-elisp--should-complete))
  55           prefix)
  56       'stop)))
  57
  58 (defun company-elisp--predicate (symbol)
  59   (or (boundp symbol)
  60       (fboundp symbol)
  61       (facep symbol)
  62       (featurep symbol)))
  63
  64 (defun company-elisp--fns-regexp (&rest names)
  65   (concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
  66
  67 (defvar company-elisp-parse-limit 30)
  68 (defvar company-elisp-parse-depth 100)
  69
  70 (defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
  71
  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.")
  76
  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.")
  80
  81 (defvar company-elisp-fun-binding-regexp
  82   (company-elisp--fns-regexp "flet" "labels")
  83   "Regular expression matching head of a function bindings form.")
  84
  85 (defvar company-elisp-defuns-regexp
  86   (concat "([ \t\n]*"
  87           (apply #'company-elisp--fns-regexp company-elisp-defun-names)))
  88
  89 (defun company-elisp--should-complete ()
  90   (let ((start (point))
  91         (depth (car (syntax-ppss))))
  92     (not
  93      (when (> depth 0)
  94        (save-excursion
  95          (up-list (- depth))
  96          (when (looking-at company-elisp-defuns-regexp)
  97            (forward-char)
  98            (forward-sexp 1)
  99            (unless (= (point) start)
 100              (condition-case nil
 101                  (let ((args-end (scan-sexps (point) 2)))
 102                    (or (null args-end)
 103                        (> args-end start)))
 104                (scan-error
 105                 t)))))))))
 106
 107 (defun company-elisp--locals (prefix functions-p)
 108   (let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
 109                         "\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
 110         (pos (point))
 111         res)
 112     (condition-case nil
 113         (save-excursion
 114           (dotimes (_ company-elisp-parse-depth)
 115             (up-list -1)
 116             (save-excursion
 117               (when (eq (char-after) ?\()
 118                 (forward-char 1)
 119                 (when (ignore-errors
 120                         (save-excursion (forward-list)
 121                                         (<= (point) pos)))
 122                   (skip-chars-forward " \t\n")
 123                   (cond
 124                    ((looking-at (if functions-p
 125                                     company-elisp-fun-binding-regexp
 126                                   company-elisp-var-binding-regexp))
 127                     (down-list 1)
 128                     (condition-case nil
 129                         (dotimes (_ company-elisp-parse-limit)
 130                           (save-excursion
 131                             (when (looking-at "[ \t\n]*(")
 132                               (down-list 1))
 133                             (when (looking-at regexp)
 134                               (pushnew (match-string-no-properties 1) res)))
 135                           (forward-sexp))
 136                       (scan-error nil)))
 137                    ((unless functions-p
 138                       (looking-at company-elisp-var-binding-regexp-1))
 139                     (down-list 1)
 140                     (when (looking-at regexp)
 141                       (pushnew (match-string-no-properties 1) res)))))))))
 142       (scan-error nil))
 143     res))
 144
 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 (loop for local in locals
 150                        when (not (member local globals))
 151                        collect local)))
 152     (if company-elisp-show-locals-first
 153         (append (sort locals 'string<)
 154                 (sort globals 'string<))
 155       (append locals globals))))
 156
 157 (defun company-elisp--globals (prefix predicate)
 158   (all-completions prefix obarray predicate))
 159
 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 ?\()
 167                  (not
 168                   (save-excursion
 169                     (ignore-errors
 170                       (goto-char (1- beg))
 171                       (or (company-elisp--before-binding-varlist-p)
 172                           (progn
 173                             (up-list -1)
 174                             (company-elisp--before-binding-varlist-p)))))))
 175             'fboundp
 176           'boundp)
 177       'company-elisp--predicate)))
 178
 179 (defun company-elisp--before-binding-varlist-p ()
 180   (save-excursion
 181     (and (prog1 (search-backward "(")
 182            (forward-char 1))
 183          (looking-at company-elisp-var-binding-regexp))))
 184
 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))))
 190     (and (stringp doc)
 191          (string-match ".*$" doc)
 192          (match-string 0 doc))))
 193
 194 ;;;###autoload
 195 (defun company-elisp (command &optional arg &rest ignored)
 196   "`company-mode' completion back-end for Emacs Lisp."
 197   (interactive (list 'interactive))
 198   (case command
 199     (interactive (company-begin-backend 'company-elisp))
 200     (prefix (and (eq (derived-mode-p 'emacs-lisp-mode) '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
 207                     (ignore-errors
 208                       (cond
 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)))
 214                       (help-buffer)))))
 215     (location (let ((sym (intern arg)))
 216                 (cond
 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
 220                                                             (symbol-name sym)))
 221                                        0))
 222                  ((facep sym) (find-definition-noselect sym 'defface)))))))
 223
 224 (provide 'company-elisp)
 225 ;;; company-elisp.el ends here