avoid doing mac os x-specific tests unless under mac os x
svn: r18154 original commit: 8424dea37b9cf83dce52b07dd8eeb4c3a15c0495
This commit is contained in:
commit
075f36f524
|
@ -5,14 +5,14 @@
|
|||
(let ([basics (list "Bring Frame to Front..." "Most Recent Window"
|
||||
#f)])
|
||||
(if (eq? (system-type) 'macosx)
|
||||
(list* "Minimize" "Zoom" basics)
|
||||
basics)))
|
||||
(list* "Minimize" "Zoom" basics)
|
||||
basics)))
|
||||
(send-sexp-to-mred
|
||||
'(define-syntax car*
|
||||
(syntax-rules ()
|
||||
[(car* x) (if (pair? x)
|
||||
(car x)
|
||||
(error 'car* "got a non-pair for ~s" 'x))])))
|
||||
(car x)
|
||||
(error 'car* "got a non-pair for ~s" 'x))])))
|
||||
|
||||
;; this test uses a new eventspace so that the mred function
|
||||
;; current-eventspace-has-standard-menus? returns #f and thus
|
||||
|
@ -54,7 +54,7 @@
|
|||
(send-sexp-to-mred
|
||||
`(begin0 (map (lambda (x) (send x get-label))
|
||||
(send (group:get-the-frame-group) get-frames))
|
||||
(send (get-top-level-focus-window) close)))))
|
||||
(send (get-top-level-focus-window) close)))))
|
||||
|
||||
(test
|
||||
'two-frames-registered
|
||||
|
@ -94,89 +94,92 @@
|
|||
frames)
|
||||
(map (lambda (x) (send x get-label)) frames)))))
|
||||
|
||||
(test
|
||||
'windows-menu
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "first" "test"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "test")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "test")
|
||||
(send-sexp-to-mred
|
||||
'(begin0 (map (lambda (x)
|
||||
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send (car* (send (send (get-top-level-focus-window)
|
||||
get-menu-bar)
|
||||
get-items))
|
||||
get-items))
|
||||
(send (get-top-level-focus-window) close)))))
|
||||
|
||||
(test
|
||||
'windows-menu-unshown
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "first" "test"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame1 (make-object frame:basic% "test")]
|
||||
[frame2 (make-object frame:basic% "test-not-shown")])
|
||||
(send frame1 show #t)))
|
||||
(wait-for-frame "test")
|
||||
(send-sexp-to-mred
|
||||
'(begin0 (map (lambda (x)
|
||||
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send (car* (send (send (get-top-level-focus-window)
|
||||
get-menu-bar)
|
||||
get-items))
|
||||
get-items))
|
||||
(send (get-top-level-focus-window) close)))))
|
||||
|
||||
(test
|
||||
'windows-menu-sorted1
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "aaa")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "aaa")
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "bbb")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "bbb")
|
||||
(send-sexp-to-mred
|
||||
`(let ([frames (send (group:get-the-frame-group) get-frames)])
|
||||
(begin0 (map (lambda (x)
|
||||
(when (eq? (system-type) 'macosx)
|
||||
|
||||
(test
|
||||
'windows-menu
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "first" "test"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "test")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "test")
|
||||
(send-sexp-to-mred
|
||||
'(begin0 (map (lambda (x)
|
||||
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send (car* (send (send (car* frames) get-menu-bar)
|
||||
(send (car* (send (send (get-top-level-focus-window)
|
||||
get-menu-bar)
|
||||
get-items))
|
||||
get-items))
|
||||
(for-each (lambda (x)
|
||||
(unless (equal? (send x get-label) "first")
|
||||
(send x close)))
|
||||
frames))))))
|
||||
|
||||
(test
|
||||
'windows-menu-sorted2
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "bbb")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "bbb")
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "aaa")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "aaa")
|
||||
(send-sexp-to-mred
|
||||
`(let ([frames (send (group:get-the-frame-group) get-frames)])
|
||||
(begin0 (map (lambda (x)
|
||||
(send (get-top-level-focus-window) close)))))
|
||||
|
||||
(test
|
||||
'windows-menu-unshown
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "first" "test"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame1 (make-object frame:basic% "test")]
|
||||
[frame2 (make-object frame:basic% "test-not-shown")])
|
||||
(send frame1 show #t)))
|
||||
(wait-for-frame "test")
|
||||
(send-sexp-to-mred
|
||||
'(begin0 (map (lambda (x)
|
||||
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send (car* (send (send (car* frames) get-menu-bar)
|
||||
(send (car* (send (send (get-top-level-focus-window)
|
||||
get-menu-bar)
|
||||
get-items))
|
||||
get-items))
|
||||
(for-each (lambda (x)
|
||||
(unless (equal? (send x get-label) "first")
|
||||
(send x close)))
|
||||
frames))))))
|
||||
(send (get-top-level-focus-window) close)))))
|
||||
|
||||
(test
|
||||
'windows-menu-sorted1
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "aaa")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "aaa")
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "bbb")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "bbb")
|
||||
(send-sexp-to-mred
|
||||
`(let ([frames (send (group:get-the-frame-group) get-frames)])
|
||||
(begin0 (map (lambda (x)
|
||||
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send (car* (send (send (car* frames) get-menu-bar)
|
||||
get-items))
|
||||
get-items))
|
||||
(for-each (lambda (x)
|
||||
(unless (equal? (send x get-label) "first")
|
||||
(send x close)))
|
||||
frames))))))
|
||||
|
||||
(test
|
||||
'windows-menu-sorted2
|
||||
(lambda (x)
|
||||
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
|
||||
(lambda ()
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "bbb")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "bbb")
|
||||
(send-sexp-to-mred
|
||||
'(let ([frame (make-object frame:basic% "aaa")])
|
||||
(send frame show #t)))
|
||||
(wait-for-frame "aaa")
|
||||
(send-sexp-to-mred
|
||||
`(let ([frames (send (group:get-the-frame-group) get-frames)])
|
||||
(begin0 (map (lambda (x)
|
||||
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send (car* (send (send (car* frames) get-menu-bar)
|
||||
get-items))
|
||||
get-items))
|
||||
(for-each (lambda (x)
|
||||
(unless (equal? (send x get-label) "first")
|
||||
(send x close)))
|
||||
frames))))))
|
||||
)
|
Loading…
Reference in New Issue
Block a user