[nongnu] elpa/geiser-guile f1ac35f 140/284: Guile: filtering gensym names in autodoc display.

[Philip Kaludercic]

branch: elpa/geiser-guile
commit f1ac35fa6563827c16f175f3aedc285c58616bec
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>

    Guile: filtering gensym names in autodoc display.
---
 geiser/doc.scm     | 24 +++++++++++-------------
 geiser/modules.scm | 14 +++++++-------
 geiser/utils.scm   | 12 ++++++++++--
 3 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/geiser/doc.scm b/geiser/doc.scm
index 982af95..85bf4d4 100644
--- a/geiser/doc.scm
+++ b/geiser/doc.scm
@@ -38,11 +38,14 @@
     (and args (signature name args))))
 
 (define (signature id args-list)
+  (define (rem-gensyms args)
+    (map (lambda (s) (if (gensym? s) '_
+                         (if (list? s) (rem-gensyms s) s))) args))
   (define (arglst args kind)
     (let ((args (assq-ref args kind)))
-      (cond ((or (not args) (null? args)) '())
-            ((list? args) args)
-            (else (list args)))))
+      (rem-gensyms (cond ((or (not args) (null? args)) '())
+                         ((list? args) args)
+                         (else (list args))))))
   (define (mkargs as)
     `((required ,@(arglst as 'required))
       (optional ,@(arglst as 'optional)
@@ -80,24 +83,19 @@
           (else #f))))
 
 (define (arity->args art)
+  (define (gen-arg-names count)
+    (map (lambda (x) '_) (iota (max count 0))))
   (let ((req (car art))
         (opt (cadr art))
         (rest (caddr art)))
     `(,@(if (> req 0)
-            (list (cons 'required (gen-arg-names 1 req)))
+            (list (cons 'required (gen-arg-names req)))
             '())
       ,@(if (> opt 0)
-            (list (cons 'optional (gen-arg-names (+ 1 req) opt)))
+            (list (cons 'optional (gen-arg-names opt)))
             '())
       ,@(if rest (list (cons 'rest 'rest)) '()))))
 
-(define (gen-arg-names fst count)
-  (let* ((letts (list->vector '(#\x #\y #\z #\u #\v #\w #\t)))
-         (len (vector-length letts))
-         (lett (lambda (n) (vector-ref letts (modulo n len)))))
-    (map (lambda (n) (string->symbol (format "~A" (lett (- n 1)))))
-         (iota (max count 1) fst))))
-
 (define (arglist->args arglist)
   `((required . ,(car arglist))
     (optional . ,(cadr arglist))
@@ -173,7 +171,7 @@
   (with-output-to-string
     (lambda ()
       (let* ((type (cond ((macro? obj) "A macro")
-                         ((procedure? obj) "A  procedure")
+                         ((procedure? obj) "A procedure")
                          ((program? obj) "A compiled program")
                          (else "An object")))
              (modname (symbol-module sym))
diff --git a/geiser/modules.scm b/geiser/modules.scm
index 6f499dd..7ca18c9 100644
--- a/geiser/modules.scm
+++ b/geiser/modules.scm
@@ -25,7 +25,7 @@
 
 (define (module-name? module-name)
   (and (list? module-name)
-       (> (length module-name) 0)
+       (not (null? module-name))
        (every symbol? module-name)))
 
 (define (symbol-module sym . all)
@@ -67,13 +67,13 @@
 
 (define (all-modules)
   (define (maybe-name m)
-    (let ((name (format "~A" (module-name m))))
-      (and (not (string-match "^[(]#[{]" name)) name)))
+    (let ((name (module-name m)))
+      (and (not (gensym? (car name)))
+           (format "~A" name))))
   (let* ((guile (resolve-module '(guile)))
-         (roots (remove (lambda (m) (eq? m guile)) (root-modules))))
-    (cons "(guile)"
-          (filter-map maybe-name
-                      (apply append (map all-child-modules roots))))))
+         (roots (remove (lambda (m) (eq? m guile)) (root-modules)))
+         (children (append-map all-child-modules roots)))
+    (cons "(guile)" (filter-map maybe-name children))))
 
 (define* (all-child-modules mod #:optional (seen '()))
   (let ((cs (filter (lambda (m) (not (member m seen))) (submodules mod))))
diff --git a/geiser/utils.scm b/geiser/utils.scm
index b047e6c..01dfaa0 100644
--- a/geiser/utils.scm
+++ b/geiser/utils.scm
@@ -1,6 +1,6 @@
 ;;; utils.scm -- utility functions
 
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the Modified BSD License. You should
@@ -13,7 +13,9 @@
   #:export (make-location
             symbol->object
             pair->list
-            sort-symbols!))
+            sort-symbols!
+            gensym?)
+  #:use-module (ice-9 regex))
 
 (define (symbol->object sym)
   (and (symbol? sym)
@@ -35,4 +37,10 @@
                (string<? (symbol->string l) (symbol->string r)))))
     (sort! syms cmp)))
 
+(define (gensym? sym)
+  (and (symbol? sym) (gensym-name? (format "~A" sym))))
+
+(define (gensym-name? name)
+  (and (string-match "^#[{]" name) #t))
+
 ;;; utils.scm ends here