From 4723df4a890372da1a072e03c60f368a021bbbb0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 25 Nov 2010 08:02:33 -0700 Subject: [PATCH] fix some racket/gui tests and fix cocoa frame centering original commit: 347869fc9e90560493f39654afd7037be7dac690 --- collects/mred/private/wx/cocoa/frame.rkt | 12 +++++------ collects/tests/gracket/windowing.rktl | 27 ++++++++++-------------- 2 files changed, 17 insertions(+), 22 deletions(-) diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 79e5c6a3..81972157 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -451,15 +451,15 @@ #:type _NSRect (make-NSRect (make-NSPoint (if (or (eq? dir 'both) (eq? dir 'horizontal)) - (/ (- (NSSize-width (NSRect-size s)) - (NSSize-width (NSRect-size f))) - 2) + (quotient (- (NSSize-width (NSRect-size s)) + (NSSize-width (NSRect-size f))) + 2) (NSPoint-x (NSRect-origin f))) (if (or (eq? dir 'both) (eq? dir 'vertical)) - (/ (- (NSSize-height (NSRect-size s)) - (NSSize-height (NSRect-size f))) - 2) + (quotient (- (NSSize-height (NSRect-size s)) + (NSSize-height (NSRect-size f))) + 2) (NSPoint-x (NSRect-origin f)))) (NSRect-size f)) display: #:type _BOOL #t))) diff --git a/collects/tests/gracket/windowing.rktl b/collects/tests/gracket/windowing.rktl index 52f0f245..34e479a4 100644 --- a/collects/tests/gracket/windowing.rktl +++ b/collects/tests/gracket/windowing.rktl @@ -66,7 +66,7 @@ (test #t `(client-size ,f ,cw ,ch ,w ,h) (and (<= 1 cw w) (<= 1 ch h)))) (stv f refresh)) -(define (area-tests f sw? sh? no-stretch?) +(define (area-tests f sw? sh? no-stretch? use-client-size?) (printf "Area ~a\n" f) (let ([x (send f min-width)] [y (send f min-height)]) @@ -75,7 +75,9 @@ (stv (send f get-top-level-window) reflow-container) (pause) ; to make sure size has taken effect (let-values ([(w h) (if no-stretch? - (send f get-size) + (if use-client-size? + (send f get-client-size) + (send f get-size)) (values 0 0))]) (printf "Size ~a x ~a\n" w h) (when no-stretch? @@ -95,7 +97,7 @@ (stv f min-height y))) (define (containee-tests f sw? sh? m) - (area-tests f sw? sh? #f) + (area-tests f sw? sh? #f #f) (printf "Containee ~a\n" f) (st m f horiz-margin) (st m f vert-margin) @@ -166,7 +168,7 @@ (st my-l b get-plain-label) (stv b set-label &-l))) -(let ([f (make-object frame% "Yes & No" #f 150 151 20 21)]) +(let ([f (make-object frame% "Yes & No" #f 150 151 70 21)]) (let ([init-tests (lambda (hidden?) (st "Yes & No" f get-label) @@ -177,15 +179,8 @@ (stv f set-label "Yes & No") (st #f f get-parent) (st f f get-top-level-window) - (case (system-type 'os) - [(unix) - (st 21 f get-x) - (if hidden? - (st 43 f get-y) - (st 22 f get-y))] - [else - (st 20 f get-x) - (st 21 f get-y)]) + (st 70 f get-x) + (st 21 f get-y) (st 150 f get-width) (st 151 f get-height) (stvals (list (send f get-width) (send f get-height)) f get-size) @@ -218,7 +213,7 @@ [container-tests (lambda () (printf "Container\n") - (area-tests f #t #t #t) + (area-tests f #t #t #t #t) (let-values ([(x y) (send f container-size null)]) (st x f min-width) (st y f min-height)) @@ -263,7 +258,7 @@ (stv f iconize #t) (pause) (pause) - (st #t f is-iconized?) ; NB: test will fail on MacOS + (st #t f is-iconized?) (stv f show #t) (pause) (st #f f is-iconized?) @@ -1010,7 +1005,7 @@ (test-controls panel frame) (if win? ((if % containee-window-tests window-tests) panel #t #t (and % frame) frame 0) - (area-tests panel #t #t #f)) + (area-tests panel #t #t #f #f)) (when (is-a? panel panel%) (st #t panel get-orientation (is-a? panel horizontal-panel%))) (container-tests panel win?)