Racket: more information in symbol documentation

When the symbol is imported and re-exported by a second module, we
display its definition name and original module, besides the name of
the module re-exporting it.

2 files changed, 55 insertions, 10 deletions

diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt
index 02b4f0f..dea8f43 100644
--- a/scheme/racket/geiser/autodoc.rkt
+++ b/scheme/racket/geiser/autodoc.rkt
@@ -36,18 +36,20 @@
                      [else #f])])
       (and sym (get-help sym mod)))))
 
-(define (symbol-documentation id)
-  (let* ([val (value id (symbol-module id))]
-         [sign (autodoc* id)])
+(define (symbol-documentation sym)
+  (let* ([val (value sym (symbol-module sym))]
+         [sign (autodoc* sym)])
     (and sign
-         (list (cons 'signature (autodoc* id #f))
-               (cons 'docstring (docstring id val sign))))))
+         (list (cons 'signature (autodoc* sym #f))
+               (cons 'docstring (docstring sym val sign))))))
 
-(define (docstring id val sign)
+(define (docstring sym val sign)
   (let* ([mod (assoc 'module (cdr sign))]
-         [mod (if mod (cdr mod) "<unknown>")])
+         [mod (if mod (cdr mod) "<unknown>")]
+         [id (namespace-symbol->identifier sym)]
+         [desc (if (identifier? id) (format "~%~%~a" (describe id sym)) "")])
     (if val
-        (format "A ~a in module ~a.~a~a"
+        (format "A ~a in module ~a.~a~a~a"
                 (if (procedure? val) "procedure" "variable")
                 mod
                 (if (procedure? val)
@@ -56,8 +58,44 @@
                 (if (has-contract? val)
                     (format "~%~%Contract:~%~%  ~a"
                             (contract-name (value-contract val)))
-                    ""))
-        (format "A syntax object in module ~a." mod))))
+                    "")
+                desc)
+        (format "An identifier in module ~a.~a" mod desc))))
+
+;; Lifted from Eli's interactive.rkt
+(define (describe id s)
+  (define b (identifier-binding id))
+  (cond
+   [(not b) (format "`~s' is a toplevel (or unbound) identifier." s)]
+   [(eq? b 'lexical) (format "`~s' is a lexical identifier." s)]
+   [(or (not (list? b)) (not (= 7 (length b))))
+    "*** internal error, racket changed ***"]
+   [else
+    (let-values ([(source-mod source-id
+                   nominal-source-mod nominal-source-id
+                   source-phase import-phase
+                   nominal-export-phase)
+                  (apply values b)])
+      (let ([aliased (not (eq? s source-id))]
+            [for-syn (eqv? source-phase 1)]
+            [amod (not (equal? source-mod nominal-source-mod))]
+            [aid (not (eq? s nominal-source-id))])
+        (if (or aliased for-syn amod aid)
+            (string-append
+             "Defined"
+             (if for-syn " for syntax" "")
+             (if aliased (format " as `~s' " source-id) "")
+             (if amod
+                 (format " in module ~a\nand required~a in module ~a"
+                         (module-path-index->name source-mod)
+                         (if (eqv? import-phase 1) "-for-syntax" "")
+                         (module-path-index->name nominal-source-mod))
+                 "")
+             (if aid
+                 (format ",\nwhere it is defined as `~s'" nominal-source-id)
+                 "")
+             ".")
+            "")))]))
 
 (define (value id mod)
   (with-handlers ([exn? (const #f)])
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index eac3a6c..9e6e14c 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -18,6 +18,7 @@
          namespace->module-path-name
          module-path-name->name
          module-spec->path-name
+         module-path-index->name
          module-identifiers
          module-list
          submodules)
@@ -84,6 +85,12 @@
         [(symbol? path) (symbol->string path)]
         [else ""]))
 
+(define (module-path-index->name mpi)
+  (let ([rmp (module-path-index-resolve mpi)])
+    (if (resolved-module-path? rmp)
+        (module-path-name->name (resolved-module-path-name rmp))
+        "<unknown module>")))
+
 (define namespace->module-name
   (compose module-path-name->name namespace->module-path-name))