summaryrefslogtreecommitdiff
path: root/scheme
diff options
context:
space:
mode:
Diffstat (limited to 'scheme')
-rw-r--r--scheme/racket/geiser.rkt4
-rw-r--r--scheme/racket/geiser/server.rkt12
-rw-r--r--scheme/racket/geiser/user.rkt67
3 files changed, 50 insertions, 33 deletions
diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser.rkt
index 44a2ed8..3d75157 100644
--- a/scheme/racket/geiser.rkt
+++ b/scheme/racket/geiser.rkt
@@ -18,8 +18,6 @@
(version)))
(require errortrace)
-
(require geiser/user)
-(init-geiser-repl)
-;;; geiser.rkt ends here
+(init-geiser-repl)
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))