geiser-implementation-help, for Geiser hackers

This interactive command will list all method needed to define a new
Scheme implementation in Geiser, together with their callers and doc
strings. Although i know very few additional schemes meta-dynamic
enough to be supported by Geiser (actually, just one: scheme48), one
never knows (there was a time when i thought that PLT Scheme wasn't in
the list).

1 files changed, 32 insertions, 7 deletions

diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 8c55ab4..5c09d51 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -82,24 +82,49 @@ determine its scheme flavour."
   (let ((fun (geiser-impl--method method impl)))
     (when (functionp fun) (apply fun args))))
 
-(defun geiser-impl--method-doc (method doc)
-  (push (cons method doc) geiser-impl--method-docs))
+(defun geiser-impl--method-doc (method doc user)
+  (let* ((user (if user (format " Used via `%s'." user) ""))
+         (extra-doc (format "%s%s" doc user)))
+    (add-to-list 'geiser-impl--method-docs (cons method extra-doc))
+    (put method 'function-documentation doc)))
+
+(defun geiser-implementation-help ()
+  "Shows a list of implementation methods, with descriptions."
+  (interactive)
+  (with-current-buffer (get-buffer-create "* Geiser implementation help*")
+    (setq buffer-read-only nil)
+    (delete-region (point-min) (point-max))
+    (insert "Methods used to define an implementation:\n\n")
+    (let ((ms (sort (copy-list geiser-impl--method-docs)
+                    (lambda (a b) (string< (symbol-name (car a))
+                                      (symbol-name (car b)))))))
+      (dolist (m ms)
+        (geiser--insert-with-face (format "%s: " (car m)) 'bold)
+        (insert (cdr m))
+        (fill-paragraph)
+        (insert "\n\n")))
+    (goto-char (point-min))
+    (unless (eq major-mode 'help-mode) (help-mode))
+    (help-make-xrefs)
+    (setq buffer-read-only t)
+    (pop-to-buffer (current-buffer))))
 
 (defun geiser-impl--register-local-method (var-name method fallback doc)
   (add-to-list 'geiser-impl--local-methods (list var-name method fallback))
-  (geiser-impl--method-doc method doc))
+  (geiser-impl--method-doc method doc var-name)
+  (put var-name 'function-documentation doc))
 
 (defun geiser-impl--register-local-variable (var-name method fallback doc)
   (add-to-list 'geiser-impl--local-variables (list var-name method fallback))
-  (geiser-impl--method-doc method doc))
+  (geiser-impl--method-doc method doc var-name)
+  (put var-name 'variable-documentation doc))
 
 (defmacro geiser-impl--define-caller (fun-name method arglist doc)
-  (let ((m (make-symbol "method-candidate"))
-        (impl (make-symbol "implementation-name")))
+  (let ((impl (make-symbol "implementation-name")))
     `(progn
        (defun ,fun-name ,(cons impl arglist) ,doc
          (geiser-impl--call-method ',method ,impl ,@arglist))
-       (geiser-impl--method-doc ',method ,doc))))
+       (geiser-impl--method-doc ',method ,doc ',fun-name))))
 (put 'geiser-impl--define-caller 'lisp-indent-function 3)
 
 (defun geiser-impl--register (file impl methods)