66660791da
(possibly changing on drdr!) preferences file and add a little more to help debug keys.rkt failures
52 lines
1.7 KiB
Racket
52 lines
1.7 KiB
Racket
#lang racket/base
|
|
(require framework/private/focus-table
|
|
framework/preferences
|
|
racket/gui/base
|
|
racket/class
|
|
(for-syntax racket/base))
|
|
|
|
(provide wait-for-frame wait-for/here
|
|
with-private-prefs)
|
|
|
|
(define (wait-for/here test)
|
|
(define timeout 10)
|
|
(define pause-time 1/2)
|
|
(let loop ([n (ceiling (/ timeout pause-time))])
|
|
(if (zero? n)
|
|
(error 'wait-for "after ~a seconds, ~s didn't come true" timeout test)
|
|
(unless (test)
|
|
(sleep pause-time)
|
|
(loop (- n 1))))))
|
|
|
|
(define (wait-for-frame name [eventspace (current-eventspace)])
|
|
(define (check-for-frame)
|
|
(for/or ([frame (in-list (frame:lookup-focus-table eventspace))])
|
|
(and (equal? name (send frame get-label))
|
|
frame)))
|
|
(wait-for/here
|
|
(procedure-rename check-for-frame
|
|
(string->symbol (format "check-for-frame-named-\"~a\"" name)))))
|
|
|
|
(define-syntax (with-private-prefs stx)
|
|
(syntax-case stx ()
|
|
[(_ e1 e2 ...)
|
|
#'(with-private-prefs/proc (λ () e1 e2 ...))]))
|
|
|
|
(define (with-private-prefs/proc t)
|
|
(define pref-ht (make-hash))
|
|
(parameterize ([preferences:low-level-get-preference
|
|
(λ (sym [fail (λ () #f)])
|
|
(hash-ref pref-ht sym fail))]
|
|
[preferences:low-level-put-preferences
|
|
(λ (syms vals)
|
|
(for ([sym (in-list syms)]
|
|
[val (in-list vals)])
|
|
(hash-set! pref-ht sym val)))])
|
|
|
|
;; make sure we're back to a clean preferences state
|
|
;; and the parameterize above ensure that we won't
|
|
;; look at the disk so together this should mean
|
|
;; no interference between different concurrent tests
|
|
(preferences:restore-defaults)
|
|
(t)))
|