From acffa001cd9effa4a74261ac9b72e736b9b61937 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 25 Nov 2010 01:30:48 +0100
Subject: [PATCH] Guile: fixes for documentation display

We put the value of the identifier where it belongs, and add a missing
period. Works, but geiser/doc.scm is in sore need of a refactoring.
---
 scheme/guile/geiser/doc.scm | 34 ++++++++++++++++++++++------------
 1 file changed, 22 insertions(+), 12 deletions(-)

diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm
index 345febd..640f4ad 100644
--- a/scheme/guile/geiser/doc.scm
+++ b/scheme/guile/geiser/doc.scm
@@ -29,7 +29,7 @@
       '()
       (map (lambda (id) (or (autodoc* id) (list id))) ids)))
 
-(define (autodoc* id)
+(define* (autodoc* id)
   (let ((args (obj-args (symbol->object id))))
     (and args
          `(,@(signature id args)
@@ -39,7 +39,10 @@
   (let ((args (obj-args obj)))
     (and args (signature name args))))
 
-(define (signature id args-list)
+(define (value-str obj)
+  (format #f "~:@y" obj))
+
+(define* (signature id args-list #:optional (detail #t))
   (define (arglst args kind)
     (let ((args (assq-ref args kind)))
       (cond ((or (not args) (null? args)) '())
@@ -52,10 +55,9 @@
                     (if rest (list "...") '())))
       (key ,@(arglst as 'keyword))))
   (let* ((args-list (map mkargs (if (list? args-list) args-list '())))
-         (value (if (null? args-list)
-                    (format #f "~:@y" (symbol->object id))
-                    "")))
-    (list id (cons 'args args-list) (cons 'value value))))
+         (value (and (and detail (null? args-list))
+                     (value-str (symbol->object id)))))
+    `(,id (args ,@args-list) ,@(if value `((value . ,value)) '()))))
 
 (define default-macro-args '(((required ...))))
 
@@ -184,10 +186,12 @@
 (define (symbol-documentation sym)
   (let ((obj (symbol->object sym)))
     (if obj
-        `((signature . ,(or (obj-signature sym obj) sym))
+        `((signature . ,(or (obj-signature sym obj #f) sym))
           (docstring . ,(docstring sym obj))))))
 
 (define (docstring sym obj)
+  (define (valuable?)
+    (not (or (macro? obj) (procedure? obj) (program? obj))))
   (with-output-to-string
     (lambda ()
       (let* ((type (cond ((macro? obj) "A macro")
@@ -200,13 +204,19 @@
         (if modname
             (begin
               (display " in module ")
-              (display modname)))
+              (display modname)
+              (display ".")))
         (newline)
-        (if doc (begin (newline) (display doc)))))))
-
-(define (obj-signature sym obj)
+        (if doc (begin (newline) (display doc)))
+        (if (valuable?) (begin (newline)
+                               (display "Value:")
+                               (newline)
+                               (display "   ")
+                               (display (value-str obj))))))))
+
+(define* (obj-signature sym obj #:optional (detail #t))
   (let ((args (obj-args obj)))
-    (and args (signature sym args))))
+    (and args (signature sym args detail))))
 
 (define (module-exports mod-name)
   (define elt-sort (make-symbol-sort car))
-- 
2.11.4.GIT