From ca0ee2dd5377b7bc0df635c4e03fe18c0b58a4a0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 8 Apr 2011 14:21:19 -0600
Subject: [PATCH] gtk, cocoa: fix auto-sizing of text `message%'s

original commit: 71df6ddc051414540ff4e80503b5b4f7aec78ee9
---
 collects/mred/private/mritem.rkt           | 12 +++++++++---
 collects/mred/private/wx/cocoa/message.rkt |  4 ++++
 collects/mred/private/wx/gtk/message.rkt   |  8 +++++++-
 collects/mred/private/wx/win32/message.rkt |  2 ++
 4 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/collects/mred/private/mritem.rkt b/collects/mred/private/mritem.rkt
index b44cd34b..bff01dba 100644
--- a/collects/mred/private/mritem.rkt
+++ b/collects/mred/private/mritem.rkt
@@ -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)))])))])
diff --git a/collects/mred/private/wx/cocoa/message.rkt b/collects/mred/private/wx/cocoa/message.rkt
index 79b865e8..212b043e 100644
--- a/collects/mred/private/wx/cocoa/message.rkt
+++ b/collects/mred/private/wx/cocoa/message.rkt
@@ -119,5 +119,9 @@
 
   (define/override (gets-focus?) #f)
 
+  (define/public (set-preferred-size)
+    (tellv (get-cocoa) sizeToFit)
+    #t)
+
   (def/public-unimplemented get-font))
 
diff --git a/collects/mred/private/wx/gtk/message.rkt b/collects/mred/private/wx/gtk/message.rkt
index 545f8a78..c1167350 100644
--- a/collects/mred/private/wx/gtk/message.rkt
+++ b/collects/mred/private/wx/gtk/message.rkt
@@ -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))
diff --git a/collects/mred/private/wx/win32/message.rkt b/collects/mred/private/wx/win32/message.rkt
index e4f6fdce..3403c676 100644
--- a/collects/mred/private/wx/win32/message.rkt
+++ b/collects/mred/private/wx/win32/message.rkt
@@ -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)))