Add collection for typed version of collections.

Start with mred and framework.

svn: r12409

original commit: 48c90f1c10857f0a486bacd3d01b71cb1f19ba90
This commit is contained in:
Sam Tobin-Hochstadt 2008-11-12 15:57:45 +00:00
parent 2a450f220f
commit c9e6071981
3 changed files with 125 additions and 0 deletions

View File

@ -0,0 +1,40 @@
#lang typed-scheme
(require (only-in typed/mred/mred dt require/typed/provide Font%))
(dt Style-List% (Class ()
()
([find-named-style
(String -> (Instance (Class ()
()
([get-font (-> (Instance Font%))]))))])))
(dt Scheme:Text% (Class ()
()
([begin-edit-sequence (-> Void)]
[end-edit-sequence (-> Void)]
[lock (Boolean -> Void)]
[last-position (-> Number)]
[last-paragraph (-> Number)]
[delete (Number Number -> Void)]
[auto-wrap (Any -> Void)]
[paragraph-end-position (Number -> Number)]
[paragraph-start-position (Number -> Number)]
[get-start-position (-> Number)]
[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 "prefs-contract.ss"
[preferences:get-drscheme:large-letters-font (-> (U #f (Pair String Number)))])
(require (only-in "prefs-contract.ss" preferences:get))
(provide preferences:get)

View File

@ -0,0 +1,16 @@
#lang scheme/base
(require (for-syntax scheme/base)
framework/framework)
(provide (rename-out [-preferences:get preferences:get])
preferences:get-drscheme:large-letters-font)
(define (preferences:get-drscheme:large-letters-font)
(preferences:get 'drscheme:large-letters-font))
(define-syntax (-preferences:get stx)
(syntax-case stx (quote)
[(_ (quote sym))
(with-syntax ([nm (datum->syntax stx (string->symbol (string-append "preferences:get" "-" (symbol->string (syntax-e #'sym)))))])
(syntax/loc stx (nm)))]))

View File

@ -0,0 +1,69 @@
#lang typed-scheme
(define-syntax-rule (dt nm t)
(begin (define-type-alias nm t) (provide nm)))
(define-syntax-rule (require/typed/provide lib [nm t] ...)
(begin
(require/typed lib [nm t] ...)
(provide nm ...)))
(provide dt require/typed/provide)
(dt Bitmap% (Class (Number Number Boolean)
()
([get-width (-> Number)]
[get-height (-> Number)])))
(dt Font-List% (Class () () ([find-or-create-font (Any * -> (Instance Font%))])))
(dt Font% (Class () () ([get-face (-> (Option String))]
[get-point-size (-> Number)])))
(dt Dialog% (Class ()
([parent Any] [width Number] [label String])
([show (Any -> Void)])))
(dt Text-Field% (Class ()
([parent Any] [callback Any] [label String])
([get-value (-> String)]
[focus (-> String)])))
(dt Horizontal-Panel% (Class ()
([parent Any]
[stretchable-height Any #t]
[alignment (List Symbol Symbol) #t])
()))
(dt Choice% (Class ()
([parent Any] [label String] [choices List] [callback Any])
([get-string-selection (-> (Option String))]
[set-string-selection (String -> Void)])))
(dt Message% (Class ()
([parent Any] [label String])
([set-label ((U String (Instance Bitmap%)) -> Void)])))
(dt Horizontal-Pane% (Class ()
([parent Any])
()))
(dt Editor-Canvas% (Class ()
([parent Any] [editor Any])
([set-line-count (Number -> Void)])))
(dt Bitmap-DC% (Class ((Instance Bitmap%))
()
([get-text-extent (String (Instance Font%) -> (values Number Number Number Number))]
[get-pixel (Number Number (Instance Color%) -> Boolean)]
[set-bitmap ((Option (Instance Bitmap%)) -> Void)]
[clear (-> Void)]
[set-font ((Instance Font%) -> Void)]
[draw-text (String Number Number -> Void)])))
(dt Color% (Class () () ([red (-> Number)])))
(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%])