yet more cocoa canvas repairs

original commit: f716ae049a730cbc9fc17c974087cce78ababcc1

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

@@ -68,6 +68,28 @@
           (CGContextStrokePath cg))
         (tellv ctx restoreGraphicsState))))
 
+(define-objc-class CornerlessFrameView NSView 
+  []
+  (-a _void (drawRect: [_NSRect r])
+      (let ([ctx (tell NSGraphicsContext currentContext)])
+        (tellv ctx saveGraphicsState)
+        (let ([cg (tell #:type _CGContextRef ctx graphicsPort)]
+              [r (tell #:type _NSRect self bounds)])
+          (CGContextSetRGBFillColor cg 0 0 0 1.0)
+          (let* ([l (NSPoint-x (NSRect-origin r))]
+                 [t (NSPoint-y (NSRect-origin r))]
+                 [b (+ t (NSSize-height (NSRect-size r)))]
+                 [r (+ l (NSSize-width (NSRect-size r)))])
+            (CGContextAddLines cg
+                               (vector
+                                (make-NSPoint r (+ t scroll-width))
+                                (make-NSPoint r b)
+                                (make-NSPoint l b)
+                                (make-NSPoint l t)
+                                (make-NSPoint (- r scroll-width) t))))
+          (CGContextStrokePath cg))
+        (tellv ctx restoreGraphicsState))))
+
 (define-cocoa NSSetFocusRingStyle (_fun _int -> _void))
 (define-cocoa NSRectFill (_fun _NSRect -> _void))
 
@@ -136,6 +158,7 @@
              get-eventspace
              make-graphics-context
              is-shown-to-root?
+             is-shown-to-before-root?
              move get-x get-y
              on-size
              register-as-child
@@ -199,7 +222,9 @@
        (tell (tell (cond
                     [is-combo? NSView]
                     [(memq 'control-border style) FocusView]
-                    [(memq 'border style) FrameView]
+                    [(memq 'border style) (if (memq 'vscroll style)
+                                              CornerlessFrameView
+                                              FrameView)]
                     [else NSView])
                    alloc) 
              initWithFrame: #:type _NSRect (make-NSRect (make-NSPoint x y)
@@ -236,19 +261,22 @@
     (define/public (get-dc) dc)
 
     (define/public (fix-dc)
-      (let ([p (tell #:type _NSPoint content-cocoa 
+      (when (dc . is-a? . dc%)
-                     convertPoint: #:type _NSPoint (make-NSPoint 0 0)
+        (if (is-shown-to-before-root?)
-                     toView: #f)]
+            (let ([p (tell #:type _NSPoint content-cocoa 
-            [xb (box 0)]
+                           convertPoint: #:type _NSPoint (make-NSPoint 0 0)
-            [yb (box 0)])
+                           toView: #f)]
-        (get-client-size xb yb)
+                  [xb (box 0)]
-        (send dc reset-bounds 
+                  [yb (box 0)])
-              (+ (NSPoint-x p) (if is-combo? 2 0))
+              (get-client-size xb yb)
-              (- (NSPoint-y p) (if is-combo? 22 0))
+              (send dc reset-bounds 
-              (max 1 (- (unbox xb) (if is-combo? 22 0)))
+                    (+ (NSPoint-x p) (if is-combo? 2 0))
-              (unbox yb)
+                    (- (NSPoint-y p) (if is-combo? 22 0))
-              (if auto-scroll? (scroll-pos h-scroller) 0)
+                    (max 1 (- (unbox xb) (if is-combo? 22 0)))
-              (if auto-scroll? (scroll-pos v-scroller) 0))))
+                    (unbox yb)
+                    (if auto-scroll? (scroll-pos h-scroller) 0)
+                    (if auto-scroll? (scroll-pos v-scroller) 0)))
+            (send dc reset-bounds  0 0 0 0 0 0))))
 
     (define/override (get-client-size xb yb)
       (super get-client-size xb yb)
@@ -267,7 +295,8 @@
 
     (define/override (show on?)
       ;; FIXME: what if we're in the middle of an on-paint?
-      (super show on?))
+      (super show on?)
+      (fix-dc))
 
     (define/private (do-set-size x y w h)
       (super set-size x y w h)

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

@@ -15,7 +15,8 @@
          CGContextSetRGBFillColor
          CGContextFillRect
          CGContextAddRect
-         CGContextStrokePath)
+         CGContextStrokePath
+         CGContextAddLines)
 
 (define _CGContextRef (_cpointer 'CGContextRef))
 (define-appserv CGContextTranslateCTM (_fun _CGContextRef _CGFloat _CGFloat -> _void))
@@ -24,6 +25,7 @@
 (define-appserv CGContextSetRGBFillColor (_fun _CGContextRef _CGFloat _CGFloat _CGFloat _CGFloat -> _void))
 (define-appserv CGContextFillRect (_fun _CGContextRef _NSRect -> _void))
 (define-appserv CGContextAddRect (_fun _CGContextRef _NSRect -> _void))
+(define-appserv CGContextAddLines (_fun _CGContextRef (v : (_vector i _NSPoint)) (_long = (vector-length v)) -> _void))
 (define-appserv CGContextStrokePath (_fun _CGContextRef -> _void))
 (define-appserv CGContextConvertPointToUserSpace (_fun  _CGContextRef _NSPoint -> _NSPoint))
 (define-appserv CGContextConvertSizeToUserSpace (_fun  _CGContextRef _NSSize -> _NSSize))

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

@@ -240,6 +240,8 @@
     (define/override (is-shown-to-root?)
       (is-shown?))
 
+    (define/override (is-shown-to-before-root?) #t)
+
     (define/override (is-parent-enabled-to-root?)
       #t)
 

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

@@ -44,6 +44,10 @@
                 (if on?
                     (cons child children)
                     (remq child children))))))
+
+    (define/override (show on?)
+      (super show on?)
+      (fix-dc))
     
     (def/public-unimplemented on-paint)
     (define/public (set-item-cursor x y) (void))

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

@@ -213,6 +213,10 @@
       (and (is-shown?)
            (send parent is-shown-to-root?)))
 
+    (define/public (is-shown-to-before-root?)
+      (and (is-shown?)
+           (send parent is-shown-to-before-root?)))
+
     (define enabled? #t)
     (define/public (is-enabled-to-root?)
       (and (is-window-enabled?) (is-parent-enabled-to-root?)))