From e033d9edf157e015103a9652cea70c803990e3a0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 31 Oct 2010 09:38:57 -0600
Subject: [PATCH] cocoa & gtk: fix some test failures

---
 collects/mred/private/wx/cocoa/canvas.rkt   |  7 ++++---
 collects/mred/private/wx/cocoa/list-box.rkt |  7 ++++++-
 collects/mred/private/wx/gtk/canvas.rkt     | 21 ++++++++++++++++-----
 collects/mred/private/wx/win32/canvas.rkt   | 11 ++++++-----
 collects/tests/gracket/windowing.rktl       |  5 +++--
 5 files changed, 35 insertions(+), 16 deletions(-)

diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt
index ee897ce35f..4add0ce9d3 100644
--- a/collects/mred/private/wx/cocoa/canvas.rkt
+++ b/collects/mred/private/wx/cocoa/canvas.rkt
@@ -712,9 +712,10 @@
        in-menu-click?)
 
      (define/public (scroll x y)
-       (when (x . > . 0) (scroll-pos h-scroller (* x (scroll-range h-scroller))))
-       (when (y . > . 0) (scroll-pos v-scroller (* y (scroll-range v-scroller))))
-       (when (is-auto-scroll?) (refresh-for-autoscroll)))
+       (when (is-auto-scroll?) 
+         (when (x . >= . 0) (scroll-pos h-scroller (floor (* x (scroll-range h-scroller)))))
+         (when (y . >= . 0) (scroll-pos v-scroller (floor (* y (scroll-range v-scroller)))))
+         (refresh-for-autoscroll)))
 
      (define/public (warp-pointer x y) (void))
 
diff --git a/collects/mred/private/wx/cocoa/list-box.rkt b/collects/mred/private/wx/cocoa/list-box.rkt
index 72419a0eae..0c8828ba0b 100644
--- a/collects/mred/private/wx/cocoa/list-box.rkt
+++ b/collects/mred/private/wx/cocoa/list-box.rkt
@@ -116,7 +116,12 @@
     cell-font)
 
   (define/public (get-selection)
-    (tell #:type _NSInteger content-cocoa selectedRow))
+    (if allow-multi?
+        (let ([l (get-selections)])
+          (if (null? l)
+              -1
+              (car l)))
+        (tell #:type _NSInteger content-cocoa selectedRow)))
   (define/public (get-selections)
     (atomically
      (with-autorelease
diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index bbc494d031..2de985baca 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -542,11 +542,22 @@
      (define/public (on-scroll e) (void))
 
      (define/public (scroll x y)
-       (as-scroll-change
-        (lambda ()
-          (when hscroll-adj (gtk_adjustment_set_value hscroll-adj x))
-          (when vscroll-adj (gtk_adjustment_set_value vscroll-adj y))))
-       (when (is-auto-scroll?) (refresh-for-autoscroll)))
+       (when (is-auto-scroll?) 
+         (as-scroll-change
+          (lambda ()
+            (when (and hscroll-adj (>= x 0))
+              (gtk_adjustment_set_value 
+               hscroll-adj 
+               (floor
+                (* x (- (gtk_adjustment_get_upper hscroll-adj)
+                        (gtk_adjustment_get_page_size hscroll-adj))))))
+            (when (and vscroll-adj  (>= y 0))
+              (gtk_adjustment_set_value 
+               vscroll-adj
+               (floor
+                (* y (- (gtk_adjustment_get_upper vscroll-adj)
+                        (gtk_adjustment_get_page_size vscroll-adj))))))))
+         (refresh-for-autoscroll)))
 
      (define/public (warp-pointer x y) (void))
 
diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt
index 759b4c4032..b222663bff 100644
--- a/collects/mred/private/wx/win32/canvas.rkt
+++ b/collects/mred/private/wx/win32/canvas.rkt
@@ -445,11 +445,12 @@
            (ptr-equal? combo-hwnd a-hwnd)))
 
      (define/public (scroll x y)
-       (when (x . > . 0)
-         (set-scroll-pos 'horizontal (->long (* x (get-scroll-range 'horizontal)))))
-       (when (y . > . 0)
-         (set-scroll-pos 'vertical (->long (* y (get-scroll-range 'vertical)))))
-       (when (is-auto-scroll?) (refresh-for-autoscroll)))
+       (when (is-auto-scroll?) 
+         (when (x . > . 0)
+           (set-scroll-pos 'horizontal (->long (* x (get-scroll-range 'horizontal)))))
+         (when (y . > . 0)
+           (set-scroll-pos 'vertical (->long (* y (get-scroll-range 'vertical)))))
+         (refresh-for-autoscroll)))
 
      (define/public (warp-pointer x y) (void))
 
diff --git a/collects/tests/gracket/windowing.rktl b/collects/tests/gracket/windowing.rktl
index d6e2120e18..52f0f2459c 100644
--- a/collects/tests/gracket/windowing.rktl
+++ b/collects/tests/gracket/windowing.rktl
@@ -56,6 +56,7 @@
 
 (define (client->screen-tests f)
   (printf "Client<->Screen ~a\n" f)
+  (send (or (send f get-parent) f) reflow-container)
   (let-values ([(x y) (send f client->screen 0 0)])
     (stvals '(0 0) f screen->client x y))
   (let-values ([(x y) (send f screen->client 0 0)])
@@ -885,8 +886,8 @@
 	     (lambda (xpos ypos)
 	       (let-values ([(x y) (send c get-view-start)])
 		 (let ([coerce (lambda (x) (inexact->exact (floor x)))])
-		   (test (coerce (* xpos (- 500 cw))) `(canvas-view-x ,xpos ,ypos ,x ,cw) x)
-		   (test (coerce (* ypos (- 606 ch))) `(canvas-view-y ,xpos ,ypos ,y ,ch) y))))])
+		   (test (coerce (* xpos (- 500 cw))) `(canvas-view-x ,xpos ,ypos ,x ,cw ,w) x)
+		   (test (coerce (* ypos (- 606 ch))) `(canvas-view-y ,xpos ,ypos ,y ,ch , h) y))))])
 	(test 500 'canvas-virt-w-size w)
 	(test 606 'canvas-virt-h-size h)