Racket: showing contracts in module documentation.

2 files changed, 21 insertions, 12 deletions

diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index b8701b4..04bea85 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -199,11 +199,14 @@
     (geiser-doc--insert-title title)
     (newline)
     (dolist (w lst)
-      (insert (format "\t- "))
-      (if module
-          (geiser-doc--insert-button w module impl)
-        (geiser-doc--insert-button nil w impl))
-      (newline))
+      (let ((name (if (listp w) (car w) w))
+            (info (and (listp w) (cdr w))))
+        (insert (format "\t- "))
+        (if module
+            (geiser-doc--insert-button name module impl)
+          (geiser-doc--insert-button nil name impl))
+        (when info (insert (format "  %s" info)))
+        (newline)))
     (newline)))
 
 
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 0ab372a..6ed2ecc 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -138,24 +138,30 @@
   module-cache)
 
 (define (module-exports mod)
+  (define (value id) (dynamic-require mod id (const #f)))
+  (define (contracted id)
+    (let ([v (value id)])
+      (if (has-contract? v)
+          (cons id (contract-name (value-contract v)))
+          id)))
   (define (extract-ids ls)
     (append-map (lambda (idls)
                   (map car (cdr idls)))
                 ls))
-  (define (classify-ids ids ns)
+  (define (classify-ids ids)
     (let loop ([ids ids] [procs '()] [vars '()])
       (cond [(null? ids)
-             `((procs ,@(reverse procs)) (vars ,@(reverse vars)))]
-            [(procedure?
-              (namespace-variable-value (car ids) #t (const #f) ns))
+             `((procs ,@(map contracted (reverse procs)))
+               (vars ,@(map contracted (reverse vars))))]
+            [(procedure? (value (car ids)))
              (loop (cdr ids) (cons (car ids) procs) vars)]
             [else (loop (cdr ids) procs (cons (car ids) vars))])))
   (let-values (((reg syn)
                 (module-compiled-exports
                  (get-module-code (resolve-module-path mod #f)))))
-    (let ((syn (extract-ids syn))
-          (reg (extract-ids reg)))
-      `((syntax ,@syn) ,@(classify-ids reg (module-spec->namespace mod))))))
+    (let ([syn (map contracted (extract-ids syn))]
+          [reg (extract-ids reg)])
+      `((syntax ,@syn) ,@(classify-ids reg)))))
 
 (define (startup)
  (thread update-module-cache)