From e2b4318dfa4d479fe1f39238fbb6f2b87ad83660 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 10 Feb 2010 20:23:59 +0000
Subject: [PATCH] More precise types for typed MrEd wrappers. More precise
 types in auto-language.ss

svn: r18041

original commit: c224d2ebfc878ddb2758cdd409cacd2dbf49e891
---
 collects/typed/framework/framework.ss | 19 +++++++-------
 collects/typed/mred/mred.ss           | 38 ++++++++++++++++-----------
 collects/typed/net/mime.ss            |  7 +++--
 3 files changed, 36 insertions(+), 28 deletions(-)

diff --git a/collects/typed/framework/framework.ss b/collects/typed/framework/framework.ss
index a447016b..ab85a779 100644
--- a/collects/typed/framework/framework.ss
+++ b/collects/typed/framework/framework.ss
@@ -1,7 +1,6 @@
 #lang typed-scheme
              
-(require typed/private/utils
-         (only-in typed/mred/mred Font%))
+(require typed/private/utils typed/mred/mred)
 
 (dt Style-List% (Class () 
                        ()
@@ -25,13 +24,15 @@
                          [get-end-position (-> Number)]
                          [insert (String Number Number -> Void)])))
 
-(require/typed/provide framework/framework
-                       [preferences:set-default (Symbol Any Any -> Void)]
-                       [preferences:set (Symbol Any -> Void)]
-                       [editor:get-standard-style-list 
-                        (-> (Instance Style-List%))]
-                       [scheme:text% Scheme:Text%]
-                       [gui-utils:ok/cancel-buttons (Any (Any Any -> Any) (Any Any -> Any) -> (values Any Any))])
+(require/typed/provide 
+ framework/framework
+ [preferences:set-default (Symbol Sexp (Any -> Boolean) -> Void)]
+ [preferences:set (Symbol Sexp -> Void)]
+ [editor:get-standard-style-list 
+  (-> (Instance Style-List%))]
+ [scheme:text% Scheme:Text%]
+ [gui-utils:ok/cancel-buttons 
+  ((Instance Horizontal-Panel%) ((Instance Button%) (Instance Event%) -> Void) ((Instance Button%) (Instance Event%) -> Void) -> (values Any Any))])
 
 (require/typed/provide "prefs-contract.ss"
                        [preferences:get-drscheme:large-letters-font (-> (U #f (Pair String Number)))])
diff --git a/collects/typed/mred/mred.ss b/collects/typed/mred/mred.ss
index 60e475e4..91a19bc0 100644
--- a/collects/typed/mred/mred.ss
+++ b/collects/typed/mred/mred.ss
@@ -46,6 +46,8 @@
                        [draw-text (String Number Number -> Void)])))
 (dt Color% (Class () () ([red (-> Number)])))
 
+(dt Snip% (Class () () ()))
+
 (dt Text% (Class ()
 		 ()
 		 ([begin-edit-sequence (-> Void)]
@@ -63,20 +65,26 @@
 		  [get-text (Integer (U Integer 'eof) -> String)]
 		  [insert (String Number Number -> Void)])))
 
+(dt Button% (Class () () ()))
+(dt Event% (Class () () ()))
 
-
-(require/typed/provide mred/mred
-                       [the-font-list (Instance Font-List%)]
-                       [dialog% Dialog%]
-                       [text-field% Text-Field%]
-                       [horizontal-panel% Horizontal-Panel%]
-                       [choice% Choice%]
-                       [get-face-list (-> (Listof String))]
-                       [message% Message%]
-                       [horizontal-pane% Horizontal-Pane%]
-                       [editor-canvas% Editor-Canvas%]
-                       [bitmap-dc% Bitmap-DC%]
-                       [bitmap% Bitmap%]
-                       [color% Color%]
-		       [open-input-text-editor ((Instance Text%) Integer (U 'end Integer) (Any -> Any) Any Any -> Input-Port)])
+(require/typed/provide 
+ scheme/gui
+ [button% Button%]
+ [event% Event%]
+ [the-font-list (Instance Font-List%)] 
+ [dialog% Dialog%] 
+ [text-field% Text-Field%]
+ [horizontal-panel% Horizontal-Panel%]
+ [choice% Choice%]
+ [get-face-list (-> (Listof String))]
+ [message% Message%]
+ [horizontal-pane% Horizontal-Pane%]
+ [editor-canvas% Editor-Canvas%]
+ [bitmap-dc% Bitmap-DC%]
+ [bitmap% Bitmap%]
+ [color% Color%]
+ [snip% Snip%]
+ [open-input-text-editor 
+  ((Instance Text%) Integer (U 'end Integer) ((Instance Snip%) -> (Instance Snip%)) (Instance Text%) Boolean -> Input-Port)])
 
diff --git a/collects/typed/net/mime.ss b/collects/typed/net/mime.ss
index 5a9b3f7b..8abfaddb 100644
--- a/collects/typed/net/mime.ss
+++ b/collects/typed/net/mime.ss
@@ -9,7 +9,7 @@
                        [modification : String]
                        [read : String]                                       
                        [size : Number]
-                       [params : Any])
+                       [params : (Listof (Pair Symbol String))])
                       net/mime)
 (require-typed-struct entity  ([type : (U Symbol String)] 
                                [subtype : (U Symbol String)] 
@@ -20,7 +20,7 @@
                                [id : String]
                                [description : String] 
                                [other : String]
-                               [fields : Any]
+                               [fields : (Listof String)]
                                [parts : (Listof String) ]
                                [body : (Output-Port -> Void)])
                       net/mime)
@@ -30,7 +30,7 @@
 
 
 ;; -- exceptions raised --
-#|
+#| ;; constructors not exported
 (require-typed-struct mime-error () net/mime)
 (require-typed-struct (unexpected-termination mime-error) ([msg : String]) net/mime)
 (require-typed-struct (missing-multipart-boundary-parameter mime-error) () net/mime)
@@ -40,7 +40,6 @@
 (require-typed-struct (empty-subtype mime-error) () net/mime)
 (require-typed-struct (empty-disposition-type mime-error) () net/mime)
 |#
-
 ;; -- mime methods --
 (require/typed/provide net/mime
   [mime-analyze ((U Bytes Input-Port) Any -> message)])