summaryrefslogtreecommitdiff
path: root/scheme/plt/geiser
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-05-25 03:39:47 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-05-25 03:39:47 +0200
commitac726e6c49846b920466650fe9f3b57b1eb50e20 (patch)
treeedfe88d359c61ebcbd2a3bbd9841da13fbcb453a /scheme/plt/geiser
parent76d5f69c79182687225248a7a0e424ef990daafd (diff)
downloadgeiser-chez-ac726e6c49846b920466650fe9f3b57b1eb50e20.tar.gz
geiser-chez-ac726e6c49846b920466650fe9f3b57b1eb50e20.tar.bz2
PLT: New help functionality:
- Using our own help function, which takes care of trying on not yet loaded modules. - Module children implemented.
Diffstat (limited to 'scheme/plt/geiser')
-rw-r--r--scheme/plt/geiser/autodoc.ss9
-rw-r--r--scheme/plt/geiser/modules.ss22
2 files changed, 27 insertions, 4 deletions
diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss
index f7a0c55..73ed24d 100644
--- a/scheme/plt/geiser/autodoc.ss
+++ b/scheme/plt/geiser/autodoc.ss
@@ -22,9 +22,14 @@
#lang scheme
-(provide autodoc update-module-cache)
+(provide autodoc update-module-cache get-help)
-(require geiser/utils geiser/modules geiser/locations)
+(require geiser/utils geiser/modules geiser/locations scheme/help)
+
+(define (get-help symbol mod)
+ (with-handlers ((exn? (lambda (e)
+ (eval `(help ,symbol #:from ,mod)))))
+ (eval `(help ,symbol))))
(define (autodoc form)
(cond ((null? form) #f)
diff --git a/scheme/plt/geiser/modules.ss b/scheme/plt/geiser/modules.ss
index 1b03d1a..02287e0 100644
--- a/scheme/plt/geiser/modules.ss
+++ b/scheme/plt/geiser/modules.ss
@@ -27,9 +27,10 @@
namespace->module-path-name
module-path-name->name
module-spec->path-name
- module-list)
+ module-list
+ module-children)
-(require srfi/13 scheme/enter)
+(require srfi/13 scheme/enter syntax/modresolve syntax/modcode)
(define (ensure-module-spec spec)
(cond ((symbol? spec) spec)
@@ -127,5 +128,22 @@
string<?)))
module-cache)
+(define (module-children mod)
+ (define (extract-ids ls)
+ (append-map (lambda (idls)
+ (map car (cdr idls)))
+ ls))
+ (define (classify-ids ids ns)
+ (let loop ((ids ids) (procs '()) (vars '()))
+ (cond ((null? ids) `((procs ,@(reverse procs)) (vars ,@(reverse vars))))
+ ((procedure? (namespace-variable-value (car ids) #t (lambda () #f) ns))
+ (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))))))
;;; modules.ss ends here