company-elisp.el (8583B)
1 ;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2009-2015, 2017, 2020 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 <https://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