Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

226 lines
8.4 KiB

преди 4 години
  1. ;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2009, 2011-2013, 2017 Free Software Foundation, Inc.
  3. ;; Author: Nikolaj Schumacher
  4. ;; This file is part of GNU Emacs.
  5. ;; GNU Emacs is free software: you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; GNU Emacs is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;;
  17. ;; In newer versions of Emacs, company-capf is used instead.
  18. ;;; Code:
  19. (require 'company)
  20. (require 'cl-lib)
  21. (require 'help-mode)
  22. (require 'find-func)
  23. (defgroup company-elisp nil
  24. "Completion backend for Emacs Lisp."
  25. :group 'company)
  26. (defcustom company-elisp-detect-function-context t
  27. "If enabled, offer Lisp functions only in appropriate contexts.
  28. Functions are offered for completion only after ' and \(."
  29. :type '(choice (const :tag "Off" nil)
  30. (const :tag "On" t)))
  31. (defcustom company-elisp-show-locals-first t
  32. "If enabled, locally bound variables and functions are displayed
  33. first in the candidates list."
  34. :type '(choice (const :tag "Off" nil)
  35. (const :tag "On" t)))
  36. (defun company-elisp--prefix ()
  37. (let ((prefix (company-grab-symbol)))
  38. (if prefix
  39. (when (if (company-in-string-or-comment)
  40. (= (char-before (- (point) (length prefix))) ?`)
  41. (company-elisp--should-complete))
  42. prefix)
  43. 'stop)))
  44. (defun company-elisp--predicate (symbol)
  45. (or (boundp symbol)
  46. (fboundp symbol)
  47. (facep symbol)
  48. (featurep symbol)))
  49. (defun company-elisp--fns-regexp (&rest names)
  50. (concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
  51. (defvar company-elisp-parse-limit 30)
  52. (defvar company-elisp-parse-depth 100)
  53. (defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
  54. (defvar company-elisp-var-binding-regexp
  55. (apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
  56. company-elisp-defun-names)
  57. "Regular expression matching head of a multiple variable bindings form.")
  58. (defvar company-elisp-var-binding-regexp-1
  59. (company-elisp--fns-regexp "dolist" "dotimes")
  60. "Regular expression matching head of a form with one variable binding.")
  61. (defvar company-elisp-fun-binding-regexp
  62. (company-elisp--fns-regexp "flet" "labels")
  63. "Regular expression matching head of a function bindings form.")
  64. (defvar company-elisp-defuns-regexp
  65. (concat "([ \t\n]*"
  66. (apply #'company-elisp--fns-regexp company-elisp-defun-names)))
  67. (defun company-elisp--should-complete ()
  68. (let ((start (point))
  69. (depth (car (syntax-ppss))))
  70. (not
  71. (when (> depth 0)
  72. (save-excursion
  73. (up-list (- depth))
  74. (when (looking-at company-elisp-defuns-regexp)
  75. (forward-char)
  76. (forward-sexp 1)
  77. (unless (= (point) start)
  78. (condition-case nil
  79. (let ((args-end (scan-sexps (point) 2)))
  80. (or (null args-end)
  81. (> args-end start)))
  82. (scan-error
  83. t)))))))))
  84. (defun company-elisp--locals (prefix functions-p)
  85. (let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
  86. "\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
  87. (pos (point))
  88. res)
  89. (condition-case nil
  90. (save-excursion
  91. (dotimes (_ company-elisp-parse-depth)
  92. (up-list -1)
  93. (save-excursion
  94. (when (eq (char-after) ?\()
  95. (forward-char 1)
  96. (when (ignore-errors
  97. (save-excursion (forward-list)
  98. (<= (point) pos)))
  99. (skip-chars-forward " \t\n")
  100. (cond
  101. ((looking-at (if functions-p
  102. company-elisp-fun-binding-regexp
  103. company-elisp-var-binding-regexp))
  104. (down-list 1)
  105. (condition-case nil
  106. (dotimes (_ company-elisp-parse-limit)
  107. (save-excursion
  108. (when (looking-at "[ \t\n]*(")
  109. (down-list 1))
  110. (when (looking-at regexp)
  111. (cl-pushnew (match-string-no-properties 1) res)))
  112. (forward-sexp))
  113. (scan-error nil)))
  114. ((unless functions-p
  115. (looking-at company-elisp-var-binding-regexp-1))
  116. (down-list 1)
  117. (when (looking-at regexp)
  118. (cl-pushnew (match-string-no-properties 1) res)))))))))
  119. (scan-error nil))
  120. res))
  121. (defun company-elisp-candidates (prefix)
  122. (let* ((predicate (company-elisp--candidates-predicate prefix))
  123. (locals (company-elisp--locals prefix (eq predicate 'fboundp)))
  124. (globals (company-elisp--globals prefix predicate))
  125. (locals (cl-loop for local in locals
  126. when (not (member local globals))
  127. collect local)))
  128. (if company-elisp-show-locals-first
  129. (append (sort locals 'string<)
  130. (sort globals 'string<))
  131. (append locals globals))))
  132. (defun company-elisp--globals (prefix predicate)
  133. (all-completions prefix obarray predicate))
  134. (defun company-elisp--candidates-predicate (prefix)
  135. (let* ((completion-ignore-case nil)
  136. (beg (- (point) (length prefix)))
  137. (before (char-before beg)))
  138. (if (and company-elisp-detect-function-context
  139. (not (memq before '(?' ?`))))
  140. (if (and (eq before ?\()
  141. (not
  142. (save-excursion
  143. (ignore-errors
  144. (goto-char (1- beg))
  145. (or (company-elisp--before-binding-varlist-p)
  146. (progn
  147. (up-list -1)
  148. (company-elisp--before-binding-varlist-p)))))))
  149. 'fboundp
  150. 'boundp)
  151. 'company-elisp--predicate)))
  152. (defun company-elisp--before-binding-varlist-p ()
  153. (save-excursion
  154. (and (prog1 (search-backward "(")
  155. (forward-char 1))
  156. (looking-at company-elisp-var-binding-regexp))))
  157. (defun company-elisp--doc (symbol)
  158. (let* ((symbol (intern symbol))
  159. (doc (if (fboundp symbol)
  160. (documentation symbol t)
  161. (documentation-property symbol 'variable-documentation t))))
  162. (and (stringp doc)
  163. (string-match ".*$" doc)
  164. (match-string 0 doc))))
  165. ;;;###autoload
  166. (defun company-elisp (command &optional arg &rest ignored)
  167. "`company-mode' completion backend for Emacs Lisp."
  168. (interactive (list 'interactive))
  169. (cl-case command
  170. (interactive (company-begin-backend 'company-elisp))
  171. (prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
  172. (company-elisp--prefix)))
  173. (candidates (company-elisp-candidates arg))
  174. (sorted company-elisp-show-locals-first)
  175. (meta (company-elisp--doc arg))
  176. (doc-buffer (let ((symbol (intern arg)))
  177. (save-window-excursion
  178. (ignore-errors
  179. (cond
  180. ((fboundp symbol) (describe-function symbol))
  181. ((boundp symbol) (describe-variable symbol))
  182. ((featurep symbol) (describe-package symbol))
  183. ((facep symbol) (describe-face symbol))
  184. (t (signal 'user-error nil)))
  185. (help-buffer)))))
  186. (location (let ((sym (intern arg)))
  187. (cond
  188. ((fboundp sym) (find-definition-noselect sym nil))
  189. ((boundp sym) (find-definition-noselect sym 'defvar))
  190. ((featurep sym) (cons (find-file-noselect (find-library-name
  191. (symbol-name sym)))
  192. 0))
  193. ((facep sym) (find-definition-noselect sym 'defface)))))))
  194. (provide 'company-elisp)
  195. ;;; company-elisp.el ends here