.
original commit: e6205874a768bc4437f9074b877b7f3a3ea047ae
This commit is contained in:
parent
91103c9d38
commit
224c192205
|
@ -597,6 +597,24 @@
|
||||||
(sequence
|
(sequence
|
||||||
(apply super-init mred proxy args))))
|
(apply super-init mred proxy args))))
|
||||||
|
|
||||||
|
(define active-frame #f)
|
||||||
|
|
||||||
|
(define application-file-handler (make-parameter
|
||||||
|
void
|
||||||
|
(lambda (f)
|
||||||
|
(unless (procedure-arity-includes? f 1)
|
||||||
|
(raise-syntax-error 'application-file-handler "procedure, arity 2" f))
|
||||||
|
f)))
|
||||||
|
|
||||||
|
(wx:application-file-handler (lambda (f)
|
||||||
|
(and active-frame
|
||||||
|
(let* ([e (send (wx->mred active-frame) get-eventspace)]
|
||||||
|
[p (wx:eventspace-parameterization e)])
|
||||||
|
(parameterize ([wx:current-eventspace e])
|
||||||
|
(semaphore-callback
|
||||||
|
(make-semaphore 1)
|
||||||
|
(((in-parameterization p application-file-handler)) f)))))))
|
||||||
|
|
||||||
(define (make-top-level-window-glue% %) ; implies make-window-glue%
|
(define (make-top-level-window-glue% %) ; implies make-window-glue%
|
||||||
(class (make-window-glue% %) (mred proxy . args)
|
(class (make-window-glue% %) (mred proxy . args)
|
||||||
(rename [super-on-activate on-activate])
|
(rename [super-on-activate on-activate])
|
||||||
|
@ -610,6 +628,7 @@
|
||||||
#f)
|
#f)
|
||||||
#t))]
|
#t))]
|
||||||
[on-activate (lambda (on?)
|
[on-activate (lambda (on?)
|
||||||
|
(set! active-frame this)
|
||||||
(super-on-activate on?)
|
(super-on-activate on?)
|
||||||
(send mred on-activate on?))])
|
(send mred on-activate on?))])
|
||||||
(sequence (apply super-init mred proxy args))))
|
(sequence (apply super-init mred proxy args))))
|
||||||
|
@ -2695,6 +2714,8 @@
|
||||||
|
|
||||||
(define waiting (make-semaphore 0))
|
(define waiting (make-semaphore 0))
|
||||||
|
|
||||||
|
(application-file-handler (lambda (f) (send repl-buffer print (format "ignoring file: ~a~n" f))))
|
||||||
|
|
||||||
;; Just a few key bindings:
|
;; Just a few key bindings:
|
||||||
(let* ([k (send repl-buffer get-keymap)]
|
(let* ([k (send repl-buffer get-keymap)]
|
||||||
[mouse-paste (lambda (edit event)
|
[mouse-paste (lambda (edit event)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user