diff options
| -rw-r--r-- | elisp/geiser-racket.el | 7 | ||||
| -rw-r--r-- | scheme/Makefile.am | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/autodoc.rkt | 5 | ||||
| -rw-r--r-- | scheme/racket/geiser/completions.rkt | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/modules.rkt | 71 | ||||
| -rw-r--r-- | scheme/racket/geiser/startup.rkt (renamed from scheme/racket/geiser.rkt) | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/user.rkt | 4 |
7 files changed, 66 insertions, 27 deletions
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index ac2e1f6..616c3af 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -79,13 +79,14 @@ This executable is used by `run-gracket', and, if This function uses `geiser-racket-init-file' if it exists." (let ((init-file (and (stringp geiser-racket-init-file) (expand-file-name geiser-racket-init-file))) - (binary (geiser-racket--real-binary))) + (binary (geiser-racket--real-binary)) + (rackdir (expand-file-name "racket/" geiser-scheme-dir))) `("-i" "-q" - "-S" ,(expand-file-name "racket/" geiser-scheme-dir) + "-S" ,rackdir ,@(apply 'append (mapcar (lambda (p) (list "-S" p)) geiser-racket-collects)) ,@(and (listp binary) (cdr binary)) ,@(and init-file (file-readable-p init-file) (list "-f" init-file)) - "-f" ,(expand-file-name "racket/geiser.rkt" geiser-scheme-dir)))) + "-f" ,(expand-file-name "geiser/startup.rkt" rackdir)))) (defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*?> ") diff --git a/scheme/Makefile.am b/scheme/Makefile.am index 3c8908e..e1b6559 100644 --- a/scheme/Makefile.am +++ b/scheme/Makefile.am @@ -7,7 +7,6 @@ nobase_dist_pkgdata_DATA = \ guile/geiser/modules.scm \ guile/geiser/utils.scm \ guile/geiser/xref.scm \ - racket/geiser.rkt \ racket/geiser/autodoc.rkt \ racket/geiser/completions.rkt \ racket/geiser/enter.rkt \ @@ -16,5 +15,6 @@ nobase_dist_pkgdata_DATA = \ racket/geiser/main.rkt \ racket/geiser/modules.rkt \ racket/geiser/server.rkt \ + racket/geiser/startup.rkt \ racket/geiser/user.rkt \ racket/geiser/utils.rkt 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<?)) + (sort (foldl (find-modules #t) + '() + (current-library-collection-paths)) + string<?)) (define registered (make-hash)) +(define registered-paths (make-hash)) + +(define (get-path mod) + (hash-ref registered mod #f)) -(define (get-path mod) (hash-ref registered mod #f)) +(define (get-mod path) + (hash-ref registered-paths path #f)) (define (register-path mod path) (hash-set! registered mod path) + (hash-set! registered-paths path mod) path) (define module-cache #f) diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser/startup.rkt index 3d75157..6af06da 100644 --- a/scheme/racket/geiser.rkt +++ b/scheme/racket/geiser/startup.rkt @@ -1,4 +1,4 @@ -;;; geiser.rkt -- entry point +;;; startup.rkt -- entry point ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz 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)]) |