suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk: fix border (when requested) for canvas% with scrollbars

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-01 07:06:39 -06:00
parent 3f11ef9b11
commit 9d5f45a9d1
3 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -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)

18
collects/mred/private/wx/gtk/panel.rkt
View File

@ -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))

4
collects/mred/private/wx/gtk/window.rkt
View File

@ -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)))