[#2203] Extract the code completion functionality in its own source file

4 files changed, 254 insertions, 214 deletions

diff --git a/cider-completion.el b/cider-completion.el
new file mode 100644
index 00000000..a582907c
--- /dev/null
+++ b/cider-completion.el
@@ -0,0 +1,251 @@
+;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*-
+
+;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors
+;;
+;; Author: Bozhidar Batsov <bozhidar@batsov.com>
+;;         Artur Malabarba <bruce.connor.am@gmail.com>
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;; This file is not part of GNU Emacs.
+
+;;; Commentary:
+
+;; Smart REPL-powered code completion and integration with company-mode.
+
+;;; Code:
+
+(require 'subr-x)
+
+(require 'cider-client)
+(require 'cider-common)
+(require 'nrepl-dict)
+
+(defcustom cider-completion-use-context t
+  "When true, uses context at point to improve completion suggestions."
+  :type 'boolean
+  :group 'cider
+  :package-version '(cider . "0.7.0"))
+
+(defcustom cider-annotate-completion-candidates t
+  "When true, annotate completion candidates with some extra information."
+  :type 'boolean
+  :group 'cider
+  :package-version '(cider . "0.8.0"))
+
+(defcustom cider-annotate-completion-function
+  #'cider-default-annotate-completion-function
+  "Controls how the annotations for completion candidates are formatted.
+Must be a function that takes two arguments: the abbreviation of the
+candidate type according to `cider-completion-annotations-alist' and the
+candidate's namespace."
+  :type 'function
+  :group 'cider
+  :package-version '(cider . "0.9.0"))
+
+(defcustom cider-completion-annotations-alist
+  '(("class" "c")
+    ("field" "fi")
+    ("function" "f")
+    ("import" "i")
+    ("keyword" "k")
+    ("local" "l")
+    ("macro" "m")
+    ("method" "me")
+    ("namespace" "n")
+    ("protocol" "p")
+    ("protocol-function" "pf")
+    ("record" "r")
+    ("special-form" "s")
+    ("static-field" "sf")
+    ("static-method" "sm")
+    ("type" "t")
+    ("var" "v"))
+  "Controls the abbreviations used when annotating completion candidates.
+
+Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE
+is a possible value of the candidate's type returned from the completion
+backend, and ABBREVIATION is a short form of that type."
+  :type '(alist :key-type string :value-type string)
+  :group 'cider
+  :package-version '(cider . "0.9.0"))
+
+(defcustom cider-completion-annotations-include-ns 'unqualified
+  "Controls passing of namespaces to `cider-annotate-completion-function'.
+
+When set to 'always, the candidate's namespace will always be passed if it
+is available.  When set to 'unqualified, the namespace will only be passed
+if the candidate is not namespace-qualified."
+  :type '(choice (const always)
+                 (const unqualified)
+                 (const :tag "never" nil))
+  :group 'cider
+  :package-version '(cider . "0.9.0"))
+
+(defvar cider-completion-last-context nil)
+
+(defun cider-completion-symbol-start-pos ()
+  "Find the starting position of the symbol at point, unless inside a string."
+  (let ((sap (symbol-at-point)))
+    (when (and sap (not (nth 3 (syntax-ppss))))
+      (car (bounds-of-thing-at-point 'symbol)))))
+
+(defun cider-completion-get-context-at-point ()
+  "Extract the context at point.
+If point is not inside the list, returns nil; otherwise return \"top-level\"
+form, with symbol at point replaced by __prefix__."
+  (when (save-excursion
+          (condition-case _
+              (progn
+                (up-list)
+                (check-parens)
+                t)
+            (scan-error nil)
+            (user-error nil)))
+    (save-excursion
+      (let* ((pref-end (point))
+             (pref-start (cider-completion-symbol-start-pos))
+             (context (cider-defun-at-point))
+             (_ (beginning-of-defun))
+             (expr-start (point)))
+        (concat (when pref-start (substring context 0 (- pref-start expr-start)))
+                "__prefix__"
+                (substring context (- pref-end expr-start)))))))
+
+(defun cider-completion-get-context ()
+  "Extract context depending on `cider-completion-use-context' and major mode."
+  (let ((context (if (and cider-completion-use-context
+                          ;; Important because `beginning-of-defun' and
+                          ;; `ending-of-defun' work incorrectly in the REPL
+                          ;; buffer, so context extraction fails there.
+                          (derived-mode-p 'clojure-mode))
+                     (or (cider-completion-get-context-at-point)
+                         "nil")
+                   "nil")))
+    (if (string= cider-completion-last-context context)
+        ":same"
+      (setq cider-completion-last-context context)
+      context)))
+
+(defun cider-completion--parse-candidate-map (candidate-map)
+  "Get \"candidate\" from CANDIDATE-MAP.
+Put type and ns properties on the candidate"
+  (let ((candidate (nrepl-dict-get candidate-map "candidate"))
+        (type (nrepl-dict-get candidate-map "type"))
+        (ns (nrepl-dict-get candidate-map "ns")))
+    (put-text-property 0 1 'type type candidate)
+    (put-text-property 0 1 'ns ns candidate)
+    candidate))
+
+(defun cider-complete (str)
+  "Complete STR with context at point."
+  (let* ((context (cider-completion-get-context))
+         (candidates (cider-sync-request:complete str context)))
+    (mapcar #'cider-completion--parse-candidate-map candidates)))
+
+(defun cider-completion--get-candidate-type (symbol)
+  "Get candidate type for SYMBOL."
+  (let ((type (get-text-property 0 'type symbol)))
+    (or (cadr (assoc type cider-completion-annotations-alist))
+        type)))
+
+(defun cider-completion--get-candidate-ns (symbol)
+  "Get candidate ns for SYMBOL."
+  (when (or (eq 'always cider-completion-annotations-include-ns)
+            (and (eq 'unqualified cider-completion-annotations-include-ns)
+                 (not (cider-namespace-qualified-p symbol))))
+    (get-text-property 0 'ns symbol)))
+
+(defun cider-default-annotate-completion-function (type ns)
+  "Get completion function based on TYPE and NS."
+  (concat (when ns (format " (%s)" ns))
+          (when type (format " <%s>" type))))
+
+(defun cider-annotate-symbol (symbol)
+  "Return a string suitable for annotating SYMBOL.
+If SYMBOL has a text property `type` whose value is recognised, its
+abbreviation according to `cider-completion-annotations-alist' will be
+used.  If `type` is present but not recognised, its value will be used
+unaltered.  If SYMBOL has a text property `ns`, then its value will be used
+according to `cider-completion-annotations-include-ns'.  The formatting is
+performed by `cider-annotate-completion-function'."
+  (when cider-annotate-completion-candidates
+    (let* ((type (cider-completion--get-candidate-type symbol))
+           (ns (cider-completion--get-candidate-ns symbol)))
+      (funcall cider-annotate-completion-function type ns))))
+
+(defun cider-complete-at-point ()
+  "Complete the symbol at point."
+  (when-let* ((bounds (bounds-of-thing-at-point 'symbol)))
+    (when (and (cider-connected-p)
+               (not (or (cider-in-string-p) (cider-in-comment-p))))
+      (list (car bounds) (cdr bounds)
+            (completion-table-dynamic #'cider-complete)
+            :annotation-function #'cider-annotate-symbol
+            :company-doc-buffer #'cider-create-doc-buffer
+            :company-location #'cider-company-location
+            :company-docsig #'cider-company-docsig))))
+
+(defun cider-completion-flush-caches ()
+  "Force Compliment to refill its caches.
+This command should be used if Compliment fails to pick up new classnames
+and methods from dependencies that were loaded dynamically after the REPL
+has started."
+  (interactive)
+  (cider-sync-request:complete-flush-caches))
+
+(defun cider-company-location (var)
+  "Open VAR's definition in a buffer.
+Returns the cons of the buffer itself and the location of VAR's definition
+in the buffer."
+  (when-let* ((info (cider-var-info var))
+              (file (nrepl-dict-get info "file"))
+              (line (nrepl-dict-get info "line"))
+              (buffer (cider-find-file file)))
+    (with-current-buffer buffer
+      (save-excursion
+        (goto-char (point-min))
+        (forward-line (1- line))
+        (cons buffer (point))))))
+
+(defun cider-company-docsig (thing)
+  "Return signature for THING."
+  (let* ((eldoc-info (cider-eldoc-info thing))
+         (ns (lax-plist-get eldoc-info "ns"))
+         (symbol (lax-plist-get eldoc-info "symbol"))
+         (arglists (lax-plist-get eldoc-info "arglists")))
+    (when eldoc-info
+      (format "%s: %s"
+              (cider-eldoc-format-thing ns symbol thing
+                                        (cider-eldoc-thing-type eldoc-info))
+              (cider-eldoc-format-arglist arglists 0)))))
+
+;; Fuzzy completion for company-mode
+
+(defun cider-company-unfiltered-candidates (string &rest _)
+  "Return CIDER completion candidates for STRING as is, unfiltered."
+  (cider-complete string))
+
+(add-to-list 'completion-styles-alist
+             '(cider
+               cider-company-unfiltered-candidates
+               cider-company-unfiltered-candidates
+               "CIDER backend-driven completion style."))
+
+(defun cider-company-enable-fuzzy-completion ()
+  "Enable backend-driven fuzzy completion in the current buffer."
+  (setq-local completion-styles '(cider)))
+
+(provide 'cider-completion)
+;;; cider-completion.el ends here
diff --git a/cider-interaction.el b/cider-interaction.el
index dbbbd228..659448a4 100644
--- a/cider-interaction.el
+++ b/cider-interaction.el
@@ -40,6 +40,7 @@
 (require 'cider-test)
 (require 'cider-doc)
 (require 'cider-eldoc)
+(require 'cider-completion)
 (require 'cider-overlays)
 (require 'subr-x)
 (require 'cider-compat)
@@ -110,66 +111,6 @@ If t, save the file without confirmation."
   :group 'cider
   :package-version '(cider . "0.6.0"))
 
-(defcustom cider-completion-use-context t
-  "When true, uses context at point to improve completion suggestions."
-  :type 'boolean
-  :group 'cider
-  :package-version '(cider . "0.7.0"))
-
-(defcustom cider-annotate-completion-candidates t
-  "When true, annotate completion candidates with some extra information."
-  :type 'boolean
-  :group 'cider
-  :package-version '(cider . "0.8.0"))
-
-(defcustom cider-annotate-completion-function
-  #'cider-default-annotate-completion-function
-  "Controls how the annotations for completion candidates are formatted.
-Must be a function that takes two arguments: the abbreviation of the
-candidate type according to `cider-completion-annotations-alist' and the
-candidate's namespace."
-  :type 'function
-  :group 'cider
-  :package-version '(cider . "0.9.0"))
-
-(defcustom cider-completion-annotations-alist
-  '(("class" "c")
-    ("field" "fi")
-    ("function" "f")
-    ("import" "i")
-    ("keyword" "k")
-    ("local" "l")
-    ("macro" "m")
-    ("method" "me")
-    ("namespace" "n")
-    ("protocol" "p")
-    ("protocol-function" "pf")
-    ("record" "r")
-    ("special-form" "s")
-    ("static-field" "sf")
-    ("static-method" "sm")
-    ("type" "t")
-    ("var" "v"))
-  "Controls the abbreviations used when annotating completion candidates.
-
-Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE
-is a possible value of the candidate's type returned from the completion
-backend, and ABBREVIATION is a short form of that type."
-  :type '(alist :key-type string :value-type string)
-  :group 'cider
-  :package-version '(cider . "0.9.0"))
-
-(defcustom cider-completion-annotations-include-ns 'unqualified
-  "Controls passing of namespaces to `cider-annotate-completion-function'.
-
-When set to 'always, the candidate's namespace will always be passed if it
-is available.  When set to 'unqualified, the namespace will only be passed
-if the candidate is not namespace-qualified."
-  :type '(choice (const always)
-                 (const unqualified)
-                 (const :tag "never" nil))
-  :group 'cider
-  :package-version '(cider . "0.9.0"))
 
 (defconst cider-output-buffer "*cider-out*")
 
@@ -476,159 +417,6 @@ thing at point."
     (cider--find-ns kw-ns arg)
     (search-forward-regexp kw-to-find nil 'noerror)))
 
-(defvar cider-completion-last-context nil)
-
-(defun cider-completion-symbol-start-pos ()
-  "Find the starting position of the symbol at point, unless inside a string."
-  (let ((sap (symbol-at-point)))
-    (when (and sap (not (nth 3 (syntax-ppss))))
-      (car (bounds-of-thing-at-point 'symbol)))))
-
-(defun cider-completion-get-context-at-point ()
-  "Extract the context at point.
-If point is not inside the list, returns nil; otherwise return \"top-level\"
-form, with symbol at point replaced by __prefix__."
-  (when (save-excursion
-          (condition-case _
-              (progn
-                (up-list)
-                (check-parens)
-                t)
-            (scan-error nil)
-            (user-error nil)))
-    (save-excursion
-      (let* ((pref-end (point))
-             (pref-start (cider-completion-symbol-start-pos))
-             (context (cider-defun-at-point))
-             (_ (beginning-of-defun))
-             (expr-start (point)))
-        (concat (when pref-start (substring context 0 (- pref-start expr-start)))
-                "__prefix__"
-                (substring context (- pref-end expr-start)))))))
-
-(defun cider-completion-get-context ()
-  "Extract context depending on `cider-completion-use-context' and major mode."
-  (let ((context (if (and cider-completion-use-context
-                          ;; Important because `beginning-of-defun' and
-                          ;; `ending-of-defun' work incorrectly in the REPL
-                          ;; buffer, so context extraction fails there.
-                          (derived-mode-p 'clojure-mode))
-                     (or (cider-completion-get-context-at-point)
-                         "nil")
-                   "nil")))
-    (if (string= cider-completion-last-context context)
-        ":same"
-      (setq cider-completion-last-context context)
-      context)))
-
-(defun cider-completion--parse-candidate-map (candidate-map)
-  "Get \"candidate\" from CANDIDATE-MAP.
-Put type and ns properties on the candidate"
-  (let ((candidate (nrepl-dict-get candidate-map "candidate"))
-        (type (nrepl-dict-get candidate-map "type"))
-        (ns (nrepl-dict-get candidate-map "ns")))
-    (put-text-property 0 1 'type type candidate)
-    (put-text-property 0 1 'ns ns candidate)
-    candidate))
-
-(defun cider-complete (str)
-  "Complete STR with context at point."
-  (let* ((context (cider-completion-get-context))
-         (candidates (cider-sync-request:complete str context)))
-    (mapcar #'cider-completion--parse-candidate-map candidates)))
-
-(defun cider-completion--get-candidate-type (symbol)
-  "Get candidate type for SYMBOL."
-  (let ((type (get-text-property 0 'type symbol)))
-    (or (cadr (assoc type cider-completion-annotations-alist))
-        type)))
-
-(defun cider-completion--get-candidate-ns (symbol)
-  "Get candidate ns for SYMBOL."
-  (when (or (eq 'always cider-completion-annotations-include-ns)
-            (and (eq 'unqualified cider-completion-annotations-include-ns)
-                 (not (cider-namespace-qualified-p symbol))))
-    (get-text-property 0 'ns symbol)))
-
-(defun cider-default-annotate-completion-function (type ns)
-  "Get completion function based on TYPE and NS."
-  (concat (when ns (format " (%s)" ns))
-          (when type (format " <%s>" type))))
-
-(defun cider-annotate-symbol (symbol)
-  "Return a string suitable for annotating SYMBOL.
-If SYMBOL has a text property `type` whose value is recognised, its
-abbreviation according to `cider-completion-annotations-alist' will be
-used.  If `type` is present but not recognised, its value will be used
-unaltered.  If SYMBOL has a text property `ns`, then its value will be used
-according to `cider-completion-annotations-include-ns'.  The formatting is
-performed by `cider-annotate-completion-function'."
-  (when cider-annotate-completion-candidates
-    (let* ((type (cider-completion--get-candidate-type symbol))
-           (ns (cider-completion--get-candidate-ns symbol)))
-      (funcall cider-annotate-completion-function type ns))))
-
-(defun cider-complete-at-point ()
-  "Complete the symbol at point."
-  (when-let* ((bounds (bounds-of-thing-at-point 'symbol)))
-    (when (and (cider-connected-p)
-               (not (or (cider-in-string-p) (cider-in-comment-p))))
-      (list (car bounds) (cdr bounds)
-            (completion-table-dynamic #'cider-complete)
-            :annotation-function #'cider-annotate-symbol
-            :company-doc-buffer #'cider-create-doc-buffer
-            :company-location #'cider-company-location
-            :company-docsig #'cider-company-docsig))))
-
-(defun cider-completion-flush-caches ()
-  "Force Compliment to refill its caches.
-This command should be used if Compliment fails to pick up new classnames
-and methods from dependencies that were loaded dynamically after the REPL
-has started."
-  (interactive)
-  (cider-sync-request:complete-flush-caches))
-
-(defun cider-company-location (var)
-  "Open VAR's definition in a buffer.
-Returns the cons of the buffer itself and the location of VAR's definition
-in the buffer."
-  (when-let* ((info (cider-var-info var))
-              (file (nrepl-dict-get info "file"))
-              (line (nrepl-dict-get info "line"))
-              (buffer (cider-find-file file)))
-    (with-current-buffer buffer
-      (save-excursion
-        (goto-char (point-min))
-        (forward-line (1- line))
-        (cons buffer (point))))))
-
-(defun cider-company-docsig (thing)
-  "Return signature for THING."
-  (let* ((eldoc-info (cider-eldoc-info thing))
-         (ns (lax-plist-get eldoc-info "ns"))
-         (symbol (lax-plist-get eldoc-info "symbol"))
-         (arglists (lax-plist-get eldoc-info "arglists")))
-    (when eldoc-info
-      (format "%s: %s"
-              (cider-eldoc-format-thing ns symbol thing
-                                        (cider-eldoc-thing-type eldoc-info))
-              (cider-eldoc-format-arglist arglists 0)))))
-
-;; Fuzzy completion for company-mode
-
-(defun cider-company-unfiltered-candidates (string &rest _)
-  "Return CIDER completion candidates for STRING as is, unfiltered."
-  (cider-complete string))
-
-(add-to-list 'completion-styles-alist
-             '(cider
-               cider-company-unfiltered-candidates
-               cider-company-unfiltered-candidates
-               "CIDER backend-driven completion style."))
-
-(defun cider-company-enable-fuzzy-completion ()
-  "Enable backend-driven fuzzy completion in the current buffer."
-  (setq-local completion-styles '(cider)))
 
 (defun cider-stdin-handler (&optional buffer)
   "Make a stdin response handler for BUFFER."
diff --git a/cider-mode.el b/cider-mode.el
index e29dec06..31c10c6d 100644
--- a/cider-mode.el
+++ b/cider-mode.el
@@ -38,6 +38,7 @@
 (require 'cider-eldoc)
 (require 'cider-resolve)
 (require 'cider-doc)
+(require 'cider-completion)
 (require 'subr-x)
 (require 'cider-compat)
 
diff --git a/cider-repl.el b/cider-repl.el
index c6b2bc50..be9a7088 100644
--- a/cider-repl.el
+++ b/cider-repl.el
@@ -1701,7 +1701,7 @@ constructs."
         (let ((font-lock-dont-widen t))
           (apply func (max beg cider-repl-input-start-mark) end rest))))))
 
-(declare-function cider-complete-at-point "cider-interaction")
+(declare-function cider-complete-at-point "cider-completion")
 (defvar cider--static-font-lock-keywords)
 
 (define-derived-mode cider-repl-mode fundamental-mode "REPL"