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

gtk, cocoa: fix auto-sizing of text `message%'s

Browse Source
This commit is contained in:
Matthew Flatt 2011-04-08 14:21:19 -06:00
parent f0310df85b
commit 71df6ddc05
4 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/mred/private/mritem.rkt
View File

@ -142,9 +142,15 @@
(cond
[(symbol? s) (void)]
[(string? s)
(let-values ([(mw mh) (get-window-text-extent s orig-font #t)])
(super-min-width (+ dx mw))
(super-min-height (+ dy mh)))]
(let ([m (mred->wx this)])
(if (send m set-preferred-size)
(let ([w (box 0)] [h (box 0)])
(send m get-size w h)
(super-min-width (unbox w))
(super-min-height (unbox h)))
(let-values ([(mw mh) (get-window-text-extent s orig-font #t)])
(super-min-width (+ dx mw))
(super-min-height (+ dy mh)))))]
[(s . is-a? . wx:bitmap%)
(super-min-width (+ dx (send s get-width)))
(super-min-height (+ dy (send s get-height)))])))])

4
collects/mred/private/wx/cocoa/message.rkt
View File

@ -119,5 +119,9 @@
(define/override (gets-focus?) #f)
(define/public (set-preferred-size)
(tellv (get-cocoa) sizeToFit)
#t)
(def/public-unimplemented get-font))

8
collects/mred/private/wx/gtk/message.rkt
View File

@ -6,7 +6,8 @@
"item.rkt"
"utils.rkt"
"types.rkt"
"pixbuf.rkt")
"pixbuf.rkt"
"window.rkt")
(provide
(protect-out message%
@ -83,4 +84,9 @@
(gtk_image_set_from_pixbuf (get-gtk) pixbuf)
(release-pixbuf pixbuf)))]))
(define/public (set-preferred-size)
(gtk_widget_set_size_request (get-gtk) -1 -1)
(set-auto-size)
#t)
(def/public-unimplemented get-font))

2
collects/mred/private/wx/win32/message.rkt
View File

@ -116,5 +116,7 @@
(set-size -11111 -11111 32 32)
(auto-size font label 0 0 0 0))
(define/public (set-preferred-size) #f)
(define/override (get-setimage-message)
STM_SETIMAGE)))