More precise types for typed MrEd wrappers.

More precise types in auto-language.ss

svn: r18041

collects/drscheme/private/auto-language.ss

@@ -9,21 +9,23 @@
 (: reader-tag String)
 (define reader-tag "#reader")
 
-(: pick-new-language ((Instance Text%) 
+(define-type-alias (Language% Settings)
-                      (Listof
+  (Class () () ([get-reader-module (-> Sexp)]
-                       (Instance (Class () () ([get-reader-module (-> Any)]
+                [get-metadata-lines (-> Number)]
-                                               [get-metadata-lines (-> Number)]
+                [metadata->settings (String -> Settings)])))
-                                               [metadata->settings (String -> Any)]))))
+
-                      Any Any -> (values Any Any)))
+(: pick-new-language (All (S)
+                          ((Instance Text%) 
+                           (Listof
+                            (Instance (Language% S)))
+                           (U #f (Instance (Language% S))) (U #f S) -> (values (U #f (Instance (Language% S))) (U #f S)))))
 (define (pick-new-language text all-languages module-language module-language-settings)
   (with-handlers ([exn:fail:read? (λ (x) (values #f #f))])
-    (let: ([found-language? : Any #f]
+    (let: ([found-language? : (U #f (Instance (Language% S))) #f]
-           [settings : Any #f])
+           [settings : (U #f S) #f])
       
       (for-each
-       (λ: ([lang : (Instance (Class () () ([get-reader-module (-> Any)]
+       (λ: ([lang : (Instance (Language% S))])
-					    [get-metadata-lines (-> Number)]
-					    [metadata->settings (String -> Any)])))])
          (let ([lang-spec (send lang get-reader-module)])
            (when lang-spec
              (let* ([lines (send lang get-metadata-lines)]
@@ -51,7 +53,7 @@
       (values found-language?
               settings))))
 
-(: looks-like-module? ((Instance Text%) -> Any))
+(: looks-like-module? ((Instance Text%) -> Boolean))
 (define (looks-like-module? text)
   (or (looks-like-new-module-style? text)
       (looks-like-old-module-style? text)))
@@ -66,11 +68,11 @@
            (pair? r1)
            (eq? (car r1) 'module)))))
 
-(: looks-like-new-module-style? ((Instance Text%) -> Any))
+(: looks-like-new-module-style? ((Instance Text%) -> Boolean))
 (define (looks-like-new-module-style? text)
   (let* ([tp (open-input-text-editor text 0 'end (lambda (s) s) text #t)]
          [l1 (with-handlers ([exn:fail? (lambda (exn) eof)])
                ;; If tp contains a snip, read-line fails.
                (read-line tp))])
     (and (string? l1)
-         (regexp-match #rx"#lang .*$" l1))))
+         (regexp-match? #rx"#lang .*$" l1))))

collects/typed/framework/framework.ss

@@ -1,7 +1,6 @@
 #lang typed-scheme
              
-(require typed/private/utils
+(require typed/private/utils typed/mred/mred)
-         (only-in typed/mred/mred Font%))
 
 (dt Style-List% (Class () 
                        ()
@@ -25,13 +24,15 @@
                          [get-end-position (-> Number)]
                          [insert (String Number Number -> Void)])))
 
-(require/typed/provide framework/framework
+(require/typed/provide 
-                       [preferences:set-default (Symbol Any Any -> Void)]
+ framework/framework
-                       [preferences:set (Symbol Any -> Void)]
+ [preferences:set-default (Symbol Sexp (Any -> Boolean) -> Void)]
-                       [editor:get-standard-style-list 
+ [preferences:set (Symbol Sexp -> Void)]
-                        (-> (Instance Style-List%))]
+ [editor:get-standard-style-list 
-                       [scheme:text% Scheme:Text%]
+  (-> (Instance Style-List%))]
-                       [gui-utils:ok/cancel-buttons (Any (Any Any -> Any) (Any Any -> Any) -> (values Any Any))])
+ [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)))])

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 
-(require/typed/provide mred/mred
+ scheme/gui
-                       [the-font-list (Instance Font-List%)]
+ [button% Button%]
-                       [dialog% Dialog%]
+ [event% Event%]
-                       [text-field% Text-Field%]
+ [the-font-list (Instance Font-List%)] 
-                       [horizontal-panel% Horizontal-Panel%]
+ [dialog% Dialog%] 
-                       [choice% Choice%]
+ [text-field% Text-Field%]
-                       [get-face-list (-> (Listof String))]
+ [horizontal-panel% Horizontal-Panel%]
-                       [message% Message%]
+ [choice% Choice%]
-                       [horizontal-pane% Horizontal-Pane%]
+ [get-face-list (-> (Listof String))]
-                       [editor-canvas% Editor-Canvas%]
+ [message% Message%]
-                       [bitmap-dc% Bitmap-DC%]
+ [horizontal-pane% Horizontal-Pane%]
-                       [bitmap% Bitmap%]
+ [editor-canvas% Editor-Canvas%]
-                       [color% Color%]
+ [bitmap-dc% Bitmap-DC%]
-		       [open-input-text-editor ((Instance Text%) Integer (U 'end Integer) (Any -> Any) Any Any -> Input-Port)])
+ [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)])
 

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)])