From 9d5f45a9d1ff254b2d677801ced48026f9948fa6 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 1 Sep 2011 07:06:39 -0600
Subject: [PATCH] gtk: fix border (when requested) for canvas% with scrollbars

---
 collects/mred/private/wx/gtk/canvas.rkt |  3 ++-
 collects/mred/private/wx/gtk/panel.rkt  | 18 ++++++++++--------
 collects/mred/private/wx/gtk/window.rkt |  4 ++++
 3 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index 0091e46230..abe4cff19c 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -280,7 +280,8 @@
               (unless (eq? client-gtk container-gtk)
                 (gtk_fixed_set_has_window client-gtk #t)) ; imposes clipping
               (when has-border?
-                (gtk_container_set_border_width h margin))
+                (gtk_container_set_border_width h margin)
+                (connect-expose-border h))
               (gtk_box_pack_start h v #t #t 0)
               (gtk_box_pack_start v client-gtk #t #t 0)
               (gtk_box_pack_start h v2 #f #f 0)
diff --git a/collects/mred/private/wx/gtk/panel.rkt b/collects/mred/private/wx/gtk/panel.rkt
index 566d601b8a..8fe82e7161 100644
--- a/collects/mred/private/wx/gtk/panel.rkt
+++ b/collects/mred/private/wx/gtk/panel.rkt
@@ -35,14 +35,16 @@
            [gray #x8000])
       (when gc
         (gdk_gc_set_rgb_fg_color gc (make-GdkColor 0 gray gray gray))
-        (let ([a (widget-allocation gtk)]
-              [no-window? (not (zero? (bitwise-and (get-gtk-object-flags gtk)
-                                                   GTK_NO_WINDOW)))])
-          (gdk_draw_rectangle win gc #f
-                              (if no-window? (GtkAllocation-x a) 0)
-                              (if no-window? (GtkAllocation-y a) 0)
-                              (sub1 (GtkAllocation-width a))
-                              (sub1 (GtkAllocation-height a))))
+        (let* ([a (widget-allocation gtk)]
+               [w (sub1 (GtkAllocation-width a))]
+               [h (sub1 (GtkAllocation-height a))])
+          (let loop ([gtk gtk] [x 0] [y 0])
+            (if (not (zero? (bitwise-and (get-gtk-object-flags gtk) GTK_NO_WINDOW)))
+                ;; no window:
+                (let ([a (widget-allocation gtk)])
+                  (loop (widget-parent gtk) (+ x (GtkAllocation-x a)) (+ y (GtkAllocation-y a))))
+                ;; found window:
+                (gdk_draw_rectangle win gc #f x y w h))))
         (gdk_gc_unref gc)))
     #f))
 
diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt
index 9bbca2874f..ef2a9b2feb 100644
--- a/collects/mred/private/wx/gtk/window.rkt
+++ b/collects/mred/private/wx/gtk/window.rkt
@@ -42,6 +42,7 @@
 
               widget-window
               widget-allocation
+              widget-parent
 
               the-accelerator-group
               gtk_window_add_accel_group
@@ -105,6 +106,9 @@
 (define (widget-window gtk)
   (GtkWidgetT-window (cast gtk _GtkWidget _GtkWidgetT-pointer)))
 
+(define (widget-parent gtk)
+  (GtkWidgetT-parent (cast gtk _GtkWidget _GtkWidgetT-pointer)))
+
 (define (widget-allocation gtk)
   (GtkWidgetT-alloc (cast gtk _GtkWidget _GtkWidgetT-pointer)))