From f531c3e0f5afda77ada497d3932ea10502e22bdb Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 21 Nov 2010 16:12:41 +0100 Subject: Racket: showing submodules in module help --- scheme/racket/geiser.rkt | 23 ------------ scheme/racket/geiser/autodoc.rkt | 5 ++- scheme/racket/geiser/completions.rkt | 2 - scheme/racket/geiser/modules.rkt | 71 ++++++++++++++++++++++++++++-------- scheme/racket/geiser/startup.rkt | 23 ++++++++++++ scheme/racket/geiser/user.rkt | 4 +- 6 files changed, 83 insertions(+), 45 deletions(-) delete mode 100644 scheme/racket/geiser.rkt create mode 100644 scheme/racket/geiser/startup.rkt (limited to 'scheme/racket') diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser.rkt deleted file mode 100644 index 3d75157..0000000 --- a/scheme/racket/geiser.rkt +++ /dev/null @@ -1,23 +0,0 @@ -;;; geiser.rkt -- entry point - -;; 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 -;; have received a copy of the license along with this program. If -;; not, see . - -;; Start date: Sat Apr 25, 2009 22:36 - -;;; Code: - -(require version/utils) -(unless (version<=? "5.0" (version)) - (error 'geiser - "Racket version 5.0 or better required (found ~a)" - (version))) - -(require errortrace) -(require geiser/user) - -(init-geiser-repl) diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt index e9c6a07..54cac24 100644 --- a/scheme/racket/geiser/autodoc.rkt +++ b/scheme/racket/geiser/autodoc.rkt @@ -229,5 +229,6 @@ (module-compiled-exports (get-module-code (resolve-module-path mod #f)))]) (let ([syn (map contracted (extract-ids syn))] - [reg (extract-ids reg)]) - `((syntax ,@syn) ,@(classify-ids reg))))) + [reg (extract-ids reg)] + [subm (map list (or (submodules mod) '()))]) + `((syntax ,@syn) ,@(classify-ids reg) (modules ,@subm))))) diff --git a/scheme/racket/geiser/completions.rkt b/scheme/racket/geiser/completions.rkt index 4cbc09f..0ed18d1 100644 --- a/scheme/racket/geiser/completions.rkt +++ b/scheme/racket/geiser/completions.rkt @@ -27,5 +27,3 @@ (define (module-completions prefix) (filter-prefix prefix (module-list) #f)) - -;;; completions.rkt ends here diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt index 8e85570..02fd460 100644 --- a/scheme/racket/geiser/modules.rkt +++ b/scheme/racket/geiser/modules.rkt @@ -18,7 +18,8 @@ namespace->module-path-name module-path-name->name module-spec->path-name - module-list) + module-list + submodules) (require srfi/13 geiser/enter) @@ -71,8 +72,8 @@ [lens (map prefix-len cpaths)] [real-path (substring path (apply max lens))]) (if (absolute-path? real-path) - (call-with-values (lambda () (split-path path)) - (lambda (_ basename __) (path->string basename))) + (let-values ([(_ base __) (split-path path)]) + (path->string base)) (regexp-replace "\\.[^./]*$" real-path "")))] ;; [(eq? path '#%kernel) "(kernel)"] [(string? path) path] @@ -98,37 +99,75 @@ [len (- (string-length path) (bytes-length ext) 1)]) (substring path 0 len))))) -(define (visit-module-path path kind acc) +(define main-rkt (build-path "main.rkt")) +(define main-ss (build-path "main.ss")) + +(define ((visit-module-path reg?) path kind acc) (define (register e p) - (register-path (string->symbol e) (build-path (current-directory) p)) - (cons e acc)) - (define (find-main ext) - (let ([m (build-path path (string-append "main." ext))]) - (and (file-exists? m) m))) + (when reg? + (register-path (string->symbol e) (build-path (current-directory) p))) + (values (cons e acc) reg?)) + (define (get-main path main) + (and (file-exists? main) (build-path path main))) + (define (find-main path) + (parameterize ([current-directory path]) + (or (get-main path main-rkt) (get-main path main-ss)))) (case kind [(file) (let ([entry (path->entry path)]) (if (not entry) acc (register entry path)))] [(dir) (cond [(skippable-dir? path) (values acc #f)] - [(or (find-main "rkt") (find-main "ss")) => - (curry register (path->string path))] - [else acc])] + [(find-main path) => (curry register (path->string path))] + [else (values acc reg?)])] [else acc])) -(define (find-modules path acc) +(define ((find-modules reg?) path acc) (if (directory-exists? path) (parameterize ([current-directory path]) - (fold-files visit-module-path acc)) + (fold-files (visit-module-path reg?) acc)) acc)) +(define (take-while pred lst) + (let loop ([lst lst] [acc '()]) + (cond [(null? lst) (reverse acc)] + [(pred (car lst)) (loop (cdr lst) (cons (car lst) acc))] + [else (reverse acc)]))) + +(define (submodules mod) + (let* ([mod-name (if (symbol? mod) mod (get-mod mod))] + [mod-str (and (symbol? mod-name) (symbol->string mod-name))]) + (if mod-str + (let ([ms (member mod-str (module-list))]) + (and ms + (take-while (lambda (m) (string-prefix? mod-str m)) + (cdr ms)))) + (find-submodules mod)))) + +(define (find-submodules path) + (and (path-string? path) + (let-values ([(dir base ign) (split-path path)]) + (and (or (equal? base main-rkt) + (equal? base main-ss)) + (map (lambda (m) (path->string (build-path dir m))) + (remove "main" ((find-modules #f) dir '()))))))) + (define (known-modules) - (sort (foldl find-modules '() (current-library-collection-paths)) string. + +;; Start date: Sat Apr 25, 2009 22:36 + +;;; Code: + +(require version/utils) +(unless (version<=? "5.0" (version)) + (error 'geiser + "Racket version 5.0 or better required (found ~a)" + (version))) + +(require errortrace) +(require geiser/user) + +(init-geiser-repl) diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt index 4dc13e4..70defd4 100644 --- a/scheme/racket/geiser/user.rkt +++ b/scheme/racket/geiser/user.rkt @@ -16,7 +16,7 @@ (require (for-syntax racket/base) mzlib/thread racket/tcp - geiser/main + geiser geiser/enter geiser/eval geiser/modules) @@ -38,7 +38,7 @@ (define geiser-loader (module-loader orig-loader)) (define (geiser-eval) - (define geiser-main (module->namespace 'geiser/main)) + (define geiser-main (module->namespace 'geiser)) (let* ([mod (read)] [lang (read)] [form (read)]) -- cgit v1.2.3