djavu-asus/emacs/elpa/company-20230926.32/company-elisp.el

   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