From b020c2f858caf30364e633dc19894cae3d21e47e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 6 Aug 2010 18:20:52 -0600 Subject: [PATCH] fix gtk widget size info for sizing and positioning --- collects/mred/private/wx/gtk/canvas.rkt | 6 ++- .../mred/private/wx/gtk/client-window.rkt | 1 + collects/mred/private/wx/gtk/frame.rkt | 12 +++-- collects/mred/private/wx/gtk/group-panel.rkt | 14 ++---- collects/mred/private/wx/gtk/menu-bar.rkt | 18 ++++++- collects/mred/private/wx/gtk/tab-panel.rkt | 22 +++++---- collects/mred/private/wx/gtk/window.rkt | 48 +++++++++++++++++-- collects/tests/gracket/draw.rkt | 2 +- 8 files changed, 96 insertions(+), 27 deletions(-) diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 1991a0ddc3..5609d9d332 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -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) diff --git a/collects/mred/private/wx/gtk/client-window.rkt b/collects/mred/private/wx/gtk/client-window.rkt index 9fbfe58672..79b562a3f6 100644 --- a/collects/mred/private/wx/gtk/client-window.rkt +++ b/collects/mred/private/wx/gtk/client-window.rkt @@ -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)) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 8e67ae9a5b..045ae06acf 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -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)) diff --git a/collects/mred/private/wx/gtk/group-panel.rkt b/collects/mred/private/wx/gtk/group-panel.rkt index 2550a2c0df..a147a0346a 100644 --- a/collects/mred/private/wx/gtk/group-panel.rkt +++ b/collects/mred/private/wx/gtk/group-panel.rkt @@ -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)) diff --git a/collects/mred/private/wx/gtk/menu-bar.rkt b/collects/mred/private/wx/gtk/menu-bar.rkt index 20d225e519..b1afb74aee 100644 --- a/collects/mred/private/wx/gtk/menu-bar.rkt +++ b/collects/mred/private/wx/gtk/menu-bar.rkt @@ -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) diff --git a/collects/mred/private/wx/gtk/tab-panel.rkt b/collects/mred/private/wx/gtk/tab-panel.rkt index ab06e85db8..8e1bc1b603 100644 --- a/collects/mred/private/wx/gtk/tab-panel.rkt +++ b/collects/mred/private/wx/gtk/tab-panel.rkt @@ -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) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index c0f652d848..c3b726d6c0 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -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?) diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index 5bfdca0314..066da70e1e 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -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)]