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.

4 files changed, 59 insertions, 14 deletions

diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index b6a19e9..37c069e 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -274,10 +274,10 @@ help (e.g. browse an HTML page) implementing this method.")
   (geiser-eval--send/result
    `(:eval (:ge module-exports '(:module ,module)) :f)))
 
-(defun geiser-doc--buttonize-module (impl)
+(defun geiser-doc--buttonize-modules (impl)
   (save-excursion
     (goto-char (point-min))
-    (when (re-search-forward "in module \\([^.\n]+\\)\\." nil t)
+    (while (re-search-forward "in module \\([^.\n]+\\)\\b" nil t)
       (geiser-doc--make-module-button (match-beginning 1)
                                       (match-end 1)
                                       (geiser-doc--module (match-string 1)
@@ -298,7 +298,7 @@ help (e.g. browse an HTML page) implementing this method.")
                                 (cdr (assoc 'signature ds))))
           (newline)
           (insert (or (cdr (assoc 'docstring ds)) ""))
-          (geiser-doc--buttonize-module impl)
+          (geiser-doc--buttonize-modules impl)
           (setq geiser-doc--buffer-link
                 (geiser-doc--history-push (geiser-doc--make-link symbol
                                                                  module
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index 112b3c4..e826bde 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -178,7 +178,7 @@ This function uses `geiser-racket-init-file' if it exists."
    `(:eval (get-help ',symbol '(:module ,module)) geiser/autodoc)))
 
 (defun geiser-racket--external-help (id module)
-  (message "Requesting help for '%s'..." id)
+  (message "Looking up manual for '%s'..." id)
   (let ((out (geiser-eval--retort-output
               (geiser-racket--get-help id module))))
     (when (and out (string-match " but provided by:\n +\\(.+\\)\n" out))
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))