-;;; company-elisp.el --- A company-mode completion back-end for emacs-lisp-mode -*- lexical-binding: t -*-
+;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 2009, 2011-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;;; Code:
(require 'company)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'help-mode)
(require 'find-func)
+(defgroup company-elisp nil
+ "Completion backend for Emacs Lisp."
+ :group 'company)
+
(defcustom company-elisp-detect-function-context t
"If enabled, offer Lisp functions only in appropriate contexts.
Functions are offered for completion only after ' and \(."
- :group 'company
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defcustom company-elisp-show-locals-first t
"If enabled, locally bound variables and functions are displayed
-first in the candidates list.")
+first in the candidates list."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t)))
-(defun company-grab-lisp-symbol ()
+(defun company-elisp--prefix ()
(let ((prefix (company-grab-symbol)))
(if prefix
- (unless (and (company-in-string-or-comment)
- (/= (char-before (- (point) (length prefix))) ?`))
+ (when (if (company-in-string-or-comment)
+ (= (char-before (- (point) (length prefix))) ?`)
+ (company-elisp--should-complete))
prefix)
'stop)))
-(defun company-elisp-predicate (symbol)
+(defun company-elisp--predicate (symbol)
(or (boundp symbol)
(fboundp symbol)
(facep symbol)
(featurep symbol)))
+(defun company-elisp--fns-regexp (&rest names)
+ (concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
+
(defvar company-elisp-parse-limit 30)
(defvar company-elisp-parse-depth 100)
+(defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
+
(defvar company-elisp-var-binding-regexp
- (concat "\\_<" (regexp-opt '("let" "defun" "defmacro" "defsubst"
- "lambda" "lexical-let"))
- "\\*?\\_>")
+ (apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
+ company-elisp-defun-names)
"Regular expression matching head of a multiple variable bindings form.")
(defvar company-elisp-var-binding-regexp-1
- (concat "\\_<\\(?:cl-\\)?" (regexp-opt '("dolist" "dotimes")) "\\_>")
+ (company-elisp--fns-regexp "dolist" "dotimes")
"Regular expression matching head of a form with one variable binding.")
(defvar company-elisp-fun-binding-regexp
- (concat "\\_<\\(?:cl-\\)?" (regexp-opt '("flet" "labels")) "\\_>")
+ (company-elisp--fns-regexp "flet" "labels")
"Regular expression matching head of a function bindings form.")
-(defun company-elisp-locals (prefix functions-p)
+(defvar company-elisp-defuns-regexp
+ (concat "([ \t\n]*"
+ (apply #'company-elisp--fns-regexp company-elisp-defun-names)))
+
+(defun company-elisp--should-complete ()
+ (let ((start (point))
+ (depth (car (syntax-ppss))))
+ (not
+ (when (> depth 0)
+ (save-excursion
+ (up-list (- depth))
+ (when (looking-at company-elisp-defuns-regexp)
+ (forward-char)
+ (forward-sexp 1)
+ (unless (= (point) start)
+ (condition-case nil
+ (let ((args-end (scan-sexps (point) 2)))
+ (or (null args-end)
+ (> args-end start)))
+ (scan-error
+ t)))))))))
+
+(defun company-elisp--locals (prefix functions-p)
(let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
"\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
(pos (point))
res)
(condition-case nil
(save-excursion
- (dotimes (i company-elisp-parse-depth)
+ (dotimes (_ company-elisp-parse-depth)
(up-list -1)
(save-excursion
(when (eq (char-after) ?\()
company-elisp-var-binding-regexp))
(down-list 1)
(condition-case nil
- (dotimes (i company-elisp-parse-limit)
+ (dotimes (_ company-elisp-parse-limit)
(save-excursion
(when (looking-at "[ \t\n]*(")
(down-list 1))
(when (looking-at regexp)
- (pushnew (match-string-no-properties 1) res)))
+ (cl-pushnew (match-string-no-properties 1) res)))
(forward-sexp))
(scan-error nil)))
((unless functions-p
(looking-at company-elisp-var-binding-regexp-1))
(down-list 1)
(when (looking-at regexp)
- (pushnew (match-string-no-properties 1) res)))))))))
+ (cl-pushnew (match-string-no-properties 1) res)))))))))
(scan-error nil))
res))
(defun company-elisp-candidates (prefix)
- (let* ((predicate (company-elisp-candidates-predicate prefix))
- (locals (company-elisp-locals prefix (eq predicate 'fboundp)))
- (globals (company-elisp-globals prefix predicate))
- (locals (loop for local in locals
- when (not (member local globals))
- collect local)))
+ (let* ((predicate (company-elisp--candidates-predicate prefix))
+ (locals (company-elisp--locals prefix (eq predicate 'fboundp)))
+ (globals (company-elisp--globals prefix predicate))
+ (locals (cl-loop for local in locals
+ when (not (member local globals))
+ collect local)))
(if company-elisp-show-locals-first
(append (sort locals 'string<)
(sort globals 'string<))
(append locals globals))))
-(defun company-elisp-globals (prefix predicate)
+(defun company-elisp--globals (prefix predicate)
(all-completions prefix obarray predicate))
-(defun company-elisp-candidates-predicate (prefix)
+(defun company-elisp--candidates-predicate (prefix)
(let* ((completion-ignore-case nil)
- (before (char-before (- (point) (length prefix)))))
+ (beg (- (point) (length prefix)))
+ (before (char-before beg)))
(if (and company-elisp-detect-function-context
- (not (eq before ?')))
+ (not (memq before '(?' ?`))))
(if (and (eq before ?\()
(not
(save-excursion
(ignore-errors
- (up-list -2)
- (forward-char 1)
- (looking-at " *(")))))
+ (goto-char (1- beg))
+ (or (company-elisp--before-binding-varlist-p)
+ (progn
+ (up-list -1)
+ (company-elisp--before-binding-varlist-p)))))))
'fboundp
'boundp)
- 'company-elisp-predicate)))
+ 'company-elisp--predicate)))
+
+(defun company-elisp--before-binding-varlist-p ()
+ (save-excursion
+ (and (prog1 (search-backward "(")
+ (forward-char 1))
+ (looking-at company-elisp-var-binding-regexp))))
-(defun company-elisp-doc (symbol)
+(defun company-elisp--doc (symbol)
(let* ((symbol (intern symbol))
(doc (if (fboundp symbol)
(documentation symbol t)
;;;###autoload
(defun company-elisp (command &optional arg &rest ignored)
- "A `company-mode' completion back-end for `emacs-lisp-mode'."
+ "`company-mode' completion backend for Emacs Lisp."
(interactive (list 'interactive))
- (case command
+ (cl-case command
(interactive (company-begin-backend 'company-elisp))
- (prefix (and (eq (derived-mode-p 'emacs-lisp-mode) 'emacs-lisp-mode)
- (company-grab-lisp-symbol)))
+ (prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
+ (company-elisp--prefix)))
(candidates (company-elisp-candidates arg))
(sorted company-elisp-show-locals-first)
- (meta (company-elisp-doc arg))
+ (meta (company-elisp--doc arg))
(doc-buffer (let ((symbol (intern arg)))
(save-window-excursion
(ignore-errors