diff options
Diffstat (limited to 'scheme/racket/geiser')
| -rw-r--r-- | scheme/racket/geiser/server.rkt | 12 | ||||
| -rw-r--r-- | scheme/racket/geiser/user.rkt | 67 | 
2 files changed, 49 insertions, 30 deletions
| diff --git a/scheme/racket/geiser/server.rkt b/scheme/racket/geiser/server.rkt index cf86b2c..10b15a1 100644 --- a/scheme/racket/geiser/server.rkt +++ b/scheme/racket/geiser/server.rkt @@ -11,14 +11,6 @@  #lang racket/base -(require geiser/user mzlib/thread) -(provide run-geiser-server start-geiser) +(require geiser/user) +(provide start-geiser) -(define (run-geiser-server port enforce-module-constants) -  (run-server port -              (lambda (in out) -                (run-geiser-repl in out enforce-module-constants)) -              #f)) - -(define (start-geiser (port 1969) (enforce-module-constants #f)) -  (thread (lambda () (run-geiser-server port enforce-module-constants)))) diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt index 37763b9..9d5b169 100644 --- a/scheme/racket/geiser/user.rkt +++ b/scheme/racket/geiser/user.rkt @@ -11,10 +11,15 @@  #lang racket/base -(provide init-geiser-repl run-geiser-repl enter!) +(provide init-geiser-repl run-geiser-server start-geiser)  (require (for-syntax racket/base) -	 geiser/main geiser/enter geiser/eval geiser/modules) +         mzlib/thread +         racket/tcp +         geiser/main +         geiser/enter +         geiser/eval +         geiser/modules)  (define top-namespace (current-namespace)) @@ -32,11 +37,8 @@  (define orig-loader (current-load/use-compiled))  (define geiser-loader (module-loader orig-loader)) -(define geiser-send-null (make-parameter #f)) -  (define (geiser-eval)    (define geiser-main (module->namespace 'geiser/main)) -  (geiser-send-null #t)    (let* ([mod (read)]           [lang (read)]           [form (read)]) @@ -45,32 +47,38 @@                           (cond [(equal? form '(unquote apply))                                  (let* ([proc (eval (read) geiser-main)]                                         [args (read)]) -                                  ((geiser:eval lang) `(,proc ,@args) mod))] -                               [else ((geiser:eval lang) form mod)]))))) - -(define (geiser-read) -  (if (geiser-send-null) -      (begin (geiser-send-null #f) -	     (write-char #\nul)) -      (printf "racket@~a> " (namespace->module-name (current-namespace)))) +                                  (eval-in `(,proc ,@args) mod lang))] +                               [else (eval-in form mod lang)]))))) + +(define ((geiser-read prompt)) +  (prompt)    (flush-output)    (let* ([in (current-input-port)]  	 [form ((current-read-interaction) (object-name in) in)])      (syntax-case form ()        [(uq cmd) (eq? 'unquote (syntax-e #'uq))         (case (syntax-e #'cmd) -         ((enter) (enter! (read) #'cmd)) -         ((geiser-eval) (geiser-eval)) -         ((geiser-no-values) (datum->syntax #f (void))) -         (else form))] +         [(start-geiser) (datum->syntax #f `(list 'port ,(start-geiser)))] +         [(enter) (enter! (read) #'cmd)] +         [(geiser-eval) (geiser-eval)] +         [(geiser-no-values) (datum->syntax #f (void))] +         [else form])]        [_ form]))) -(define geiser-prompt-read (make-repl-reader geiser-read)) +(define geiser-prompt +  (lambda () (printf "> "))) + +(define geiser-server-prompt +  (lambda () +    (printf "racket@~a> " (namespace->module-name (current-namespace))))) + +(define (geiser-prompt-read prompt) +  (make-repl-reader (geiser-read prompt)))  (define (init-geiser-repl)    (compile-enforce-module-constants #f)    (current-load/use-compiled geiser-loader) -  (current-prompt-read geiser-prompt-read)) +  (current-prompt-read (geiser-prompt-read geiser-prompt)))  (define (run-geiser-repl in out enforce-module-constants)    (parameterize [(compile-enforce-module-constants enforce-module-constants) @@ -78,5 +86,24 @@                   (current-output-port out)                   (current-error-port out)                   (current-load/use-compiled geiser-loader) -                 (current-prompt-read geiser-prompt-read)] +                 (current-prompt-read (geiser-prompt-read +                                       geiser-server-prompt))]      (read-eval-print-loop))) + +(define server-channel (make-channel)) + +(define (run-geiser-server port enforce-module-constants) +  (run-server port +              (lambda (in out) +                (run-geiser-repl in out enforce-module-constants)) +              #f +              void +              (lambda (p _ __) +                (let ([lsner (tcp-listen p)]) +                  (let-values ([(_ p __ ___) (tcp-addresses lsner #t)]) +                    (channel-put server-channel p) +                    lsner))))) + +(define (start-geiser (port 0) (enforce-module-constants #f)) +  (thread (lambda () (run-geiser-server port enforce-module-constants))) +  (channel-get server-channel)) | 
