blob: 5d3ab3275a82defbfa76753202cc955c71b790c0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
;;; user.rkt -- global bindings visible to geiser users
;; Copyright (C) 2010, 2011, 2012 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 <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
;; Start date: Wed Mar 31, 2010 22:24
#lang racket/base
(provide init-geiser-repl run-geiser-server start-geiser)
(require (for-syntax racket/base)
file/convertible
mzlib/thread
racket/file
racket/pretty
racket/tcp
geiser
geiser/enter
geiser/eval
geiser/modules)
(define top-namespace (current-namespace))
(define last-entered (make-parameter ""))
(define (do-enter mod name)
(enter-module mod)
(current-namespace (module->namespace mod))
(last-entered name))
(define (enter! mod stx)
(cond [(not mod)
(current-namespace top-namespace)
(last-entered "")]
[(symbol? mod) (do-enter mod (symbol->string mod))]
[(and (list? mod)
(= 2 (length mod))
(eq? 'file (car mod))
(path-string? (cadr mod))) (do-enter mod (cadr mod))]
[(path-string? mod) (do-enter `(file ,mod) mod)]
[else (raise-syntax-error
#f
"not a valid module path, and not #f"
stx
mod)]))
(define orig-loader (current-load/use-compiled))
(define geiser-loader (module-loader orig-loader))
(define (geiser-eval)
(define geiser-main (module->namespace 'geiser))
(define (eval-here form) (eval form geiser-main))
(let* ([mod (read)]
[lang (read)]
[form (read)])
(datum->syntax #f
(list 'quote
(cond [(equal? form '(unquote apply))
(let* ([proc (eval-here (read))]
[args (map eval-here (read))]
[ev (lambda () (apply proc args))])
(eval-in `(,ev) mod lang))]
[else ((geiser:eval lang) form mod)])))))
(define ((geiser-read prompt))
(prompt)
(flush-output)
(let* ([in ((current-get-interaction-input-port))]
[form ((current-read-interaction) (object-name in) in)])
(syntax-case form ()
[(uq cmd) (eq? 'unquote (syntax-e #'uq))
(case (syntax-e #'cmd)
[(start-geiser) (datum->syntax #f `(list 'port ,(start-geiser)))]
[(enter) (enter! (read) #'cmd)]
[(geiser-eval) (geiser-eval)]
[(geiser-no-values) (datum->syntax #f (void))]
[(add-to-load-path) (add-to-load-path (read))]
[(set-image-cache) (image-cache (read))]
[(image-cache) (image-cache)]
[(gcd) (current-directory)]
[(cd) (current-directory (read))]
[else form])]
[_ form])))
(define geiser-prompt
(lambda ()
(printf "racket@~a> "
(namespace->module-name (current-namespace) (last-entered)))))
(define image-cache
(let ([ensure-dir (lambda (dir)
(and (path-string? dir)
(begin (make-directory* dir) dir)))])
(make-parameter #f ensure-dir)))
(define (geiser-prompt-read prompt)
(make-repl-reader (geiser-read prompt)))
(define (geiser-save-tmpimage imgbytes)
;; Save imgbytes to a new temporary file and return the filename
(define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache)))
(with-output-to-file filename #:exists 'truncate
(lambda () (display imgbytes)))
filename)
(define (geiser-maybe-print-image value)
(cond
[(and (convertible? value)
(convert value 'png-bytes))
=> (lambda (pngbytes)
;; (The above could be problematic if a future version of racket
;; suddenly decides it can "convert" strings to picts)
(printf "#<Image: ~a>\n" (geiser-save-tmpimage pngbytes)))]
[else
(unless (void? value)
(pretty-print value))]))
(define (init-geiser-repl)
(compile-enforce-module-constants #f)
(current-load/use-compiled geiser-loader)
(current-prompt-read (geiser-prompt-read geiser-prompt))
(current-print geiser-maybe-print-image))
(define (run-geiser-repl in out enforce-module-constants)
(parameterize [(compile-enforce-module-constants enforce-module-constants)
(current-input-port in)
(current-output-port out)
(current-error-port out)
(current-load/use-compiled geiser-loader)
(current-prompt-read (geiser-prompt-read geiser-prompt))
(current-print geiser-maybe-print-image)]
(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))
|
