suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

...

Browse Source 
original commit: daf3484a29aba903a2e23762374c1b712fbe8709
This commit is contained in:
Robby Findler 2001-04-17 01:57:07 +00:00
parent 9006b972fa
commit 52b007f6a0
1 changed files with 44 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/mred/mred.ss
View File

@ -1,3 +1,4 @@
(module mred mzscheme (module mred mzscheme
(require (prefix wx: (lib "kernel.ss" "mred" "private"))) (require (prefix wx: (lib "kernel.ss" "mred" "private")))
(require (lib "class.ss") (require (lib "class.ss")
@ -4646,7 +4647,8 @@
(let ([mred-name ((current-module-name-resolver) '(lib "mred.ss" "mred") #f #f)] (let ([mred-name ((current-module-name-resolver) '(lib "mred.ss" "mred") #f #f)]
[orig-namespace (current-namespace)]) [orig-namespace (current-namespace)])
(parameterize ([current-namespace user-namespace]) (parameterize ([current-namespace user-namespace])
(namespace-attach-module orig-namespace mred-name))) (namespace-attach-module orig-namespace mred-name)
(namespace-require '(lib "mred.ss" "mred"))))
(unless user-esp (unless user-esp
(parameterize ((wx:current-eventspace user-eventspace)) (parameterize ((wx:current-eventspace user-eventspace))
@ -4665,7 +4667,7 @@
(wx:queue-callback (wx:queue-callback
(lambda () (lambda ()
(dynamic-wind (dynamic-wind
void (lambda () (send execute-button enable #f))
(lambda () (lambda ()
(call-with-values (call-with-values
(lambda () (eval (read (open-input-string expr-str)))) (lambda () (eval (read (open-input-string expr-str))))
@ -4677,10 +4679,42 @@
(newline))) (newline)))
results)))) results))))
(lambda () (lambda ()
(queue-output (lambda () (send repl-buffer new-prompt))))))))) (queue-output (lambda () (send repl-buffer new-prompt)))
(send execute-button enable #t)))))))
(define waiting (make-semaphore 0)) (define waiting (make-semaphore 0))
(define execute-menu-item 'execute-menu-item-not-yet-set)
(define execute-filename #f)
(define (update-execute-label)
(when execute-button
(let ([label (if execute-filename
(format "Execute ~a" execute-filename)
"Execute File...")])
(send execute-button set-label label)
(send execute-menu-item set-label label))))
(define (do-execute)
(unless execute-filename
(set! execute-filename (get-file #f frame))
(when execute-filename
(update-execute-label)))
(when execute-filename
(do-reset)
(send execute-button enable #f)
(evaluate (format "(load ~s)" execute-filename))))
(define (do-reset)
(custodian-shutdown-all user-custodian)
(user-space-init)
(send repl-buffer reset)
(send execute-button enable #t))
(define (do-kill)
(custodian-shutdown-all user-custodian)
(send repl-buffer kill-repl))
(send execute-panel stretchable-height #f)
(when execute-button
(send execute-button stretchable-width #t))
(define execute-menu-item 'execute-menu-item-not-yet-set) (define execute-menu-item 'execute-menu-item-not-yet-set)
(define execute-filename #f) (define execute-filename #f)
(define (update-execute-label) (define (update-execute-label)
@ -4712,12 +4746,13 @@
(let ([mb (make-object menu-bar% frame)]) (let ([mb (make-object menu-bar% frame)])
(let ([m (make-object menu% "&File" mb)]) (let ([m (make-object menu% "&File" mb)])
(make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file #f frame)]) (and f (evaluate (format "(load ~s)" f)))))) (make-object menu-item% "Load File..." m
(lambda (i e) (let ([f (get-file #f frame)]) (and f (evaluate (format "(load ~s)" f))))))
(make-object menu-item% (make-object menu-item%
(if (eq? (system-type) 'windows) (if (eq? (system-type) 'windows)
"E&xit" "E&xit"
"&Quit") "&Quit")
m (lambda (i e) (send frame on-close) (send frame show #f)) #\q)) m (lambda (i e) (send frame on-close) (send frame show #f)) #\q))
(let ([m (make-object menu% "&Edit" mb)]) (let ([m (make-object menu% "&Edit" mb)])
(append-editor-operation-menu-items m #f)) (append-editor-operation-menu-items m #f))
(unless user-esp (unless user-esp