From 3fa1b480295f4022edc389a890134c6621f2aaf8 Mon Sep 17 00:00:00 2001
From: Mike MacHenry <dskippy@ccs.neu.edu>
Date: Thu, 12 Aug 2004 19:01:10 +0000
Subject: [PATCH] fixed buttons and realy resized error is hacked to be caught

original commit: 07182c63afd0a5642972c0912dac4ecca1a6a12a
---
 collects/embedded-gui/private/button-snip.ss  | 47 +++++++++++++------
 .../private/really-resized-pasteboard.ss      |  9 ++--
 2 files changed, 38 insertions(+), 18 deletions(-)

diff --git a/collects/embedded-gui/private/button-snip.ss b/collects/embedded-gui/private/button-snip.ss
index 667166bc..ecfd9759 100644
--- a/collects/embedded-gui/private/button-snip.ss
+++ b/collects/embedded-gui/private/button-snip.ss
@@ -1,3 +1,5 @@
+#| Rewrite these to use snip-wrapper% automatically |#
+
 (module button-snip mzscheme
   
   (require
@@ -88,20 +90,34 @@
   (define toggle-button-snip%
     (class button-snip%
       (inherit set-images)
-      (init-field images-off images-on callback-off callback-on (state 'on))
+      (init-field images-off images-on turn-off turn-on (state 'on))
+      
+      ;; Emulates clicking the button to a certain state
+      (define/public (turn astate)
+        (case astate
+          [(off) (set-state 'off)
+                 (turn-on this #f)]
+          [(on) (set-state 'on)
+                (turn-off this #f)]))
+      
+      (define/public (set-state value)
+        (case value
+          [(off) (set-images images-off)
+                 (set! state 'off)]
+          [(on) (set-images images-on)
+                (set! state 'on)]))
+      
       (super-new
-       (images (if (symbol=? state 'on) images-on images-off))
+       (images (case state
+                 [(on) images-on]
+                 [(off) images-off]))
        (callback
         (lambda (b e)
-          (if (symbol=? state 'on)
-              (begin
-                (set-images images-off)
-                (set! state 'off)
-                (callback-on b e))
-              (begin
-                (set-images images-on)
-                (set! state 'on)
-                (callback-off b e))))))))
+          ;; NOTE: I lose the event right here, but turn can't require it.
+          ;; Since it's public.
+          (case state
+            [(on) (turn 'off)]
+            [(off) (turn 'on)]))))))
   
   ;;;;;;;;;;
   ;; tests
@@ -132,17 +148,18 @@
     (define t (new text%))
     (define es (new editor-snip% (editor t)))
     (define b (new toggle-button-snip%
-                   (images1 (cons (build-path (collection-path "icons") "turn-up.gif")
+                   (images-on (cons (build-path (collection-path "icons") "turn-up.gif")
                                   (build-path (collection-path "icons") "turn-up-click.gif")))
-                   (images2 (cons (build-path (collection-path "icons") "turn-down.gif")
+                   (images-off (cons (build-path (collection-path "icons") "turn-down.gif")
                                   (build-path (collection-path "icons") "turn-down-click.gif")))
-                   (callback1
+                   (turn-on
                     (lambda (b e)
                       (send* t (erase) (insert "Up"))))
-                   (callback2
+                   (turn-off
                     (lambda (b e)
                       (send* t (erase) (insert "Down"))))))
     (send e insert es 50 0)
     (send e insert b)
     (send f show #t))
+  
 )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/really-resized-pasteboard.ss b/collects/embedded-gui/private/really-resized-pasteboard.ss
index fe7eaad0..e1788bab 100644
--- a/collects/embedded-gui/private/really-resized-pasteboard.ss
+++ b/collects/embedded-gui/private/really-resized-pasteboard.ss
@@ -40,7 +40,11 @@ get text deteleted from them, etc.
         (super-resized snip redraw-now?)
         (unless ignore-resizing?
           (let ([size (snip-size snip)])
-            (unless (equal? size (hash-table-get snip-cache snip))
+            ;; The snip is getting remove from hash table in  a way I
+            ;; am not antisipating. I need to find it and then I can
+            ;; remove this error catcher.
+            (unless (equal? size (with-handlers ([exn? (lambda x 0)])
+                                   (hash-table-get snip-cache snip)))
               (hash-table-put! snip-cache snip size)
               (really-resized snip)))))
       
@@ -76,8 +80,7 @@ get text deteleted from them, etc.
           (cons (- (unbox right) (unbox left))
                 (- (unbox bottom) (unbox top)))))
       
-      (super-new)
-      ))
+      (super-new)))
   
   (define really-resized-pasteboard%
     (really-resized-pasteboard-mixin