]> code.delx.au - gnu-emacs-elpa/blobdiff - company-elisp.el
Remove the As
[gnu-emacs-elpa] / company-elisp.el
index 52126bd43331d669143649bd419ac63ce00649d9..2046f6a4e6da82bdf4773a82b983dad7138cb912 100644 (file)
@@ -1,6 +1,6 @@
-;;; company-elisp.el --- A company-mode completion back-end for emacs-lisp-mode
+;;; company-elisp.el --- company-mode completion back-end for emacs-lisp-mode -*- lexical-binding: t -*-
 
-;; Copyright (C) 2009, 2011-2012  Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011-2013  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 
@@ -37,38 +37,72 @@ Functions are offered for completion only after ' and \(."
   :type '(choice (const :tag "Off" nil)
                  (const :tag "On" t)))
 
-(defun company-grab-lisp-symbol ()
+(defcustom company-elisp-show-locals-first t
+  "If enabled, locally bound variables and functions are displayed
+first in the candidates list."
+  :group 'company
+  :type '(choice (const :tag "Off" nil)
+                 (const :tag "On" t)))
+
+(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))
@@ -107,30 +141,46 @@ Functions are offered for completion only after ' and \(."
     res))
 
 (defun company-elisp-candidates (prefix)
-  (let ((predicate (company-elisp-candidates-predicate prefix)))
-    (append (company-elisp-locals prefix (eq predicate 'fboundp))
-            (company-elisp-globals prefix predicate))))
-
-(defun company-elisp-globals (prefix predicate)
+  (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)))
+    (if company-elisp-show-locals-first
+        (append (sort locals 'string<)
+                (sort globals 'string<))
+      (append locals globals))))
+
+(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)
@@ -141,14 +191,15 @@ Functions are offered for completion only after ' and \(."
 
 ;;;###autoload
 (defun company-elisp (command &optional arg &rest ignored)
-  "`company-mode' completion back-end for `emacs-lisp-mode'."
+  "`company-mode' completion back-end for `emacs-lisp-mode'."
   (interactive (list 'interactive))
   (case command
     (interactive (company-begin-backend 'company-elisp))
     (prefix (and (eq (derived-mode-p 'emacs-lisp-mode) 'emacs-lisp-mode)
-                 (company-grab-lisp-symbol)))
+                 (company-elisp--prefix)))
     (candidates (company-elisp-candidates arg))
-    (meta (company-elisp-doc arg))
+    (sorted company-elisp-show-locals-first)
+    (meta (company-elisp--doc arg))
     (doc-buffer (let ((symbol (intern arg)))
                   (save-window-excursion
                     (ignore-errors