diff options
Diffstat (limited to 'scheme/racket')
| -rw-r--r-- | scheme/racket/geiser/autodoc.rkt | 75 | ||||
| -rw-r--r-- | scheme/racket/geiser/locations.rkt | 11 | ||||
| -rw-r--r-- | scheme/racket/geiser/main.rkt | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/modules.rkt | 21 |
4 files changed, 76 insertions, 33 deletions
diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt index 54cac24..02b4f0f 100644 --- a/scheme/racket/geiser/autodoc.rkt +++ b/scheme/racket/geiser/autodoc.rkt @@ -11,19 +11,57 @@ #lang racket -(provide autodoc module-exports update-signature-cache get-help) +(provide autodoc + symbol-documentation + module-exports + update-signature-cache + get-help) (require racket/help - syntax/modcode - syntax/modresolve geiser/utils geiser/modules geiser/locations) (define (get-help symbol mod) - (with-handlers ([exn? (lambda (_) - (eval `(help ,symbol)))]) - (eval `(help ,symbol #:from ,(ensure-module-spec mod))))) + (if (eq? symbol mod) + (get-mod-help mod) + (with-handlers ([exn? (lambda (_) + (eval `(help ,symbol)))]) + (eval `(help ,symbol #:from ,(ensure-module-spec mod)))))) + +(define (get-mod-help mod) + (let-values ([(ids syns) (module-identifiers mod)]) + (let ([sym (cond [(not (null? syns)) (car syns)] + [(not (null? ids)) (car ids)] + [else #f])]) + (and sym (get-help sym mod))))) + +(define (symbol-documentation id) + (let* ([val (value id (symbol-module id))] + [sign (autodoc* id)]) + (and sign + (list (cons 'signature (autodoc* id #f)) + (cons 'docstring (docstring id val sign)))))) + +(define (docstring id val sign) + (let* ([mod (assoc 'module (cdr sign))] + [mod (if mod (cdr mod) "<unknown>")]) + (if val + (format "A ~a in module ~a.~a~a" + (if (procedure? val) "procedure" "variable") + mod + (if (procedure? val) + "" + (format "~%~%Value:~%~% ~a" val)) + (if (has-contract? val) + (format "~%~%Contract:~%~% ~a" + (contract-name (value-contract val))) + "")) + (format "A syntax object in module ~a." mod)))) + +(define (value id mod) + (with-handlers ([exn? (const #f)]) + (dynamic-require mod id (const #f)))) (define (autodoc ids) (if (not (list? ids)) @@ -33,7 +71,8 @@ (define (autodoc* id (extra #t)) (define (val) (with-handlers ([exn? (const "")]) - (format "~.a" (namespace-variable-value id)))) + (parameterize ([error-print-width 60]) + (format "~.a" (namespace-variable-value id))))) (and (symbol? id) (let* ([loc (symbol-location* id)] @@ -201,11 +240,8 @@ (hash-remove! signatures path))) (define (module-exports mod) - (define (value id) - (with-handlers ([exn? (const #f)]) - (dynamic-require mod id (const #f)))) (define (contracted id) - (let ([v (value id)]) + (let ([v (value id mod)]) (if (has-contract? v) (list id (cons 'info (contract-name (value-contract v)))) (entry id)))) @@ -213,22 +249,15 @@ (let ((sign (eval `(,autodoc* ',id #f) (module-spec->namespace mod #f #f)))) (if sign (list id (cons 'signature sign)) (list id)))) - (define (extract-ids ls) - (append-map (lambda (idls) - (map car (cdr idls))) - ls)) (define (classify-ids ids) (let loop ([ids ids] [procs '()] [vars '()]) (cond [(null? ids) `((procs ,@(map entry (reverse procs))) (vars ,@(map list (reverse vars))))] - [(procedure? (value (car ids))) + [(procedure? (value (car ids) mod)) (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 (map contracted (extract-ids syn))] - [reg (extract-ids reg)] - [subm (map list (or (submodules mod) '()))]) - `((syntax ,@syn) ,@(classify-ids reg) (modules ,@subm))))) + (let-values ([(ids syn) (module-identifiers mod)]) + `(,@(classify-ids ids) + (syntax ,@(map contracted syn)) + (modules ,@(map list (or (submodules mod) '())))))) diff --git a/scheme/racket/geiser/locations.rkt b/scheme/racket/geiser/locations.rkt index 7f69d3a..4715b8f 100644 --- a/scheme/racket/geiser/locations.rkt +++ b/scheme/racket/geiser/locations.rkt @@ -14,8 +14,8 @@ (provide symbol-location symbol-location* module-location - symbol-module-name - symbol-module-path-name) + symbol-module + symbol-module-name) (require geiser/utils geiser/modules) @@ -42,13 +42,10 @@ (make-location name path #f) (module-location sym)))) -(define symbol-module-path-name (compose cdr symbol-location*)) +(define symbol-module (compose cdr symbol-location*)) (define symbol-module-name - (compose module-path-name->name symbol-module-path-name)) + (compose module-path-name->name symbol-module)) (define (module-location sym) (make-location sym (module-spec->path-name sym) 1)) - - -;;; locations.rkt ends here diff --git a/scheme/racket/geiser/main.rkt b/scheme/racket/geiser/main.rkt index 0c7de4e..c759089 100644 --- a/scheme/racket/geiser/main.rkt +++ b/scheme/racket/geiser/main.rkt @@ -22,6 +22,7 @@ geiser:module-location geiser:module-exports geiser:autodoc + geiser:symbol-documentation geiser:help geiser:no-values) @@ -52,6 +53,7 @@ (define geiser:module-location module-location) (define geiser:module-exports module-exports) (define geiser:macroexpand macroexpand) +(define geiser:symbol-documentation symbol-documentation) (define (geiser:no-values) (values)) ;;; main.rkt ends here diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt index 02fd460..eac3a6c 100644 --- a/scheme/racket/geiser/modules.rkt +++ b/scheme/racket/geiser/modules.rkt @@ -18,10 +18,14 @@ namespace->module-path-name module-path-name->name module-spec->path-name + module-identifiers module-list submodules) -(require srfi/13 geiser/enter) +(require srfi/13 + syntax/modcode + syntax/modresolve + geiser/enter) (define (ensure-module-spec spec) (cond [(symbol? spec) spec] @@ -48,7 +52,7 @@ (define (namespace->module-path-name ns) (let ([rmp (variable-reference->resolved-module-path - (eval '(#%variable-reference) ns))]) + (eval '(#%variable-reference) (or ns (current-namespace))))]) (and (resolved-module-path? rmp) (resolved-module-path-name rmp)))) @@ -57,7 +61,7 @@ (or (get-path spec) (register-path spec (namespace->module-path-name - (module-spec->namespace spec) #f #f))))) + (module-spec->namespace spec #f #f)))))) (define (module-path-name->name path) (cond [(path? path) @@ -83,6 +87,17 @@ (define namespace->module-name (compose module-path-name->name namespace->module-path-name)) +(define (module-identifiers mod) + (define (extract-ids ls) + (append-map (lambda (idls) + (map car (cdr idls))) + ls)) + (let-values ([(reg syn) + (module-compiled-exports + (get-module-code (resolve-module-path + (ensure-module-spec mod) #f)))]) + (values (extract-ids reg) (extract-ids syn)))) + (define (skippable-dir? path) (call-with-values (lambda () (split-path path)) (lambda (_ basename __) |