autodoc: correctly display docsigs for in-region completions (#56)

we were doing it really wrong: first, by not setting the evaluation
environment when things are computed outside the original buffer (the
completion in region case for consult and the likes, where the current buffer
is the minibuffer) and, to add insult to injury, by not waiting for a response
from the scheme side!

actually waiting can make things a tad laggy when the scheme is not as fast
as, say, chez and there are lots of completions (if one uses
completion-in-region; for pop ups like company it's fine), so i've also added
a flag, geiser-autodoc-use-docsig, to turn the functionality off.

2 files changed, 52 insertions, 33 deletions

diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 20ef499..f9db008 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -36,19 +36,27 @@
 
 (geiser-custom--defcustom geiser-autodoc-delay 0.3
   "Delay before autodoc messages are fetched and displayed, in seconds."
-  :type 'number
-  :group 'geiser-autodoc)
+  :type 'number)
 
-(geiser-custom--defcustom geiser-autodoc-display-module-p t
+(geiser-custom--defcustom geiser-autodoc-display-module t
   "Whether to display procedure module in autodoc strings."
-  :type 'boolean
-  :group 'geiser-autodoc)
+  :type 'boolean)
 
 (geiser-custom--defcustom geiser-autodoc-identifier-format "%s:%s"
   "Format for displaying module and procedure or variable name, in that order,
-when `geiser-autodoc-display-module-p' is on."
-  :type 'string
-  :group 'geiser-autodoc)
+when `geiser-autodoc-display-module' is on."
+  :type 'string)
+
+(geiser-custom--defcustom geiser-autodoc-use-docsig t
+  "Provide signature docstrings for systems like company or corfu.
+
+With this flag set, the signature of selected completions using
+packages like company, corfu or completion-in-region functions
+will be displayed in the echo area.  For the case of a
+completion-in-region function (e.g. consult's), which collects
+all the docstrings at once, this might have a performace impact:
+you can set this variable to nil to avoid them."
+  :type 'boolean)
 
 
 ;;; Procedure arguments:
@@ -58,7 +66,7 @@ when `geiser-autodoc-display-module-p' is on."
 (defsubst geiser-autodoc--clean-cache ()
   (setq geiser-autodoc--cached-signatures nil))
 
-(defun geiser-autodoc--show-signatures (ret callback)
+(defun geiser-autodoc--update-signatures (ret callback)
   (let ((res (geiser-eval--retort-result ret))
         (signs))
     (when res
@@ -72,10 +80,13 @@ when `geiser-autodoc-display-module-p' is on."
 
 (defun geiser-autodoc--get-signatures (funs callback)
   (when funs
-    (let ((m (format "'(%s)" (mapconcat 'identity funs " "))))
-      (geiser-eval--send `(:eval (:ge autodoc (:scm ,m)))
-                         (lambda (r)
-                           (geiser-autodoc--show-signatures r callback)))))
+    (let* ((m (format "'(%s)" (mapconcat 'identity funs " ")))
+           (str (geiser-eval--scheme-str `(:eval (:ge autodoc (:scm ,m))))))
+      (if callback
+          (geiser-eval--send str
+                             (lambda (r)
+                               (geiser-autodoc--update-signatures r callback)))
+        (geiser-autodoc--update-signatures (geiser-eval--send/wait str) nil))))
   (and (or (assoc (car funs) geiser-autodoc--cached-signatures)
            (assoc (cadr funs) geiser-autodoc--cached-signatures))
        geiser-autodoc--cached-signatures))
@@ -131,7 +142,7 @@ when `geiser-autodoc-display-module-p' is on."
     (geiser-autodoc--insert-arg-group keys prev nil)))
 
 (defsubst geiser-autodoc--id-name (proc module)
-  (let ((str (if module
+  (let ((str (if (and module geiser-autodoc-display-module)
                  (format geiser-autodoc-identifier-format module proc)
                (format "%s" proc))))
     (propertize str 'face 'geiser-font-lock-autodoc-identifier)))
diff --git a/elisp/geiser-capf.el b/elisp/geiser-capf.el
index 1372f8a..e2b80ea 100644
--- a/elisp/geiser-capf.el
+++ b/elisp/geiser-capf.el
@@ -18,31 +18,38 @@
 (require 'geiser-completion)
 (require 'geiser-edit)
 
+(defvar geiser-capf--buffer nil)
+
 (defun geiser-capf--company-docsig (id)
   (ignore-errors
-    (when (not (geiser-autodoc--inhibit))
-      (let ((help (geiser-autodoc--autodoc `((,id 0)) nil)))
-        (and help (substring-no-properties help))))))
+    (when (and geiser-capf--buffer (not (geiser-autodoc--inhibit)))
+      (with-current-buffer geiser-capf--buffer
+        (let* ((id (substring-no-properties id))
+               (help (geiser-autodoc--autodoc `((,id 0) (,id 0)) nil)))
+          (and help (substring-no-properties help)))))))
 
 (defun geiser-capf--company-doc-buffer (id)
-  (let* ((impl geiser-impl--implementation)
-         (module (geiser-eval--get-module))
-         (symbol (make-symbol id))
-         (ds (geiser-doc--get-docstring symbol module)))
-    (when (consp ds)
-      (with-current-buffer (get-buffer-create "*company-documentation*")
-        (geiser-doc--render-docstring ds symbol module impl)
-        (current-buffer)))))
+  (when geiser-capf--buffer
+    (with-current-buffer geiser-capf--buffer
+      (let* ((module (geiser-eval--get-module))
+             (symbol (make-symbol id))
+             (ds (geiser-doc--get-docstring symbol module)))
+        (when (consp ds)
+          (with-current-buffer (get-buffer-create "*company-documentation*")
+            (geiser-doc--render-docstring ds symbol module)
+            (current-buffer)))))))
 
 (defun geiser-capf--company-location (id)
   (ignore-errors
-    (when (not (geiser-autodoc--inhibit))
-      (let ((id (make-symbol id)))
-        (condition-case nil
-            (geiser-edit-module id 'noselect)
-          (error (geiser-edit-symbol id 'noselect)))))))
-
-(defun geiser-capf--thing-at-point (module &optional predicate)
+    (when (and geiser-capf--buffer (not (geiser-autodoc--inhibit)))
+      (with-current-buffer geiser-capf--buffer
+        (let ((id (make-symbol id)))
+          (condition-case nil
+              (geiser-edit-module id 'noselect)
+            (error (geiser-edit-symbol id 'noselect))))))))
+
+(defun geiser-capf--thing-at-point (module &optional _predicate)
+  (setq geiser-capf--buffer (current-buffer))
   (with-syntax-table scheme-mode-syntax-table
     (let* ((beg (geiser-completion--symbol-begin module))
            (end (or (geiser-completion--prefix-end beg module) beg))
@@ -54,7 +61,8 @@
            (cmps (and prefix (geiser-completion--complete prefix module))))
       (when cmps
         (list beg end cmps
-              :company-docsig #'geiser-capf--company-docsig
+              :company-docsig
+              (and geiser-autodoc-use-docsig #'geiser-capf--company-docsig)
               :company-doc-buffer #'geiser-capf--company-doc-buffer
               :company-location #'geiser-capf--company-location)))))