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

streamline gtk widget repositioning

Browse Source 
original commit: 7edbdd8a5a13b826977d5531fee4e16e909d2e9e
This commit is contained in:
Matthew Flatt 2010-08-16 11:43:06 -06:00
parent e2687511b3
commit 4cc2244c0c
6 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -41,6 +41,8 @@
(define-gtk gtk_hscrollbar_new (_fun _pointer -> _GtkWidget))
(define-gtk gtk_vscrollbar_new (_fun _pointer -> _GtkWidget))
(define-gtk gtk_widget_set_double_buffered (_fun _GtkWidget _gboolean -> _void))
(define _GtkAdjustment _GtkWidget) ; no, actually a GtkObject
(define-gtk gtk_adjustment_new (_fun _double* _double* _double* _double* _double* _double* -> _GtkAdjustment))
(define-gtk gtk_adjustment_configure (_fun _GtkAdjustment _double* _double* _double* _double* _double* _double* -> _void)
@ -282,6 +284,7 @@
(GtkRequisition-height r))))
(connect-expose client-gtk)
#;(gtk_widget_set_double_buffered client-gtk #f)
(connect-key-and-mouse client-gtk)
(connect-focus client-gtk)
(gtk_widget_add_events client-gtk (bitwise-ior GDK_KEY_PRESS_MASK
@ -329,6 +332,12 @@
(set! paint-queued? #f)
(set! now-drawing? #t)
(send dc reset-backing-retained) ; clean slate
(let ([bg (get-canvas-background)])
(when bg
(let ([old-bg (send dc get-background)])
(send dc set-background bg)
(send dc clear)
(send dc set-background old-bg))))
(on-paint)
(set! now-drawing? #f)
(when refresh-after-drawing?

7
collects/mred/private/wx/gtk/frame.rkt
View File

@ -136,8 +136,9 @@
(when label
(gtk_window_set_title gtk label))
(define/public (set-child-position child-gtk x y)
(gtk_fixed_move panel-gtk child-gtk x y))
(define/override (set-child-size child-gtk x y w h)
(gtk_fixed_move panel-gtk child-gtk x y)
(gtk_widget_set_size_request child-gtk w h))
(define/public (on-close) (void))
@ -255,7 +256,7 @@
(direct-show #f))
(define/override (on-client-size w h)
(on-size w h))
(void))
(define/augment (is-enabled-to-root?) #t)

2
collects/mred/private/wx/gtk/group-panel.rkt
View File

@ -53,4 +53,4 @@
(define/override (set-child-size child-gtk x y w h)
(gtk_fixed_move client-gtk child-gtk x y)
(super set-child-size child-gtk x y w h))))
(gtk_widget_set_size_request child-gtk w h))))

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

@ -64,4 +64,4 @@
(define/override (set-child-size child-gtk x y w h)
(gtk_fixed_move gtk child-gtk x y)
(super set-child-size child-gtk x y w h))))
(gtk_widget_set_size_request child-gtk w h))))

2
collects/mred/private/wx/gtk/tab-panel.rkt
View File

@ -165,4 +165,4 @@
(define/override (set-child-size child-gtk x y w h)
(gtk_fixed_move client-gtk child-gtk x y)
(super set-child-size child-gtk x y w h))))
(gtk_widget_set_size_request child-gtk w h))))

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

@ -332,13 +332,18 @@
(gtk_widget_set_size_request child-gtk w h)
(gtk_widget_size_allocate child-gtk (make-GtkAllocation x y w h)))
(define on-size-queued? #f)
(define/public (remember-size w h)
;; called in event-pump thread
(unless (and (= save-w w)
(= save-h h))
(set! save-w w)
(set! save-h h)
(queue-window-event this (lambda () (on-size w h)))))
(unless on-size-queued?
(set! on-size-queued? #t)
(queue-window-event this (lambda ()
(set! on-size-queued? #f)
(on-size w h))))))
(define client-delta-w 0)
(define client-delta-h 0)
@ -348,7 +353,8 @@
;; Called in the Gtk event-loop thread
;(set! client-delta-w (max min-client-delta-w (- save-w w)))
;(set! client-delta-h (max min-client-delta-h (- save-h h)))
(queue-window-event this (lambda () (on-size 0 0))))
#;(queue-window-event this (lambda () (on-size 0 0)))
(void))
(define/public (tentative-client-size w h)
(void))