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

fix gtk widget size info for sizing and positioning

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-06 18:20:52 -06:00
parent 206c42429b
commit b020c2f858
8 changed files with 96 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -137,7 +137,8 @@
[gl-config #f])
(inherit get-gtk set-size get-size get-client-size
on-size register-as-child get-top-win)
on-size register-as-child get-top-win
set-auto-size adjust-client-delta)
(define is-combo? (memq 'combo style))
(define has-border? (or (memq 'border style)
@ -252,6 +253,9 @@
(when hscroll-adj (connect-value-changed-h hscroll-adj))
(when vscroll-adj (connect-value-changed-v vscroll-adj))
(set-auto-size)
(adjust-client-delta margin margin)
(define/override (direct-update?) #f)
(define/public (get-dc) dc)

1
collects/mred/private/wx/gtk/client-window.rkt
View File

@ -57,6 +57,7 @@
(set! client-w w)
(set! client-h h))
#;
(define/override (get-client-size xb yb)
(set-box! xb client-w)
(set-box! yb client-h))

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

@ -97,7 +97,8 @@
(inherit get-gtk set-size on-size
pre-on-char pre-on-event
get-client-delta get-size
get-parent get-eventspace)
get-parent get-eventspace
adjust-client-delta)
(define gtk (gtk_window_new GTK_WINDOW_TOPLEVEL))
(when (memq 'no-caption style)
@ -133,10 +134,15 @@
(define/public (on-close) (void))
(define/public (set-menu-bar mb)
(send mb set-top-window this)
(let ([mb-gtk (send mb get-gtk)])
(gtk_box_pack_start vbox-gtk mb-gtk #t #t 0)
(gtk_widget_show mb-gtk)))
(gtk_widget_show mb-gtk))
(let ([h (send mb set-top-window this)])
;; adjust client delta right away, so that we make
;; better assumptions about the client size and more
;; quickly converge to the right size of the frame
;; based on its content
(adjust-client-delta 0 h)))
(define saved-enforcements (vector 0 0 -1 -1))

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

@ -17,6 +17,7 @@
(define-gtk gtk_fixed_move (_fun _GtkWidget _GtkWidget _int _int -> _void))
(define-gtk gtk_frame_set_label (_fun _GtkWidget _string -> _void))
(define-gtk gtk_frame_get_label_widget (_fun _GtkWidget -> _GtkWidget))
(define group-panel%
(class (client-size-mixin (panel-mixin window%))
@ -25,7 +26,8 @@
style
label)
(inherit set-size set-auto-size get-gtk get-height)
(inherit set-size set-auto-size infer-client-delta
get-gtk get-height)
(define gtk (gtk_frame_new label))
(define client-gtk (gtk_fixed_new))
@ -38,17 +40,9 @@
[extra-gtks (list client-gtk)]
[no-show? (memq 'deleted style)])
(infer-client-delta #t #t (gtk_frame_get_label_widget gtk))
(set-auto-size)
;; The delta between the group box height and its
;; client height can go bad if the label is set.
;; Avoid the problem by effectively using the
;; original delta.
(define orig-h (get-height))
(define/override (get-client-size xb yb)
(super get-client-size xb yb)
(set-box! yb (- (get-height) orig-h)))
(define/public (set-label s)
(gtk_frame_set_label gtk s))

18
collects/mred/private/wx/gtk/menu-bar.rkt
View File

@ -5,6 +5,7 @@
"../common/freeze.rkt"
"../common/queue.rkt"
"widget.rkt"
"window.rkt"
"utils.rkt"
"types.rkt")
(unsafe!)
@ -22,6 +23,8 @@
(define-gtk gtk_label_set_text_with_mnemonic (_fun _GtkWidget _string -> _void))
(define-gtk gtk_bin_get_child (_fun _GtkWidget -> _GtkWidget))
(define-gtk gtk_widget_set_usize (_fun _GtkWidget _int _int -> _void))
(define (fixup-mneumonic title)
(regexp-replace*
"&&"
@ -76,9 +79,22 @@
(connect-menu-button-press gtk)
(define top-wx #f)
(define/public (set-top-window top)
(set! top-wx top)
(install-widget-parent top))
(install-widget-parent top)
;; return initial size; also, add a menu to make sure there is one,
;; and force the menu bar to be at least that tall always
(let ([item (gtk_menu_item_new_with_mnemonic "Xyz")])
(gtk_menu_shell_append gtk item)
(gtk_widget_show item)
(begin0
(let ([req (make-GtkRequisition 0 0)])
(gtk_widget_size_request gtk req)
(gtk_widget_set_usize gtk -1 (GtkRequisition-height req))
(GtkRequisition-height req))
(gtk_container_remove gtk item))))
(define/public (get-top-window)
top-wx)

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

@ -44,13 +44,22 @@
style
labels)
(inherit set-size set-auto-size get-gtk
reset-child-dcs)
(inherit set-size set-auto-size infer-client-delta get-gtk
reset-child-dcs get-height)
(define gtk (gtk_notebook_new))
;; Reparented so that it's always in the current page's bin:
(define client-gtk (gtk_fixed_new))
(super-new [parent parent]
[gtk gtk]
[client-gtk client-gtk]
[extra-gtks (list client-gtk)]
[no-show? (memq 'deleted style)])
; Once without tabs to set client-width delta:
(infer-client-delta #t #f)
(define empty-bin-gtk (gtk_hbox_new #f 0))
(define current-bin-gtk #f)
@ -80,14 +89,11 @@
(select-bin (page-bin-gtk (car pages)))))
(gtk_widget_show client-gtk)
(super-new [parent parent]
[gtk gtk]
[client-gtk client-gtk]
[extra-gtks (list client-gtk)]
[no-show? (memq 'deleted style)])
(connect-key-and-mouse gtk)
; With tabs to set client-width delta:
(infer-client-delta #f #t)
(set-auto-size)
(define callback void)

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

@ -76,6 +76,16 @@
(connect-focus-in gtk)
(connect-focus-out gtk))
(define-signal-handler connect-size-allocate "size-allocate"
(_fun _GtkWidget _GtkAllocation-pointer -> _gboolean)
(lambda (gtk a)
(let ([wx (gtk->wx gtk)])
(send wx save-size
(GtkAllocation-x a)
(GtkAllocation-y a)
(GtkAllocation-width a)
(GtkAllocation-height a)))
#t))
;; ----------------------------------------
(define-signal-handler connect-key-press "key-press-event"
@ -256,6 +266,8 @@
(define save-w 0)
(define save-h 0)
(connect-size-allocate gtk)
(when add-to-parent?
(gtk_container_add (send parent get-client-gtk) gtk))
@ -275,10 +287,16 @@
(unless (= y -11111) (set! save-y y))
(unless (= w -1) (set! save-w w))
(unless (= h -1) (set! save-h h))
(set! save-w (max save-w client-delta-w))
(set! save-h (max save-h client-delta-h))
(tentative-client-size (+ save-w client-delta-w)
(+ save-h client-delta-h))
(really-set-size gtk save-x save-y save-w save-h)))
(define/public (save-size x y w h)
(set! save-w w)
(set! save-h h))
(define/public (really-set-size gtk x y w h)
(send parent set-child-size gtk x y w h))
@ -296,14 +314,36 @@
(define client-delta-w 0)
(define client-delta-h 0)
(define min-client-delta-w 0)
(define min-client-delta-h 0)
(define/public (remember-client-size w h)
;; Called in the Gtk event-loop thread
(set! client-delta-w (max 0 (- save-w w)))
(set! client-delta-h (max 0 (- save-h h)))
;(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))))
(define/public (tentative-client-size w h)
(void))
(define/public (adjust-client-delta dw dh)
(set! client-delta-w dw)
(set! client-delta-h dh))
(define/public (infer-client-delta [w? #t] [h? #t] [sub-h-gtk #f])
(let ([req (make-GtkRequisition 0 0)]
[creq (make-GtkRequisition 0 0)]
[hreq (make-GtkRequisition 0 0)])
(gtk_widget_size_request gtk req)
(gtk_widget_size_request (get-client-gtk) creq)
(when sub-h-gtk
(gtk_widget_size_request sub-h-gtk hreq))
(when w?
(set! client-delta-w (- (GtkRequisition-width req)
(max (GtkRequisition-width creq)
(GtkRequisition-width hreq)))))
(when h?
(set! client-delta-h (- (GtkRequisition-height req)
(GtkRequisition-height creq))))))
(define/public (set-auto-size)
(let ([req (make-GtkRequisition 0 0)])
(gtk_widget_size_request gtk req)
@ -345,7 +385,9 @@
(set-box! xb save-w)
(set-box! yb save-h))
(define/public (get-client-size xb yb)
(get-size xb yb))
(get-size xb yb)
(set-box! xb (max 0 (- (unbox xb) client-delta-w)))
(set-box! yb (max 0 (- (unbox yb) client-delta-h))))
(define enabled? #t)
(define/pubment (is-enabled-to-root?)

2
collects/tests/gracket/draw.rkt
View File

@ -262,7 +262,7 @@
(override*
[on-paint
(case-lambda
[() (on-paint #f)]
[() (time (on-paint #f))]
[(ps?)
(let* ([can-dc (get-dc)]
[pen0s (make-object pen% "BLACK" 0 'solid)]