racket/gui: fix access of scrollbar values for canvas without a scrollbar

original commit: 1800680c6ba0dec0f8b2f7d0495c615906b27b47

collects/mred/private/wx/cocoa/canvas.rkt

@@ -233,7 +233,8 @@
               get-size get-position
               set-focus
               client-to-screen
-              is-auto-scroll? get-virtual-width get-virtual-height
+              is-auto-scroll? is-disabled-scroll? 
+              get-virtual-width get-virtual-height
               reset-auto-scroll
               refresh-for-autoscroll
               refresh-all-children
@@ -521,25 +522,32 @@
      (define/public (set-scroll-pos which v)
        (update which scroll-pos v))
 
-     (define/private (guard-scroll skip-guard? which v)
+     (define/private (guard-scroll skip-guard? which get-v)
        (if skip-guard?
-           v
+           (get-v)
-           (if (is-auto-scroll?)
+           (if (or (if (eq? which 'vertical)
+                       (not vscroll-ok?)
+                       (not hscroll-ok?))
+                   (is-disabled-scroll?)
+                   (is-auto-scroll?))
                0
-               v)))
+               (get-v))))
 
      (define/public (get-scroll-page which [skip-guard? #f]) 
        (guard-scroll skip-guard?
                      which
-                     (scroll-page (if (eq? which 'vertical) v-scroller h-scroller))))
+                     (lambda ()
+                       (scroll-page (if (eq? which 'vertical) v-scroller h-scroller)))))
      (define/public (get-scroll-range which [skip-guard? #f])
        (guard-scroll skip-guard?
                      which
-                     (scroll-range (if (eq? which 'vertical) v-scroller h-scroller))))
+                     (lambda ()
+                       (scroll-range (if (eq? which 'vertical) v-scroller h-scroller)))))
      (define/public (get-scroll-pos which [skip-guard? #f])
        (guard-scroll skip-guard?
                      which
-                     (scroll-pos (if (eq? which 'vertical) v-scroller h-scroller))))
+                     (lambda ()
+                       (scroll-pos (if (eq? which 'vertical) v-scroller h-scroller)))))
      
      (define v-scroller
        (and vscroll-ok?

collects/mred/private/wx/common/canvas-mixin.rkt

@@ -18,11 +18,13 @@
     (inherit get-client-size
              refresh)
 
+    (define any-scroll? #f)
     (define auto-scroll? #f)
     (define virtual-height #f)
     (define virtual-width #f)
 
     (define/public (is-auto-scroll?) auto-scroll?)
+    (define/public (is-disabled-scroll?) (not any-scroll?))
     (define/public (get-virtual-height) virtual-height)
     (define/public (get-virtual-width) virtual-width)
     
@@ -31,6 +33,7 @@
                                    h-page v-page
                                    h-pos v-pos
                                    auto?)
+       (set! any-scroll? #t)
        (cond
         [auto?
          (set! auto-scroll? #t)

collects/mred/private/wx/gtk/canvas.rkt

@@ -239,7 +239,8 @@
               get-top-win
               set-auto-size 
               adjust-client-delta infer-client-delta
-              is-auto-scroll? get-virtual-width get-virtual-height
+              is-auto-scroll? is-disabled-scroll?
+              get-virtual-width get-virtual-height
               refresh-for-autoscroll refresh-all-children
               get-eventspace)
 
@@ -609,19 +610,25 @@
                           (lambda ()
                             (gtk_adjustment_set_value adj v))))))
 
+     (define/private (is-disabled-scroll-dir? which)
+       (or (if (eq? which 'vertical)
+               (not vscroll-gtk)
+               (not hscroll-gtk))
+           (is-disabled-scroll?)))
+
      (define/public (get-scroll-page which) 
-       (if (is-auto-scroll?)
+       (if (or (is-disabled-scroll-dir? which) (is-auto-scroll?))
            0
            (->long (dispatch which gtk_adjustment_get_page_size 0))))
      (define/public (get-scroll-range which)
-       (if (is-auto-scroll?)
+       (if (or (is-disabled-scroll-dir? which) (is-auto-scroll?))
            0
            (->long (dispatch which (lambda (adj)
                                      (- (gtk_adjustment_get_upper adj)
                                         (gtk_adjustment_get_page_size adj)))
                              0))))
      (define/public (get-scroll-pos which)
-       (if (is-auto-scroll?)
+       (if (or (is-disabled-scroll-dir? which) (is-auto-scroll?))
            0
            (->long (dispatch which gtk_adjustment_get_value 0))))
      

collects/mred/private/wx/win32/canvas.rkt

@@ -70,7 +70,7 @@
                                                                                   SIF_PAGE SIF_TRACKPOS)
                                                                      0 0 0 0 0))
                                     -> (r : _BOOL)
-                                    -> (if r i (error 'GetScrollInfo "failed"))))
+                                    -> (if r i (failed 'GetScrollInfo))))
 
 (define COMBO-WIDTH 18)
 
@@ -87,7 +87,8 @@
               get-client-size
               get-eventspace
               set-control-font
-              is-auto-scroll? get-virtual-width get-virtual-height
+              is-auto-scroll? is-disabled-scroll?
+              get-virtual-width get-virtual-height
               reset-auto-scroll
               refresh-for-autoscroll)
 
@@ -416,12 +417,18 @@
     (define/override (get-virtual-v-pos)
       (GetScrollPos canvas-hwnd SB_VERT))
 
+    (define/private (is-disabled-scroll-dir? which)
+      (or (if (eq? which 'vertical)
+              (not vscroll?)
+              (not hscroll?))
+          (is-disabled-scroll?)))
+
      (define/public (get-scroll-pos which)
-       (if (is-auto-scroll?)
+       (if (or (is-disabled-scroll-dir? which) (is-auto-scroll?))
            0
            (GetScrollPos canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))))
      (define/public (get-scroll-range which)
-       (if (is-auto-scroll?)
+       (if (or (is-disabled-scroll-dir? which) (is-auto-scroll?))
            0
            (get-real-scroll-range which)))
      (define/public (get-real-scroll-range which)
@@ -430,7 +437,7 @@
                (SCROLLINFO-nPage i))
             1)))
      (define/public (get-scroll-page which)
-       (if (is-auto-scroll?)
+       (if (or (is-disabled-scroll-dir? which) (is-auto-scroll?))
            0
            (let ([i (GetScrollInfo canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))])
              (SCROLLINFO-nPage i))))

collects/tests/gracket/windowing.rktl

@@ -909,8 +909,21 @@
 	(send parent delete-child t)
 	(loop (cdr styles)))))
 
-  (let ([c (make-object canvas% parent '(hscroll vscroll))])
+  (define (check-canvas-no-scroll c)
+    (st 0 c get-scroll-range 'vertical)
+    (st 0 c get-scroll-range 'horizontal)
+    (st 0 c get-scroll-page 'vertical)
+    (st 0 c get-scroll-page 'horizontal)
+    (st 0 c get-scroll-pos 'vertical)
+    (st 0 c get-scroll-pos 'horizontal))
 
+  (let ([c (make-object canvas% parent '())])
+    (check-canvas-no-scroll c)
+    (stv c init-manual-scrollbars 5 6 2 3 4 5)
+    (check-canvas-no-scroll c))
+
+  (let ([c (make-object canvas% parent '(hscroll vscroll))])
+    
     (printf "Tab Focus\n")
     (st #f c accept-tab-focus)
     (stv c accept-tab-focus #t)
@@ -918,6 +931,8 @@
     (stv c accept-tab-focus #f)
     (st #f c accept-tab-focus)
 
+    (check-canvas-no-scroll c)
+
     (stv c init-auto-scrollbars 500 606 .02 .033)
     ; (stv c set-scrollbars 100 101 5 6 2 3 10 20 #t)
     (let-values ([(w h) (send c get-virtual-size)]