Grab the completion prefix correctly

cider-completion.el

@@ -179,39 +179,24 @@ performed by `cider-annotate-completion-function'."
            (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))))
-      (let* (last-prefix
-             last-result
-             (complete
-              (lambda (prefix)
-                (unless (string-equal last-prefix prefix)
-                  (setq last-prefix prefix)
-                  (setq last-result (cider-complete prefix)))
-                last-result)))
-        (list (car bounds) (cdr bounds)
-              (lambda (prefix pred action)
-                ;; When the 'action is 'metadata, this lambda returns metadata about this
-                ;; capf, when action is (boundaries . suffix), it returns nil. With every
-                ;; other value of 'action (t, nil, or lambda), 'action is forwarded to
-                ;; (complete-with-action), together with (cider-complete), prefix and pred.
-                ;; And that function performs the completion based on those arguments.
-                ;;
-                ;; This api is better described in the section
-                ;; '21.6.7 Programmed Completion' of the elisp manual.
-                (cond ((eq action 'metadata) `(metadata (category . cider))) ;; defines a completion category named 'cider, used later in our `completion-category-overrides` logic.
-                      ((eq (car-safe action) 'boundaries) nil)
-                      (t (with-current-buffer (current-buffer)
-                           (complete-with-action action
-                                                 (funcall complete prefix) prefix pred)))))
-              :annotation-function #'cider-annotate-symbol
-              :company-kind #'cider-company-symbol-kind
-              :company-doc-buffer #'cider-create-compact-doc-buffer
-              :company-location #'cider-company-location
-              :company-docsig #'cider-company-docsig)))))
+(defvar cider--completion-cache nil
+  "Cache used by `cider--complete-with-cache'.
+this is a cons cell of (BOUNDS . COMPLETIONS).")
+
+(defun cider--complete-with-cache (bounds)
+  "Return completions to the symbol at `BOUNDS' with caching.
+If the completion of `bounds' is cached, return the cached completions,
+otherwise, call `cider-complete', set the cache, and return the completions."
+  (let* ((prefix (or (buffer-substring-no-properties (car bounds) (cdr bounds)) ""))
+         (completions nil))
+    (when (and (consp cider--completion-cache)
+               (equal prefix (car cider--completion-cache)))
+      (setq completions (cdr cider--completion-cache)))
+    (when (null completions)
+      (let ((resp (cider-complete prefix)))
+        (setq cider--completion-cache `(,prefix . ,resp)
+              completions resp)))
+    completions))
 
 (defun cider-completion-flush-caches ()
   "Force Compliment to refill its caches.
@@ -221,6 +206,43 @@ has started."
   (interactive)
   (cider-sync-request:complete-flush-caches))
 
+(defun cider--clear-completion-cache (_ _)
+  "Clears the completion cache."
+  (cider-completion-flush-caches)
+  (setq cider--completion-cache nil))
+
+(defun cider-complete-at-point ()
+  "Complete the symbol at point."
+  (when-let* ((bounds (or (bounds-of-thing-at-point 'symbol)
+                          (cons (point) (point))))
+              (bounds-string (buffer-substring (car bounds) (cdr bounds))))
+    (when (and (cider-connected-p)
+               (not (or (cider-in-string-p) (cider-in-comment-p))))
+      (list (car bounds) (cdr bounds)
+            (lambda (pattern pred action)
+              ;; When the 'action is 'metadata, this lambda returns metadata about this
+              ;; capf, when action is (boundaries . suffix), it returns nil. With every
+              ;; other value of 'action (t, nil, or lambda), 'action is forwarded to
+              ;; (complete-with-action), together with (cider-complete), prefix and pred.
+              ;; And that function performs the completion based on those arguments.
+              ;;
+              ;; This api is better described in the section
+              ;; '21.6.7 Programmed Completion' of the elisp manual.
+              (cond ((eq action 'metadata) `(metadata (category . cider))) ;; defines a completion category named 'cider, used later in our `completion-category-overrides` logic.
+                    ((eq (car-safe action) 'boundaries) nil) ; boundaries
+                    ((eq action 'lambda) ; test-completion
+                     (test-completion pattern (cider--complete-with-cache bounds)))
+                    ((null action)  ; try-completion
+                     (try-completion pattern (cider--complete-with-cache bounds)))
+                    ((eq action t)  ; all-completions
+                     (all-completions "" (cider--complete-with-cache bounds)))))
+            :annotation-function #'cider-annotate-symbol
+            :company-kind #'cider-company-symbol-kind
+            :company-doc-buffer #'cider-create-compact-doc-buffer
+            :company-location #'cider-company-location
+            :company-docsig #'cider-company-docsig
+            :exit-function #'cider--clear-completion-cache))))
+
 (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
@@ -264,12 +286,6 @@ in the buffer."
                cider-company-unfiltered-candidates
                "CIDER backend-driven completion style."))
 
-;; Currently CIDER completions only work for `basic`, and not `initials`, `partial-completion`, `orderless`, etc.
-;; So we ensure that those other styles aren't used with CIDER, otherwise one would see bad or no completions at all.
-;; This `add-to-list` call can be removed once we implement the other completion styles.
-;; (When doing that, please refactor `cider-enable-flex-completion' as well)
-(add-to-list 'completion-category-overrides '(cider (styles basic)))
-
 (defun cider-company-enable-fuzzy-completion ()
   "Enable backend-driven fuzzy completion in the current buffer.
 
@@ -292,6 +308,8 @@ Only affects the `cider' completion category.`"
     (setq completion-category-overrides (seq-remove (lambda (x)
                                                       (equal 'cider (car x)))
                                                     completion-category-overrides))
+    (unless found-styles
+      (setq found-styles '(styles)))
     (unless (member 'flex found-styles)
       (setq found-styles (append found-styles '(flex))))
     (add-to-list 'completion-category-overrides (apply #'list 'cider found-styles (when found-cycle