Merge pull request #995 from cichli/completion-metadata

Add options for configuring completion annotations

6 files changed, 110 insertions, 20 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index bb032cdd..fc76148b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -21,6 +21,9 @@
 * Warn when used with incompatible nREPL server.
 * Allow the prompt to be tailored by adding `cider-repl-prompt-function` and `cider-repl-default-prompt`.
 * Support for middleware-annotated completion candidates.
+  - `cider-annotate-completion-function` controls how the annotations are formatted.
+  - `cider-completion-annotations-alist` controls the abbreviations used in annotations.
+  - `cider-completion-annotations-include-ns` controls when to include the candidate namespace in annotations.
 
 ### Changes
 
diff --git a/README.md b/README.md
index 5f5d8989..370eb0db 100644
--- a/README.md
+++ b/README.md
@@ -498,6 +498,22 @@ from `cider-complete-at-point`, and requires no additional setup or plugins.
 
 * Remove `cider-mode` and `cider-repl-mode` from the `ac-modes` list
 
+#### Completion annotations
+
+Completion candidates will be annotated by default with an abbreviation
+corresponding to their type, and (contextually) their ns. The function used to
+format the annotation can be configured by `cider-annotate-completion-function.`
+The abbreviations used are configured by `cider-completion-annotations-alist`
+and the context in which their namespace is included is configured by
+`cider-completion-annotations-include-ns.`
+
+Completion annotations can be disabled by setting
+`cider-annotate-completion-candidates` to nil.
+
+<p align="center">
+  <img src="screenshots/completion-annotations.png" width="400" />
+</p>
+
 ### Integration with other modes
 
 * Enabling `CamelCase` support for editing commands(like
diff --git a/cider-interaction.el b/cider-interaction.el
index 523c5e7d..6060c1ec 100644
--- a/cider-interaction.el
+++ b/cider-interaction.el
@@ -125,6 +125,50 @@ which will use the default REPL connection."
   :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")
+    ("function" "f")
+    ("import" "i")
+    ("macro" "m")
+    ("namespace" "n")
+    ("protocol" "p")
+    ("protocol-function" "pf")
+    ("record" "r")
+    ("special-form" "s")
+    ("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*")
 
 (defcustom cider-interactive-eval-output-destination 'repl-buffer
@@ -799,37 +843,49 @@ form, with symbol at point replaced by __prefix__."
 
 (defun cider-completion--parse-candidate-map (candidate-map)
   (let ((candidate (nrepl-dict-get candidate-map "candidate"))
-        (type (nrepl-dict-get candidate-map "type")))
+        (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)))
-    (map 'list #'cider-completion--parse-candidate-map candidates)))
+    (mapcar #'cider-completion--parse-candidate-map candidates)))
+
+(defun cider-completion--get-candidate-type (symbol)
+  (let ((type (get-text-property 0 'type symbol)))
+    (or (cl-second (assoc type cider-completion-annotations-alist))
+        type)))
+
+(defun cider-completion--get-candidate-ns (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)
+  (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, use an
-abbreviation; if `type` is present but not recognised, its value is used
-unaltered. Otherwise, return nil."
-  (-when-let* ((_  cider-annotate-completion-candidates)
-               (type (pcase (get-text-property 0 'type symbol)
-                       (`"class" "c")
-                       (`"function" "f")
-                       (`"import" "i")
-                       (`"macro" "m")
-                       (`"namespace" "n")
-                       (`"protocol" "p")
-                       (`"protocol-function" "pf")
-                       (`"record" "r")
-                       (`"special-form" "s")
-                       (`"type" "t")
-                       (`"var" "v")
-                       (type type))))
-    (format " <%s>" type)))
+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."
diff --git a/cider-util.el b/cider-util.el
index a032f314..7fca3ba4 100644
--- a/cider-util.el
+++ b/cider-util.el
@@ -167,6 +167,10 @@ objects."
               (cons el el)))
           candidates))
 
+(defun cider-namespace-qualified-p (sym)
+  "Return t if SYM is namespace-qualified."
+  (string-match-p "[^/]+/" sym))
+
 (provide 'cider-util)
 
 ;;; cider-util.el ends here
diff --git a/screenshots/completion-annotations.png b/screenshots/completion-annotations.png
new file mode 100644
index 00000000..f823db42
--- /dev/null
+++ b/screenshots/completion-annotations.png
diff --git a/test/cider-tests.el b/test/cider-tests.el
index 88c6ec9a..70ab4685 100644
--- a/test/cider-tests.el
+++ b/test/cider-tests.el
@@ -547,3 +547,14 @@
              (should (equal (funcall cider-to-nrepl-filename-function unix-file-name) windows-file-name)))
       (and (should (eq (funcall cider-from-nrepl-filename-function unix-file-name) unix-file-name))
            (should (eq (funcall cider-to-nrepl-filename-function unix-file-name) unix-file-name))))))
+
+
+;;; Util tests
+
+(ert-deftest cider-namespace-qualified-p-test ()
+  (should (cider-namespace-qualified-p "a/a"))
+  (should (cider-namespace-qualified-p "a.a/a"))
+  (should (cider-namespace-qualified-p "a-a/a"))
+  (should (cider-namespace-qualified-p "a.a-a/a-a"))
+  (should (not (cider-namespace-qualified-p "/")))
+  (should (not (cider-namespace-qualified-p "/a"))))