X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/36108c9f82d401113c2b87c18576e9835bd44e1c..4a6eea94edb138a3ea73e7a50553b69dedc5c3ad:/company-elisp.el diff --git a/company-elisp.el b/company-elisp.el index eec64f44e..3db0d8b83 100644 --- a/company-elisp.el +++ b/company-elisp.el @@ -1,6 +1,6 @@ -;;; 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 @@ -26,60 +26,92 @@ ;;; 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) ?\() @@ -94,54 +126,63 @@ first in the candidates list.") 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) @@ -152,15 +193,15 @@ first in the candidates list.") ;;;###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