[nongnu] elpa/geiser-gauche 5c18e45 030/119: Finish autodoc and symbol signature lookup

[Philip Kaludercic]

branch: elpa/geiser-gauche
commit 5c18e45ca21936437df86ed1eef3749fa6f8c861
Author: András Simonyi <andras.simonyi@gmail.com>
Commit: András Simonyi <andras.simonyi@gmail.com>

    Finish autodoc and symbol signature lookup
---
 geiser.scm | 142 +++++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 91 insertions(+), 51 deletions(-)

diff --git a/geiser.scm b/geiser.scm
index 21eacb6..3108de2 100644
--- a/geiser.scm
+++ b/geiser.scm
@@ -11,11 +11,11 @@
    geiser:completions
    geiser:module-completions
    geiser:add-to-load-path
+   geiser:symbol-documentation
    ;; Missing functions:
    ;; geiser-start-server
    ;; geiser-object-signature
    ;; geiser-symbol-location
-   ;; geiser-symbol-documentation
    ;; geiser-find-file
    ;; geiser-compile-file
    ;; geiser-compile
@@ -78,7 +78,7 @@
 
 (define (geiser:no-values)
   (values))
-
+
 ;;; Completions
 
 (define (geiser:completions prefix)
@@ -96,66 +96,106 @@
    (cut string-prefix? prefix <>)
    (map (^x (symbol->string (module-name x)))
        (all-modules))))
-
 
-;;; Autodoc
-
-(define (geiser:autodoc ids . rest)
-  (map (cut gauche-info <>)
-       ids))
-
-(define (gauche-info id)
-  (car 
-   (sort (filter-map (cut gauche-info-in-module id <>) (all-modules))
-        > (^x (length (car (cadadr x)))))))
+;; Symbol documentation 
 
-(define (gauche-info-in-module id module)
-  (if (hash-table-get (module-table module) id #f)
-      (let1 obj (global-variable-ref module id)
+;; Return the signature of SYMBOL in MODULE if there is one, SYMBOL if the
+;; symbol is bound without one, #f otherwise.
+(define (signature-in-module symbol module)
+  (if (hash-table-get (module-table module) symbol #f)
+      (let1 obj (global-variable-ref module symbol)
            (if (is-a? obj <procedure>)
-               (process-info (~ obj 'info) module)
-               `(,id ("args" (("required" "...")))
-                     ("module" ,(module-id module)))))
+               (~ obj 'info)
+               symbol))
       #f))
 
-(define (process-info info module)
-  `(,(car info)
+;; Return a list of (signature module) pairs for all bindings of SYMBOL with
+;; signature. If SYMBOL is bound without the signature then the car is SYMBOL.
+(define (signatures symbol)
+  (let ((signatures-w-modules
+        (map (^x (cons (signature-in-module symbol x)
+                       (module-id x)))
+             (all-modules))))
+    (remove (^x (not (car x)))
+           signatures-w-modules)))
+
+;; Format a signature list for presenting with symbol documentation
+(define (format-signatures sigs)
+  (map (^x `(,(cdr x) ,(if (pair? (car x))
+                          (car x)
+                          `(,(car x) "..."))))
+       sigs))
+
+(define (geiser:symbol-documentation symbol . rest)
+  `(("signature" ,(format-signatures (signatures symbol)))))
+
+
+;;; Autodoc
+
+(define (geiser:autodoc symbols . rest)
+  (map (cut formatted-autodoc <>)
+       symbols))
+
+(define (formatted-autodoc symbol)
+  (format-autodoc-signature (autodoc-signature symbol)))
+
+(define (format-autodoc-signature as)
+  (if (symbol? as)
+      (list as)
+      (let ((sig (car as))
+           (module (cdr as)))
+       (if (symbol? sig)
+           `(,sig ("args" (("required" "...")))
+                  ("module" ,module))
+           (signature->autodoc sig module)))))
+
+;; Return a (signature module) pair to be displayed in autodoc for SYMBOL.
+;; Return a (SYMBOL module) pair if SYMBOL is bound without signature and 
+;; SYMBOL if no binding was found.
+(define (autodoc-signature symbol)
+  (let1 sigs (signatures symbol)
+       (if (not (null? sigs))
+           (or (find (^x ($ not $ symbol? $ car x)) sigs)
+               (car sigs))
+           symbol)))
+
+;; Format a signature for Geiser autodoc
+(define (signature->autodoc signature module-id)
+  (define (process-normal-arg-info arg-info)
+    (let ((required '("required"))
+         (optional '("optional"))
+         (key '("key"))
+         (section :required)
+         (arg-no 0))
+      (dolist (x arg-info)
+             (if (memq x '(:optional :key :rest))
+                 (set! section x)
+                 (begin
+                   (inc! arg-no)
+                   (case section
+                     ((:optional) (push! optional x))
+                     ((:key) (push! key
+                                    (cons (coloned-sym (get-first-leaf x))
+                                          arg-no)))
+                     ((:rest) (push! required "..."))
+                     (else (push! required x))))))
+      (map (cut reverse <>)
+          (list required optional key))))
+  (define (process-dotted-arg-info arg-info)
+    `(("required" ,@(dotted-list-head arg-info) "...")
+      ("optional")
+      ("key")))
+  `(,(car signature)
     ("args"
-     ,((if (list? info)
+     ,((if (list? signature)
           process-normal-arg-info
           process-dotted-arg-info)
-       (cdr info)))
-    ("module" ,(module-id module))))
-
-(define (process-normal-arg-info arg-info)
-  (let ((required '("required"))
-       (optional '("optional"))
-       (key '("key"))
-       (section :required)
-       (arg-no 0))
-    (dolist (x arg-info)
-           (if (memq x '(:optional :key :rest))
-               (set! section x)
-               (begin
-                 (inc! arg-no)
-                 (case section
-                   ((:optional) (push! optional x))
-                   ((:key) (push! key
-                                  (cons (coloned-sym (get-first-leaf x))
-                                        arg-no)))
-                   ((:rest) (push! required "..."))
-                   (else (push! required x))))))
-    (map (cut reverse <>)
-        (list required optional key))))
-
-(define (process-dotted-arg-info arg-info)
-  `(("required" ,@(dotted-list-head arg-info) "...")
-    ("optional")
-    ("key")))
+       (cdr signature)))
+    ("module" ,module-id)))
 
+
 ;; Further
 
 ;; TODO We add the load-path at the end. Is this correct?
 (define-macro (geiser:add-to-load-path dir)
   `(add-load-path ,dir :after))
-