[nongnu] elpa/geiser 727d2dfe98: autodoc: correctly display docsigs for in-region completions (#56)

[ELPA Syncer]

branch: elpa/geiser
commit 727d2dfe988943c277804d87ac9cd40f2ddc65e0
Author: jao <jao@gnu.org>
Commit: jao <jao@gnu.org>

    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.
---
 elisp/geiser-autodoc.el | 39 +++++++++++++++++++++++++--------------
 elisp/geiser-capf.el    | 46 +++++++++++++++++++++++++++-------------------
 2 files changed, 52 insertions(+), 33 deletions(-)

diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 20ef499334..f9db0081f1 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 1372f8a967..e2b80ea799 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)))))