From 611e8d0d17ce096ef624ef442d632f954a783e7b Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 10 May 2012 10:35:33 -0600 Subject: [PATCH] Changing from racket to racket/base in xml, html, and web-server --- collects/html/html-spec.rkt | 5 +- collects/html/html-structs.rkt | 5 +- collects/html/html.rkt | 3 +- collects/html/sgml-reader.rkt | 5 +- .../configuration/configuration-table.rkt | 7 +- .../web-server/configuration/namespace.rkt | 6 +- .../web-server/configuration/responders.rkt | 6 +- .../htdocs/servlets/examples/add-dispatch.rkt | 2 +- .../servlets/examples/add-formlets0.rkt | 2 +- .../servlets/examples/add-formlets1.rkt | 2 +- .../servlets/examples/add-formlets2.rkt | 2 +- .../htdocs/servlets/examples/fupload.rkt | 5 +- .../htdocs/servlets/examples/quiz.rkt | 6 +- .../servlets/examples/template-compat0.rkt | 2 +- .../servlets/examples/template-full.rkt | 5 +- .../servlets/examples/template-simple.rkt | 5 +- .../servlets/examples/template-xexpr.rkt | 2 +- .../htdocs/servlets/examples/wc-fake.rkt | 2 +- .../htdocs/servlets/examples/wc.rkt | 2 +- collects/web-server/dispatch/bidi-match.rkt | 6 +- collects/web-server/dispatch/coercion.rkt | 5 +- collects/web-server/dispatch/extend.rkt | 2 +- .../web-server/dispatch/http-expanders.rkt | 5 +- collects/web-server/dispatch/pattern.rkt | 5 +- collects/web-server/dispatch/serve.rkt | 5 +- collects/web-server/dispatch/syntax.rkt | 9 +- collects/web-server/dispatch/url-patterns.rkt | 5 +- .../dispatchers/dispatch-sequencer.rkt | 6 +- collects/web-server/dispatchers/limit.rkt | 6 +- collects/web-server/formlets.rkt | 2 +- collects/web-server/formlets/dyn-syntax.rkt | 9 +- collects/web-server/formlets/input.rkt | 6 +- collects/web-server/formlets/lib.rkt | 8 +- collects/web-server/formlets/servlet.rkt | 5 +- collects/web-server/formlets/syntax.rkt | 6 +- collects/web-server/http/basic-auth.rkt | 6 +- collects/web-server/http/cookie-parse.rkt | 6 +- collects/web-server/http/cookie.rkt | 2 +- collects/web-server/http/digest-auth.rkt | 7 +- collects/web-server/lang/abort-resume.rkt | 7 +- collects/web-server/lang/closure.rkt | 5 +- collects/web-server/lang/labels.rkt | 5 +- collects/web-server/lang/native.rkt | 4 +- collects/web-server/lang/serial-lambda.rkt | 8 +- collects/web-server/lang/soft.rkt | 7 +- collects/web-server/lang/stuff-url.rkt | 6 +- collects/web-server/lang/web-cells.rkt | 6 +- collects/web-server/lang/web.rkt | 5 +- .../private/dispatch-server-sig.rkt | 6 +- collects/web-server/private/gzip.rkt | 5 +- collects/web-server/private/launch.rkt | 2 +- collects/web-server/private/mod-map.rkt | 5 +- collects/web-server/private/xexpr.rkt | 7 +- .../scribblings/tutorial/examples/dummy-3.rkt | 6 +- .../scribblings/tutorial/examples/model-2.rkt | 4 +- .../scribblings/tutorial/examples/model-3.rkt | 6 +- .../scribblings/tutorial/examples/model.rkt | 2 +- .../scribblings/tutorial/tutorial-util.rkt | 5 +- .../web-server/scribblings/web-server.rkt | 3 +- collects/web-server/servlet-dispatch.rkt | 4 +- collects/web-server/servlet-env.rkt | 5 +- collects/web-server/servlet/setup.rkt | 6 +- collects/web-server/servlet/web-cells.rkt | 4 +- collects/web-server/servlet/web.rkt | 6 +- collects/web-server/stuffers.rkt | 2 +- collects/web-server/stuffers/base64.rkt | 5 +- collects/web-server/stuffers/gzip.rkt | 5 +- collects/web-server/stuffers/hash.rkt | 5 +- collects/web-server/stuffers/hmac-sha1.rkt | 5 +- collects/web-server/stuffers/serialize.rkt | 5 +- collects/web-server/stuffers/store.rkt | 4 +- collects/web-server/stuffers/stuffer.rkt | 5 +- collects/web-server/web-config-sig.rkt | 6 +- collects/xml/plist.rkt | 6 +- collects/xml/private/reader.rkt | 7 +- collects/xml/private/space.rkt | 6 +- collects/xml/private/syntax.rkt | 6 +- collects/xml/private/writer.rkt | 5 +- collects/xml/scheme-snipclass.rkt | 66 ++-- collects/xml/text-box-tool.rkt | 72 ++--- collects/xml/text-snipclass.rkt | 282 +++++++++--------- collects/xml/xml-snipclass.rkt | 68 ++--- collects/xml/xml.rkt | 2 +- 83 files changed, 496 insertions(+), 380 deletions(-) diff --git a/collects/html/html-spec.rkt b/collects/html/html-spec.rkt index b511673c28..1a0a3ad173 100644 --- a/collects/html/html-spec.rkt +++ b/collects/html/html-spec.rkt @@ -1,5 +1,6 @@ -#lang racket -(require "sgml-reader.rkt") +#lang racket/base +(require racket/contract + "sgml-reader.rkt") (provide/contract [html-spec spec/c]) diff --git a/collects/html/html-structs.rkt b/collects/html/html-structs.rkt index 3db4f92744..f3a353ad58 100644 --- a/collects/html/html-structs.rkt +++ b/collects/html/html-structs.rkt @@ -1,5 +1,6 @@ -#lang racket -(require xml) +#lang racket/base +(require racket/contract + xml) (define-struct html-element (attributes)) (define-struct (html-full html-element) (content)) diff --git a/collects/html/html.rkt b/collects/html/html.rkt index 726c1033cf..163ee9c809 100644 --- a/collects/html/html.rkt +++ b/collects/html/html.rkt @@ -1,9 +1,10 @@ -#lang racket +#lang racket/base ;; copyright by Paul Graunke June 2000 AD (require "html-structs.rkt" "html-spec.rkt" "sgml-reader.rkt" + racket/contract xml) (provide (all-from-out "html-structs.rkt") diff --git a/collects/html/sgml-reader.rkt b/collects/html/sgml-reader.rkt index 2f3ee25906..d5348e0569 100644 --- a/collects/html/sgml-reader.rkt +++ b/collects/html/sgml-reader.rkt @@ -1,9 +1,10 @@ ;; copyright by Paul Graunke June 2000 AD ;; warning - this was copied from the XML collection. ;; It needs to be abstracted back in. -#lang racket +#lang racket/base (require xml - (prefix-in racket: racket)) + racket/contract + (prefix-in racket: racket/base)) ;; Kid-lister : (Symbol -> (U (listof Symbol) #f)) (define kid-lister/c diff --git a/collects/web-server/configuration/configuration-table.rkt b/collects/web-server/configuration/configuration-table.rkt index 15c35c4388..cebbd90f82 100644 --- a/collects/web-server/configuration/configuration-table.rkt +++ b/collects/web-server/configuration/configuration-table.rkt @@ -1,5 +1,8 @@ -#lang racket -(require racket/pretty +#lang racket/base +(require racket/contract + racket/list + (for-syntax racket/base) + racket/pretty racket/runtime-path "configuration-table-structs.rkt" web-server/http/bindings) diff --git a/collects/web-server/configuration/namespace.rkt b/collects/web-server/configuration/namespace.rkt index 57bb7f7aeb..53959f9ccc 100644 --- a/collects/web-server/configuration/namespace.rkt +++ b/collects/web-server/configuration/namespace.rkt @@ -1,5 +1,7 @@ -#lang racket -(require racket/runtime-path) +#lang racket/base +(require racket/contract + racket/list + racket/runtime-path) (define-runtime-module-path racket-module-spec racket) (define mred-module-spec 'mred) diff --git a/collects/web-server/configuration/responders.rkt b/collects/web-server/configuration/responders.rkt index 34471c1b38..40170664e5 100644 --- a/collects/web-server/configuration/responders.rkt +++ b/collects/web-server/configuration/responders.rkt @@ -1,5 +1,7 @@ -#lang racket -(require racket/runtime-path +#lang racket/base +(require racket/contract + (for-syntax racket/base) + racket/runtime-path net/url web-server/private/xexpr web-server/http/xexpr diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-dispatch.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-dispatch.rkt index 1c79ff275d..e8b3609da4 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/add-dispatch.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-dispatch.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/servlet) (define (extract-number req) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets0.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets0.rkt index f2b33f6fda..4c470e3cc2 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets0.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets0.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/servlet web-server/formlets) (provide (all-defined-out)) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt index 4007caa25d..97f1a74a20 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/servlet web-server/formlets) (provide (all-defined-out)) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt index 030abaf5fd..0c943bcd4a 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/servlet web-server/formlets) (provide (all-defined-out)) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/fupload.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/fupload.rkt index 86693a7109..b04923e1c0 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/fupload.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/fupload.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/servlet) +#lang racket/base +(require racket/match + web-server/servlet) (provide (all-defined-out)) (define interface-version 'v1) (define timeout +inf.0) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/quiz.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/quiz.rkt index eab610009e..6c4bd1d713 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/quiz.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/quiz.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base ;; Written by Don Felgar, edited by Greg Pettyjohn ;; ;; Multiple-choice quiz Racket servlet sample. @@ -13,7 +13,9 @@ ;; correct-answer = integer, index into choices ;; ;; Configuration -(require racket/runtime-path) +(require racket/runtime-path + racket/file + (for-syntax racket/base)) (define-runtime-path *data-file* (list 'lib "web-server/default-web-root/htdocs/servlets/examples/english-measure-questions.rkt")) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-compat0.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/template-compat0.rkt index d5f7fb63f5..4481c5b67a 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-compat0.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-compat0.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/templates web-server/http web-server/compat/0/coerce) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.rkt index 65c03e0179..6cf4abb6d2 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/templates +#lang racket/base +(require racket/list + web-server/templates web-server/http) (provide (all-defined-out)) (define interface-version 'v1) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.rkt index 65c03e0179..6cf4abb6d2 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/templates +#lang racket/base +(require racket/list + web-server/templates web-server/http) (provide (all-defined-out)) (define interface-version 'v1) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.rkt index 984b209930..1b25a0826f 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/templates web-server/http xml) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/wc-fake.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/wc-fake.rkt index f5d070aa08..67071d9682 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/wc-fake.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/wc-fake.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/servlet) (define interface-version 'v1) (define timeout +inf.0) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/wc.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/wc.rkt index 21b2334747..97db212d2e 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/wc.rkt +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/wc.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/servlet) (define interface-version 'v1) (define timeout +inf.0) diff --git a/collects/web-server/dispatch/bidi-match.rkt b/collects/web-server/dispatch/bidi-match.rkt index 5e354901fd..788d1c4ffc 100644 --- a/collects/web-server/dispatch/bidi-match.rkt +++ b/collects/web-server/dispatch/bidi-match.rkt @@ -1,5 +1,7 @@ -#lang racket -(require racket/stxparam) +#lang racket/base +(require (for-syntax racket/base) + racket/match + racket/stxparam) (define-syntax-parameter bidi-match-going-in? #t) diff --git a/collects/web-server/dispatch/coercion.rkt b/collects/web-server/dispatch/coercion.rkt index 585eb7ed57..ff5bcc3aff 100644 --- a/collects/web-server/dispatch/coercion.rkt +++ b/collects/web-server/dispatch/coercion.rkt @@ -1,4 +1,7 @@ -#lang racket +#lang racket/base +(require racket/contract + racket/match + (for-syntax racket/base)) (define (make-coerce-safe? coerce) (lambda (x) diff --git a/collects/web-server/dispatch/extend.rkt b/collects/web-server/dispatch/extend.rkt index 8e0f5f586c..4e9a50582e 100644 --- a/collects/web-server/dispatch/extend.rkt +++ b/collects/web-server/dispatch/extend.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/dispatch/coercion web-server/dispatch/bidi-match) (provide (all-from-out web-server/dispatch/coercion diff --git a/collects/web-server/dispatch/http-expanders.rkt b/collects/web-server/dispatch/http-expanders.rkt index 12163899c5..7517d12d8e 100644 --- a/collects/web-server/dispatch/http-expanders.rkt +++ b/collects/web-server/dispatch/http-expanders.rkt @@ -1,5 +1,6 @@ -#lang racket -(require net/url +#lang racket/base +(require racket/match + net/url web-server/http) (define-match-expander url/path diff --git a/collects/web-server/dispatch/pattern.rkt b/collects/web-server/dispatch/pattern.rkt index 808f8fb610..ac724e3217 100644 --- a/collects/web-server/dispatch/pattern.rkt +++ b/collects/web-server/dispatch/pattern.rkt @@ -1,4 +1,7 @@ -#lang racket +#lang racket/base +(require racket/list + racket/contract) + ; A dispatch pattern is either ; - a string ; - a bidi match expander diff --git a/collects/web-server/dispatch/serve.rkt b/collects/web-server/dispatch/serve.rkt index 19eb848079..59d704ff38 100644 --- a/collects/web-server/dispatch/serve.rkt +++ b/collects/web-server/dispatch/serve.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/servlet-env +#lang racket/base +(require racket/contract + web-server/servlet-env web-server/servlet/servlet-structs web-server/http) diff --git a/collects/web-server/dispatch/syntax.rkt b/collects/web-server/dispatch/syntax.rkt index 35d4e83513..3d6d80c49b 100644 --- a/collects/web-server/dispatch/syntax.rkt +++ b/collects/web-server/dispatch/syntax.rkt @@ -1,10 +1,13 @@ -#lang racket -(require racket/stxparam +#lang racket/base +(require racket/list + racket/match + racket/stxparam net/url web-server/dispatchers/dispatch web-server/dispatch/http-expanders web-server/dispatch/bidi-match - (for-syntax web-server/dispatch/pattern)) + (for-syntax racket/base + web-server/dispatch/pattern)) (define (default-else req) (next-dispatcher)) diff --git a/collects/web-server/dispatch/url-patterns.rkt b/collects/web-server/dispatch/url-patterns.rkt index f24c41da8a..aaf7710c38 100644 --- a/collects/web-server/dispatch/url-patterns.rkt +++ b/collects/web-server/dispatch/url-patterns.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/dispatch/coercion +#lang racket/base +(require racket/match + web-server/dispatch/coercion web-server/dispatch/bidi-match) (define-syntax define-bidi-match-expander/coercions diff --git a/collects/web-server/dispatchers/dispatch-sequencer.rkt b/collects/web-server/dispatchers/dispatch-sequencer.rkt index e01e6df75f..1cbca8a04e 100644 --- a/collects/web-server/dispatchers/dispatch-sequencer.rkt +++ b/collects/web-server/dispatchers/dispatch-sequencer.rkt @@ -1,5 +1,7 @@ -#lang racket -(require web-server/dispatchers/dispatch) +#lang racket/base +(require racket/contract + racket/list + web-server/dispatchers/dispatch) (provide/contract [interface-version dispatcher-interface-version/c] [make (() () #:rest (listof dispatcher/c) . ->* . dispatcher/c)]) diff --git a/collects/web-server/dispatchers/limit.rkt b/collects/web-server/dispatchers/limit.rkt index 1a9fddbd49..0fe51465ac 100644 --- a/collects/web-server/dispatchers/limit.rkt +++ b/collects/web-server/dispatchers/limit.rkt @@ -1,5 +1,7 @@ -#lang racket -(require web-server/dispatchers/dispatch) +#lang racket/base +(require racket/contract + racket/list + web-server/dispatchers/dispatch) (provide/contract [interface-version dispatcher-interface-version/c] [make ((number? dispatcher/c) (#:over-limit (symbols 'block 'kill-new 'kill-old)) . ->* . dispatcher/c)]) diff --git a/collects/web-server/formlets.rkt b/collects/web-server/formlets.rkt index 27412d9b77..333b4bad72 100644 --- a/collects/web-server/formlets.rkt +++ b/collects/web-server/formlets.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/formlets/syntax web-server/formlets/dyn-syntax web-server/formlets/input diff --git a/collects/web-server/formlets/dyn-syntax.rkt b/collects/web-server/formlets/dyn-syntax.rkt index f2927cb002..9548a7c195 100644 --- a/collects/web-server/formlets/dyn-syntax.rkt +++ b/collects/web-server/formlets/dyn-syntax.rkt @@ -1,7 +1,12 @@ -#lang racket -(require (for-syntax racket +#lang racket/base +(require (for-syntax racket/base + racket/local + racket/list syntax/parse syntax/strip-context) + racket/function + racket/list + racket/match racket/stxparam "lib.rkt" "syntax.rkt" diff --git a/collects/web-server/formlets/input.rkt b/collects/web-server/formlets/input.rkt index ff1526b8d5..f9524d1ec0 100644 --- a/collects/web-server/formlets/input.rkt +++ b/collects/web-server/formlets/input.rkt @@ -1,5 +1,7 @@ -#lang racket -(require web-server/http +#lang racket/base +(require racket/contract + racket/list + web-server/http web-server/private/xexpr (only-in "lib.rkt" formlet/c diff --git a/collects/web-server/formlets/lib.rkt b/collects/web-server/formlets/lib.rkt index ef8c9be086..999bc727c2 100644 --- a/collects/web-server/formlets/lib.rkt +++ b/collects/web-server/formlets/lib.rkt @@ -1,9 +1,11 @@ -#lang racket -(require web-server/http +#lang racket/base +(require racket/list + racket/contract + racket/function + web-server/http web-server/private/xexpr) ; Combinators -(define (const x) (lambda _ x)) (define (id x) x) ; Formlets diff --git a/collects/web-server/formlets/servlet.rkt b/collects/web-server/formlets/servlet.rkt index c8a00fc3c3..5d8832d2fe 100644 --- a/collects/web-server/formlets/servlet.rkt +++ b/collects/web-server/formlets/servlet.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/servlet +#lang racket/base +(require racket/contract + web-server/servlet web-server/private/xexpr "lib.rkt") diff --git a/collects/web-server/formlets/syntax.rkt b/collects/web-server/formlets/syntax.rkt index 98dc34ad68..6bf9dfd2c3 100644 --- a/collects/web-server/formlets/syntax.rkt +++ b/collects/web-server/formlets/syntax.rkt @@ -1,7 +1,9 @@ -#lang racket -(require (for-syntax racket +#lang racket/base +(require (for-syntax racket/base syntax/parse) racket/stxparam + racket/match + racket/list "lib.rkt" (for-syntax "lib.rkt")) diff --git a/collects/web-server/http/basic-auth.rkt b/collects/web-server/http/basic-auth.rkt index 8a6f2a2059..849568884f 100644 --- a/collects/web-server/http/basic-auth.rkt +++ b/collects/web-server/http/basic-auth.rkt @@ -1,5 +1,7 @@ -#lang racket -(require net/base64 +#lang racket/base +(require racket/contract + racket/match + net/base64 web-server/http/request-structs) (define (request->basic-credentials req) diff --git a/collects/web-server/http/cookie-parse.rkt b/collects/web-server/http/cookie-parse.rkt index 6e9344ba7e..5e098fecb8 100644 --- a/collects/web-server/http/cookie-parse.rkt +++ b/collects/web-server/http/cookie-parse.rkt @@ -1,5 +1,7 @@ -#lang racket -(require web-server/http/request-structs +#lang racket/base +(require racket/port + racket/match + web-server/http/request-structs net/cookie web-server/private/util racket/contract) diff --git a/collects/web-server/http/cookie.rkt b/collects/web-server/http/cookie.rkt index e86ae4c47b..ac5d26a823 100644 --- a/collects/web-server/http/cookie.rkt +++ b/collects/web-server/http/cookie.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require net/cookie web-server/http/request-structs web-server/http/response-structs diff --git a/collects/web-server/http/digest-auth.rkt b/collects/web-server/http/digest-auth.rkt index 3cf860fca8..602b31a66d 100644 --- a/collects/web-server/http/digest-auth.rkt +++ b/collects/web-server/http/digest-auth.rkt @@ -1,5 +1,8 @@ -#lang racket -(require net/base64 +#lang racket/base +(require racket/port + racket/match + racket/contract + net/base64 file/md5 web-server/http/request-structs) diff --git a/collects/web-server/lang/abort-resume.rkt b/collects/web-server/lang/abort-resume.rkt index e33a37e866..115b7ad51e 100644 --- a/collects/web-server/lang/abort-resume.rkt +++ b/collects/web-server/lang/abort-resume.rkt @@ -1,5 +1,8 @@ -#lang racket -(require racket/serialize +#lang racket/base +(require racket/contract + racket/list + racket/match + racket/serialize web-server/private/servlet web-server/managers/manager web-server/private/define-closure diff --git a/collects/web-server/lang/closure.rkt b/collects/web-server/lang/closure.rkt index 22795bd85d..8061e66658 100644 --- a/collects/web-server/lang/closure.rkt +++ b/collects/web-server/lang/closure.rkt @@ -1,5 +1,6 @@ -#lang racket -(require syntax/free-vars +#lang racket/base +(require racket/list + syntax/free-vars racket/syntax (for-template racket/base diff --git a/collects/web-server/lang/labels.rkt b/collects/web-server/lang/labels.rkt index dcaacf0657..d0eed832bc 100644 --- a/collects/web-server/lang/labels.rkt +++ b/collects/web-server/lang/labels.rkt @@ -1,5 +1,6 @@ -#lang racket -(require file/md5) +#lang racket/base +(require racket/contract + file/md5) (provide/contract [make-labeling (bytes? . -> . (-> symbol?))]) diff --git a/collects/web-server/lang/native.rkt b/collects/web-server/lang/native.rkt index 2871075501..f3e1a0193c 100644 --- a/collects/web-server/lang/native.rkt +++ b/collects/web-server/lang/native.rkt @@ -1,6 +1,6 @@ -#lang racket +#lang racket/base (require web-server/lang/abort-resume - (for-syntax racket)) + (for-syntax racket/base)) (define-syntax (define-native stx) (syntax-case stx () diff --git a/collects/web-server/lang/serial-lambda.rkt b/collects/web-server/lang/serial-lambda.rkt index b2bc708556..83330b0213 100644 --- a/collects/web-server/lang/serial-lambda.rkt +++ b/collects/web-server/lang/serial-lambda.rkt @@ -1,6 +1,8 @@ -#lang racket -(require racket/serialize - (for-syntax racket +#lang racket/base +(require racket/contract + racket/list + racket/serialize + (for-syntax racket/base web-server/lang/closure web-server/lang/labels)) diff --git a/collects/web-server/lang/soft.rkt b/collects/web-server/lang/soft.rkt index 8f7aa795d1..1b2eb34897 100644 --- a/collects/web-server/lang/soft.rkt +++ b/collects/web-server/lang/soft.rkt @@ -1,5 +1,8 @@ -#lang racket -(require racket/serialize) +#lang racket/base +(require racket/contract + racket/match + racket/local + racket/serialize) (define-serializable-struct soft-state-record (thnk)) (define-struct some (value)) diff --git a/collects/web-server/lang/stuff-url.rkt b/collects/web-server/lang/stuff-url.rkt index f058a9405f..431abc283d 100644 --- a/collects/web-server/lang/stuff-url.rkt +++ b/collects/web-server/lang/stuff-url.rkt @@ -1,5 +1,7 @@ -#lang racket -(require net/url +#lang racket/base +(require racket/contract + racket/list + net/url racket/serialize web-server/private/servlet web-server/stuffers/stuffer diff --git a/collects/web-server/lang/web-cells.rkt b/collects/web-server/lang/web-cells.rkt index 9315634c17..8669eac013 100644 --- a/collects/web-server/lang/web-cells.rkt +++ b/collects/web-server/lang/web-cells.rkt @@ -1,5 +1,7 @@ -#lang racket -(require racket/serialize +#lang racket/base +(require racket/contract + racket/list + racket/serialize web-server/lang/serial-lambda) ;; Implementation: Have a distinguished frame variable that is read and captured by send/suspend, ;; installed on invocations of continuations by the server (and NOT from other continuation invocations) diff --git a/collects/web-server/lang/web.rkt b/collects/web-server/lang/web.rkt index 8572edebd4..e9ba3953fe 100644 --- a/collects/web-server/lang/web.rkt +++ b/collects/web-server/lang/web.rkt @@ -1,5 +1,6 @@ -#lang racket -(require net/url +#lang racket/base +(require racket/match + net/url racket/contract racket/serialize web-server/servlet/servlet-structs diff --git a/collects/web-server/private/dispatch-server-sig.rkt b/collects/web-server/private/dispatch-server-sig.rkt index 06847143ac..dfa3e369ab 100644 --- a/collects/web-server/private/dispatch-server-sig.rkt +++ b/collects/web-server/private/dispatch-server-sig.rkt @@ -1,5 +1,7 @@ -#lang racket -(require racket/async-channel +#lang racket/base +(require racket/unit + racket/contract + racket/async-channel web-server/private/util unstable/contract web-server/private/connection-manager) diff --git a/collects/web-server/private/gzip.rkt b/collects/web-server/private/gzip.rkt index 83bf82f596..c8ad8b6c3e 100644 --- a/collects/web-server/private/gzip.rkt +++ b/collects/web-server/private/gzip.rkt @@ -1,5 +1,6 @@ -#lang racket -(require file/gzip +#lang racket/base +(require racket/contract + file/gzip file/gunzip) (provide/contract diff --git a/collects/web-server/private/launch.rkt b/collects/web-server/private/launch.rkt index d9cc6de49f..9e3983e46d 100644 --- a/collects/web-server/private/launch.rkt +++ b/collects/web-server/private/launch.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require racket/cmdline racket/unit net/tcp-sig diff --git a/collects/web-server/private/mod-map.rkt b/collects/web-server/private/mod-map.rkt index 9a4eb56fee..62f439a20f 100644 --- a/collects/web-server/private/mod-map.rkt +++ b/collects/web-server/private/mod-map.rkt @@ -1,4 +1,7 @@ -#lang racket +#lang racket/base +(require racket/contract + racket/list + racket/match) (provide/contract [compress-serial (list? . -> . list?)] [decompress-serial (list? . -> . list?)]) diff --git a/collects/web-server/private/xexpr.rkt b/collects/web-server/private/xexpr.rkt index 2cb72bd733..3267617146 100644 --- a/collects/web-server/private/xexpr.rkt +++ b/collects/web-server/private/xexpr.rkt @@ -1,5 +1,8 @@ -#lang racket -(require racket/pretty +#lang racket/base +(require racket/contract + racket/match + racket/list + racket/pretty xml) (define-struct (exn:pretty exn) (xexpr)) diff --git a/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt b/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt index 6e6a8a4066..5f1d7d23b2 100644 --- a/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt +++ b/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt @@ -1,5 +1,7 @@ -#lang racket -(require "../dummy-sqlite.rkt") +#lang racket/base +(require racket/list + racket/local + "../dummy-sqlite.rkt") ;; A blog is a (make-blog db) ;; where db is an sqlite database handle diff --git a/collects/web-server/scribblings/tutorial/examples/model-2.rkt b/collects/web-server/scribblings/tutorial/examples/model-2.rkt index 58260c2924..6ccbb5a7ad 100644 --- a/collects/web-server/scribblings/tutorial/examples/model-2.rkt +++ b/collects/web-server/scribblings/tutorial/examples/model-2.rkt @@ -1,4 +1,6 @@ -#lang racket +#lang racket/base +(require racket/local + racket/list) ;; A blog is a (make-blog home posts) ;; where home is a string, posts is a (listof post) diff --git a/collects/web-server/scribblings/tutorial/examples/model-3.rkt b/collects/web-server/scribblings/tutorial/examples/model-3.rkt index 9bcd48322e..bd9b28f7ec 100644 --- a/collects/web-server/scribblings/tutorial/examples/model-3.rkt +++ b/collects/web-server/scribblings/tutorial/examples/model-3.rkt @@ -1,5 +1,7 @@ -#lang racket -(require db) +#lang racket/base +(require racket/list + racket/local + db) ;; A blog is a (make-blog db) ;; where db is an sqlite connection diff --git a/collects/web-server/scribblings/tutorial/examples/model.rkt b/collects/web-server/scribblings/tutorial/examples/model.rkt index c9676ab0f7..b0f893a6df 100644 --- a/collects/web-server/scribblings/tutorial/examples/model.rkt +++ b/collects/web-server/scribblings/tutorial/examples/model.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base ;; A blog is a (make-blog posts) ;; where posts is a (listof post) diff --git a/collects/web-server/scribblings/tutorial/tutorial-util.rkt b/collects/web-server/scribblings/tutorial/tutorial-util.rkt index 66ea4a6bbf..2575376ee0 100644 --- a/collects/web-server/scribblings/tutorial/tutorial-util.rkt +++ b/collects/web-server/scribblings/tutorial/tutorial-util.rkt @@ -1,6 +1,7 @@ -#lang racket +#lang racket/base (require scribble/basic - (for-syntax racket/port) + (for-syntax racket/base + racket/port) racket/include (except-in scribble/manual link)) (provide external-file) diff --git a/collects/web-server/scribblings/web-server.rkt b/collects/web-server/scribblings/web-server.rkt index 1d9d86aab0..bd5345dc68 100644 --- a/collects/web-server/scribblings/web-server.rkt +++ b/collects/web-server/scribblings/web-server.rkt @@ -1,6 +1,7 @@ -#lang racket +#lang racket/base (require scribble/manual scribble/eval + (for-syntax racket/base) (for-label racket/base racket/contract racket/unit)) diff --git a/collects/web-server/servlet-dispatch.rkt b/collects/web-server/servlet-dispatch.rkt index e138c0e500..9119fe74e5 100644 --- a/collects/web-server/servlet-dispatch.rkt +++ b/collects/web-server/servlet-dispatch.rkt @@ -1,7 +1,9 @@ ; Derived from plai/web/server, which was based on an older version of this ; Also derived from planet/untyped/instaservlet -#lang racket +#lang racket/base (require (prefix-in net: net/sendurl) + racket/match + racket/local racket/contract racket/async-channel racket/list diff --git a/collects/web-server/servlet-env.rkt b/collects/web-server/servlet-env.rkt index 120fb8b70b..268ffb97bf 100644 --- a/collects/web-server/servlet-env.rkt +++ b/collects/web-server/servlet-env.rkt @@ -1,10 +1,11 @@ ; Derived from plai/web/server, which was based on an older version of this ; Also derived from planet/untyped/instaservlet -#lang racket +#lang racket/base (require racket/contract racket/list racket/serialize - racket/runtime-path) + racket/runtime-path + (for-syntax racket/base)) (require net/url web-server/managers/lru web-server/managers/manager diff --git a/collects/web-server/servlet/setup.rkt b/collects/web-server/servlet/setup.rkt index 1eb2d5e6b5..ce08f1e14d 100644 --- a/collects/web-server/servlet/setup.rkt +++ b/collects/web-server/servlet/setup.rkt @@ -1,5 +1,7 @@ -#lang racket -(require racket/serialize +#lang racket/base +(require racket/contract + racket/match + racket/serialize web-server/managers/manager web-server/managers/timeouts web-server/managers/none diff --git a/collects/web-server/servlet/web-cells.rkt b/collects/web-server/servlet/web-cells.rkt index 44a595c4c2..7fad0a788a 100644 --- a/collects/web-server/servlet/web-cells.rkt +++ b/collects/web-server/servlet/web-cells.rkt @@ -1,6 +1,8 @@ -#lang racket +#lang racket/base ;; Implementation: Have a distinguished frame variable that is read and captured by send/suspend, ;; installed on invocations of continuations by the server (and NOT from other continuation invocations) +(require racket/list + racket/contract) ;; Data types (define-struct primitive-wc (id)) diff --git a/collects/web-server/servlet/web.rkt b/collects/web-server/servlet/web.rkt index 59b5959387..8efa13f2d2 100644 --- a/collects/web-server/servlet/web.rkt +++ b/collects/web-server/servlet/web.rkt @@ -1,5 +1,7 @@ -#lang racket -(require net/url) +#lang racket/base +(require racket/contract + racket/list + net/url) (require web-server/managers/manager web-server/private/util web-server/private/servlet diff --git a/collects/web-server/stuffers.rkt b/collects/web-server/stuffers.rkt index 4067e86b7b..98710123fd 100644 --- a/collects/web-server/stuffers.rkt +++ b/collects/web-server/stuffers.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require web-server/stuffers/stuffer web-server/stuffers/base64 web-server/stuffers/gzip diff --git a/collects/web-server/stuffers/base64.rkt b/collects/web-server/stuffers/base64.rkt index 13df099118..f8b00dcfa5 100644 --- a/collects/web-server/stuffers/base64.rkt +++ b/collects/web-server/stuffers/base64.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/stuffers/stuffer +#lang racket/base +(require racket/contract + web-server/stuffers/stuffer net/base64) (define base64-stuffer diff --git a/collects/web-server/stuffers/gzip.rkt b/collects/web-server/stuffers/gzip.rkt index 8034cc6b69..2b1658d206 100644 --- a/collects/web-server/stuffers/gzip.rkt +++ b/collects/web-server/stuffers/gzip.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/private/gzip +#lang racket/base +(require racket/contract + web-server/private/gzip web-server/stuffers/stuffer) (define gzip-stuffer diff --git a/collects/web-server/stuffers/hash.rkt b/collects/web-server/stuffers/hash.rkt index cc1d7c6908..43c29ed91f 100644 --- a/collects/web-server/stuffers/hash.rkt +++ b/collects/web-server/stuffers/hash.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/stuffers/stuffer +#lang racket/base +(require racket/contract + web-server/stuffers/stuffer web-server/stuffers/store file/md5) diff --git a/collects/web-server/stuffers/hmac-sha1.rkt b/collects/web-server/stuffers/hmac-sha1.rkt index c9ccbfa225..c81056c23f 100644 --- a/collects/web-server/stuffers/hmac-sha1.rkt +++ b/collects/web-server/stuffers/hmac-sha1.rkt @@ -1,5 +1,6 @@ -#lang racket -(require web-server/stuffers/stuffer +#lang racket/base +(require racket/contract + web-server/stuffers/stuffer racket/runtime-path openssl/libcrypto (rename-in ffi/unsafe diff --git a/collects/web-server/stuffers/serialize.rkt b/collects/web-server/stuffers/serialize.rkt index 7a0c945133..d81b26cb51 100644 --- a/collects/web-server/stuffers/serialize.rkt +++ b/collects/web-server/stuffers/serialize.rkt @@ -1,5 +1,6 @@ -#lang racket -(require racket/serialize +#lang racket/base +(require racket/contract + racket/serialize web-server/stuffers/stuffer web-server/private/util web-server/private/mod-map) diff --git a/collects/web-server/stuffers/store.rkt b/collects/web-server/stuffers/store.rkt index fe98aef3ca..5bdf11512e 100644 --- a/collects/web-server/stuffers/store.rkt +++ b/collects/web-server/stuffers/store.rkt @@ -1,4 +1,6 @@ -#lang racket +#lang racket/base +(require racket/contract) + (define-struct store (write read)) (define (dir-store home) diff --git a/collects/web-server/stuffers/stuffer.rkt b/collects/web-server/stuffers/stuffer.rkt index 18095253fe..ef8d662457 100644 --- a/collects/web-server/stuffers/stuffer.rkt +++ b/collects/web-server/stuffers/stuffer.rkt @@ -1,4 +1,7 @@ -#lang racket +#lang racket/base +(require racket/contract + racket/match) + (define-struct stuffer (in out)) (define (stuffer/c dom rng) (define in (dom . -> . rng)) diff --git a/collects/web-server/web-config-sig.rkt b/collects/web-server/web-config-sig.rkt index 156b49310e..35a10553fd 100644 --- a/collects/web-server/web-config-sig.rkt +++ b/collects/web-server/web-config-sig.rkt @@ -1,5 +1,7 @@ -#lang racket -(require web-server/private/util +#lang racket/base +(require racket/unit + racket/contract + web-server/private/util web-server/configuration/namespace web-server/configuration/configuration-table-structs) diff --git a/collects/xml/plist.rkt b/collects/xml/plist.rkt index a56e700027..291bf614ce 100644 --- a/collects/xml/plist.rkt +++ b/collects/xml/plist.rkt @@ -1,5 +1,7 @@ -#lang racket -(require xml) +#lang racket/base +(require racket/list + racket/contract + xml) ; a dict is (list 'dict assoc-pair ...) ; an assoc-pair is (list 'assoc-pair key value) diff --git a/collects/xml/private/reader.rkt b/collects/xml/private/reader.rkt index 12c2fa8a49..634c91e8d9 100644 --- a/collects/xml/private/reader.rkt +++ b/collects/xml/private/reader.rkt @@ -1,5 +1,8 @@ -#lang racket -(require "structures.rkt") +#lang racket/base +(require racket/contract + racket/list + racket/match + "structures.rkt") (provide/contract [read-xml (() (input-port?) . ->* . document?)] diff --git a/collects/xml/private/space.rkt b/collects/xml/private/space.rkt index 0fc5f311f2..c3b3d95dfb 100644 --- a/collects/xml/private/space.rkt +++ b/collects/xml/private/space.rkt @@ -1,5 +1,7 @@ -#lang racket -(require "structures.rkt") +#lang racket/base +(require racket/contract + racket/list + "structures.rkt") (provide/contract [eliminate-whitespace (() ((listof symbol?) (boolean? . -> . boolean?)) . ->* . (element? . -> . element?))]) diff --git a/collects/xml/private/syntax.rkt b/collects/xml/private/syntax.rkt index 35bb1c2985..60ad149bf7 100644 --- a/collects/xml/private/syntax.rkt +++ b/collects/xml/private/syntax.rkt @@ -1,5 +1,7 @@ -#lang racket -(require "structures.rkt" +#lang racket/base +(require racket/contract + racket/list + "structures.rkt" "reader.rkt" "xexpr.rkt") diff --git a/collects/xml/private/writer.rkt b/collects/xml/private/writer.rkt index b3ad03ed35..7443ccf236 100644 --- a/collects/xml/private/writer.rkt +++ b/collects/xml/private/writer.rkt @@ -1,5 +1,6 @@ -#lang racket -(require "structures.rkt") +#lang racket/base +(require racket/contract + "structures.rkt") (provide/contract [write-xml ((document?) (output-port?) . ->* . void?)] diff --git a/collects/xml/scheme-snipclass.rkt b/collects/xml/scheme-snipclass.rkt index 45bd2b80cb..94c7f3500c 100644 --- a/collects/xml/scheme-snipclass.rkt +++ b/collects/xml/scheme-snipclass.rkt @@ -1,35 +1,35 @@ -(module scheme-snipclass mzscheme - (require stepper/private/xml-snip-helpers - mzlib/class - mred) - - (provide snip-class scheme-snip%) +#lang racket/base +(require stepper/private/xml-snip-helpers + mzlib/class + mred) - (define scheme-snip% - (class* editor-snip% (scheme-snip<%> readable-snip<%>) - (init-field splice?) - (define/public (get-splice?) splice?) +(provide snip-class scheme-snip%) - (define/public (read-special file line col pos) - (scheme-read-special this - file - line - col - pos)) - - (super-instantiate ()))) - - (define scheme-snipclass% - (class snip-class% - (define/override (read stream-in) - (let* ([splice? (zero? (send stream-in get-exact))] - [snip (instantiate scheme-snip% () - (splice? splice?))]) - (send (send snip get-editor) read-from-file stream-in #f) - snip)) - (super-instantiate ()))) - - (define snip-class (make-object scheme-snipclass%)) - (send snip-class set-version 1) - (send snip-class set-classname (format "~s" '(lib "scheme-snipclass.rkt" "xml"))) - (send (get-the-snip-class-list) add snip-class)) +(define scheme-snip% + (class* editor-snip% (scheme-snip<%> readable-snip<%>) + (init-field splice?) + (define/public (get-splice?) splice?) + + (define/public (read-special file line col pos) + (scheme-read-special this + file + line + col + pos)) + + (super-instantiate ()))) + +(define scheme-snipclass% + (class snip-class% + (define/override (read stream-in) + (let* ([splice? (zero? (send stream-in get-exact))] + [snip (instantiate scheme-snip% () + (splice? splice?))]) + (send (send snip get-editor) read-from-file stream-in #f) + snip)) + (super-instantiate ()))) + +(define snip-class (make-object scheme-snipclass%)) +(send snip-class set-version 1) +(send snip-class set-classname (format "~s" '(lib "scheme-snipclass.rkt" "xml"))) +(send (get-the-snip-class-list) add snip-class) diff --git a/collects/xml/text-box-tool.rkt b/collects/xml/text-box-tool.rkt index b9c08e8479..458cd51448 100644 --- a/collects/xml/text-box-tool.rkt +++ b/collects/xml/text-box-tool.rkt @@ -1,37 +1,37 @@ -(module text-box-tool mzscheme - (require drscheme/tool - mred - framework - "text-snipclass.rkt" - mzlib/unit - mzlib/class - string-constants - mrlib/include-bitmap) - - (provide tool@) +#lang racket/base +(require drscheme/tool + mred + framework + "text-snipclass.rkt" + mzlib/unit + mzlib/class + string-constants + mrlib/include-bitmap) - (define tool@ - (unit - (import drscheme:tool^) - (export drscheme:tool-exports^) - (define (phase1) (void)) - (define (phase2) (void)) - - (define (text-box-mixin %) - (class % - (inherit get-insert-menu get-edit-target-object register-capability-menu-item) - (super-new) - (new menu-item% - (label (string-constant insert-text-box-item)) - (parent (get-insert-menu)) - (callback - (lambda (menu event) - (let ([c-box (new text-box%)] - [text (get-edit-target-object)]) - (send text insert c-box) - (send text set-caret-owner c-box 'global))))) - (register-capability-menu-item 'drscheme:special:insert-text-box (get-insert-menu)))) - - (drscheme:get/extend:extend-unit-frame text-box-mixin) - - (drscheme:language:register-capability 'drscheme:special:insert-text-box boolean? #t)))) +(provide tool@) + +(define tool@ + (unit + (import drscheme:tool^) + (export drscheme:tool-exports^) + (define (phase1) (void)) + (define (phase2) (void)) + + (define (text-box-mixin %) + (class % + (inherit get-insert-menu get-edit-target-object register-capability-menu-item) + (super-new) + (new menu-item% + (label (string-constant insert-text-box-item)) + (parent (get-insert-menu)) + (callback + (lambda (menu event) + (let ([c-box (new text-box%)] + [text (get-edit-target-object)]) + (send text insert c-box) + (send text set-caret-owner c-box 'global))))) + (register-capability-menu-item 'drscheme:special:insert-text-box (get-insert-menu)))) + + (drscheme:get/extend:extend-unit-frame text-box-mixin) + + (drscheme:language:register-capability 'drscheme:special:insert-text-box boolean? #t))) diff --git a/collects/xml/text-snipclass.rkt b/collects/xml/text-snipclass.rkt index 70a910a0d8..7ee5cf77a5 100644 --- a/collects/xml/text-snipclass.rkt +++ b/collects/xml/text-snipclass.rkt @@ -1,148 +1,148 @@ -(module text-snipclass mzscheme - (require framework - mzlib/class - mred) +#lang racket/base +(require framework + mzlib/class + mred) - (provide text-box% - (rename snipclass snip-class)) +(provide text-box% + (rename-out [snipclass snip-class])) - ;; chunk-string: (listof any) -> (listof any) - (define (chunk-string s acc) - (cond - ((and (null? s) (null? acc)) null) - ((null? s) (list (list->string (reverse acc)))) - ((char? (car s)) (chunk-string (cdr s) (cons (car s) acc))) - ((null? acc) (cons (car s) (chunk-string (cdr s) null))) - (else (cons (list->string (reverse acc)) (cons (car s) (chunk-string (cdr s) null)))))) - - (define get-icon - (let ([icon #f]) - (λ () - (unless icon - (let () - (define str "“”") - (define bdc (make-object bitmap-dc% (make-object bitmap% 1 1))) - (define font (send the-font-list find-or-create-font 24 'default 'normal 'normal)) - (define-values (w h _1 _2) (send bdc get-text-extent str font)) - (define bmp (make-object bitmap% (floor (inexact->exact w)) (floor (inexact->exact h)))) - (send bdc set-bitmap bmp) - (send bdc set-smoothing 'aligned) - (send bdc set-font font) - (send bdc clear) - (send bdc draw-text str 0 0) - (send bdc set-bitmap #f) - (set! icon bmp))) - icon))) - - - ;; marshall: writable -> string - (define (marshall s) - (let ((os (open-output-string))) - (with-handlers ((exn:fail? (lambda (x) ""))) - (write s os) - (get-output-string os)))) +;; chunk-string: (listof any) -> (listof any) +(define (chunk-string s acc) + (cond + ((and (null? s) (null? acc)) null) + ((null? s) (list (list->string (reverse acc)))) + ((char? (car s)) (chunk-string (cdr s) (cons (car s) acc))) + ((null? acc) (cons (car s) (chunk-string (cdr s) null))) + (else (cons (list->string (reverse acc)) (cons (car s) (chunk-string (cdr s) null)))))) - (define snipclass-text-box% - (class decorated-editor-snipclass% - (define/override (make-snip stream-in) (new text-box%)) - (super-instantiate ()))) - - (define old-snipclass (new snipclass-text-box%)) - (send old-snipclass set-version 1) - (send old-snipclass set-classname "text-box%") - (send (get-the-snip-class-list) add old-snipclass) +(define get-icon + (let ([icon #f]) + (λ () + (unless icon + (let () + (define str "“”") + (define bdc (make-object bitmap-dc% (make-object bitmap% 1 1))) + (define font (send the-font-list find-or-create-font 24 'default 'normal 'normal)) + (define-values (w h _1 _2) (send bdc get-text-extent str font)) + (define bmp (make-object bitmap% (floor (inexact->exact w)) (floor (inexact->exact h)))) + (send bdc set-bitmap bmp) + (send bdc set-smoothing 'aligned) + (send bdc set-font font) + (send bdc clear) + (send bdc draw-text str 0 0) + (send bdc set-bitmap #f) + (set! icon bmp))) + icon))) - (define snipclass (new snipclass-text-box%)) - (send snipclass set-version 1) - (send snipclass set-classname (format "~s" '(lib "text-snipclass.ss" "xml"))) - (send (get-the-snip-class-list) add snipclass) - (define text-box% - (class* decorated-editor-snip% (readable-snip<%>) - (define/override (make-editor) (let ([e (new text:keymap%)]) - (send e set-max-undo-history 'forever) - e)) - (define/override (make-snip) (make-object text-box%)) - (inherit get-editor get-admin) - - - (define/override (get-corner-bitmap) - (get-icon)) +;; marshall: writable -> string +(define (marshall s) + (let ((os (open-output-string))) + (with-handlers ((exn:fail? (lambda (x) ""))) + (write s os) + (get-output-string os)))) - (define/override (get-menu) - (let ([menu (new popup-menu%)]) - (new menu-item% - (label "Convert to string") - (parent menu) - (callback - (lambda (x y) - (let ([to-ed (find-containing-editor)]) - (when to-ed - (let ([this-pos (find-this-position)]) - (when this-pos - (let ([from-ed (get-editor)]) - (send to-ed begin-edit-sequence) - (send from-ed begin-edit-sequence) - (send to-ed delete this-pos (+ this-pos 1)) - (let* ((p (open-input-text-editor from-ed 0 'end - (lambda (s) - (values (box s) 1)))) - (contents - (let loop ((next (read-char-or-special p))) - (cond - ((eof-object? next) null) - (else - (cons next (loop (read-char-or-special p))))))) - (repaired-contents - (map (lambda (x) - (if (string? x) - (marshall x) - (send (unbox x) copy))) - (chunk-string contents null)))) - (for-each - (lambda (x) - (send to-ed insert x this-pos)) - (reverse repaired-contents))) - (send to-ed end-edit-sequence) - (send from-ed end-edit-sequence))))))))) - menu)) - - ;; find-containing-editor : -> (union #f editor) - (define/private (find-containing-editor) - (let ([admin (get-admin)]) - (and admin - (send admin get-editor)))) - - ;; find-this-position : -> (union #f number) - (define/private (find-this-position) - (let ([ed (find-containing-editor)]) - (and ed - (send ed get-snip-position this)))) +(define snipclass-text-box% + (class decorated-editor-snipclass% + (define/override (make-snip stream-in) (new text-box%)) + (super-instantiate ()))) - ;; input-port -> (union (listof char) char eof-object? syntax-object) - (define/private (get-next port) - (let ([v (read-char-or-special port)]) - (if (special-comment? v) - (get-next port) - v))) - - (define/public (read-special source line column position) - (let* ((ed (get-editor)) - (port (open-input-text-editor ed)) - (str (let loop ((next (get-next port))) - (cond - ((eof-object? next) null) - ((char? next) - (cons next (loop (get-next port)))) - (else (cons #`(marshall #,next) (loop (get-next port)))))))) - #`(let ((marshall - (lambda (s) - (let ((os (open-output-string))) - (with-handlers ((exn:fail? (lambda (x) ""))) - (display s os) - (get-output-string os)))))) - (string-append #,@(chunk-string str null))))) - - (super-instantiate ()) - (inherit set-snipclass) - (set-snipclass snipclass)))) +(define old-snipclass (new snipclass-text-box%)) +(send old-snipclass set-version 1) +(send old-snipclass set-classname "text-box%") +(send (get-the-snip-class-list) add old-snipclass) + +(define snipclass (new snipclass-text-box%)) +(send snipclass set-version 1) +(send snipclass set-classname (format "~s" '(lib "text-snipclass.ss" "xml"))) +(send (get-the-snip-class-list) add snipclass) + +(define text-box% + (class* decorated-editor-snip% (readable-snip<%>) + (define/override (make-editor) (let ([e (new text:keymap%)]) + (send e set-max-undo-history 'forever) + e)) + (define/override (make-snip) (make-object text-box%)) + (inherit get-editor get-admin) + + + (define/override (get-corner-bitmap) + (get-icon)) + + (define/override (get-menu) + (let ([menu (new popup-menu%)]) + (new menu-item% + (label "Convert to string") + (parent menu) + (callback + (lambda (x y) + (let ([to-ed (find-containing-editor)]) + (when to-ed + (let ([this-pos (find-this-position)]) + (when this-pos + (let ([from-ed (get-editor)]) + (send to-ed begin-edit-sequence) + (send from-ed begin-edit-sequence) + (send to-ed delete this-pos (+ this-pos 1)) + (let* ((p (open-input-text-editor from-ed 0 'end + (lambda (s) + (values (box s) 1)))) + (contents + (let loop ((next (read-char-or-special p))) + (cond + ((eof-object? next) null) + (else + (cons next (loop (read-char-or-special p))))))) + (repaired-contents + (map (lambda (x) + (if (string? x) + (marshall x) + (send (unbox x) copy))) + (chunk-string contents null)))) + (for-each + (lambda (x) + (send to-ed insert x this-pos)) + (reverse repaired-contents))) + (send to-ed end-edit-sequence) + (send from-ed end-edit-sequence))))))))) + menu)) + + ;; find-containing-editor : -> (union #f editor) + (define/private (find-containing-editor) + (let ([admin (get-admin)]) + (and admin + (send admin get-editor)))) + + ;; find-this-position : -> (union #f number) + (define/private (find-this-position) + (let ([ed (find-containing-editor)]) + (and ed + (send ed get-snip-position this)))) + + ;; input-port -> (union (listof char) char eof-object? syntax-object) + (define/private (get-next port) + (let ([v (read-char-or-special port)]) + (if (special-comment? v) + (get-next port) + v))) + + (define/public (read-special source line column position) + (let* ((ed (get-editor)) + (port (open-input-text-editor ed)) + (str (let loop ((next (get-next port))) + (cond + ((eof-object? next) null) + ((char? next) + (cons next (loop (get-next port)))) + (else (cons #`(marshall #,next) (loop (get-next port)))))))) + #`(let ((marshall + (lambda (s) + (let ((os (open-output-string))) + (with-handlers ((exn:fail? (lambda (x) ""))) + (display s os) + (get-output-string os)))))) + (string-append #,@(chunk-string str null))))) + + (super-instantiate ()) + (inherit set-snipclass) + (set-snipclass snipclass))) diff --git a/collects/xml/xml-snipclass.rkt b/collects/xml/xml-snipclass.rkt index a03f8fc6aa..65490f8b07 100644 --- a/collects/xml/xml-snipclass.rkt +++ b/collects/xml/xml-snipclass.rkt @@ -1,35 +1,35 @@ -(module xml-snipclass mzscheme - (require stepper/private/xml-snip-helpers - mzlib/class - mred) - - (provide snip-class xml-snip%) +#lang racket/base +(require stepper/private/xml-snip-helpers + mzlib/class + mred) - (define xml-snip% - (class* editor-snip% (xml-snip<%> readable-snip<%>) - (init-field eliminate-whitespace-in-empty-tags?) - - (define/public (read-special file line col pos) - (xml-read-special eliminate-whitespace-in-empty-tags? - this - file - line - col - pos)) - - (super-new))) - - (define xml-snipclass% - (class snip-class% - (define/override (read stream-in) - (let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))] - [snip (instantiate xml-snip% () - (eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))]) - (send (send snip get-editor) read-from-file stream-in #f) - snip)) - (super-new))) - - (define snip-class (make-object xml-snipclass%)) - (send snip-class set-version 1) - (send snip-class set-classname (format "~s" '(lib "xml-snipclass.rkt" "xml"))) - (send (get-the-snip-class-list) add snip-class)) +(provide snip-class xml-snip%) + +(define xml-snip% + (class* editor-snip% (xml-snip<%> readable-snip<%>) + (init-field eliminate-whitespace-in-empty-tags?) + + (define/public (read-special file line col pos) + (xml-read-special eliminate-whitespace-in-empty-tags? + this + file + line + col + pos)) + + (super-new))) + +(define xml-snipclass% + (class snip-class% + (define/override (read stream-in) + (let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))] + [snip (instantiate xml-snip% () + (eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))]) + (send (send snip get-editor) read-from-file stream-in #f) + snip)) + (super-new))) + +(define snip-class (make-object xml-snipclass%)) +(send snip-class set-version 1) +(send snip-class set-classname (format "~s" '(lib "xml-snipclass.rkt" "xml"))) +(send (get-the-snip-class-list) add snip-class) diff --git a/collects/xml/xml.rkt b/collects/xml/xml.rkt index d2928312d3..6a00c155c3 100644 --- a/collects/xml/xml.rkt +++ b/collects/xml/xml.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require "private/structures.rkt" "private/reader.rkt" "private/space.rkt"