From d1a0086471bf5e9553a9b056b26286c427831d38 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 14 Jan 2009 03:10:47 +0000 Subject: [PATCH 1/8] newlines at EOFs svn: r13105 --- collects/2htdp/universe.ss | 2 +- collects/drscheme/private/insert-large-letters.ss | 2 +- collects/framework/private/comment-box.ss | 2 +- collects/framework/private/search.ss | 2 +- collects/framework/private/sig.ss | 2 +- collects/games/chat-noir/info.ss | 2 +- collects/htdp/Test/hangman-error.ss | 2 +- collects/macro-debugger/model/hiding-policies.ss | 2 +- collects/mrlib/close-icon.ss | 2 +- collects/mzlib/contract.ss | 2 +- collects/mzlib/scribblings/trace.scrbl | 2 +- collects/net/scribblings/ssl-tcp-unit.scrbl | 2 +- collects/plot/plot.scrbl | 2 +- collects/profj/scribblings/advanced.scrbl | 2 +- collects/profj/scribblings/beginner.scrbl | 2 +- collects/profj/scribblings/intermediate-access.scrbl | 2 +- collects/profj/scribblings/intermediate.scrbl | 2 +- collects/redex/examples/beginner.ss | 2 +- collects/redex/examples/semaphores.ss | 2 +- collects/redex/examples/subject-reduction.ss | 2 +- collects/redex/examples/subst.ss | 2 +- collects/redex/gui.ss | 2 +- collects/redex/main.ss | 2 +- collects/redex/pict.ss | 2 +- collects/redex/private/color-test.ss | 2 +- collects/redex/private/core-layout.ss | 2 +- collects/redex/private/lw-test-util.ss | 2 +- collects/redex/private/pict-test.ss | 2 +- collects/redex/private/reduction-semantics.ss | 2 +- collects/redex/private/rewrite-side-conditions.ss | 2 +- collects/redex/private/rg.ss | 2 +- collects/redex/private/size-snip.ss | 2 +- collects/redex/private/term-test.ss | 2 +- collects/redex/private/term.ss | 2 +- collects/redex/private/underscore-allowed.ss | 2 +- collects/redex/reduction-semantics.ss | 2 +- collects/scheme/private/contract-guts.ss | 2 +- collects/scheme/private/map.ss | 1 - collects/scribble/private/manual-style.ss | 2 +- collects/scribblings/framework/standard-menus.scrbl | 2 +- collects/scribblings/tools/tool-lib-extracts.ss | 2 +- collects/srfi/42/comprehensions.scm | 2 +- collects/srfi/42/generator-definitions.scm | 2 +- collects/srfi/42/generator-struct.scm | 2 +- collects/srfi/42/generators.scm | 2 +- collects/srfi/42/loops.scm | 2 +- collects/srfi/42/simplifier.scm | 2 +- collects/stepper/private/debugger-summary.txt | 2 +- collects/syntax/modcollapse.ss | 2 +- collects/syntax/private/modhelp.ss | 2 +- collects/tests/mzscheme/benchmarks/shootout/mandelbrot.ss | 2 +- collects/tests/typed-scheme/660-examples/hw02.scm | 2 +- collects/tests/typed-scheme/660-examples/hw04.scm | 2 +- collects/tests/typed-scheme/660-examples/hw05.scm | 2 +- collects/tests/typed-scheme/fail/apply-dots.ss | 2 +- collects/tests/typed-scheme/fail/cl-bug.ss | 2 +- collects/tests/typed-scheme/fail/dotted-identity.ss | 2 +- collects/tests/typed-scheme/fail/formal-len-mismatches.ss | 2 +- collects/tests/typed-scheme/fail/nested-tvars.ss | 2 +- collects/tests/typed-scheme/fail/unbound-type.ss | 2 +- collects/tests/typed-scheme/succeed/cl-bug.ss | 2 +- collects/tests/typed-scheme/succeed/dot-intro.ss | 2 +- collects/tests/typed-scheme/succeed/fold-left-inst.ss | 2 +- collects/tests/typed-scheme/succeed/fold-left.ss | 2 +- collects/tests/typed-scheme/succeed/foldo.scm | 2 +- collects/tests/typed-scheme/succeed/hw01.scm | 1 - collects/tests/typed-scheme/succeed/lots-o-bugs.ss | 2 +- collects/tests/typed-scheme/succeed/nested-poly.ss | 2 +- collects/tests/typed-scheme/succeed/poly-subtype.ss | 2 +- collects/tests/typed-scheme/succeed/star-sizes.ss | 2 +- collects/tests/typed-scheme/succeed/unholy-terror.ss | 2 +- collects/tests/typed-scheme/succeed/values-dots.ss | 2 +- collects/tests/typed-scheme/succeed/with-handlers.ss | 2 +- collects/tests/typed-scheme/unit-tests/random-testing.ss | 2 +- collects/tests/web-server/dispatchers/dispatch-servlets-test.ss | 2 +- collects/tests/web-server/dispatchers/filesystem-map-test.ss | 2 +- collects/tests/web-server/lang-test.ss | 2 +- collects/tests/web-server/lang/abort-resume-test.ss | 2 +- collects/tests/web-server/servlet-env/env.ss | 2 +- collects/typed-scheme/infer/constraint-structs.ss | 2 +- collects/typed-scheme/infer/dmap.ss | 2 +- collects/typed-scheme/infer/infer-dummy.ss | 2 +- collects/typed-scheme/infer/infer.ss | 2 +- collects/typed-scheme/infer/restrict.ss | 2 +- collects/typed-scheme/no-check.ss | 2 +- collects/typed-scheme/private/env-lang.ss | 2 +- collects/typed-scheme/private/extra-procs.ss | 2 +- collects/typed-scheme/private/type-annotation.ss | 2 +- collects/typed-scheme/private/type-effect-convenience.ss | 2 +- collects/typed-scheme/private/type-env-lang.ss | 2 +- collects/typed-scheme/typecheck/tc-dots-unit.ss | 2 +- collects/typed-scheme/utils/utils.ss | 2 +- collects/typed/net/base64.ss | 1 - collects/typed/net/cgi.ss | 2 +- collects/typed/net/cookie.ss | 2 +- collects/typed/net/head.ss | 2 +- collects/typed/net/imap.ss | 2 +- collects/typed/net/pop3.ss | 2 -- collects/typed/net/qp.ss | 1 - collects/typed/net/sendmail.ss | 1 - collects/typed/net/sendurl.ss | 1 - collects/typed/net/smtp.ss | 2 -- collects/typed/net/uri-codec.ss | 1 - .../default-web-root/htdocs/servlets/examples/template-full.ss | 2 +- .../htdocs/servlets/examples/template-simple.ss | 2 +- .../default-web-root/htdocs/servlets/examples/template-xexpr.ss | 2 +- collects/web-server/dispatchers/dispatch-servlets.ss | 2 +- collects/web-server/formlets.ss | 2 +- collects/web-server/formlets/input.ss | 2 +- collects/web-server/formlets/lib.ss | 2 +- collects/web-server/formlets/servlet.ss | 2 +- collects/web-server/formlets/syntax.ss | 2 +- collects/web-server/http.ss | 2 +- collects/web-server/insta/insta.ss | 2 +- collects/web-server/lang/abort-resume.ss | 2 +- collects/web-server/lang/stuff-url.ss | 2 +- collects/web-server/private/gzip.ss | 2 +- collects/web-server/scribblings/configuration.scrbl | 2 +- collects/web-server/scribblings/formlets.scrbl | 2 +- collects/web-server/scribblings/http.scrbl | 2 +- collects/web-server/scribblings/lang-web-cells.scrbl | 2 +- collects/web-server/scribblings/lang.scrbl | 2 +- collects/web-server/scribblings/managers.scrbl | 2 +- collects/web-server/scribblings/running.scrbl | 2 +- collects/web-server/scribblings/servlet-env.scrbl | 2 +- collects/web-server/scribblings/stateless-servlet.scrbl | 2 +- collects/web-server/scribblings/tutorial/examples/dummy-10.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-10.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-5.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-6.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-7.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-8.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-9.ss | 2 +- .../web-server/scribblings/tutorial/examples/iteration-9s.ss | 2 +- .../web-server/scribblings/tutorial/examples/no-use-redirect.ss | 2 +- .../web-server/scribblings/tutorial/examples/send-suspend-2.ss | 2 +- .../web-server/scribblings/tutorial/examples/test-static.ss | 2 +- .../web-server/scribblings/tutorial/examples/use-redirect.ss | 2 +- collects/web-server/scribblings/tutorial/tutorial-util.ss | 2 +- collects/web-server/scribblings/v1-servlet.scrbl | 2 +- collects/web-server/scribblings/v2-servlet.scrbl | 2 +- collects/web-server/scribblings/web-cells.scrbl | 2 +- collects/web-server/scribblings/web-config-unit.scrbl | 2 +- collects/web-server/scribblings/web-server-unit.scrbl | 2 +- collects/web-server/scribblings/web.scrbl | 2 +- collects/web-server/servlet.ss | 2 +- collects/web-server/servlet/setup.ss | 2 +- collects/web-server/servlet/web.ss | 2 +- collects/web-server/templates.ss | 2 +- 149 files changed, 140 insertions(+), 151 deletions(-) diff --git a/collects/2htdp/universe.ss b/collects/2htdp/universe.ss index f8182421f8..4d2758168a 100644 --- a/collects/2htdp/universe.ss +++ b/collects/2htdp/universe.ss @@ -309,4 +309,4 @@ (on-new nu) (on-msg process) #; - (on-tick (lambda (u x) (printf "hello!\n") (list u)) 1))) \ No newline at end of file + (on-tick (lambda (u x) (printf "hello!\n") (list u)) 1))) diff --git a/collects/drscheme/private/insert-large-letters.ss b/collects/drscheme/private/insert-large-letters.ss index 97dcac48ae..ea55ecfbfb 100644 --- a/collects/drscheme/private/insert-large-letters.ss +++ b/collects/drscheme/private/insert-large-letters.ss @@ -195,4 +195,4 @@ (send bdc set-bitmap #f) bitmap) -;(make-large-letters-dialog ";" #\; #f) \ No newline at end of file +;(make-large-letters-dialog ";" #\; #f) diff --git a/collects/framework/private/comment-box.ss b/collects/framework/private/comment-box.ss index f95d26172d..ce73ab0f7f 100644 --- a/collects/framework/private/comment-box.ss +++ b/collects/framework/private/comment-box.ss @@ -122,4 +122,4 @@ (make-special-comment "comment")) (super-instantiate ()) (inherit set-snipclass) - (set-snipclass snipclass)))) \ No newline at end of file + (set-snipclass snipclass)))) diff --git a/collects/framework/private/search.ss b/collects/framework/private/search.ss index 3f066dfa3d..6f3acb577f 100644 --- a/collects/framework/private/search.ss +++ b/collects/framework/private/search.ss @@ -96,4 +96,4 @@ (if (not embedded-pos) (next-loop) (values embedded embedded-pos)))] - [else (next-loop)]))))))) \ No newline at end of file + [else (next-loop)]))))))) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index b96eef8d56..32e5a03316 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -465,4 +465,4 @@ (open (prefix frame: frame^)) (open (prefix handler: handler^)) (open (prefix scheme: scheme^)) - (open (prefix main: main^)))) \ No newline at end of file + (open (prefix main: main^)))) diff --git a/collects/games/chat-noir/info.ss b/collects/games/chat-noir/info.ss index 3e6104bd42..5c94ee961b 100644 --- a/collects/games/chat-noir/info.ss +++ b/collects/games/chat-noir/info.ss @@ -3,4 +3,4 @@ (define game "chat-noir-unit.ss") (define game-set "Puzzle Games") (define compile-omit-files '("chat-noir.ss")) -(define name "Chat Noir") \ No newline at end of file +(define name "Chat Noir") diff --git a/collects/htdp/Test/hangman-error.ss b/collects/htdp/Test/hangman-error.ss index 185c71e5fe..a3e6290f2d 100644 --- a/collects/htdp/Test/hangman-error.ss +++ b/collects/htdp/Test/hangman-error.ss @@ -11,4 +11,4 @@ (start 200 200) (check-error (hangman-list reveal-list draw-next-part) - "draw-next-part: result of type expected, given: #") \ No newline at end of file + "draw-next-part: result of type expected, given: #") diff --git a/collects/macro-debugger/model/hiding-policies.ss b/collects/macro-debugger/model/hiding-policies.ss index 0933b07056..7c5e36fe5d 100644 --- a/collects/macro-debugger/model/hiding-policies.ss +++ b/collects/macro-debugger/model/hiding-policies.ss @@ -437,4 +437,4 @@ (define (lib-module-path? mp) (or (symbol? mp) (and (pair? mp) (memq (car mp) '(lib planet))))) -|# \ No newline at end of file +|# diff --git a/collects/mrlib/close-icon.ss b/collects/mrlib/close-icon.ss index 80a7681e94..24e05a0c1b 100644 --- a/collects/mrlib/close-icon.ss +++ b/collects/mrlib/close-icon.ss @@ -118,4 +118,4 @@ (define f (new frame% [label "test"])) (define c (new close-icon% [parent f] [callback (λ () (printf "hi\n"))])) (define gb (new grow-box-spacer-pane% [parent f])) - (send f show #t)) \ No newline at end of file + (send f show #t)) diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss index bf96a1caf5..30abf6d70f 100644 --- a/collects/mzlib/contract.ss +++ b/collects/mzlib/contract.ss @@ -85,4 +85,4 @@ (define (flat-contract/predicate? pred) (or (flat-contract? pred) (and (procedure? pred) - (procedure-arity-includes? pred 1)))) \ No newline at end of file + (procedure-arity-includes? pred 1)))) diff --git a/collects/mzlib/scribblings/trace.scrbl b/collects/mzlib/scribblings/trace.scrbl index 148a86f9a9..0b7324e98f 100644 --- a/collects/mzlib/scribblings/trace.scrbl +++ b/collects/mzlib/scribblings/trace.scrbl @@ -78,4 +78,4 @@ traced call. It receives the name of the function, the function's ordinary arguments, its keywords, the values of the keywords, and a number indicating the depth of the call. -} \ No newline at end of file +} diff --git a/collects/net/scribblings/ssl-tcp-unit.scrbl b/collects/net/scribblings/ssl-tcp-unit.scrbl index c78ed27ec8..134d7c7ee7 100644 --- a/collects/net/scribblings/ssl-tcp-unit.scrbl +++ b/collects/net/scribblings/ssl-tcp-unit.scrbl @@ -53,4 +53,4 @@ connections: trusted root certificates; @scheme[#f] disables verification of peer server certificates} -]} \ No newline at end of file +]} diff --git a/collects/plot/plot.scrbl b/collects/plot/plot.scrbl index de02f5b2b0..3af0ea7439 100644 --- a/collects/plot/plot.scrbl +++ b/collects/plot/plot.scrbl @@ -668,4 +668,4 @@ Returns the altitude (in degrees) from which the 3-D box is viewed.} Returns the azimuthal angle.} -} \ No newline at end of file +} diff --git a/collects/profj/scribblings/advanced.scrbl b/collects/profj/scribblings/advanced.scrbl index d779c4d555..1746dea8ad 100644 --- a/collects/profj/scribblings/advanced.scrbl +++ b/collects/profj/scribblings/advanced.scrbl @@ -611,4 +611,4 @@ with their values specified by the ArrayInit. @item{@(scheme false)} - } \ No newline at end of file + } diff --git a/collects/profj/scribblings/beginner.scrbl b/collects/profj/scribblings/beginner.scrbl index 1aa767f30c..2a46233a60 100644 --- a/collects/profj/scribblings/beginner.scrbl +++ b/collects/profj/scribblings/beginner.scrbl @@ -252,4 +252,4 @@ The initialization statements pass the value provided to the constructor to the } @item{@(scheme true)} @item{@(scheme false)} - } \ No newline at end of file + } diff --git a/collects/profj/scribblings/intermediate-access.scrbl b/collects/profj/scribblings/intermediate-access.scrbl index e4945c43df..2c151d687b 100644 --- a/collects/profj/scribblings/intermediate-access.scrbl +++ b/collects/profj/scribblings/intermediate-access.scrbl @@ -421,4 +421,4 @@ us unique. Each constructor may set its own @elemref['(inta "mods")]{access}. A @item{@(scheme false)} - } \ No newline at end of file + } diff --git a/collects/profj/scribblings/intermediate.scrbl b/collects/profj/scribblings/intermediate.scrbl index 35e105f180..3f66b1a060 100644 --- a/collects/profj/scribblings/intermediate.scrbl +++ b/collects/profj/scribblings/intermediate.scrbl @@ -400,4 +400,4 @@ parameters, then the first statement in the constructor must be a @elemref['(int @item{@(scheme false)} - } \ No newline at end of file + } diff --git a/collects/redex/examples/beginner.ss b/collects/redex/examples/beginner.ss index 06ec094afb..1c1ddff67d 100644 --- a/collects/redex/examples/beginner.ss +++ b/collects/redex/examples/beginner.ss @@ -920,4 +920,4 @@ reflects the (broken) spec). ;; timing test #; (time (run-tests) - (run-big-test)) \ No newline at end of file + (run-big-test)) diff --git a/collects/redex/examples/semaphores.ss b/collects/redex/examples/semaphores.ss index 14dcbb44a4..dd3e939926 100644 --- a/collects/redex/examples/semaphores.ss +++ b/collects/redex/examples/semaphores.ss @@ -163,4 +163,4 @@ semaphores make things much more predictable... (semaphore-post (semaphore x))) (begin (semaphore-wait (semaphore x)) (set! y (cons 2 y)) - (semaphore-post (semaphore x)))))) \ No newline at end of file + (semaphore-post (semaphore x)))))) diff --git a/collects/redex/examples/subject-reduction.ss b/collects/redex/examples/subject-reduction.ss index 108ba8b741..a0a1beb918 100644 --- a/collects/redex/examples/subject-reduction.ss +++ b/collects/redex/examples/subject-reduction.ss @@ -105,4 +105,4 @@ (define (show term) (traces reductions term #:pred (pred term))) -(show '((lambda (x (num -> num)) 1) ((lambda (x (num -> num)) x) (lambda (x num) x)))) \ No newline at end of file +(show '((lambda (x (num -> num)) 1) ((lambda (x (num -> num)) x) (lambda (x num) x)))) diff --git a/collects/redex/examples/subst.ss b/collects/redex/examples/subst.ss index 0fd1307291..114a52338f 100644 --- a/collects/redex/examples/subst.ss +++ b/collects/redex/examples/subst.ss @@ -68,4 +68,4 @@ (term (λ (z1 x1) (λ (x) z)))) (test-equal (term (subst (x 1 (λ (x x) x)))) (term (λ (x x) x))) - (test-results)) \ No newline at end of file + (test-results)) diff --git a/collects/redex/gui.ss b/collects/redex/gui.ss index 873595fc01..4049673df4 100644 --- a/collects/redex/gui.ss +++ b/collects/redex/gui.ss @@ -85,4 +85,4 @@ [initial-char-width (parameter/c number?)]) (provide reduction-steps-cutoff - default-pretty-printer) \ No newline at end of file + default-pretty-printer) diff --git a/collects/redex/main.ss b/collects/redex/main.ss index 228d1030ea..c097d94864 100644 --- a/collects/redex/main.ss +++ b/collects/redex/main.ss @@ -5,4 +5,4 @@ (provide (all-from-out "reduction-semantics.ss" "gui.ss" "pict.ss")) -(provide render-language) \ No newline at end of file +(provide render-language) diff --git a/collects/redex/pict.ss b/collects/redex/pict.ss index cfe27898f0..4963c707cd 100644 --- a/collects/redex/pict.ss +++ b/collects/redex/pict.ss @@ -102,4 +102,4 @@ [lw->pict (-> (or/c (listof symbol?) compiled-lang?) lw? pict?)] [render-lw - (-> (or/c (listof symbol?) compiled-lang?) lw? pict?)]) \ No newline at end of file + (-> (or/c (listof symbol?) compiled-lang?) lw? pict?)]) diff --git a/collects/redex/private/color-test.ss b/collects/redex/private/color-test.ss index 181471a5fc..e010120f9a 100644 --- a/collects/redex/private/color-test.ss +++ b/collects/redex/private/color-test.ss @@ -66,4 +66,4 @@ In the other window, you expect to see the currently unreducted terms in green a (,(* (term number_1) 2) word) dup)) '(1 word) - #:pred last-color-pred)) \ No newline at end of file + #:pred last-color-pred)) diff --git a/collects/redex/private/core-layout.ss b/collects/redex/private/core-layout.ss index 4476b1c3e2..2699ca32d7 100644 --- a/collects/redex/private/core-layout.ss +++ b/collects/redex/private/core-layout.ss @@ -762,4 +762,4 @@ [else (for-each find/lw e)])) (find/e in-lws) - lws) \ No newline at end of file + lws) diff --git a/collects/redex/private/lw-test-util.ss b/collects/redex/private/lw-test-util.ss index 6ac0bed790..fb6e335dc4 100644 --- a/collects/redex/private/lw-test-util.ss +++ b/collects/redex/private/lw-test-util.ss @@ -40,4 +40,4 @@ [(string? e) (void)] [else (for-each find-min/lw e)])) (find-min/lw lw) - (values min-line min-col))) \ No newline at end of file + (values min-line min-col))) diff --git a/collects/redex/private/pict-test.ss b/collects/redex/private/pict-test.ss index c4332fd564..c80da26ac0 100644 --- a/collects/redex/private/pict-test.ss +++ b/collects/redex/private/pict-test.ss @@ -50,4 +50,4 @@ (render-language x0-10) - (printf "pict-test.ss passed\n")) \ No newline at end of file + (printf "pict-test.ss passed\n")) diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss index dbd0e873dc..2d8e625760 100644 --- a/collects/redex/private/reduction-semantics.ss +++ b/collects/redex/private/reduction-semantics.ss @@ -1847,4 +1847,4 @@ (provide relation-coverage covered-cases (rename-out [fresh-coverage make-coverage]) - coverage?) \ No newline at end of file + coverage?) diff --git a/collects/redex/private/rewrite-side-conditions.ss b/collects/redex/private/rewrite-side-conditions.ss index 398b29f1f8..f2fabd9671 100644 --- a/collects/redex/private/rewrite-side-conditions.ss +++ b/collects/redex/private/rewrite-side-conditions.ss @@ -177,4 +177,4 @@ (current-continuation-marks) (list (id/depth-id x) (id/depth-id (car dups))))))) (not same-id?))) - (loop (cdr dups))))])))) \ No newline at end of file + (loop (cdr dups))))])))) diff --git a/collects/redex/private/rg.ss b/collects/redex/private/rg.ss index c293b00359..039ab97946 100644 --- a/collects/redex/private/rg.ss +++ b/collects/redex/private/rg.ss @@ -859,4 +859,4 @@ To do a better job of not generating programs with free variables, generation-decisions) (provide/contract - [find-base-cases (-> compiled-lang? hash?)]) \ No newline at end of file + [find-base-cases (-> compiled-lang? hash?)]) diff --git a/collects/redex/private/size-snip.ss b/collects/redex/private/size-snip.ss index 005eb24c48..15d40ae1f8 100644 --- a/collects/redex/private/size-snip.ss +++ b/collects/redex/private/size-snip.ss @@ -193,4 +193,4 @@ (super-new) (inherit use-style-background) - (use-style-background #t)))) \ No newline at end of file + (use-style-background #t)))) diff --git a/collects/redex/private/term-test.ss b/collects/redex/private/term-test.ss index 2e37e83501..12d357c470 100644 --- a/collects/redex/private/term-test.ss +++ b/collects/redex/private/term-test.ss @@ -76,4 +76,4 @@ (term (((metafun x) y) ...)))) '((whatever 4) (whatever 5) (whatever 6))) - (print-tests-passed 'term-test.ss)) \ No newline at end of file + (print-tests-passed 'term-test.ss)) diff --git a/collects/redex/private/term.ss b/collects/redex/private/term.ss index 5be16c23f4..59ead46a8b 100644 --- a/collects/redex/private/term.ss +++ b/collects/redex/private/term.ss @@ -127,4 +127,4 @@ (with-syntax ([x rhs] ...) (begin body1 body2 ...)))] [(_ x) - (raise-syntax-error 'term-let "expected at least one body" stx)]))) \ No newline at end of file + (raise-syntax-error 'term-let "expected at least one body" stx)]))) diff --git a/collects/redex/private/underscore-allowed.ss b/collects/redex/private/underscore-allowed.ss index b5180ce00c..fcc48db73a 100644 --- a/collects/redex/private/underscore-allowed.ss +++ b/collects/redex/private/underscore-allowed.ss @@ -1,3 +1,3 @@ (module underscore-allowed mzscheme (provide underscore-allowed) - (define underscore-allowed '(any number string variable))) \ No newline at end of file + (define underscore-allowed '(any number string variable))) diff --git a/collects/redex/reduction-semantics.ss b/collects/redex/reduction-semantics.ss index 68c4c14a93..d4e0271841 100644 --- a/collects/redex/reduction-semantics.ss +++ b/collects/redex/reduction-semantics.ss @@ -70,4 +70,4 @@ (one-of/c #t (void)))] [relation-coverage (parameter/c (or/c false/c coverage?))] [make-coverage (-> reduction-relation? coverage?)] - [covered-cases (-> coverage? (listof (cons/c string? natural-number/c)))]) \ No newline at end of file + [covered-cases (-> coverage? (listof (cons/c string? natural-number/c)))]) diff --git a/collects/scheme/private/contract-guts.ss b/collects/scheme/private/contract-guts.ss index 6627e2dee7..6ff2129aed 100644 --- a/collects/scheme/private/contract-guts.ss +++ b/collects/scheme/private/contract-guts.ss @@ -516,4 +516,4 @@ #:property name-prop (λ (ctc) (predicate-contract-name ctc)) #:property flat-prop (λ (ctc) (predicate-contract-pred ctc))) -(define (build-flat-contract name pred) (make-predicate-contract name pred)) \ No newline at end of file +(define (build-flat-contract name pred) (make-predicate-contract name pred)) diff --git a/collects/scheme/private/map.ss b/collects/scheme/private/map.ss index c30c179da4..682747f0b4 100644 --- a/collects/scheme/private/map.ss +++ b/collects/scheme/private/map.ss @@ -127,4 +127,3 @@ (ormap f l1 l2))] [(f . args) (apply ormap f args)])]) ormap))) - \ No newline at end of file diff --git a/collects/scribble/private/manual-style.ss b/collects/scribble/private/manual-style.ss index 9a54845ea3..4af411d344 100644 --- a/collects/scribble/private/manual-style.ss +++ b/collects/scribble/private/manual-style.ss @@ -240,4 +240,4 @@ (list (make-element 'italic (list i)))])] [(eq? i 'rsquo) (list 'prime)] [else (list i)]))) - c)))) \ No newline at end of file + c)))) diff --git a/collects/scribblings/framework/standard-menus.scrbl b/collects/scribblings/framework/standard-menus.scrbl index 68ea66be92..ae1cce4e20 100644 --- a/collects/scribblings/framework/standard-menus.scrbl +++ b/collects/scribblings/framework/standard-menus.scrbl @@ -349,4 +349,4 @@ @(defmethod (help-menu:after-about (menu (is-a?/c menu-item%))) void? "This method is called " "after" " the addition of the" "\n" (tt "about") " menu-item. Override it to add additional" "\n" "menu items at that point. ") -} \ No newline at end of file +} diff --git a/collects/scribblings/tools/tool-lib-extracts.ss b/collects/scribblings/tools/tool-lib-extracts.ss index a568392373..469341348a 100644 --- a/collects/scribblings/tools/tool-lib-extracts.ss +++ b/collects/scribblings/tools/tool-lib-extracts.ss @@ -2,4 +2,4 @@ (require scribble/extract) -(provide-extracted (lib "tool-lib.ss" "drscheme")) \ No newline at end of file +(provide-extracted (lib "tool-lib.ss" "drscheme")) diff --git a/collects/srfi/42/comprehensions.scm b/collects/srfi/42/comprehensions.scm index c2776152ed..0d870cf575 100644 --- a/collects/srfi/42/comprehensions.scm +++ b/collects/srfi/42/comprehensions.scm @@ -401,4 +401,4 @@ (qualifier) (first-ec #t qualifier (if (not expression)) #f) )) - ) \ No newline at end of file + ) diff --git a/collects/srfi/42/generator-definitions.scm b/collects/srfi/42/generator-definitions.scm index 94d6b32037..f2c1aad20f 100644 --- a/collects/srfi/42/generator-definitions.scm +++ b/collects/srfi/42/generator-definitions.scm @@ -35,4 +35,4 @@ (raise-syntax-error 'define-generator "expected either (define-generator ) or (define-generator ( ) ... , got: " - stx)]))) \ No newline at end of file + stx)]))) diff --git a/collects/srfi/42/generator-struct.scm b/collects/srfi/42/generator-struct.scm index b104e80987..af0dd942e3 100644 --- a/collects/srfi/42/generator-struct.scm +++ b/collects/srfi/42/generator-struct.scm @@ -14,4 +14,4 @@ ; of a generator clause as input. For example ; #'(:list x (list 1 2 3)). The function form->loop ; returns a loop structure. - (define-struct generator (name clause->loop))) \ No newline at end of file + (define-struct generator (name clause->loop))) diff --git a/collects/srfi/42/generators.scm b/collects/srfi/42/generators.scm index 89f2c1034f..c82dccb392 100644 --- a/collects/srfi/42/generators.scm +++ b/collects/srfi/42/generators.scm @@ -455,4 +455,4 @@ "expected (:while ) got: " form-stx)])) - ) \ No newline at end of file + ) diff --git a/collects/srfi/42/loops.scm b/collects/srfi/42/loops.scm index aa6e93fa61..8ec3c13f6f 100644 --- a/collects/srfi/42/loops.scm +++ b/collects/srfi/42/loops.scm @@ -107,4 +107,4 @@ (if ne2 (loop ls ...))))))))))])) - ) \ No newline at end of file + ) diff --git a/collects/srfi/42/simplifier.scm b/collects/srfi/42/simplifier.scm index d948e5ac39..ffa56f12f5 100644 --- a/collects/srfi/42/simplifier.scm +++ b/collects/srfi/42/simplifier.scm @@ -90,4 +90,4 @@ ; anything else ((ec-simplify expression) - #'expression )))) \ No newline at end of file + #'expression )))) diff --git a/collects/stepper/private/debugger-summary.txt b/collects/stepper/private/debugger-summary.txt index 1d76fd5600..a92604bfc0 100644 --- a/collects/stepper/private/debugger-summary.txt +++ b/collects/stepper/private/debugger-summary.txt @@ -13,4 +13,4 @@ by the chosen frame (bound) : all bound vars (v ) : value of a named variable - (src) : the source code \ No newline at end of file + (src) : the source code diff --git a/collects/syntax/modcollapse.ss b/collects/syntax/modcollapse.ss index a9db3765b3..a673d2d324 100644 --- a/collects/syntax/modcollapse.ss +++ b/collects/syntax/modcollapse.ss @@ -23,4 +23,4 @@ . -> . simple-rel-to-module-path-v/c)] [collapse-module-path-index ((or/c symbol? module-path-index?) rel-to-module-path-v/c - . -> . simple-rel-to-module-path-v/c)]) \ No newline at end of file + . -> . simple-rel-to-module-path-v/c)]) diff --git a/collects/syntax/private/modhelp.ss b/collects/syntax/private/modhelp.ss index 140580de6e..fe82aa6d18 100644 --- a/collects/syntax/private/modhelp.ss +++ b/collects/syntax/private/modhelp.ss @@ -17,4 +17,4 @@ (define (module-path-v? v) (or (path? v) - (module-path? v))) \ No newline at end of file + (module-path? v))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/mandelbrot.ss b/collects/tests/mzscheme/benchmarks/shootout/mandelbrot.ss index 12350c102f..3e8306c7b8 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/mandelbrot.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/mandelbrot.ss @@ -76,4 +76,4 @@ ;; ------------------------------- (command-line #:args (n) - (main (string->number n))) \ No newline at end of file + (main (string->number n))) diff --git a/collects/tests/typed-scheme/660-examples/hw02.scm b/collects/tests/typed-scheme/660-examples/hw02.scm index 57a991e2ec..3e3a17b5c6 100644 --- a/collects/tests/typed-scheme/660-examples/hw02.scm +++ b/collects/tests/typed-scheme/660-examples/hw02.scm @@ -235,4 +235,4 @@ |#|# - ) \ No newline at end of file + ) diff --git a/collects/tests/typed-scheme/660-examples/hw04.scm b/collects/tests/typed-scheme/660-examples/hw04.scm index 5447d85bb7..a9087adf1e 100644 --- a/collects/tests/typed-scheme/660-examples/hw04.scm +++ b/collects/tests/typed-scheme/660-examples/hw04.scm @@ -346,4 +346,4 @@ {fun main {foo} {call foo foo}}}" 1)) -) \ No newline at end of file +) diff --git a/collects/tests/typed-scheme/660-examples/hw05.scm b/collects/tests/typed-scheme/660-examples/hw05.scm index fb0855b533..4281058dcb 100644 --- a/collects/tests/typed-scheme/660-examples/hw05.scm +++ b/collects/tests/typed-scheme/660-examples/hw05.scm @@ -219,4 +219,4 @@ Evaluation rules: {fun {x} {fun {y} {+ x y}}}} 123}") => 124) - |#) \ No newline at end of file + |#) diff --git a/collects/tests/typed-scheme/fail/apply-dots.ss b/collects/tests/typed-scheme/fail/apply-dots.ss index d798f8c334..fd2b031378 100644 --- a/collects/tests/typed-scheme/fail/apply-dots.ss +++ b/collects/tests/typed-scheme/fail/apply-dots.ss @@ -10,4 +10,4 @@ (apply (case-lambda: (([x : Number] . [y : Number ... a]) x) (([x : String] [y : String] . [z : String *]) 0) ([y : String *] 0)) - w)) \ No newline at end of file + w)) diff --git a/collects/tests/typed-scheme/fail/cl-bug.ss b/collects/tests/typed-scheme/fail/cl-bug.ss index 443001845c..139d06eacc 100644 --- a/collects/tests/typed-scheme/fail/cl-bug.ss +++ b/collects/tests/typed-scheme/fail/cl-bug.ss @@ -4,4 +4,4 @@ (define (f3 x y) (+ x y)) (: f2 (case-lambda (Number * -> Number))) -(define (f2 x y) (+ x y)) \ No newline at end of file +(define (f2 x y) (+ x y)) diff --git a/collects/tests/typed-scheme/fail/dotted-identity.ss b/collects/tests/typed-scheme/fail/dotted-identity.ss index 543f46c312..c00f16b91a 100644 --- a/collects/tests/typed-scheme/fail/dotted-identity.ss +++ b/collects/tests/typed-scheme/fail/dotted-identity.ss @@ -8,4 +8,4 @@ (: g (All (b ...) ( -> (b ... b -> Integer)))) (define (g) (lambda xs 0)) -(f (g)) \ No newline at end of file +(f (g)) diff --git a/collects/tests/typed-scheme/fail/formal-len-mismatches.ss b/collects/tests/typed-scheme/fail/formal-len-mismatches.ss index bd640a06e7..371e3e7b48 100644 --- a/collects/tests/typed-scheme/fail/formal-len-mismatches.ss +++ b/collects/tests/typed-scheme/fail/formal-len-mismatches.ss @@ -14,4 +14,4 @@ (: f3 (Integer Integer -> Integer)) (define (f3 x . z) - (apply + #\c x z)) \ No newline at end of file + (apply + #\c x z)) diff --git a/collects/tests/typed-scheme/fail/nested-tvars.ss b/collects/tests/typed-scheme/fail/nested-tvars.ss index 9a03b559f3..21438e598b 100644 --- a/collects/tests/typed-scheme/fail/nested-tvars.ss +++ b/collects/tests/typed-scheme/fail/nested-tvars.ss @@ -6,4 +6,4 @@ (define (g x y) y) (g "foo" (list "foo"))) -(f 3) \ No newline at end of file +(f 3) diff --git a/collects/tests/typed-scheme/fail/unbound-type.ss b/collects/tests/typed-scheme/fail/unbound-type.ss index 3ae769ab65..6789d23ddd 100644 --- a/collects/tests/typed-scheme/fail/unbound-type.ss +++ b/collects/tests/typed-scheme/fail/unbound-type.ss @@ -6,4 +6,4 @@ (: f (Foo -> String)) (define (f x) (string-append x)) -(f 1) \ No newline at end of file +(f 1) diff --git a/collects/tests/typed-scheme/succeed/cl-bug.ss b/collects/tests/typed-scheme/succeed/cl-bug.ss index 09b9327f03..c5de036e14 100644 --- a/collects/tests/typed-scheme/succeed/cl-bug.ss +++ b/collects/tests/typed-scheme/succeed/cl-bug.ss @@ -4,4 +4,4 @@ (define (f . x) (+ 1 2)) (: f4 (case-lambda (Integer * -> Integer) (Number * -> Number))) -(define (f4 . x) (apply + x)) \ No newline at end of file +(define (f4 . x) (apply + x)) diff --git a/collects/tests/typed-scheme/succeed/dot-intro.ss b/collects/tests/typed-scheme/succeed/dot-intro.ss index 72c1f6849d..50c87e353b 100644 --- a/collects/tests/typed-scheme/succeed/dot-intro.ss +++ b/collects/tests/typed-scheme/succeed/dot-intro.ss @@ -13,4 +13,4 @@ y) (plambda: (a ...) ([x : Number] . [y : Number ... a]) - (map add1 y)) \ No newline at end of file + (map add1 y)) diff --git a/collects/tests/typed-scheme/succeed/fold-left-inst.ss b/collects/tests/typed-scheme/succeed/fold-left-inst.ss index 100ecbbaa9..d826c332b6 100644 --- a/collects/tests/typed-scheme/succeed/fold-left-inst.ss +++ b/collects/tests/typed-scheme/succeed/fold-left-inst.ss @@ -16,4 +16,4 @@ c (apply f (apply (inst fold-left c a b ... b) f c (cdr as) (map cdr bss)) - (car as) (map car bss)))) \ No newline at end of file + (car as) (map car bss)))) diff --git a/collects/tests/typed-scheme/succeed/fold-left.ss b/collects/tests/typed-scheme/succeed/fold-left.ss index ca1364daef..f2c9e4a3f1 100644 --- a/collects/tests/typed-scheme/succeed/fold-left.ss +++ b/collects/tests/typed-scheme/succeed/fold-left.ss @@ -38,4 +38,4 @@ 3 4 5) (fold-left (lambda: ([a : (Listof Integer)] [c : Integer]) (cons c a)) null (list 3 4 5 6)) -(fold-right (lambda: ([a : (Listof Integer)] [c : Integer]) (cons c a)) null (list 3 4 5 6)) \ No newline at end of file +(fold-right (lambda: ([a : (Listof Integer)] [c : Integer]) (cons c a)) null (list 3 4 5 6)) diff --git a/collects/tests/typed-scheme/succeed/foldo.scm b/collects/tests/typed-scheme/succeed/foldo.scm index c8de9df63a..fc10bc20a9 100644 --- a/collects/tests/typed-scheme/succeed/foldo.scm +++ b/collects/tests/typed-scheme/succeed/foldo.scm @@ -55,4 +55,4 @@ '() root )) - ) \ No newline at end of file + ) diff --git a/collects/tests/typed-scheme/succeed/hw01.scm b/collects/tests/typed-scheme/succeed/hw01.scm index 617ecb5979..2f829c07cd 100644 --- a/collects/tests/typed-scheme/succeed/hw01.scm +++ b/collects/tests/typed-scheme/succeed/hw01.scm @@ -108,4 +108,3 @@ (= 0 (list-length '())) (= 2 (list-length '(1 2))) (= 3 (list-length '(1 2 (1 2 3 4)))) - \ No newline at end of file diff --git a/collects/tests/typed-scheme/succeed/lots-o-bugs.ss b/collects/tests/typed-scheme/succeed/lots-o-bugs.ss index 98e4711c9a..d268e482e5 100644 --- a/collects/tests/typed-scheme/succeed/lots-o-bugs.ss +++ b/collects/tests/typed-scheme/succeed/lots-o-bugs.ss @@ -18,4 +18,4 @@ #;((plambda: (a ...) () (lambda: [ys : a ... a] 3))) #;((plambda: (a ...) [xs : a ... a] (lambda: [ys : a ... a] 3)) - 1 2 3 "foo") \ No newline at end of file + 1 2 3 "foo") diff --git a/collects/tests/typed-scheme/succeed/nested-poly.ss b/collects/tests/typed-scheme/succeed/nested-poly.ss index ac8bb3cd8c..a7de587fd6 100644 --- a/collects/tests/typed-scheme/succeed/nested-poly.ss +++ b/collects/tests/typed-scheme/succeed/nested-poly.ss @@ -17,4 +17,4 @@ (apply f as)) fs)))) -(inst map-with-funcs Integer Integer Integer Integer) \ No newline at end of file +(inst map-with-funcs Integer Integer Integer Integer) diff --git a/collects/tests/typed-scheme/succeed/poly-subtype.ss b/collects/tests/typed-scheme/succeed/poly-subtype.ss index 39288d7916..9e6ed0524d 100644 --- a/collects/tests/typed-scheme/succeed/poly-subtype.ss +++ b/collects/tests/typed-scheme/succeed/poly-subtype.ss @@ -17,4 +17,4 @@ (define (g x) 3) -|# \ No newline at end of file +|# diff --git a/collects/tests/typed-scheme/succeed/star-sizes.ss b/collects/tests/typed-scheme/succeed/star-sizes.ss index 6d04d7488f..b5995780fc 100644 --- a/collects/tests/typed-scheme/succeed/star-sizes.ss +++ b/collects/tests/typed-scheme/succeed/star-sizes.ss @@ -3,4 +3,4 @@ (: f (All (a) ((Integer a * -> Integer) -> Integer))) (define (f g) 0) -(f +) \ No newline at end of file +(f +) diff --git a/collects/tests/typed-scheme/succeed/unholy-terror.ss b/collects/tests/typed-scheme/succeed/unholy-terror.ss index 1abdcc3a79..7fbf8c7961 100644 --- a/collects/tests/typed-scheme/succeed/unholy-terror.ss +++ b/collects/tests/typed-scheme/succeed/unholy-terror.ss @@ -62,4 +62,4 @@ (map (lambda: ([f : (a ... a -> b)]) (apply f as)) fs))) -(map-with-funcs + - * /) \ No newline at end of file +(map-with-funcs + - * /) diff --git a/collects/tests/typed-scheme/succeed/values-dots.ss b/collects/tests/typed-scheme/succeed/values-dots.ss index 1c853f50b0..24e6bb1cde 100644 --- a/collects/tests/typed-scheme/succeed/values-dots.ss +++ b/collects/tests/typed-scheme/succeed/values-dots.ss @@ -27,4 +27,4 @@ (((inst map-with-funcs Integer Integer) (lambda: ([x : Integer] [y : Integer]) (+ x y)) (lambda: ([x : Integer] [y : Integer]) (- x y))) - 3 4) \ No newline at end of file + 3 4) diff --git a/collects/tests/typed-scheme/succeed/with-handlers.ss b/collects/tests/typed-scheme/succeed/with-handlers.ss index cfdb88aefb..bfbb1a150c 100644 --- a/collects/tests/typed-scheme/succeed/with-handlers.ss +++ b/collects/tests/typed-scheme/succeed/with-handlers.ss @@ -7,4 +7,4 @@ (define: (is-happiness-a-warm-gun?) : Boolean (with-handlers ([integer? (lambda: ([x : Any]) #t)]) (f 42) - #t)) \ No newline at end of file + #t)) diff --git a/collects/tests/typed-scheme/unit-tests/random-testing.ss b/collects/tests/typed-scheme/unit-tests/random-testing.ss index 8284005b27..4b64b15bda 100644 --- a/collects/tests/typed-scheme/unit-tests/random-testing.ss +++ b/collects/tests/typed-scheme/unit-tests/random-testing.ss @@ -67,4 +67,4 @@ (go 0) -;(generate (base-gen 1)) \ No newline at end of file +;(generate (base-gen 1)) diff --git a/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss b/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss index 9546581058..dbfb5b1322 100644 --- a/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss +++ b/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss @@ -119,4 +119,4 @@ ; Comment in to run tests #;(require #;(planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2)) (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))) -#;(test/text-ui dispatch-servlets-tests) \ No newline at end of file +#;(test/text-ui dispatch-servlets-tests) diff --git a/collects/tests/web-server/dispatchers/filesystem-map-test.ss b/collects/tests/web-server/dispatchers/filesystem-map-test.ss index 81a6e321e2..2597c326ae 100644 --- a/collects/tests/web-server/dispatchers/filesystem-map-test.ss +++ b/collects/tests/web-server/dispatchers/filesystem-map-test.ss @@ -78,4 +78,4 @@ (test-url->path test-filter-map (build-path "dispatchers/filesystem-map.html"))))) (test-case "Allows content after w/ valid" (test-url->path test-filter-valid-map (build-path "dispatchers/filesystem-map.ss/extra/info") - #:expected (build-path "dispatchers/filesystem-map.ss")))))) \ No newline at end of file + #:expected (build-path "dispatchers/filesystem-map.ss")))))) diff --git a/collects/tests/web-server/lang-test.ss b/collects/tests/web-server/lang-test.ss index f907c0ab87..1cc0be72dd 100644 --- a/collects/tests/web-server/lang-test.ss +++ b/collects/tests/web-server/lang-test.ss @@ -565,4 +565,4 @@ (define-values (point i) (values #t 1)) i))))))) - )) \ No newline at end of file + )) diff --git a/collects/tests/web-server/lang/abort-resume-test.ss b/collects/tests/web-server/lang/abort-resume-test.ss index 6086f5573b..0c4ce62f85 100644 --- a/collects/tests/web-server/lang/abort-resume-test.ss +++ b/collects/tests/web-server/lang/abort-resume-test.ss @@ -204,4 +204,4 @@ ; XXX test dispatch - )) \ No newline at end of file + )) diff --git a/collects/tests/web-server/servlet-env/env.ss b/collects/tests/web-server/servlet-env/env.ss index 6826d5c4d7..266ddd43d3 100644 --- a/collects/tests/web-server/servlet-env/env.ss +++ b/collects/tests/web-server/servlet-env/env.ss @@ -25,4 +25,4 @@ ,(number->string (+ (request-number "first") (request-number "second"))))))) (serve/servlet start - #:servlet-path "/") \ No newline at end of file + #:servlet-path "/") diff --git a/collects/typed-scheme/infer/constraint-structs.ss b/collects/typed-scheme/infer/constraint-structs.ss index d5c970348b..ef2bccc281 100644 --- a/collects/typed-scheme/infer/constraint-structs.ss +++ b/collects/typed-scheme/infer/constraint-structs.ss @@ -48,4 +48,4 @@ (struct dcon-exact ([fixed (listof c?)] [rest c?])) (struct dcon-dotted ([type c?] [bound symbol?])) (struct dmap ([map (hashof symbol? (or/c dcon? dcon-exact? dcon-dotted?))])) - (struct cset ([maps (listof (cons/c (hashof symbol? c?) dmap?))]))) \ No newline at end of file + (struct cset ([maps (listof (cons/c (hashof symbol? c?) dmap?))]))) diff --git a/collects/typed-scheme/infer/dmap.ss b/collects/typed-scheme/infer/dmap.ss index 9592668061..92747bf43d 100644 --- a/collects/typed-scheme/infer/dmap.ss +++ b/collects/typed-scheme/infer/dmap.ss @@ -63,4 +63,4 @@ (define (dmap-meet dm1 dm2) (make-dmap (hash-union (dmap-map dm1) (dmap-map dm2) - (lambda (k dc1 dc2) (dcon-meet dc1 dc2))))) \ No newline at end of file + (lambda (k dc1 dc2) (dcon-meet dc1 dc2))))) diff --git a/collects/typed-scheme/infer/infer-dummy.ss b/collects/typed-scheme/infer/infer-dummy.ss index d83922a61e..e87f744f21 100644 --- a/collects/typed-scheme/infer/infer-dummy.ss +++ b/collects/typed-scheme/infer/infer-dummy.ss @@ -5,4 +5,4 @@ (define infer-param (make-parameter (lambda e (int-err "infer not initialized")))) (define (unify X S T) ((infer-param) X S T (make-Univ) null)) -(provide unify infer-param) \ No newline at end of file +(provide unify infer-param) diff --git a/collects/typed-scheme/infer/infer.ss b/collects/typed-scheme/infer/infer.ss index 208943a32f..b8c3788381 100644 --- a/collects/typed-scheme/infer/infer.ss +++ b/collects/typed-scheme/infer/infer.ss @@ -9,4 +9,4 @@ (provide-signature-elements restrict^ infer^) (define-values/link-units/infer - infer@ constraints@ dmap@ restrict@ promote-demote@) \ No newline at end of file + infer@ constraints@ dmap@ restrict@ promote-demote@) diff --git a/collects/typed-scheme/infer/restrict.ss b/collects/typed-scheme/infer/restrict.ss index e13656056c..4d2d26380c 100644 --- a/collects/typed-scheme/infer/restrict.ss +++ b/collects/typed-scheme/infer/restrict.ss @@ -34,4 +34,4 @@ [(subtype t2 t1) t2] ;; we don't actually want this - want something that's a part of t1 [(not (overlap t1 t2)) (Un)] ;; there's no overlap, so the restriction is empty [else t2] ;; t2 and t1 have a complex relationship, so we punt - )) \ No newline at end of file + )) diff --git a/collects/typed-scheme/no-check.ss b/collects/typed-scheme/no-check.ss index 470a7bed8a..bd104f6110 100644 --- a/collects/typed-scheme/no-check.ss +++ b/collects/typed-scheme/no-check.ss @@ -2,4 +2,4 @@ (require "private/prims.ss") (provide (all-from-out scheme/base) - (all-from-out "private/prims.ss")) \ No newline at end of file + (all-from-out "private/prims.ss")) diff --git a/collects/typed-scheme/private/env-lang.ss b/collects/typed-scheme/private/env-lang.ss index 6fb99d02b7..c047e3a61d 100644 --- a/collects/typed-scheme/private/env-lang.ss +++ b/collects/typed-scheme/private/env-lang.ss @@ -35,4 +35,4 @@ (for-syntax (all-from-out scheme/base "type-effect-convenience.ss" - "union.ss"))) \ No newline at end of file + "union.ss"))) diff --git a/collects/typed-scheme/private/extra-procs.ss b/collects/typed-scheme/private/extra-procs.ss index b5cd5378db..0c8152b109 100644 --- a/collects/typed-scheme/private/extra-procs.ss +++ b/collects/typed-scheme/private/extra-procs.ss @@ -18,4 +18,4 @@ (define values* values) (define (foo x #:bar [bar #f]) - bar) \ No newline at end of file + bar) diff --git a/collects/typed-scheme/private/type-annotation.ss b/collects/typed-scheme/private/type-annotation.ss index 9ff2f8d005..3da58d4509 100644 --- a/collects/typed-scheme/private/type-annotation.ss +++ b/collects/typed-scheme/private/type-annotation.ss @@ -131,4 +131,4 @@ (define (dotted? stx) (cond [(syntax-property stx type-dotted-symbol) => syntax-e] - [else #f])) \ No newline at end of file + [else #f])) diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss index 49f21dd872..a3937b0215 100644 --- a/collects/typed-scheme/private/type-effect-convenience.ss +++ b/collects/typed-scheme/private/type-effect-convenience.ss @@ -295,4 +295,4 @@ (make-Function (list (make-arr* (append args (take opt-args i)) result)))))) (define-syntax-rule (->opt args ... [opt ...] res) - (opt-fn (list args ...) (list opt ...) res)) \ No newline at end of file + (opt-fn (list args ...) (list opt ...) res)) diff --git a/collects/typed-scheme/private/type-env-lang.ss b/collects/typed-scheme/private/type-env-lang.ss index 314e258c9a..d12fc33cc0 100644 --- a/collects/typed-scheme/private/type-env-lang.ss +++ b/collects/typed-scheme/private/type-env-lang.ss @@ -38,4 +38,4 @@ (all-from-out scheme/base "type-effect-convenience.ss" "../rep/type-rep.ss" - "union.ss"))) \ No newline at end of file + "union.ss"))) diff --git a/collects/typed-scheme/typecheck/tc-dots-unit.ss b/collects/typed-scheme/typecheck/tc-dots-unit.ss index aa2c7c17b1..2aa1b38220 100644 --- a/collects/typed-scheme/typecheck/tc-dots-unit.ss +++ b/collects/typed-scheme/typecheck/tc-dots-unit.ss @@ -39,4 +39,4 @@ [(tc-result: t) (tc/funapp #'f #'(l) ft (list (ret lty)) #f)]) (values t lbound))))] [_ - (tc-error "form cannot be used where a term of ... type is expected")]))) \ No newline at end of file + (tc-error "form cannot be used where a term of ... type is expected")]))) diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss index 6ca8a6a901..bfa0e50592 100644 --- a/collects/typed-scheme/utils/utils.ss +++ b/collects/typed-scheme/utils/utils.ss @@ -221,4 +221,4 @@ ;; Listof[A] Listof[B] B -> Listof[B] ;; pads out t to be as long as s (define (extend s t extra) - (append t (build-list (- (length s) (length t)) (lambda _ extra)))) \ No newline at end of file + (append t (build-list (- (length s) (length t)) (lambda _ extra)))) diff --git a/collects/typed/net/base64.ss b/collects/typed/net/base64.ss index 13061e4ea5..0745794516 100644 --- a/collects/typed/net/base64.ss +++ b/collects/typed/net/base64.ss @@ -10,4 +10,3 @@ [base64-decode (Bytes -> Bytes)]) (provide base64-encode-stream base64-decode-stream base64-encode base64-decode) - \ No newline at end of file diff --git a/collects/typed/net/cgi.ss b/collects/typed/net/cgi.ss index 65aac77ccc..9318478a73 100644 --- a/collects/typed/net/cgi.ss +++ b/collects/typed/net/cgi.ss @@ -26,4 +26,4 @@ (provide (struct-out cgi-error) (struct-out incomplete-%-suffix) - (struct-out invalid-%-suffix)) \ No newline at end of file + (struct-out invalid-%-suffix)) diff --git a/collects/typed/net/cookie.ss b/collects/typed/net/cookie.ss index 391463b938..fd55ea08d8 100644 --- a/collects/typed/net/cookie.ss +++ b/collects/typed/net/cookie.ss @@ -20,4 +20,4 @@ (require-typed-struct (cookie-error exn:fail) () net/cookie) -(provide Cookie cookie? (struct-out cookie-error)) \ No newline at end of file +(provide Cookie cookie? (struct-out cookie-error)) diff --git a/collects/typed/net/head.ss b/collects/typed/net/head.ss index 958eea1ef7..ec6493dc69 100644 --- a/collects/typed/net/head.ss +++ b/collects/typed/net/head.ss @@ -28,4 +28,4 @@ standard-message-header data-lines->data extract-addresses - assemble-address-field) \ No newline at end of file + assemble-address-field) diff --git a/collects/typed/net/imap.ss b/collects/typed/net/imap.ss index a4639fad19..4617b8db12 100644 --- a/collects/typed/net/imap.ss +++ b/collects/typed/net/imap.ss @@ -52,4 +52,4 @@ (provide imap-connection? - IMAP-Connection) \ No newline at end of file + IMAP-Connection) diff --git a/collects/typed/net/pop3.ss b/collects/typed/net/pop3.ss index ddc232371c..03020a7508 100644 --- a/collects/typed/net/pop3.ss +++ b/collects/typed/net/pop3.ss @@ -40,5 +40,3 @@ (require-typed-struct/provide (malformed-server-response pop3) ([communicator : communicator]) net/pop3) - - \ No newline at end of file diff --git a/collects/typed/net/qp.ss b/collects/typed/net/qp.ss index 092ccdde3a..9d0344a2e5 100644 --- a/collects/typed/net/qp.ss +++ b/collects/typed/net/qp.ss @@ -7,4 +7,3 @@ [qp-decode ( String -> String )] [qp-encode-stream (case-lambda (Input-Port Output-Port -> Void) (Input-Port Output-Port String -> Void) )] [qp-decode-stream ( Input-Port Output-Port -> Void )]) - \ No newline at end of file diff --git a/collects/typed/net/sendmail.ss b/collects/typed/net/sendmail.ss index 1dd748d8be..8528dfba12 100644 --- a/collects/typed/net/sendmail.ss +++ b/collects/typed/net/sendmail.ss @@ -9,4 +9,3 @@ (String String (Listof String) (Listof String) (Listof String) (Listof String) String * -> Output-Port)]) (provide send-mail-message/port send-mail-message #;no-mail-recipients) - \ No newline at end of file diff --git a/collects/typed/net/sendurl.ss b/collects/typed/net/sendurl.ss index 205096db36..2be923fc7b 100644 --- a/collects/typed/net/sendurl.ss +++ b/collects/typed/net/sendurl.ss @@ -6,4 +6,3 @@ [external-browser (-> (U Symbol #f (Pair String String)))]) (provide send-url unix-browser-list browser-preference? external-browser) - \ No newline at end of file diff --git a/collects/typed/net/smtp.ss b/collects/typed/net/smtp.ss index 4923a4b116..b36a7ab494 100644 --- a/collects/typed/net/smtp.ss +++ b/collects/typed/net/smtp.ss @@ -7,5 +7,3 @@ [smtp-sending-end-of-message (Parameter (-> Any))]) (provide smtp-send-message smtp-sending-end-of-message) - - \ No newline at end of file diff --git a/collects/typed/net/uri-codec.ss b/collects/typed/net/uri-codec.ss index bfbc991191..641487727c 100644 --- a/collects/typed/net/uri-codec.ss +++ b/collects/typed/net/uri-codec.ss @@ -12,4 +12,3 @@ [alist->form-urlencoded ( (Listof (cons Symbol String)) -> String )] [form-urlencoded->alist ( String -> (Listof (cons Symbol String)) )] [current-alist-separator-mode (Parameter Symbol)]) - \ No newline at end of file diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.ss b/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.ss index 5643aab6ad..282cc4ffea 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.ss +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-full.ss @@ -10,4 +10,4 @@ 200 "Okay" (current-seconds) TEXT/HTML-MIME-TYPE empty - (list (include-template "static.html")))) \ No newline at end of file + (list (include-template "static.html")))) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.ss b/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.ss index 61ef233ab8..942b3f3459 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.ss +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-simple.ss @@ -5,4 +5,4 @@ (define timeout +inf.0) (define (start initial-request) - (list #"text/html" (include-template "static.html"))) \ No newline at end of file + (list #"text/html" (include-template "static.html"))) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.ss b/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.ss index 28407c62ca..49acb1f274 100644 --- a/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.ss +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/template-xexpr.ss @@ -8,4 +8,4 @@ (define (start initial-request) `(html (pre ,(include-template "static.html")) "versus" - ,(make-cdata #f #f (include-template "static.html")))) \ No newline at end of file + ,(make-cdata #f #f (include-template "static.html")))) diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index fdb1b831d0..5add2d5958 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -84,4 +84,4 @@ ((servlet-handler the-servlet) req)) servlet-prompt))))))) - (output-response conn response)))) \ No newline at end of file + (output-response conn response)))) diff --git a/collects/web-server/formlets.ss b/collects/web-server/formlets.ss index 2d5df1edee..33c94348ec 100644 --- a/collects/web-server/formlets.ss +++ b/collects/web-server/formlets.ss @@ -8,4 +8,4 @@ (all-from-out web-server/formlets/syntax) formlet/c formlet-display - formlet-process) \ No newline at end of file + formlet-process) diff --git a/collects/web-server/formlets/input.ss b/collects/web-server/formlets/input.ss index 4b2df7985c..b56402d14d 100644 --- a/collects/web-server/formlets/input.ss +++ b/collects/web-server/formlets/input.ss @@ -29,4 +29,4 @@ (provide/contract [input-string (formlet/c string?)] [input-int (formlet/c integer?)] - [input-symbol (formlet/c symbol?)]) \ No newline at end of file + [input-symbol (formlet/c symbol?)]) diff --git a/collects/web-server/formlets/lib.ss b/collects/web-server/formlets/lib.ss index eed6588fcc..f5430413fd 100644 --- a/collects/web-server/formlets/lib.ss +++ b/collects/web-server/formlets/lib.ss @@ -95,4 +95,4 @@ [text (string? . -> . (formlet/c procedure?))] [tag-xexpr (symbol? (listof (list/c symbol? string?)) (formlet/c alpha) . -> . (formlet/c alpha))] [formlet-display ((formlet/c alpha) . -> . xexpr-forest/c)] - [formlet-process ((formlet/c alpha) request? . -> . alpha)]) \ No newline at end of file + [formlet-process ((formlet/c alpha) request? . -> . alpha)]) diff --git a/collects/web-server/formlets/servlet.ss b/collects/web-server/formlets/servlet.ss index 2e1230ec0f..eb3d7269b5 100644 --- a/collects/web-server/formlets/servlet.ss +++ b/collects/web-server/formlets/servlet.ss @@ -29,4 +29,4 @@ `(form ([action ,(embed/url (lambda (r) (formlet-process f r)))]) - ,@(formlet-display f))) \ No newline at end of file + ,@(formlet-display f))) diff --git a/collects/web-server/formlets/syntax.ss b/collects/web-server/formlets/syntax.ss index d82f01e69b..9a7ad2912a 100644 --- a/collects/web-server/formlets/syntax.ss +++ b/collects/web-server/formlets/syntax.ss @@ -48,4 +48,4 @@ (cross (pure (match-lambda [#,(cross-of #'q) e])) #,(circ-of #'q)))])) -(provide formlet) \ No newline at end of file +(provide formlet) diff --git a/collects/web-server/http.ss b/collects/web-server/http.ss index d7941f441b..634dc4230f 100644 --- a/collects/web-server/http.ss +++ b/collects/web-server/http.ss @@ -6,4 +6,4 @@ (provide (all-from-out web-server/http/basic-auth web-server/http/request-structs web-server/http/response-structs - web-server/http/redirect)) \ No newline at end of file + web-server/http/redirect)) diff --git a/collects/web-server/insta/insta.ss b/collects/web-server/insta/insta.ss index 5b1b335efa..03b85c9358 100644 --- a/collects/web-server/insta/insta.ss +++ b/collects/web-server/insta/insta.ss @@ -64,4 +64,4 @@ #:extra-files-paths (list extra-files-path) #:launch-browser? launch-browser?) (serve/servlet #,start - #:launch-browser? launch-browser?)))))])) \ No newline at end of file + #:launch-browser? launch-browser?)))))])) diff --git a/collects/web-server/lang/abort-resume.ss b/collects/web-server/lang/abort-resume.ss index 11c70b540a..7acf796856 100644 --- a/collects/web-server/lang/abort-resume.ss +++ b/collects/web-server/lang/abort-resume.ss @@ -188,4 +188,4 @@ (provide ;; "SERVLET" INTERFACE ; A contract would interfere with the safe-call? key - send/suspend) \ No newline at end of file + send/suspend) diff --git a/collects/web-server/lang/stuff-url.ss b/collects/web-server/lang/stuff-url.ss index 3917164127..3c435f4a0c 100644 --- a/collects/web-server/lang/stuff-url.ss +++ b/collects/web-server/lang/stuff-url.ss @@ -59,4 +59,4 @@ [(extract-param uri "cc") => (compose bytes->c gunzip/bytes base64-decode string->bytes/utf-8)] [(extract-param uri "hc") - => (compose bytes->c gunzip/bytes md5-lookup string->bytes/utf-8)])) \ No newline at end of file + => (compose bytes->c gunzip/bytes md5-lookup string->bytes/utf-8)])) diff --git a/collects/web-server/private/gzip.ss b/collects/web-server/private/gzip.ss index 10ac3ef9d7..fb3d23f132 100644 --- a/collects/web-server/private/gzip.ss +++ b/collects/web-server/private/gzip.ss @@ -17,4 +17,4 @@ (define b-p (open-output-bytes)) (gunzip-through-ports (open-input-bytes gzb) b-p) - (get-output-bytes b-p)) \ No newline at end of file + (get-output-bytes b-p)) diff --git a/collects/web-server/scribblings/configuration.scrbl b/collects/web-server/scribblings/configuration.scrbl index ce9b731b20..b3c0e8a6d7 100644 --- a/collects/web-server/scribblings/configuration.scrbl +++ b/collects/web-server/scribblings/configuration.scrbl @@ -287,4 +287,4 @@ the @scheme[header]s as, you guessed it, headers. Returns a function that generates a standard "Garbage collection run" message with content from @scheme[file]. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index e3e865eaa9..0e3c143931 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -245,4 +245,4 @@ A few utilities are provided for using @tech{formlet}s in Web applications. Like @scheme[send/formlet], but for use with @scheme[send/suspend/dispatch]. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl index c285df3c66..b665d20985 100644 --- a/collects/web-server/scribblings/http.scrbl +++ b/collects/web-server/scribblings/http.scrbl @@ -281,4 +281,4 @@ An implementation of HTTP Basic Authentication. @scheme[(extract-user-pass (request-headers/raw req))] might return @scheme[(cons #"aladin" #"open sesame")]. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/lang-web-cells.scrbl b/collects/web-server/scribblings/lang-web-cells.scrbl index ba4017ed20..cde6e7118b 100644 --- a/collects/web-server/scribblings/lang-web-cells.scrbl +++ b/collects/web-server/scribblings/lang-web-cells.scrbl @@ -24,4 +24,4 @@ compatible with the Web Language. The one difference is that See @schememodname[web-server/servlet/web-cells].} -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/lang.scrbl b/collects/web-server/scribblings/lang.scrbl index 65bb088714..1f80661af4 100644 --- a/collects/web-server/scribblings/lang.scrbl +++ b/collects/web-server/scribblings/lang.scrbl @@ -103,4 +103,4 @@ In the future, we will offer the facilities to: @item{Encrypt the serialized value.} @item{Only use the CAS if the URL would be too long. (URLs may only be 1024 characters.)} ] -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/managers.scrbl b/collects/web-server/scribblings/managers.scrbl index 834fee6636..87a1f39453 100644 --- a/collects/web-server/scribblings/managers.scrbl +++ b/collects/web-server/scribblings/managers.scrbl @@ -175,4 +175,4 @@ The recommended usage of this manager is codified as the following function: stays low, it will still efficiently expire old continuations. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/running.scrbl b/collects/web-server/scribblings/running.scrbl index 89be17510a..b749364283 100644 --- a/collects/web-server/scribblings/running.scrbl +++ b/collects/web-server/scribblings/running.scrbl @@ -165,4 +165,4 @@ from a given path: you are likely to want to call this functions at the end of your script. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/servlet-env.scrbl b/collects/web-server/scribblings/servlet-env.scrbl index f17a0f8794..09c233d1e4 100644 --- a/collects/web-server/scribblings/servlet-env.scrbl +++ b/collects/web-server/scribblings/servlet-env.scrbl @@ -157,4 +157,4 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server, are those allowed by @scheme[log-format->format]. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/stateless-servlet.scrbl b/collects/web-server/scribblings/stateless-servlet.scrbl index 3bdeda9df0..48ea187dfb 100644 --- a/collects/web-server/scribblings/stateless-servlet.scrbl +++ b/collects/web-server/scribblings/stateless-servlet.scrbl @@ -96,4 +96,4 @@ is invoked before the server is restarted or the memory is garbage collected. This process is derived from the paper @href-link["http://www.cs.brown.edu/~sk/Publications/Papers/Published/pcmkf-cont-from-gen-stack-insp/" "Continuations from Generalized Stack Inspection"]. -We thank Greg Pettyjohn for his initial implementation of this algorithm. \ No newline at end of file +We thank Greg Pettyjohn for his initial implementation of this algorithm. diff --git a/collects/web-server/scribblings/tutorial/examples/dummy-10.ss b/collects/web-server/scribblings/tutorial/examples/dummy-10.ss index 3eed4f4433..81dc8ac98b 100644 --- a/collects/web-server/scribblings/tutorial/examples/dummy-10.ss +++ b/collects/web-server/scribblings/tutorial/examples/dummy-10.ss @@ -134,4 +134,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-10.ss b/collects/web-server/scribblings/tutorial/examples/iteration-10.ss index 32fed24450..13f990dc18 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-10.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-10.ss @@ -134,4 +134,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-5.ss b/collects/web-server/scribblings/tutorial/examples/iteration-5.ss index 2e9a141594..807c0bea78 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-5.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-5.ss @@ -131,4 +131,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-6.ss b/collects/web-server/scribblings/tutorial/examples/iteration-6.ss index 94ce399474..aff791c8e8 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-6.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-6.ss @@ -165,4 +165,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-7.ss b/collects/web-server/scribblings/tutorial/examples/iteration-7.ss index 4a3e0b9893..451d15a3f4 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-7.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-7.ss @@ -165,4 +165,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-8.ss b/collects/web-server/scribblings/tutorial/examples/iteration-8.ss index f51fb32fe7..1771fe37ab 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-8.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-8.ss @@ -132,4 +132,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-9.ss b/collects/web-server/scribblings/tutorial/examples/iteration-9.ss index 05f4b1e71a..5cf952f636 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-9.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-9.ss @@ -134,4 +134,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-9s.ss b/collects/web-server/scribblings/tutorial/examples/iteration-9s.ss index 1c17dd4564..8da2e2cc83 100644 --- a/collects/web-server/scribblings/tutorial/examples/iteration-9s.ss +++ b/collects/web-server/scribblings/tutorial/examples/iteration-9s.ss @@ -136,4 +136,4 @@ ;; Consumes an html-response, and produces a rendering ;; as a list item. (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss b/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss index 9661dbad93..59f172be78 100644 --- a/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss +++ b/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss @@ -44,4 +44,4 @@ ;; render-as-item: html-response -> html-response (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss b/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss index c1ae5e5471..e4a0ca75f0 100644 --- a/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss +++ b/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss @@ -12,4 +12,4 @@ (a ((href ,(make-url (lambda (request) (show-counter (+ n 1)))))) - ,(number->string n))))))) \ No newline at end of file + ,(number->string n))))))) diff --git a/collects/web-server/scribblings/tutorial/examples/test-static.ss b/collects/web-server/scribblings/tutorial/examples/test-static.ss index f14384fe1a..d409026c16 100644 --- a/collects/web-server/scribblings/tutorial/examples/test-static.ss +++ b/collects/web-server/scribblings/tutorial/examples/test-static.ss @@ -6,4 +6,4 @@ (type "text/css"))) (body (h1 "This is a header") (p "This is " (span ((class "hot")) "hot") ".")))) -(static-files-path "htdocs") \ No newline at end of file +(static-files-path "htdocs") diff --git a/collects/web-server/scribblings/tutorial/examples/use-redirect.ss b/collects/web-server/scribblings/tutorial/examples/use-redirect.ss index d5780d700d..b69ea84f53 100644 --- a/collects/web-server/scribblings/tutorial/examples/use-redirect.ss +++ b/collects/web-server/scribblings/tutorial/examples/use-redirect.ss @@ -44,4 +44,4 @@ ;; render-as-item: html-response -> html-response (define (render-as-item a-fragment) - `(li ,a-fragment)) \ No newline at end of file + `(li ,a-fragment)) diff --git a/collects/web-server/scribblings/tutorial/tutorial-util.ss b/collects/web-server/scribblings/tutorial/tutorial-util.ss index 7b72b87dcd..1d3dbf1421 100644 --- a/collects/web-server/scribblings/tutorial/tutorial-util.ss +++ b/collects/web-server/scribblings/tutorial/tutorial-util.ss @@ -29,4 +29,4 @@ (syntax-case stx () [(_ filename) #`(include/reader #,(format "examples/~a" (syntax-e #'filename)) - comment-schememod-reader)])) \ No newline at end of file + comment-schememod-reader)])) diff --git a/collects/web-server/scribblings/v1-servlet.scrbl b/collects/web-server/scribblings/v1-servlet.scrbl index 0ffbc32f0a..de6a4b0324 100644 --- a/collects/web-server/scribblings/v1-servlet.scrbl +++ b/collects/web-server/scribblings/v1-servlet.scrbl @@ -34,4 +34,4 @@ An example version 1 module: (body (h1 "Hi Mom!")))) ] -These servlets should use the @schememodname[web-server/servlet] API. \ No newline at end of file +These servlets should use the @schememodname[web-server/servlet] API. diff --git a/collects/web-server/scribblings/v2-servlet.scrbl b/collects/web-server/scribblings/v2-servlet.scrbl index 4021ba108d..85fe21b9b6 100644 --- a/collects/web-server/scribblings/v2-servlet.scrbl +++ b/collects/web-server/scribblings/v2-servlet.scrbl @@ -38,4 +38,4 @@ An example version 2 module: (body (h1 "Hi Mom!")))) ] -These servlets should use the @schememodname[web-server/servlet] API. \ No newline at end of file +These servlets should use the @schememodname[web-server/servlet] API. diff --git a/collects/web-server/scribblings/web-cells.scrbl b/collects/web-server/scribblings/web-cells.scrbl index 6ba6e8dda3..4b7b876625 100644 --- a/collects/web-server/scribblings/web-cells.scrbl +++ b/collects/web-server/scribblings/web-cells.scrbl @@ -84,4 +84,4 @@ transformations of the program into continuation or store passing style. ] } -@include-section["lang-web-cells.scrbl"] \ No newline at end of file +@include-section["lang-web-cells.scrbl"] diff --git a/collects/web-server/scribblings/web-config-unit.scrbl b/collects/web-server/scribblings/web-config-unit.scrbl index 72f96cd87a..76d050c98d 100644 --- a/collects/web-server/scribblings/web-config-unit.scrbl +++ b/collects/web-server/scribblings/web-config-unit.scrbl @@ -78,4 +78,4 @@ Provides contains the following identifiers. Parses @scheme[sexpr] as a configuration-table and constructs a @scheme[web-config^] unit. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/web-server-unit.scrbl b/collects/web-server/scribblings/web-server-unit.scrbl index eddcff7bdd..25845a1903 100644 --- a/collects/web-server/scribblings/web-server-unit.scrbl +++ b/collects/web-server/scribblings/web-server-unit.scrbl @@ -60,4 +60,4 @@ Using this @scheme[dispatcher/c], it loads a dispatching server that provides @s and @scheme[serve-ports] functions that operate as expected. } -} \ No newline at end of file +} diff --git a/collects/web-server/scribblings/web.scrbl b/collects/web-server/scribblings/web.scrbl index bd7c65ad01..3ac07a421e 100644 --- a/collects/web-server/scribblings/web.scrbl +++ b/collects/web-server/scribblings/web.scrbl @@ -194,4 +194,4 @@ functions of interest for the servlet developer. returns the instance id, continuation id, and nonce. } -} \ No newline at end of file +} diff --git a/collects/web-server/servlet.ss b/collects/web-server/servlet.ss index 6b833ea39d..65acb8629d 100644 --- a/collects/web-server/servlet.ss +++ b/collects/web-server/servlet.ss @@ -8,4 +8,4 @@ web-server/http/bindings web-server/http web-server/servlet/servlet-structs - web-server/servlet/web)) \ No newline at end of file + web-server/servlet/web)) diff --git a/collects/web-server/servlet/setup.ss b/collects/web-server/servlet/setup.ss index 62d03ab9fa..a028d4e68b 100644 --- a/collects/web-server/servlet/setup.ss +++ b/collects/web-server/servlet/setup.ss @@ -158,4 +158,4 @@ (v0.response->v1.lambda s a-path))] [else (error 'path->servlet - "Loading ~e produced ~n~e~n instead of either (1) a response or (2) nothing and exports 'interface-version" a-path s)])))) \ No newline at end of file + "Loading ~e produced ~n~e~n instead of either (1) a response or (2) nothing and exports 'interface-version" a-path s)])))) diff --git a/collects/web-server/servlet/web.ss b/collects/web-server/servlet/web.ss index ffac07e465..979957a573 100644 --- a/collects/web-server/servlet/web.ss +++ b/collects/web-server/servlet/web.ss @@ -149,4 +149,4 @@ ((response? . -> . request?) (-> any) . -> . - any)]) \ No newline at end of file + any)]) diff --git a/collects/web-server/templates.ss b/collects/web-server/templates.ss index 7a7edb0cd9..75a4bde825 100644 --- a/collects/web-server/templates.ss +++ b/collects/web-server/templates.ss @@ -28,4 +28,4 @@ (begin/text e ...))])) (provide include-template - in) \ No newline at end of file + in) From 2aeb50134d2775eb8d0a0a9e3faa18d570c2fd19 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 14 Jan 2009 06:04:57 +0000 Subject: [PATCH 2/8] macro stepper: converted more classes to use iop svn: r13108 --- .../syntax-browser/interfaces.ss | 57 +++---- .../macro-debugger/syntax-browser/keymap.ss | 1 - .../macro-debugger/syntax-browser/widget.ss | 2 +- collects/macro-debugger/util/class-iop.ss | 14 +- collects/macro-debugger/view/extensions.ss | 25 +-- collects/macro-debugger/view/frame.ss | 36 ++-- collects/macro-debugger/view/hiding-panel.ss | 10 +- collects/macro-debugger/view/interfaces.ss | 107 +++++++----- collects/macro-debugger/view/step-display.ss | 161 ++++++++---------- collects/macro-debugger/view/stepper.ss | 126 ++++++-------- collects/macro-debugger/view/term-record.ss | 50 +++--- collects/macro-debugger/view/view.ss | 42 +---- 12 files changed, 300 insertions(+), 331 deletions(-) diff --git a/collects/macro-debugger/syntax-browser/interfaces.ss b/collects/macro-debugger/syntax-browser/interfaces.ss index 49096d579d..32cbf6d3ad 100644 --- a/collects/macro-debugger/syntax-browser/interfaces.ss +++ b/collects/macro-debugger/syntax-browser/interfaces.ss @@ -1,11 +1,10 @@ - #lang scheme/base (require scheme/class macro-debugger/util/class-iop) (provide (all-defined-out)) ;; displays-manager<%> -(define-interface displays-manager<%> +(define-interface displays-manager<%> () (;; add-syntax-display : display<%> -> void add-syntax-display @@ -13,7 +12,7 @@ remove-all-syntax-displays)) ;; selection-manager<%> -(define-interface selection-manager<%> +(define-interface selection-manager<%> () (;; selected-syntax : syntax/#f set-selected-syntax get-selected-syntax @@ -21,12 +20,15 @@ ;; mark-manager<%> ;; Manages marks, mappings from marks to colors -(define-interface mark-manager<%> +(define-interface mark-manager<%> () (;; get-primary-partition : -> partition - get-primary-partition)) + get-primary-partition + + ;; reset-primary-partition : -> void + reset-primary-partition)) ;; secondary-partition<%> -(define-interface secondary-partition<%> +(define-interface secondary-partition<%> () (;; get-secondary-partition : -> partition<%> get-secondary-partition @@ -46,27 +48,15 @@ listen-identifier=?)) ;; controller<%> -(define-interface/dynamic controller<%> - (interface (displays-manager<%> - selection-manager<%> - mark-manager<%> - secondary-partition<%>)) - (add-syntax-display - remove-all-syntax-displays - set-selected-syntax - get-selected-syntax - listen-selected-syntax - get-primary-partition - get-secondary-partition - set-secondary-partition - listen-secondary-partition - get-identifier=? - set-identifier=? - listen-identifier=?)) +(define-interface controller<%> (displays-manager<%> + selection-manager<%> + mark-manager<%> + secondary-partition<%>) + ()) ;; host<%> -(define-interface host<%> +(define-interface host<%> () (;; get-controller : -> controller<%> get-controller @@ -74,7 +64,7 @@ add-keymap)) ;; display<%> -(define-interface display<%> +(define-interface display<%> () (;; refresh : -> void refresh @@ -94,7 +84,7 @@ get-range)) ;; range<%> -(define-interface range<%> +(define-interface range<%> () (;; get-ranges : datum -> (list-of (cons number number)) get-ranges @@ -111,14 +101,14 @@ ;; syntax-prefs<%> -(define-interface syntax-prefs<%> +(define-interface syntax-prefs<%> () (pref:width pref:height pref:props-percentage pref:props-shown?)) ;; widget-hooks<%> -(define-interface widget-hooks<%> +(define-interface widget-hooks<%> () (;; setup-keymap : -> void setup-keymap @@ -126,7 +116,7 @@ shutdown)) ;; keymap-hooks<%> -(define-interface keymap-hooks<%> +(define-interface keymap-hooks<%> () (;; make-context-menu : -> context-menu<%> make-context-menu @@ -134,7 +124,7 @@ get-context-menu%)) ;; context-menu-hooks<%> -(define-interface context-menu-hooks<%> +(define-interface context-menu-hooks<%> () (add-edit-items after-edit-items add-selection-items @@ -146,15 +136,16 @@ ;;---------- ;; Convenience widget, specialized for displaying stx and not much else -(define-interface syntax-browser<%> +(define-interface syntax-browser<%> () (add-syntax add-text + add-error-text + add-clickback add-separator erase-all - select-syntax get-text)) -(define-interface partition<%> +(define-interface partition<%> () (;; get-partition : any -> number get-partition diff --git a/collects/macro-debugger/syntax-browser/keymap.ss b/collects/macro-debugger/syntax-browser/keymap.ss index 40c29d4056..7bc7c8fd17 100644 --- a/collects/macro-debugger/syntax-browser/keymap.ss +++ b/collects/macro-debugger/syntax-browser/keymap.ss @@ -1,4 +1,3 @@ - #lang scheme/base (require scheme/class scheme/gui diff --git a/collects/macro-debugger/syntax-browser/widget.ss b/collects/macro-debugger/syntax-browser/widget.ss index d7eba23053..51ab11e9e7 100644 --- a/collects/macro-debugger/syntax-browser/widget.ss +++ b/collects/macro-debugger/syntax-browser/widget.ss @@ -21,7 +21,7 @@ ;; widget% ;; A syntax widget creates its own syntax-controller. (define widget% - (class* object% (widget-hooks<%>) + (class* object% (syntax-browser<%> widget-hooks<%>) (init parent) (init-field config) diff --git a/collects/macro-debugger/util/class-iop.ss b/collects/macro-debugger/util/class-iop.ss index bf63c9ddf1..029196a6b5 100644 --- a/collects/macro-debugger/util/class-iop.ss +++ b/collects/macro-debugger/util/class-iop.ss @@ -13,6 +13,7 @@ define: lambda: init: + init-field: init-private:) ;; Configuration @@ -25,10 +26,13 @@ ;; Defines NAME as an interface. (define-syntax (define-interface stx) (syntax-parse stx - [(_ name:id (mname:id ...)) - #'(define-interface/dynamic name - (let ([name (interface () mname ...)]) name) - (mname ...))])) + [(_ name:id (super:static-interface ...) (mname:id ...)) + (with-syntax ([((super-method ...) ...) + (map static-interface-members + (syntax->datum #'(super.value ...)))]) + #'(define-interface/dynamic name + (let ([name (interface (super ...) mname ...)]) name) + (super-method ... ... mname ...)))])) ;; define-interface/dynamic SYNTAX ;; (define-interface/dynamic NAME EXPR (IDENTIFIER ...)) @@ -181,7 +185,7 @@ (syntax-parse stx [(_ init name:id iface:static-interface) (with-syntax ([(name-internal) (generate-temporaries #'(name))]) - #'(begin (init (name name-internal)) + #'(begin (init ((name-internal name))) (void (check-object<:interface init: name-internal iface)) (define-syntax name (make-checked-binding diff --git a/collects/macro-debugger/view/extensions.ss b/collects/macro-debugger/view/extensions.ss index d28ed5794a..64a8779b58 100644 --- a/collects/macro-debugger/view/extensions.ss +++ b/collects/macro-debugger/view/extensions.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/unit scheme/list scheme/match @@ -13,6 +14,7 @@ "hiding-panel.ss" (prefix-in s: "../syntax-browser/widget.ss") (prefix-in s: "../syntax-browser/keymap.ss") + (prefix-in s: "../syntax-browser/interfaces.ss") "../model/deriv.ss" "../model/deriv-util.ss" "../model/trace.ss" @@ -26,7 +28,7 @@ (define stepper-keymap% (class s:syntax-keymap% - (init-field macro-stepper) + (init-field: (macro-stepper widget<%>)) (inherit-field config controller the-context-menu) @@ -39,17 +41,17 @@ (super-new) (define/public (get-hiding-panel) - (send macro-stepper get-macro-hiding-prefs)) + (send: macro-stepper widget<%> get-macro-hiding-prefs)) (add-function "hiding:show-macro" (lambda (i e) - (send* (get-hiding-panel) + (send*: (get-hiding-panel) hiding-prefs<%> (add-show-identifier) (refresh)))) (add-function "hiding:hide-macro" (lambda (i e) - (send* (get-hiding-panel) + (send*: (get-hiding-panel) hiding-prefs<%> (add-hide-identifier) (refresh)))) @@ -75,26 +77,27 @@ (send show-macro enable ?) (send hide-macro enable ?)) - (send controller listen-selected-syntax - (lambda (stx) - (enable/disable-hide/show (identifier? stx)))))) + (send: controller s:controller<%> listen-selected-syntax + (lambda (stx) + (enable/disable-hide/show (identifier? stx)))))) (define stepper-syntax-widget% (class s:widget% - (init-field macro-stepper) + (init-field: (macro-stepper widget<%>)) (inherit get-text) (inherit-field controller) (define/override (setup-keymap) (new stepper-keymap% (editor (get-text)) - (config (send macro-stepper get-config)) + (config (send: macro-stepper widget<%> get-config)) (controller controller) (macro-stepper macro-stepper))) (define/override (show-props show?) (super show-props show?) - (send macro-stepper update/preserve-view)) + (send: macro-stepper widget<%> update/preserve-view)) (super-new - (config (send macro-stepper get-config))))) + (config (send: macro-stepper widget<%> get-config))))) + diff --git a/collects/macro-debugger/view/frame.ss b/collects/macro-debugger/view/frame.ss index 29688ba4f2..856c5bb9de 100644 --- a/collects/macro-debugger/view/frame.ss +++ b/collects/macro-debugger/view/frame.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/unit scheme/list scheme/file @@ -14,6 +15,7 @@ "warning.ss" "hiding-panel.ss" (prefix-in sb: "../syntax-browser/embed.ss") + (prefix-in sb: "../syntax-browser/interfaces.ss") "../model/deriv.ss" "../model/deriv-util.ss" "../model/trace.ss" @@ -23,7 +25,7 @@ (provide macro-stepper-frame-mixin) (define (macro-stepper-frame-mixin base-frame%) - (class base-frame% + (class* base-frame% (stepper-frame<%>) (init-field config) (init-field director) (init-field (filename #f)) @@ -54,7 +56,7 @@ (define/override (on-size w h) (send config set-width w) (send config set-height h) - (send widget update/preserve-view)) + (send: widget widget<%> update/preserve-view)) (define warning-panel (new horizontal-panel% @@ -65,12 +67,13 @@ (define/public (get-macro-stepper-widget%) macro-stepper-widget%) - (define widget + (define: widget widget<%> (new (get-macro-stepper-widget%) (parent (get-area-container)) (director director) (config config))) - (define controller (send widget get-controller)) + (define: controller sb:controller<%> + (send: widget widget<%> get-controller)) (define/public (get-widget) widget) (define/public (get-controller) controller) @@ -112,11 +115,11 @@ (new (get-menu-item%) (label "Duplicate stepper") (parent file-menu) - (callback (lambda _ (send widget duplicate-stepper)))) + (callback (lambda _ (send: widget widget<%> duplicate-stepper)))) (new (get-menu-item%) (label "Duplicate stepper (current term only)") (parent file-menu) - (callback (lambda _ (send widget show-in-new-frame))))) + (callback (lambda _ (send: widget widget<%> show-in-new-frame))))) (menu-option/notify-box stepper-menu "View syntax properties" @@ -133,23 +136,24 @@ (parent id-menu) (callback (lambda _ - (send controller set-identifier=? p))))]) - (send controller listen-identifier=? - (lambda (name+func) - (send this-choice check - (eq? (car name+func) (car p))))))) + (send: controller sb:controller<%> set-identifier=? p))))]) + (send: controller sb:controller<%> listen-identifier=? + (lambda (name+func) + (send this-choice check + (eq? (car name+func) (car p))))))) (sb:identifier=-choices))) (let ([identifier=? (send config get-identifier=?)]) (when identifier=? (let ([p (assoc identifier=? (sb:identifier=-choices))]) - (send controller set-identifier=? p)))) + (send: controller sb:controller<%> set-identifier=? p)))) (new (get-menu-item%) (label "Clear selection") (parent stepper-menu) (callback - (lambda _ (send controller set-selected-syntax #f)))) + (lambda _ (send: controller sb:controller<%> + set-selected-syntax #f)))) (new separator-menu-item% (parent stepper-menu)) @@ -160,11 +164,11 @@ (new (get-menu-item%) (label "Remove selected term") (parent stepper-menu) - (callback (lambda _ (send widget remove-current-term)))) + (callback (lambda _ (send: widget widget<%> remove-current-term)))) (new (get-menu-item%) (label "Reset mark numbering") (parent stepper-menu) - (callback (lambda _ (send widget reset-primary-partition)))) + (callback (lambda _ (send: widget widget<%> reset-primary-partition)))) (let ([extras-menu (new (get-menu%) (label "Extra options") @@ -178,7 +182,7 @@ (if (send i is-checked?) 'always 'over-limit)) - (send widget update/preserve-view)))) + (send: widget widget<%> update/preserve-view)))) (menu-option/notify-box extras-menu "Highlight redex/contractum" (get-field highlight-foci? config)) diff --git a/collects/macro-debugger/view/hiding-panel.ss b/collects/macro-debugger/view/hiding-panel.ss index def418938e..993354928f 100644 --- a/collects/macro-debugger/view/hiding-panel.ss +++ b/collects/macro-debugger/view/hiding-panel.ss @@ -1,9 +1,11 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/gui scheme/list syntax/boundmap + "interfaces.ss" "../model/hiding-policies.ss" "../util/mpi.ss" "../util/notify.ss") @@ -16,9 +18,9 @@ ;; macro-hiding-prefs-widget% (define macro-hiding-prefs-widget% - (class object% + (class* object% (hiding-prefs<%>) (init parent) - (init-field stepper) + (init-field: (stepper widget<%>)) (init-field config) (define/public (get-policy) @@ -173,11 +175,11 @@ ;; refresh : -> void (define/public (refresh) (when (macro-hiding-enabled?) - (send stepper refresh/resynth))) + (send: stepper widget<%> refresh/resynth))) ;; force-refresh : -> void (define/private (force-refresh) - (send stepper refresh/resynth)) + (send: stepper widget<%> refresh/resynth)) ;; set-syntax : syntax/#f -> void (define/public (set-syntax lstx) diff --git a/collects/macro-debugger/view/interfaces.ss b/collects/macro-debugger/view/interfaces.ss index e374aaa9f9..4d9e19ade4 100644 --- a/collects/macro-debugger/view/interfaces.ss +++ b/collects/macro-debugger/view/interfaces.ss @@ -1,50 +1,75 @@ #lang scheme/base -(require scheme/unit) +(require macro-debugger/util/class-iop) (provide (all-defined-out)) -;; Signatures +(define-interface widget<%> () + (get-config + get-controller + get-macro-hiding-prefs + get-step-displayer -#; -(define-signature view^ - (macro-stepper-frame% - macro-stepper-widget% - make-macro-stepper - go - go/deriv)) + add-trace + add-deriv -#; -(define-signature view-base^ - (base-frame%)) + update/preserve-view + refresh/resynth -#; -(define-signature prefs^ - (pref:width - pref:height - pref:props-shown? - pref:props-percentage - pref:macro-hiding-mode - pref:show-syntax-properties? - pref:show-hiding-panel? - pref:identifier=? - pref:show-rename-steps? - pref:highlight-foci? - pref:highlight-frontier? - pref:suppress-warnings? - pref:one-by-one? - pref:extra-navigation? - pref:debug-catch-errors? - pref:force-letrec-transformation? + reset-primary-partition + remove-current-term + duplicate-stepper + show-in-new-frame + + get-preprocess-deriv + get-show-macro? +)) + +(define-interface stepper-frame<%> () + (get-widget + get-controller + add-obsoleted-warning)) + +(define-interface hiding-prefs<%> () + (add-show-identifier + add-hide-identifier + set-syntax + get-policy + refresh)) + + +(define-interface step-display<%> () + (add-syntax + add-step + add-error + add-final + add-internal-error)) + + +(define-interface term-record<%> () + (get-raw-deriv + get-deriv-hidden? + get-step-index + invalidate-synth! + invalidate-steps! + + has-prev? + has-next? + at-start? + at-end? + navigate-to-start + navigate-to-end + navigate-previous + navigate-next + navigate-to + + on-get-focus + on-lose-focus + + display-initial-term + display-final-term + display-step )) -;; macro-stepper-config% -;; all fields are notify-box% objects -;; width -;; height -;; macro-hiding? -;; hide-primitives? -;; hide-libs? -;; show-syntax-properties? -;; show-hiding-panel? -;; show-rename-steps? -;; highlight-foci? +(define-interface director<%> () + (add-deriv + new-stepper)) diff --git a/collects/macro-debugger/view/step-display.ss b/collects/macro-debugger/view/step-display.ss index 5894078b63..d1af9a8ee5 100644 --- a/collects/macro-debugger/view/step-display.ss +++ b/collects/macro-debugger/view/step-display.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/unit scheme/list scheme/match @@ -21,8 +22,10 @@ "../model/reductions.ss" "../model/steps.ss" "../util/notify.ss" + (prefix-in sb: "../syntax-browser/interfaces.ss") "cursor.ss" "debug-format.ss") + #; (provide step-display% step-display<%>) @@ -35,24 +38,6 @@ (define (prestep-term1 s) (state-term (protostep-s1 s))) (define (poststep-term2 s) (state-term (protostep-s1 s))) - -(define step-display<%> - (interface () - ;; add-syntax - add-syntax - - ;; add-step - add-step - - ;; add-error - add-error - - ;; add-final - add-final - - ;; add-internal-error - add-internal-error)) - (define step-display% (class* object% (step-display<%>) @@ -61,18 +46,18 @@ (super-new) (define/public (add-internal-error part exn stx events) - (send sbview add-text - (if part - (format "Macro stepper error (~a)" part) - "Macro stepper error")) + (send: sbview sb:syntax-browser<%> add-text + (if part + (format "Macro stepper error (~a)" part) + "Macro stepper error")) (when (exn? exn) - (send sbview add-text " ") - (send sbview add-clickback "[details]" - (lambda _ (show-internal-error-details exn events)))) - (send sbview add-text ". ") - (when stx (send sbview add-text "Original syntax:")) - (send sbview add-text "\n") - (when stx (send sbview add-syntax stx))) + (send: sbview sb:syntax-browser<%> add-text " ") + (send: sbview sb:syntax-browser<%> add-clickback "[details]" + (lambda _ (show-internal-error-details exn events)))) + (send: sbview sb:syntax-browser<%> add-text ". ") + (when stx (send: sbview sb:syntax-browser<%> add-text "Original syntax:")) + (send: sbview sb:syntax-browser<%> add-text "\n") + (when stx (send: sbview sb:syntax-browser<%> add-syntax stx))) (define/private (show-internal-error-details exn events) (case (message-box/custom "Macro stepper internal error" @@ -91,8 +76,9 @@ ((3 #f) (void)))) (define/public (add-error exn) - (send sbview add-error-text (exn-message exn)) - (send sbview add-text "\n")) + (send*: sbview sb:syntax-browser<%> + (add-error-text (exn-message exn)) + (add-text "\n"))) (define/public (add-step step #:binders binders @@ -110,21 +96,22 @@ #:binders [binders #f] #:shift-table [shift-table #f] #:definites [definites null]) - (send sbview add-syntax stx - #:binder-table binders - #:shift-table shift-table - #:definites definites)) + (send: sbview sb:syntax-browser<%> add-syntax stx + #:binder-table binders + #:shift-table shift-table + #:definites definites)) (define/public (add-final stx error #:binders binders #:shift-table [shift-table #f] #:definites definites) (when stx - (send sbview add-text "Expansion finished\n") - (send sbview add-syntax stx - #:binder-table binders - #:shift-table shift-table - #:definites definites)) + (send*: sbview sb:syntax-browser<%> + (add-text "Expansion finished\n") + (add-syntax stx + #:binder-table binders + #:shift-table shift-table + #:definites definites))) (when error (add-error error))) @@ -133,17 +120,16 @@ (define state (protostep-s1 step)) (define lctx (state-lctx state)) (when (pair? lctx) - (send sbview add-text "\n") - (for-each (lambda (bf) - (send sbview add-text - "while executing macro transformer in:\n") - (insert-syntax/redex (bigframe-term bf) - (bigframe-foci bf) - binders - shift-table - (state-uses state) - (state-frontier state))) - (reverse lctx)))) + (send: sbview sb:syntax-browser<%> add-text "\n") + (for ([bf (reverse lctx)]) + (send: sbview sb:syntax-browser<%> add-text + "while executing macro transformer in:\n") + (insert-syntax/redex (bigframe-term bf) + (bigframe-foci bf) + binders + shift-table + (state-uses state) + (state-frontier state))))) ;; separator : Step -> void (define/private (separator step) @@ -194,15 +180,15 @@ (define state (protostep-s1 step)) (show-state/redex state binders shift-table) (separator step) - (send sbview add-error-text (exn-message (misstep-exn step))) - (send sbview add-text "\n") + (send*: sbview sb:syntax-browser<%> + (add-error-text (exn-message (misstep-exn step))) + (add-text "\n")) (when (exn:fail:syntax? (misstep-exn step)) - (for-each (lambda (e) - (send sbview add-syntax e - #:binder-table binders - #:shift-table shift-table - #:definites (or (state-uses state) null))) - (exn:fail:syntax-exprs (misstep-exn step)))) + (for ([e (exn:fail:syntax-exprs (misstep-exn step))]) + (send: sbview sb:syntax-browser<%> add-syntax e + #:binder-table binders + #:shift-table shift-table + #:definites (or (state-uses state) null)))) (show-lctx step binders shift-table)) ;; insert-syntax/color @@ -210,14 +196,14 @@ definites frontier hi-color) (define highlight-foci? (send config get-highlight-foci?)) (define highlight-frontier? (send config get-highlight-frontier?)) - (send sbview add-syntax stx - #:definites (or definites null) - #:binder-table binders - #:shift-table shift-table - #:hi-colors (list hi-color - "WhiteSmoke") - #:hi-stxss (list (if highlight-foci? foci null) - (if highlight-frontier? frontier null)))) + (send: sbview sb:syntax-browser<%> add-syntax stx + #:definites (or definites null) + #:binder-table binders + #:shift-table shift-table + #:hi-colors (list hi-color + "WhiteSmoke") + #:hi-stxss (list (if highlight-foci? foci null) + (if highlight-frontier? frontier null)))) ;; insert-syntax/redex (define/private (insert-syntax/redex stx foci binders shift-table @@ -233,29 +219,32 @@ ;; insert-step-separator : string -> void (define/private (insert-step-separator text) - (send sbview add-text "\n ") - (send sbview add-text - (make-object image-snip% - (build-path (collection-path "icons") - "red-arrow.bmp"))) - (send sbview add-text " ") - (send sbview add-text text) - (send sbview add-text "\n\n")) + (send*: sbview sb:syntax-browser<%> + (add-text "\n ") + (add-text + (make-object image-snip% + (build-path (collection-path "icons") + "red-arrow.bmp"))) + (add-text " ") + (add-text text) + (add-text "\n\n"))) ;; insert-as-separator : string -> void (define/private (insert-as-separator text) - (send sbview add-text "\n ") - (send sbview add-text text) - (send sbview add-text "\n\n")) + (send*: sbview sb:syntax-browser<%> + (add-text "\n ") + (add-text text) + (add-text "\n\n"))) ;; insert-step-separator/small : string -> void (define/private (insert-step-separator/small text) - (send sbview add-text " ") - (send sbview add-text - (make-object image-snip% - (build-path (collection-path "icons") - "red-arrow.bmp"))) - (send sbview add-text " ") - (send sbview add-text text) - (send sbview add-text "\n\n")) + (send*: sbview sb:syntax-browser<%> + (add-text " ") + (add-text + (make-object image-snip% + (build-path (collection-path "icons") + "red-arrow.bmp"))) + (add-text " ") + (add-text text) + (add-text "\n\n"))) )) diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.ss index 640e06e5f0..c731972a60 100644 --- a/collects/macro-debugger/view/stepper.ss +++ b/collects/macro-debugger/view/stepper.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/unit scheme/list scheme/match @@ -14,6 +15,7 @@ "hiding-panel.ss" "term-record.ss" "step-display.ss" + (prefix-in sb: "../syntax-browser/interfaces.ss") "../model/deriv.ss" "../model/deriv-util.ss" "../model/deriv-find.ss" @@ -29,10 +31,10 @@ ;; macro-stepper-widget% (define macro-stepper-widget% - (class* object% () + (class* object% (widget<%>) (init-field parent) (init-field config) - (init-field director) + (init-field: (director director<%>)) ;; Terms @@ -65,7 +67,7 @@ (define/public (add trec) (set! all-terms (cons trec all-terms)) (let ([display-new-term? (cursor:at-end? terms)] - [invisible? (send trec get-deriv-hidden?)]) + [invisible? (send: trec term-record<%> get-deriv-hidden?)]) (unless invisible? (cursor:add-to-end! terms (list trec)) (trim-navigator) @@ -83,15 +85,16 @@ (define/public (show-in-new-frame) (let ([term (focused-term)]) (when term - (let ([new-stepper (send director new-stepper '(no-new-traces))]) - (send new-stepper add-deriv (send term get-raw-deriv)) + (let ([new-stepper (send: director director<%> new-stepper '(no-new-traces))]) + (send: new-stepper widget<%> add-deriv (send term get-raw-deriv)) (void))))) ;; duplicate-stepper : -> void (define/public (duplicate-stepper) - (let ([new-stepper (send director new-stepper)]) + (let ([new-stepper (send: director director<%> new-stepper)]) (for ([term (cursor->list terms)]) - (send new-stepper add-deriv (send term get-raw-deriv))))) + (send: new-stepper widget<%> add-deriv + (send: term term-record<%> get-raw-deriv))))) (define/public (get-config) config) (define/public (get-controller) sbc) @@ -101,7 +104,7 @@ (define/public (get-macro-hiding-prefs) macro-hiding-prefs) (define/public (reset-primary-partition) - (send sbc reset-primary-partition) + (send: sbc sb:controller<%> reset-primary-partition) (update/preserve-view)) (define area (new vertical-panel% (parent parent))) @@ -126,16 +129,19 @@ (define warnings-area (new stepper-warnings% (parent area))) - (define sbview (new stepper-syntax-widget% - (parent area) - (macro-stepper this))) - (define step-displayer (new step-display% - (config config) - (syntax-widget sbview))) - (define sbc (send sbview get-controller)) + (define: sbview sb:syntax-browser<%> + (new stepper-syntax-widget% + (parent area) + (macro-stepper this))) + (define: step-displayer step-display<%> + (new step-display% + (config config) + (syntax-widget sbview))) + (define: sbc sb:controller<%> + (send sbview get-controller)) (define control-pane (new vertical-panel% (parent area) (stretchable-height #f))) - (define macro-hiding-prefs + (define: macro-hiding-prefs hiding-prefs<%> (new macro-hiding-prefs-widget% (parent control-pane) (stepper this) @@ -144,7 +150,7 @@ (send config listen-show-hiding-panel? (lambda (show?) (show-macro-hiding-panel show?))) (send sbc listen-selected-syntax - (lambda (stx) (send macro-hiding-prefs set-syntax stx))) + (lambda (stx) (send: macro-hiding-prefs hiding-prefs<%> set-syntax stx))) (send config listen-highlight-foci? (lambda (_) (update/preserve-view))) (send config listen-highlight-frontier? @@ -233,34 +239,34 @@ ;; Navigation (define/public-final (at-start?) - (send (focused-term) at-start?)) + (send: (focused-term) term-record<%> at-start?)) (define/public-final (at-end?) - (send (focused-term) at-end?)) + (send: (focused-term) term-record<%> at-end?)) (define/public-final (navigate-to-start) - (send (focused-term) navigate-to-start) + (send: (focused-term) term-record<%> navigate-to-start) (update/save-position)) (define/public-final (navigate-to-end) - (send (focused-term) navigate-to-end) + (send: (focused-term) term-record<%> navigate-to-end) (update/save-position)) (define/public-final (navigate-previous) - (send (focused-term) navigate-previous) + (send: (focused-term) term-record<%> navigate-previous) (update/save-position)) (define/public-final (navigate-next) - (send (focused-term) navigate-next) + (send: (focused-term) term-record<%> navigate-next) (update/save-position)) (define/public-final (navigate-to n) - (send (focused-term) navigate-to n) + (send: (focused-term) term-record<%> navigate-to n) (update/save-position)) (define/public-final (navigate-up) (when (focused-term) - (send (focused-term) on-lose-focus)) + (send: (focused-term) term-record<%> on-lose-focus)) (cursor:move-prev terms) (refresh/move)) (define/public-final (navigate-down) (when (focused-term) - (send (focused-term) on-lose-focus)) + (send: (focused-term) term-record<%> on-lose-focus)) (cursor:move-next terms) (refresh/move)) @@ -272,7 +278,7 @@ ;; update/preserve-lines-view : -> void (define/public (update/preserve-lines-view) - (define text (send sbview get-text)) + (define text (send: sbview sb:syntax-browser<%> get-text)) (define start-box (box 0)) (define end-box (box 0)) (send text get-visible-line-range start-box end-box) @@ -285,7 +291,7 @@ ;; update/preserve-view : -> void (define/public (update/preserve-view) - (define text (send sbview get-text)) + (define text (send: sbview sb:syntax-browser<%> get-text)) (define start-box (box 0)) (define end-box (box 0)) (send text get-visible-position-range start-box end-box) @@ -295,17 +301,17 @@ ;; update : -> void ;; Updates the terms in the syntax browser to the current step (define/private (update) - (define text (send sbview get-text)) + (define text (send: sbview sb:syntax-browser<%> get-text)) (define position-of-interest 0) (define multiple-terms? (> (length (cursor->list terms)) 1)) (send text begin-edit-sequence) - (send sbview erase-all) + (send: sbview sb:syntax-browser<%> erase-all) (update:show-prefix) - (when multiple-terms? (send sbview add-separator)) + (when multiple-terms? (send: sbview sb:syntax-browser<%> add-separator)) (set! position-of-interest (send text last-position)) (update:show-current-step) - (when multiple-terms? (send sbview add-separator)) + (when multiple-terms? (send: sbview sb:syntax-browser<%> add-separator)) (update:show-suffix) (send text end-edit-sequence) (send text scroll-to-position @@ -319,35 +325,35 @@ ;; update:show-prefix : -> void (define/private (update:show-prefix) ;; Show the final terms from the cached synth'd derivs - (for-each (lambda (trec) (send trec display-final-term)) + (for-each (lambda (trec) (send: trec term-record<%> display-final-term)) (cursor:prefix->list terms))) ;; update:show-current-step : -> void (define/private (update:show-current-step) (when (focused-term) - (send (focused-term) display-step))) + (send: (focused-term) term-record<%> display-step))) ;; update:show-suffix : -> void (define/private (update:show-suffix) (let ([suffix0 (cursor:suffix->list terms)]) (when (pair? suffix0) (for-each (lambda (trec) - (send trec display-initial-term)) + (send: trec term-record<%> display-initial-term)) (cdr suffix0))))) ;; update-nav-index : -> void (define/private (update-nav-index) (define term (focused-term)) (set-current-step-index - (and term (send term get-step-index)))) + (and term (send: term term-record<%> get-step-index)))) ;; enable/disable-buttons : -> void (define/private (enable/disable-buttons) (define term (focused-term)) - (send nav:start enable (and term (send term has-prev?))) - (send nav:previous enable (and term (send term has-prev?))) - (send nav:next enable (and term (send term has-next?))) - (send nav:end enable (and term (send term has-next?))) + (send nav:start enable (and term (send: term term-record<%> has-prev?))) + (send nav:previous enable (and term (send: term term-record<%> has-prev?))) + (send nav:next enable (and term (send: term term-record<%> has-next?))) + (send nav:end enable (and term (send: term term-record<%> has-next?))) (send nav:text enable (and term #t)) (send nav:up enable (cursor:has-prev? terms)) (send nav:down enable (cursor:has-next? terms))) @@ -357,14 +363,14 @@ ;; refresh/resynth : -> void ;; Macro hiding policy has changed; invalidate cached parts of trec (define/public (refresh/resynth) - (for-each (lambda (trec) (send trec invalidate-synth!)) + (for-each (lambda (trec) (send: trec term-record<%> invalidate-synth!)) (cursor->list terms)) (refresh)) ;; refresh/re-reduce : -> void ;; Reduction config has changed; invalidate cached parts of trec (define/private (refresh/re-reduce) - (for-each (lambda (trec) (send trec invalidate-steps!)) + (for-each (lambda (trec) (send: trec term-record<%> invalidate-steps!)) (cursor->list terms)) (refresh)) @@ -377,47 +383,15 @@ (define/public (refresh) (send warnings-area clear) (when (focused-term) - (send (focused-term) on-get-focus)) + (send: (focused-term) term-record<%> on-get-focus)) (update)) -#| - ;; delayed-recache-errors : (list-of (cons exn string)) - (define delayed-recache-errors null) - - ;; handle-recache-error : exception string -> void - (define/private (handle-recache-error exn part) - (if (send config get-debug-catch-errors?) - (begin - (set! delayed-recache-errors - (cons (cons exn part) delayed-recache-errors)) - (queue-callback - (lambda () - (when (pair? delayed-recache-errors) - (message-box - "Error" - (string-append - "Internal errors in macro stepper:\n" - (if (memq 'macro-hiding (map cdr delayed-recache-errors)) - (string-append - "Macro hiding failed on one or more terms. " - "The macro stepper is showing the terms " - "with macro hiding disabled.\n") - "") - (if (memq 'reductions (map cdr delayed-recache-errors)) - (string-append - "The macro stepper failed to compute the reduction sequence " - "for one or more terms.\n") - ""))) - (set! delayed-recache-errors null))))) - (raise exn))) -|# - (define/private (foci x) (if (list? x) x (list x))) ;; Hiding policy (define/public (get-show-macro?) - (send macro-hiding-prefs get-policy)) + (send: macro-hiding-prefs hiding-prefs<%> get-policy)) ;; Derivation pre-processing diff --git a/collects/macro-debugger/view/term-record.ss b/collects/macro-debugger/view/term-record.ss index e924a05a0a..4c1fdf95d6 100644 --- a/collects/macro-debugger/view/term-record.ss +++ b/collects/macro-debugger/view/term-record.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/unit scheme/list scheme/match @@ -30,11 +31,12 @@ ;; TermRecords (define term-record% - (class object% - (init-field stepper) + (class* object% (term-record<%>) + (init-field: (stepper widget<%>)) (define config (send stepper get-config)) - (define displayer (send stepper get-step-displayer)) + (define: displayer step-display<%> + (send: stepper widget<%> get-step-displayer)) ;; Data @@ -128,7 +130,7 @@ (unless (or deriv deriv-hidden?) (recache-raw-deriv!) (when raw-deriv - (let ([process (send stepper get-preprocess-deriv)]) + (let ([process (send: stepper widget<%> get-preprocess-deriv)]) (let ([d (process raw-deriv)]) (when (not d) (set! deriv-hidden? #t)) @@ -151,7 +153,7 @@ (unless (or raw-steps raw-steps-oops) (recache-synth!) (when deriv - (let ([show-macro? (or (send stepper get-show-macro?) + (let ([show-macro? (or (send: stepper widget<%> get-show-macro?) (lambda (id) #t))]) (with-handlers ([(lambda (e) #t) (lambda (e) @@ -274,18 +276,18 @@ ;; display-initial-term : -> void (define/public (display-initial-term) - (send displayer add-syntax (wderiv-e1 deriv))) + (send: displayer step-display<%> add-syntax (wderiv-e1 deriv))) ;; display-final-term : -> void (define/public (display-final-term) (recache-steps!) (cond [(syntax? raw-steps-estx) - (send displayer add-syntax raw-steps-estx - #:binders binders - #:shift-table shift-table - #:definites raw-steps-definites)] + (send: displayer step-display<%> add-syntax raw-steps-estx + #:binders binders + #:shift-table shift-table + #:definites raw-steps-definites)] [(exn? raw-steps-exn) - (send displayer add-error raw-steps-exn)] + (send: displayer step-display<%> add-error raw-steps-exn)] [else (display-oops #f)])) ;; display-step : -> void @@ -294,25 +296,25 @@ (cond [steps (let ([step (cursor:next steps)]) (if step - (send displayer add-step step - #:binders binders - #:shift-table shift-table) - (send displayer add-final raw-steps-estx raw-steps-exn - #:binders binders - #:shift-table shift-table - #:definites raw-steps-definites)))] + (send: displayer step-display<%> add-step step + #:binders binders + #:shift-table shift-table) + (send: displayer step-display<%> add-final raw-steps-estx raw-steps-exn + #:binders binders + #:shift-table shift-table + #:definites raw-steps-definites)))] [else (display-oops #t)])) ;; display-oops : boolean -> void (define/private (display-oops show-syntax?) (cond [raw-steps-oops - (send displayer add-internal-error - "steps" raw-steps-oops - (and show-syntax? (wderiv-e1 deriv)) - events)] + (send: displayer step-display<%> add-internal-error + "steps" raw-steps-oops + (and show-syntax? (wderiv-e1 deriv)) + events)] [raw-deriv-oops - (send displayer add-internal-error - "derivation" raw-deriv-oops #f events)] + (send: displayer step-display<%> add-internal-error + "derivation" raw-deriv-oops #f events)] [else (error 'term-record::display-oops "internal error")])) )) diff --git a/collects/macro-debugger/view/view.ss b/collects/macro-debugger/view/view.ss index 47150cf64f..be4451a49a 100644 --- a/collects/macro-debugger/view/view.ss +++ b/collects/macro-debugger/view/view.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class + macro-debugger/util/class-iop scheme/pretty scheme/gui framework/framework @@ -27,23 +28,23 @@ (hash-for-each stepper-frames (lambda (stepper-frame flags) (unless (memq 'no-obsolete flags) - (send stepper-frame add-obsoleted-warning))))) + (send: stepper-frame stepper-frame<%> add-obsoleted-warning))))) (define/public (add-trace events) (hash-for-each stepper-frames (lambda (stepper-frame flags) (unless (memq 'no-new-traces flags) - (send (send stepper-frame get-widget) - add-trace events))))) + (send: (send: stepper-frame stepper-frame<%> get-widget) widget<%> + add-trace events))))) (define/public (add-deriv deriv) (hash-for-each stepper-frames (lambda (stepper-frame flags) (unless (memq 'no-new-traces flags) - (send (send stepper-frame get-widget) - add-deriv deriv))))) + (send: (send: stepper-frame stepper-frame<%> get-widget) widget<%> + add-deriv deriv))))) (define/public (new-stepper [flags '()]) (define stepper-frame (new-stepper-frame)) - (define stepper (send stepper-frame get-widget)) + (define stepper (send: stepper-frame stepper-frame<%> get-widget)) (send stepper-frame show #t) (add-stepper! stepper-frame flags) stepper) @@ -64,31 +65,6 @@ (define (go stx) (define director (new macro-stepper-director%)) - (define stepper (send director new-stepper)) - (send director add-deriv (trace stx)) + (define stepper (send: director director<%> new-stepper)) + (send: director director<%> add-deriv (trace stx)) (void)) - -#| -(define (make-macro-stepper) - (let ([f (new macro-stepper-frame% - (config (new macro-stepper-config/prefs%)))]) - (send f show #t) - (send f get-widget))) - -(define (go stx) - (let ([stepper (make-macro-stepper)]) - (send stepper add-deriv (trace stx)) - stepper)) - -(define (go/deriv deriv) - (let* ([f (new macro-stepper-frame%)] - [w (send f get-widget)]) - (send w add-deriv deriv) - (send f show #t) - w)) - -(define (go/trace events) - (let* ([w (make-macro-stepper)]) - (send w add-trace events) - w)) -|# From 502edfb02f4abf631f1d878d207a781d71a51104 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 14 Jan 2009 06:11:59 +0000 Subject: [PATCH 3/8] macro stepper: fixed interface bugs svn: r13109 --- collects/macro-debugger/syntax-browser/controller.ss | 11 ++++++----- collects/macro-debugger/view/interfaces.ss | 2 ++ collects/macro-debugger/view/stepper.ss | 4 ++-- collects/macro-debugger/view/term-record.ss | 1 - collects/macro-debugger/view/view.ss | 2 +- 5 files changed, 11 insertions(+), 9 deletions(-) diff --git a/collects/macro-debugger/syntax-browser/controller.ss b/collects/macro-debugger/syntax-browser/controller.ss index 35241584ec..f834abc2f8 100644 --- a/collects/macro-debugger/syntax-browser/controller.ss +++ b/collects/macro-debugger/syntax-browser/controller.ss @@ -68,9 +68,10 @@ (super-new))) (define controller% - (class (secondary-partition-mixin - (selection-manager-mixin - (mark-manager-mixin - (displays-manager-mixin - object%)))) + (class* (secondary-partition-mixin + (selection-manager-mixin + (mark-manager-mixin + (displays-manager-mixin + object%)))) + (controller<%>) (super-new))) diff --git a/collects/macro-debugger/view/interfaces.ss b/collects/macro-debugger/view/interfaces.ss index 4d9e19ade4..aae81722e6 100644 --- a/collects/macro-debugger/view/interfaces.ss +++ b/collects/macro-debugger/view/interfaces.ss @@ -54,8 +54,10 @@ has-prev? has-next? +#| at-start? at-end? +|# navigate-to-start navigate-to-end navigate-previous diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.ss index c731972a60..ed9b6ed08a 100644 --- a/collects/macro-debugger/view/stepper.ss +++ b/collects/macro-debugger/view/stepper.ss @@ -237,12 +237,12 @@ (list navigator))))) ;; Navigation - +#| (define/public-final (at-start?) (send: (focused-term) term-record<%> at-start?)) (define/public-final (at-end?) (send: (focused-term) term-record<%> at-end?)) - +|# (define/public-final (navigate-to-start) (send: (focused-term) term-record<%> navigate-to-start) (update/save-position)) diff --git a/collects/macro-debugger/view/term-record.ss b/collects/macro-debugger/view/term-record.ss index 4c1fdf95d6..ae007a7781 100644 --- a/collects/macro-debugger/view/term-record.ss +++ b/collects/macro-debugger/view/term-record.ss @@ -1,4 +1,3 @@ - #lang scheme/base (require scheme/class macro-debugger/util/class-iop diff --git a/collects/macro-debugger/view/view.ss b/collects/macro-debugger/view/view.ss index be4451a49a..3d831bdee4 100644 --- a/collects/macro-debugger/view/view.ss +++ b/collects/macro-debugger/view/view.ss @@ -14,7 +14,7 @@ go) (define macro-stepper-director% - (class object% + (class* object% (director<%>) (define stepper-frames (make-hasheq)) ;; Flags is a subset(list) of '(no-obsolete no-new-traces) From a1f7e3caa2539fad21c6687e7e724344bcfc5804 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 14 Jan 2009 08:50:12 +0000 Subject: [PATCH 4/8] Welcome to a new PLT day. svn: r13110 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 3d67f16d03..40d6058f42 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "13jan2009") +#lang scheme/base (provide stamp) (define stamp "14jan2009") From 4759e25019da30783f295090f4ad7a26aca1afd7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 14 Jan 2009 13:02:03 +0000 Subject: [PATCH 5/8] fix vector-copy! bug (PR 10026) svn: r13111 --- src/mzscheme/src/string.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mzscheme/src/string.c b/src/mzscheme/src/string.c index 0623256870..1827706d9e 100644 --- a/src/mzscheme/src/string.c +++ b/src/mzscheme/src/string.c @@ -968,7 +968,7 @@ void scheme_get_substring_indices(const char *name, Scheme_Object *str, if (SCHEME_VECTORP(str)) len = SCHEME_VEC_SIZE(str); - if (SCHEME_CHAR_STRINGP(str)) + else if (SCHEME_CHAR_STRINGP(str)) len = SCHEME_CHAR_STRTAG_VAL(str); else len = SCHEME_BYTE_STRTAG_VAL(str); From 286ef262c769457f60795d8e757ef421d6eedfaf Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Wed, 14 Jan 2009 14:09:13 +0000 Subject: [PATCH 6/8] Fixed contract for `check-reduction-relation' svn: r13112 --- collects/redex/redex.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 34c0415cd6..bdb49f38e5 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -1095,7 +1095,7 @@ pattern does not match the @scheme[pattern].} [relation reduction-relation?] [property (-> any/c any/c)] [#:attempts attempts natural-number/c 100]) - (or/c true/c void?)]{ + void?]{ Tests a @scheme[relation] as follows: for each case of @scheme[relation], @scheme[check-reduction-relation] generates @scheme[attempts] random terms that match that case's left-hand side and applies @scheme[property] From e2751633f025cf2ecea15b299b7f1bc5fae592e3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 14 Jan 2009 15:39:24 +0000 Subject: [PATCH 7/8] fix set-max-width, etc. docs svn: r13113 --- collects/scribblings/gui/blurbs.ss | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/scribblings/gui/blurbs.ss b/collects/scribblings/gui/blurbs.ss index 921a626cd5..d9f21aa066 100644 --- a/collects/scribblings/gui/blurbs.ss +++ b/collects/scribblings/gui/blurbs.ss @@ -267,8 +267,8 @@ information@|details|, even if the editor currently has delayed refreshing (see (define (edsnipsize a b c) @elem{An @scheme[editor-snip%] normally stretches to wrap around the size - of the editor it contains. This method #1 of the snip - (and if the editor is #2, #3).}) + of the editor it contains. This method @|a| of the snip + (and if the editor is @|b|, @|c|).}) (define (edsnipmax n) (edsnipsize @elem{limits the @|n|} @elem{larger} From d1f65ae6c995ee6c1926aed8fb4ff6348a5cfad8 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 14 Jan 2009 15:53:29 +0000 Subject: [PATCH 8/8] fixed a bunch of bugs in layout things in order to make traces/ps work better svn: r13114 --- collects/redex/private/size-snip.ss | 363 +++++++++++++--------------- collects/redex/private/stepper.ss | 34 ++- collects/redex/private/traces.ss | 115 ++++++++- collects/redex/redex.scrbl | 26 +- 4 files changed, 318 insertions(+), 220 deletions(-) diff --git a/collects/redex/private/size-snip.ss b/collects/redex/private/size-snip.ss index 15d40ae1f8..445157d7af 100644 --- a/collects/redex/private/size-snip.ss +++ b/collects/redex/private/size-snip.ss @@ -1,196 +1,171 @@ -(module size-snip mzscheme - (require (lib "mred.ss" "mred") - (lib "class.ss") - (lib "pretty.ss") - (lib "framework.ss" "framework") - "matcher.ss") - - (provide reflowing-snip<%> - size-editor-snip% - default-pretty-printer - initial-char-width - resizing-pasteboard-mixin) - - (define initial-char-width (make-parameter 30)) - - (define (default-pretty-printer v port w spec) - (parameterize ([pretty-print-columns w] - [pretty-print-size-hook - (λ (val display? op) - (cond - [(hole? val) 4] - [(eq? val 'hole) 6] - [else #f]))] - [pretty-print-print-hook - (λ (val display? op) - (cond - [(hole? val) - (display "hole" op)] - [(eq? val 'hole) - (display ",'hole" op)]))]) - (pretty-print v port))) - - (define reflowing-snip<%> - (interface () - reflow-program)) - - (define (resizing-pasteboard-mixin pb%) - (class pb% - (init-field shrink-down?) - - (define/augment (on-interactive-resize snip) - (when (is-a? snip reflowing-snip<%>) - (send snip reflow-program)) - (inner (void) on-interactive-resize snip)) - - (define/augment (after-interactive-resize snip) - (when (is-a? snip reflowing-snip<%>) - (send snip reflow-program)) - (inner (void) after-interactive-resize snip)) - - (define/override (interactive-adjust-resize snip w h) - (super interactive-adjust-resize snip w h) - (when (is-a? snip reflowing-snip<%>) - (send snip reflow-program))) - - (inherit get-snip-location - begin-edit-sequence - end-edit-sequence) - - (define/augment (on-insert snip before x y) - (begin-edit-sequence) - (inner (void) on-insert snip before x y)) - (define/augment (after-insert snip before x y) - (inner (void) after-insert snip before x y) - (when (is-a? snip size-editor-snip%) - (let ([cw (send snip get-char-width)] - [woc (send snip get-width-of-char)] - [bt (box 0)] - [bb (box 0)]) - (get-snip-location snip #f bt #f) - (get-snip-location snip #f bb #t) - (send snip resize - (* cw woc) - (- (unbox bb) (unbox bt))) - (when shrink-down? - (send snip shrink-down)))) - (end-edit-sequence)) - (super-new))) - - (define size-editor-snip% - (class* editor-snip% (reflowing-snip<%>) - (init-field expr) - (init pp) - (init-field char-width) - (define real-pp - (if (procedure-arity-includes? pp 4) - pp - (lambda (v port w spec) (display (pp v) port)))) - (inherit get-admin) - (define/public (get-expr) expr) - (define/public (get-char-width) char-width) - - (define/override (resize w h) - (super resize w h) - (reflow-program)) - - (inherit get-editor) - ;; final - (define/pubment (reflow-program) - (let* ([tw (get-width-of-char)] - [sw (get-snip-width)]) - (when (and tw sw) - (let ([new-width (max 1 (inexact->exact (floor (/ sw tw))))]) - (unless (equal? new-width char-width) - (set! char-width new-width) - (format-expr) - (on-width-changed char-width)))))) - - ;; final - (define/pubment (shrink-down) - (let ([ed (get-editor)] - [bx (box 0)] - [by (box 0)]) - (let ([max-line-width - (let loop ([p 0] - [max-w 0]) - (cond - [(<= p (send ed last-paragraph)) - (send ed position-location - (send ed paragraph-end-position p) - bx by #t) - (let ([this-w (unbox bx)]) - (loop (+ p 1) - (max this-w max-w)))] - [else max-w]))]) - (send ed position-location (send ed last-position) bx by #f) - (let-values ([(hms vms) (get-margin-space)]) - (super resize - (+ max-line-width hms) - (+ (unbox by) vms)))))) - - (inherit get-margin) - (define/public (get-snip-width) - (let ([admin (get-admin)]) - (and admin - (let ([containing-editor (send admin get-editor)] - [bl (box 0)] - [br (box 0)]) - (send containing-editor get-snip-location this bl #f #f) - (send containing-editor get-snip-location this br #f #t) - (let ([outer-w (- (unbox br) (unbox bl))]) - (let-values ([(hms vms) (get-margin-space)]) - (- outer-w hms))))))) - - (define/private (get-margin-space) - (let ([bl (box 0)] - [br (box 0)] - [bt (box 0)] - [bb (box 0)]) - (get-margin bl bt br bb) - (values (+ (unbox bl) (unbox br) 2) ;; not sure what the 2 is for. Maybe caret space? - (+ (unbox bt) (unbox bb))))) - - (define/public (get-width-of-char) - (let ([ed (get-editor)]) - (and ed - (let ([dc (send ed get-dc)] - [std-style (send (editor:get-standard-style-list) find-named-style "Standard")]) - (and dc - (let-values ([(tw th _2 _3) (send dc get-text-extent "w" - (and std-style - (send std-style get-font)))]) - tw)))))) - - (define/public (get-height-of-char) - (let ([ed (get-editor)]) - (and ed - (let ([dc (send ed get-dc)] - [std-style (send (editor:get-standard-style-list) find-named-style "Standard")]) - (and dc - (let-values ([(tw th _2 _3) (send dc get-text-extent "w" - (and std-style - (send std-style get-font)))]) - th)))))) +#lang scheme/base +(require scheme/gui/base + scheme/class + framework + scheme/pretty + "matcher.ss") - (define/pubment (on-width-changed w) (inner (void) on-width-changed w)) - - (define/public (format-expr) - (let* ([text (get-editor)] - [port (open-output-text-editor text)]) - (send text begin-edit-sequence) - (when (is-a? text color:text<%>) - (send text thaw-colorer)) - (send text set-styles-sticky #f) - (send text erase) - (real-pp expr port char-width text) - (unless (zero? (send text last-position)) - (when (char=? #\newline (send text get-character (- (send text last-position) 1))) - (send text delete (- (send text last-position) 1) (send text last-position)))) - (when (is-a? text color:text<%>) - (send text freeze-colorer)) - (send text end-edit-sequence))) +(provide reflowing-snip<%> + size-editor-snip% + size-text% + default-pretty-printer + initial-char-width + resizing-pasteboard-mixin) + +(define initial-char-width (make-parameter 30)) + +(define (default-pretty-printer v port w spec) + (parameterize ([pretty-print-columns w] + [pretty-print-size-hook + (λ (val display? op) + (cond + [(hole? val) 4] + [(eq? val 'hole) 6] + [else #f]))] + [pretty-print-print-hook + (λ (val display? op) + (cond + [(hole? val) + (display "hole" op)] + [(eq? val 'hole) + (display ",'hole" op)]))]) + (pretty-print v port))) + +(define reflowing-snip<%> + (interface () + reflow-program)) + +(define (resizing-pasteboard-mixin pb%) + (class pb% + + (define/augment (on-interactive-resize snip) + (when (is-a? snip reflowing-snip<%>) + (send snip reflow-program)) + (inner (void) on-interactive-resize snip)) + + (define/augment (after-interactive-resize snip) + (when (is-a? snip reflowing-snip<%>) + (send snip reflow-program)) + (inner (void) after-interactive-resize snip)) + + (define/override (interactive-adjust-resize snip w h) + (super interactive-adjust-resize snip w h) + (when (is-a? snip reflowing-snip<%>) + (send snip reflow-program))) + + (inherit get-snip-location + begin-edit-sequence + end-edit-sequence + find-first-snip + get-dc) + + (super-new))) + +(define size-editor-snip% + (class* editor-snip% (reflowing-snip<%>) + (init-field expr) + (init pp) + (init-field char-width) + (define real-pp + (if (procedure-arity-includes? pp 4) + pp + (lambda (v port w spec) (display (pp v) port)))) + + (inherit get-admin) + (define/public (get-expr) expr) + (define/public (get-char-width) char-width) + + (define/override (resize w h) + (super resize w h) + (reflow-program)) + + (inherit get-editor) + ;; final + (define/pubment (reflow-program) + (let* ([tw (get-width-of-char)] + [sw (get-snip-width)]) + (when (and tw sw) + (let ([new-width (max 1 (inexact->exact (floor (/ sw tw))))]) + (unless (equal? new-width char-width) + (set! char-width new-width) + (format-expr) + (on-width-changed char-width)))))) + + (inherit get-margin) + (define/public (get-snip-width) + (let ([admin (get-admin)]) + (and admin + (let ([containing-editor (send admin get-editor)] + [bl (box 0)] + [br (box 0)]) + (send containing-editor get-snip-location this bl #f #f) + (send containing-editor get-snip-location this br #f #t) + (let ([outer-w (- (unbox br) (unbox bl))]) + (let-values ([(hms vms) (get-margin-space)]) + (- outer-w hms))))))) + + (define/private (get-margin-space) + (let ([bl (box 0)] + [br (box 0)] + [bt (box 0)] + [bb (box 0)]) + (get-margin bl bt br bb) + (values (+ (unbox bl) (unbox br) 6) ;; not sure what the 2 is for. Maybe caret space? + (+ (unbox bt) (unbox bb))))) + + ;; get-width-of-char : -> number or false + ;; depends on `dc' field + (define/public (get-width-of-char) + (let ([ed (get-editor)]) + (and ed + (let ([std-style (send (editor:get-standard-style-list) find-named-style "Standard")] + [dc (send ed get-dc)]) + (and dc + (let-values ([(tw th _2 _3) (send dc get-text-extent "w" + (and std-style + (send std-style get-font)))]) + tw)))))) + + ;; depends on `dc' field + (define/public (get-height-of-char) + (let ([ed (get-editor)]) + (and ed + (let ([dc (send ed get-dc)] + [std-style (send (editor:get-standard-style-list) find-named-style "Standard")]) + (and dc + (let-values ([(tw th _2 _3) (send dc get-text-extent "w" + (and std-style + (send std-style get-font)))]) + th)))))) + + (define/pubment (on-width-changed w) (inner (void) on-width-changed w)) + + (define/public (format-expr) + (let* ([text (get-editor)] + [port (open-output-text-editor text)]) + (send text begin-edit-sequence) + (when (is-a? text color:text<%>) + (send text thaw-colorer)) + (send text set-styles-sticky #f) + (send text erase) + (real-pp expr port char-width text) + (unless (zero? (send text last-position)) + (when (char=? #\newline (send text get-character (- (send text last-position) 1))) + (send text delete (- (send text last-position) 1) (send text last-position)))) + (when (is-a? text color:text<%>) + (send text freeze-colorer)) + (send text end-edit-sequence))) + + (super-new) + (inherit use-style-background) + (use-style-background #t))) + +(define size-text% + (scheme:set-mode-mixin + (scheme:text-mixin + (color:text-mixin + (text:autocomplete-mixin + (mode:host-text-mixin + (editor:standard-style-list-mixin + text:basic%))))))) - (super-new) - (inherit use-style-background) - (use-style-background #t)))) diff --git a/collects/redex/private/stepper.ss b/collects/redex/private/stepper.ss index 9eb80fc944..69d3bbd519 100644 --- a/collects/redex/private/stepper.ss +++ b/collects/redex/private/stepper.ss @@ -77,7 +77,6 @@ todo: (define upper-hp (new horizontal-panel% [parent dp])) (define lower-hp (new horizontal-panel% [alignment '(center center)] [parent f] [stretchable-height #f])) (define pb (new columnar-pasteboard% - [shrink-down? #f] [moved (λ (a b c d) (when (procedure? moved) (moved a b c d)))])) @@ -801,7 +800,7 @@ todo: flat-to-remove) (for-each (λ (x) (insert x)) flat-to-insert))) - (inherit get-admin move-to resize) + (inherit get-admin move-to) (define/public (update-heights) (let ([admin (get-admin)]) (let-values ([(w h) (get-view-size)]) @@ -816,9 +815,11 @@ todo: ;; if there is only a single snip in the column, we let it be as long as it wants to be. (let* ([snip (car column)] [sw (get-snip-width snip)] - [sh (get-snip-max-height snip)]) + [sh (get-snip-max-height snip)] + [new-height (- (max h sh) (get-border-height snip))]) (move-to snip x 0) - (resize snip sw (max h sh)) + (send snip set-min-height new-height) + (send snip set-max-height new-height) (loop (cdr columns) (+ x sw)))] [else ;; otherwise, we make all of the snips fit into the visible area @@ -838,16 +839,39 @@ todo: 0 1))]) (move-to snip x y) - (resize snip sw h) + (let ([border-height (get-border-height snip)]) + (send snip set-min-height (- h border-height)) + (send snip set-max-height (- h border-height))) (loop (cdr snips) (if (zero? extra-space) 0 (- extra-space 1)) (+ y h) (max widest sw)))]))]) + (for-each (λ (snip) + (let ([border-width (get-border-width snip)]) + (send snip set-min-width (- widest border-width)) + (send snip set-max-width (- widest border-width)))) + column) (loop (cdr columns) (+ x widest)))]))]))))) + (define/private (get-border-height snip) + (let ([lb (box 0)] + [tb (box 0)] + [rb (box 0)] + [bb (box 0)]) + (send snip get-margin lb tb bb rb) + (+ (unbox bb) (unbox tb)))) + + (define/private (get-border-width snip) + (let ([lb (box 0)] + [tb (box 0)] + [rb (box 0)] + [bb (box 0)]) + (send snip get-margin lb tb bb rb) + (+ (unbox lb) (unbox rb)))) + (inherit get-snip-location) (define/public (get-snip-width snip) (let ([lb (box 0)] diff --git a/collects/redex/private/traces.ss b/collects/redex/private/traces.ss index ebddb6617f..af80b79bab 100644 --- a/collects/redex/private/traces.ss +++ b/collects/redex/private/traces.ss @@ -1,15 +1,17 @@ +#lang scheme/base + ;; should cache the count of new snips -- dont ;; use `count-snips'; use something associated with the ;; equal hash-table -#lang scheme - (require mrlib/graph "reduction-semantics.ss" "matcher.ss" "size-snip.ss" "dot.ss" scheme/gui/base + scheme/class + scheme/file framework) (preferences:set-default 'plt-reducer:show-bottom #t boolean?) @@ -139,12 +141,83 @@ #:scheme-colors? scheme-colors? #:colors colors #:layout layout)]) - (let ([ps-setup (make-object ps-setup%)]) - (send ps-setup copy-from (current-ps-setup)) - (send ps-setup set-file filename) - (send ps-setup set-mode 'file) - (parameterize ([current-ps-setup ps-setup]) - (send graph-pb print #f #f 'postscript #f #f #t))))) + (print-to-ps graph-pb filename))) + +(define (print-to-ps graph-pb filename) + (let ([admin (send graph-pb get-admin)] + [printing-admin (new printing-editor-admin%)]) + (send graph-pb set-admin printing-admin) + + (dynamic-wind + void + (λ () + (let loop ([snip (send graph-pb find-first-snip)]) + (when snip + (send snip size-cache-invalid) + (loop (send snip next)))) + (send graph-pb invalidate-bitmap-cache) + + (send graph-pb re-run-layout) + + (let ([ps-setup (make-object ps-setup%)]) + (send ps-setup copy-from (current-ps-setup)) + (send ps-setup set-file filename) + (send ps-setup set-mode 'file) + (parameterize ([current-ps-setup ps-setup]) + (send graph-pb print #f #f 'postscript #f #f #t)))) + + (λ () + (send graph-pb set-admin admin) + (send printing-admin shutdown) ;; do this early + (let loop ([snip (send graph-pb find-first-snip)]) + (when snip + (send snip size-cache-invalid) + (loop (send snip next)))) + (send graph-pb invalidate-bitmap-cache) + (send graph-pb re-run-layout))))) + +(define printing-editor-admin% + (class editor-admin% + + (define temp-file (make-temporary-file "redex-size-snip-~a")) + + (define ps-dc + (let ([ps-setup (make-object ps-setup%)]) + (send ps-setup copy-from (current-ps-setup)) + (send ps-setup set-file temp-file) + (parameterize ([current-ps-setup ps-setup]) + (make-object post-script-dc% #f #f #f #t)))) + + (send ps-dc start-doc "fake dc") + (send ps-dc start-page) + (super-new) + + (define/public (shutdown) + (send ps-dc end-page) + (send ps-dc end-doc) + (delete-file temp-file)) + + + (define/override (get-dc [x #f] [y #f]) + (super get-dc x y) + ps-dc) + (define/override (get-max-view x y w h [full? #f]) + (get-view x y w h full?)) + (define/override (get-view x y w h [full? #f]) + (super get-view x y w h full?) + (when (box? w) (set-box! w 500)) + (when (box? h) (set-box! h 500))) + + ;; the following methods are not overridden; they all default to doing nothing. + ;; grab-caret + ;; modified + ;; needs-update + ;; popup-menu + ;; refresh-delayed? + ;; resized + ;; scroll-to + ;; update-cursor + )) (define (traces reductions pre-exprs #:multiple? [multiple? #f] @@ -157,7 +230,7 @@ (define exprs (if multiple? pre-exprs (list pre-exprs))) (define main-eventspace (current-eventspace)) (define saved-parameterization (current-parameterization)) - (define graph-pb (new graph-pasteboard% [shrink-down? #t])) + (define graph-pb (new graph-pasteboard% [layout layout])) (define f (instantiate red-sem-frame% () (label "PLT Redex Reduction Graph") (style '(toolbar-button)) @@ -275,7 +348,7 @@ (let loop ([snip (send graph-pb find-first-snip)]) (when snip (when (is-a? snip reflowing-snip<%>) - (send snip shrink-down)) + (send snip reflow-program)) (loop (send snip next)))))) ;; fill-out : (listof X) (listof X) -> (listof X) @@ -338,7 +411,7 @@ (set! col (+ x-spacing (find-rightmost-x graph-pb)))) (begin0 (insert-into col y graph-pb new-snips) - (layout (hash-map snip-cache (lambda (x y) (send y get-term-node)))) + (send graph-pb re-run-layout) (send graph-pb end-edit-sequence) (send status-message set-label (string-append (term-count (count-snips)) "...")))))]) @@ -469,7 +542,7 @@ null))) (out-of-dot-state) ;; make sure the state is initialized right (insert-into init-rightmost-x 0 graph-pb frontier) - (layout (map (lambda (y) (send y get-term-node)) frontier)) + (send graph-pb re-run-layout) (set-font-size (initial-font-size)) (cond [no-show-frame? @@ -507,6 +580,10 @@ (define graph-pasteboard% (class (resizing-pasteboard-mixin (graph-pasteboard-mixin pasteboard%)) + + (init-field layout) ;; (-> (listof term-node) void) + ;; this is the function supplied by the :#layout argument to traces or traces/ps + (define dot-callback #f) (define/public (set-dot-callback cb) (set! dot-callback cb)) (define/override (draw-edges dc left top right bottom dx dy) @@ -521,6 +598,17 @@ (define/augment (can-interactive-move? evt) mobile?) (define/augment (can-interactive-resize? evt) mobile?) + (inherit find-first-snip) + (define/public (re-run-layout) + (layout + (let loop ([snip (find-first-snip)]) + (cond + [(not snip) '()] + [(is-a? snip reflowing-snip<%>) + (cons (send snip get-term-node) + (loop (send snip next)))] + [else (loop (send snip next))])))) + (super-new))) (define graph-editor-snip% @@ -578,7 +666,7 @@ (super-new))) (define program-text% - (class scheme:text% + (class size-text% (define bad-color #f) (define/public (set-bad color) (set! bad-color color)) @@ -688,6 +776,7 @@ (pp pp) (expr expr))]) (send text set-autowrap-bitmap #f) + (send text set-max-width 'none) (send text freeze-colorer) (send text stop-colorer (not scheme-colors?)) (send es format-expr) diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index bdb49f38e5..19fb18d782 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -213,12 +213,13 @@ looking for a decomposition, it ignores any holes found in that @|pattern|. } -@item{The @tt{(@defpattech[side-condition] @ttpattern guard)} @pattern matches -what the embedded @pattern matches, and then the guard expression is -evaluated. If it returns @scheme[#f], the @pattern fails to match, and if it -returns anything else, the @pattern matches. In addition, any -occurrences of `name' in the @pattern are bound using @scheme[term-let] -in the guard. +@item{The @tt{(@defpattech[side-condition] @ttpattern guard)} @pattern +matches what the embedded @pattern matches, and then the guard +expression is evaluated. If it returns @scheme[#f], the @pattern fails +to match, and if it returns anything else, the @pattern matches. Any +occurrences of `name' in the @pattern (including those implicitly +there via @tt{_} pattersn) are bound using @scheme[term-let] in the +guard. } @item{The @tt{(@defpattech[cross] symbol)} @pattern is used for the compatible @@ -1367,9 +1368,18 @@ the stepper and traces. @defparam[dark-pen-color color (or/c string? (is-a?/c color<%>))]{} @defparam[dark-brush-color color (or/c string? (is-a?/c color<%>))]{} @defparam[light-pen-color color (or/c string? (is-a?/c color<%>))]{} -@defparam[light-brush-color color (or/c string? (is-a?/c color<%>))]{}]]{ +@defparam[light-brush-color color (or/c string? (is-a?/c color<%>))]{} +@defparam[dark-text-color color (or/c string? (is-a?/c color<%>))]{} +@defparam[light-text-color color (or/c string? (is-a?/c color<%>))]{}]]{ -These four parameters control the color of the edges in the graph. +These six parameters control the color of the edges in the graph. + +The dark colors are used when the mouse is over one of the nodes that +is connected to this edge. The light colors are used when it isn't. + +The pen colors control the color of the line. The brush colors control +the color used to fill the arrowhead and the text colors control the +color used to draw the label on the edge. } @defproc[(default-pretty-printer [v any] [port output-port] [width number] [text (is-a?/c text%)]) void?]{