From 02b4dbe81d4662aaf207677c53b869cc055b06a3 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 17 Feb 2009 01:31:26 +0100
Subject: Better symbol documentation.

---
 elisp/geiser-doc.el                   | 11 ++++---
 scheme/guile/geiser/emacs.scm         |  2 +-
 scheme/guile/geiser/introspection.scm | 54 +++++++++++++++++------------------
 3 files changed, 35 insertions(+), 32 deletions(-)

diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index 3a1759c..a7d6eae 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -53,7 +53,7 @@
 ;;; Docstrings:
 
 (defun geiser-doc--get-docstring (symbol)
-  (geiser-eval--send/result `(:eval ((:ge docstring) ',symbol))))
+  (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol))))
 
 (defun geiser-doc--get-module-children (module)
   (geiser-eval--send/result `(:eval ((:ge module-children) (quote (:scm ,module))))))
@@ -63,7 +63,7 @@
 
 (defun geiser-doc--insert-title (title)
   (let ((p (point)))
-    (insert title)
+    (insert (format "%s" title))
     (put-text-property p (point) 'face 'geiser-font-lock-doc-title))
   (newline))
 
@@ -86,11 +86,14 @@ With prefix argument, ask for symbol (with completion)."
                     (geiser-completion--read-symbol "Symbol: " (symbol-at-point)))))
     (when symbol
       (let ((ds (geiser-doc--get-docstring symbol)))
-        (if (or (not (stringp ds)) (zerop (length ds)))
+        (if (or (not ds) (not (listp ds)))
             (message "No documentation available for '%s'" symbol)
           (geiser-doc--with-buffer
             (erase-buffer)
-            (insert ds))
+            (geiser-doc--insert-title (cdr (assoc 'signature ds)))
+            (newline)
+            (insert (or (cdr (assoc 'docstring ds)) ""))
+            (goto-line (point-min)))
           (geiser-doc--pop-to-buffer))))))
 
 (defun geiser-doc-module (module)
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm
index b5ba284..36428f9 100644
--- a/scheme/guile/geiser/emacs.scm
+++ b/scheme/guile/geiser/emacs.scm
@@ -30,7 +30,7 @@
                ge:symbol-location
                ge:compile-file
                ge:load-file
-               ge:docstring
+               ge:symbol-documentation
                ge:all-modules
                ge:module-children
                ge:module-location)
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm
index 2021a32..5d86d62 100644
--- a/scheme/guile/geiser/introspection.scm
+++ b/scheme/guile/geiser/introspection.scm
@@ -28,7 +28,7 @@
   #:export (arguments
             completions
             symbol-location
-            docstring
+            symbol-documentation
             all-modules
             module-children
             module-location)
@@ -128,34 +128,34 @@
 
 (define module-filename (@@ (ice-9 session) module-filename))
 
-(define (display-docstring sym)
+(define (docstring sym obj)
+  (with-output-to-string
+    (lambda ()
+      (let* ((type (cond ((macro? obj) "A macro")
+                         ((procedure? obj) "A  procedure")
+                         ((program? obj) "A compiled program")
+                         (else "An object")))
+             (modname (symbol-module sym))
+            (doc (object-documentation obj)))
+        (display type)
+        (if modname
+            (begin
+              (display " in module ")
+              (display modname)))
+        (newline)
+        (if doc (display doc))))))
+
+(define (obj-signature sym obj)
+  (let* ((args (obj-args obj))
+         (req (and args (car args)))
+         (opt (and args (cadr args))))
+    (and args (if (not opt) `(,sym ,@req) `(,sym ,@req . ,opt)) sym)))
+
+(define (symbol-documentation sym)
   (let ((obj (symbol->obj sym)))
     (if obj
-        (let* ((args (obj-args obj))
-               (req (and args (car args)))
-               (opt (and args (cadr args)))
-               (signature (if args
-                              (if (not opt) `(,sym ,@req) `(,sym ,@req . ,opt))
-                              sym))
-               (type (cond ((macro? obj) "A macro")
-                           ((procedure? obj) "A  procedure")
-                           ((program? obj) "A compiled program")
-                           (else "An object")))
-               (modname (symbol-module sym))
-               (doc (object-documentation obj)))
-          (display signature)
-          (newline)
-          (display type)
-          (if modname
-              (begin
-                (display " in module ")
-                (display modname)))
-          (newline)
-          (if doc (display doc))))))
-
-(define (docstring sym)
-  (with-output-to-string
-    (lambda () (display-docstring sym))))
+        `((signature . ,(or (obj-signature sym obj) sym))
+          (docstring . ,(docstring sym obj))))))
 
 (define (all-modules)
   (let ((roots ((@@ (ice-9 session) root-modules))))
-- 
cgit v1.2.3