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

Fix the simple drracket test

Browse Source
This commit is contained in:
Eli Barzilay 2010-11-07 19:35:53 -05:00
parent d8945c0bd1
commit bc4f4e7a45
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/meta/build/test-drracket.rkt
View File

@ -45,26 +45,28 @@ exec "$PLTHOME/bin/gracket" "$0"
(with-output-to-file (find-system-path 'pref-file) #:exists 'truncate
(lambda ()
(printf "~s\n" `((plt:framework-prefs
((drscheme:last-version ,(version))
(drscheme:last-language english)))))))
((drracket:last-version ,(version))
(drracket:last-language english)))))))
;; start drscheme
(queue-callback
(lambda ()
(dynamic-require '(lib "drscheme.ss" "drscheme") #f)))
;; start drracket
(queue-callback (lambda () (dynamic-require 'drracket #f)))
;; wait for the drscheme window to appear
;; FIXME: hack a predicate for the splash window
(define (is-splash? win) (eq? 'object:splash-tlw% (object-name win)))
;; wait for the drracket window to appear
(define (window-title w) (send w get-label))
(let loop ()
(sleep 1/100)
(let ([wins (get-top-level-windows)])
(cond [(null? wins) (loop)]
[(and (regexp-match #rx"^Untitled( - DrScheme)?$"
(window-title (car wins)))
(null? (cdr wins)))
(fprintf stderr "got a good window: ~a\n"
(window-title (car wins)))]
[else (die "bad windows popped up: ~s" (map window-title wins))])))
(cond
[(null? wins) (loop)]
[(ormap is-splash? wins) (loop)] ; splash present => keep waiting
[(pair? (cdr wins))
(die "too many windows popped up: ~s" (map window-title wins))]
[(regexp-match #rx"^Untitled( - DrRacket)?$" (window-title (car wins)))
(fprintf stderr "got a good window: ~a\n" (window-title (car wins)))]
[else (die "bad window popped up: ~s" (window-title (car wins)))])))
;; handle some events
(let loop ([n 20]) (unless (zero? n) (yield) (loop (sub1 n))))