From c9e6071981c55dac77d1d7447469335d6e0fd9bb Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 12 Nov 2008 15:57:45 +0000 Subject: [PATCH] Add collection for typed version of collections. Start with mred and framework. svn: r12409 original commit: 48c90f1c10857f0a486bacd3d01b71cb1f19ba90 --- collects/typed/framework/framework.ss | 40 +++++++++++++ collects/typed/framework/prefs-contract.ss | 16 +++++ collects/typed/mred/mred.ss | 69 ++++++++++++++++++++++ 3 files changed, 125 insertions(+) create mode 100644 collects/typed/framework/framework.ss create mode 100644 collects/typed/framework/prefs-contract.ss create mode 100644 collects/typed/mred/mred.ss diff --git a/collects/typed/framework/framework.ss b/collects/typed/framework/framework.ss new file mode 100644 index 00000000..fab2f91d --- /dev/null +++ b/collects/typed/framework/framework.ss @@ -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) + diff --git a/collects/typed/framework/prefs-contract.ss b/collects/typed/framework/prefs-contract.ss new file mode 100644 index 00000000..dd62fb14 --- /dev/null +++ b/collects/typed/framework/prefs-contract.ss @@ -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)))])) diff --git a/collects/typed/mred/mred.ss b/collects/typed/mred/mred.ss new file mode 100644 index 00000000..03f60efb --- /dev/null +++ b/collects/typed/mred/mred.ss @@ -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%]) +