>> I'm not seeing it with the latest. >> >> Did you disable some tools? > > Or possibly not run raco setup so some tools didn't get registered?
I did run raco setup and I have some tools disabled (in fact, everything except htdp, stepper, and lazy racket are disabled). But it still shouldnt error, right? >> On Sun, May 15, 2011 at 2:42 PM, Stephen Chang <[email protected]> wrote: >>> I just pulled the latest from git, started drracket, selected >>> Beginning Student language, >>> pressed run, and I got this error msg: >>> >>> >>> >>> send: no such method: get-test-window for class: >>> ...per\stepper-tool.rkt:235:4 >>> >>> === context === >>> C:\plt\collects\racket\private\class-internal.rkt:4550:0: obj-error >>> C:\plt\collects\test-engine\test-display.scm:36:4: report-success >>> method in test-display% >>> C:\plt\collects\mred\private\wx\common\queue.rkt:430:6 >>> C:\plt\collects\mred\private\wx\common\queue.rkt:470:32 >>> C:\plt\collects\mred\private\wx\common\queue.rkt:607:3 >>> >>> >>> >>> >>> Does anyone else get this error? I'm running 5.1.1.5 on windows 7. >>> >>> >>> >>> >>> >>> >>> On Thu, Apr 28, 2011 at 4:22 PM, <[email protected]> wrote: >>>> clements has updated `master' from fc531c4dbf to d2a21d717c. >>>> http://git.racket-lang.org/plt/fc531c4dbf..d2a21d717c >>>> >>>> =====[ 3 Commits ]====================================================== >>>> >>>> Directory summary: >>>> 28.6% collects/stepper/private/ >>>> 14.9% collects/stepper/scribblings/ >>>> 56.4% collects/stepper/ >>>> >>>> ~~~~~~~~~~ >>>> >>>> 437baf9 John Clements <[email protected]> 2011-04-26 11:36 >>>> : >>>> | added simple scribblings from old doc.txt >>>> : >>>> M collects/stepper/info.rkt | 2 ++ >>>> A collects/stepper/scribblings/stepper.scrbl >>>> >>>> ~~~~~~~~~~ >>>> >>>> e4a834e John Clements <[email protected]> 2011-04-28 11:36 >>>> : >>>> | housekeeping, changed to drracket-tool, moved files to private >>>> : >>>> R collects/stepper/{ => private}/view-controller.rkt (96%) >>>> R collects/stepper/{ => private}/xml-sig.rkt (100%) >>>> D collects/stepper/break.rkt >>>> M collects/stepper/info.rkt | 12 +--- >>>> M collects/stepper/stepper-tool.rkt | 78 >>>> +++++++++++----------- >>>> M collects/stepper/stepper+xml-tool.rkt | 38 +++++------ >>>> M collects/stepper/tests/test-docs-complete.rkt | 4 - >>>> M collects/stepper/xml-tool.rkt | 53 +++++++-------- >>>> >>>> ~~~~~~~~~~ >>>> >>>> d2a21d7 John Clements <[email protected]> 2011-04-28 13:21 >>>> : >>>> | refactored stepper tool to work with tabs instead of frames >>>> : >>>> M collects/stepper/private/view-controller.rkt | 6 +- >>>> M collects/stepper/stepper-tool.rkt | 206 >>>> +++++++++++++--------- >>>> >>>> =====[ Overall Diff ]=================================================== >>>> >>>> collects/stepper/break.rkt >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- OLD/collects/stepper/break.rkt >>>> +++ /dev/null >>>> @@ -1,25 +0,0 @@ >>>> -(module break mzscheme >>>> - >>>> - (require mzlib/contract) >>>> - >>>> - (provide current-breakpoint-handler) >>>> - >>>> - (define (default-current-breakpoint-handler) >>>> - (error 'default-current-breakpoint-handler >>>> - "The current-breakpoint-handler parameter has not yet been set >>>> in this thread.")) >>>> - >>>> - (define current-breakpoint-handler >>>> - (make-parameter >>>> - default-current-breakpoint-handler >>>> - (lambda (new-handler) >>>> - (if (and (procedure? new-handler) >>>> - (procedure-arity-includes? new-handler 0)) >>>> - new-handler >>>> - (error 'current-breakpoint-handler >>>> - "Bad value for current-breakpoint-handler: ~e" >>>> - new-handler))))) >>>> - >>>> - (provide/contract [break (-> any)]) >>>> - >>>> - (define (break) >>>> - ((current-breakpoint-handler)))) >>>> >>>> collects/stepper/info.rkt >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- OLD/collects/stepper/info.rkt >>>> +++ NEW/collects/stepper/info.rkt >>>> @@ -1,15 +1,11 @@ >>>> #lang setup/infotab >>>> >>>> -(define tools '(("stepper+xml-tool.ss") >>>> - ;; ("debugger-tool.ss") >>>> - )) >>>> +(define drracket-tools '(("stepper+xml-tool.ss"))) >>>> >>>> -(define tool-names (list "The Stepper" >>>> - ;; "The Debugger" >>>> - )) >>>> +(define drracket-tool-names (list "The Stepper")) >>>> >>>> -(define tool-icons (list '("foot-up.png" "icons") >>>> - ;; #f >>>> - )) >>>> +(define drracket-tool-icons (list '("foot-up.png" "icons"))) >>>> >>>> (define compile-omit-paths '("debugger-tool.ss")) >>>> + >>>> +(define scribblings '(("scribblings/stepper.scrbl"))) >>>> >>>> collects/stepper/scribblings/stepper.scrbl >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- /dev/null >>>> +++ NEW/collects/stepper/scribblings/stepper.scrbl >>>> @@ -0,0 +1,177 @@ >>>> +#lang scribble/doc >>>> + >>>> +@(require scribble/manual) >>>> + >>>> +@title{The Stepper} >>>> + >>>> +@section{What is the Stepper?} >>>> + >>>> +DrRacket includes an "algebraic stepper," a tool which proceeds >>>> +through the evaluation of a set of definitions and expressions, >>>> +one step at a time. This evaluation shows the user how DrRacket >>>> +evaluates expressions and definitions, and can help in debugging >>>> +programs. Currently, the Stepper is available in the "Beginning >>>> +Student" and "Intermediate Student" language levels. >>>> + >>>> +@section{How do I use the Stepper?} >>>> + >>>> +The Stepper operates on the contents of the frontmost DrRacket >>>> +window. A click on the "Step" button brings up the stepper >>>> +window. The stepper window has two panes, arranged as follows: >>>> + >>>> +@verbatim{ >>>> +------------------ >>>> +| | | >>>> +| before -> after| >>>> +| | | >>>> +------------------ >>>> +} >>>> + >>>> +The first, "before," box, shows the current expression. The >>>> +region highlighted in green is known as the "redex". You may >>>> +pronounce this word in any way you want. It is short for >>>> +"reducible expression," and it is the expression which is the >>>> +next to be simplified. >>>> + >>>> +The second, "after," box shows the result of the reduction. The >>>> +region highlighted in purple is the new expression which is >>>> +substituted for the green one as a result of the reduction. For >>>> +most reductions, the only difference between the left- and right-hand >>>> +sides should be the contents of the green and purple boxes. >>>> + >>>> +Please note that the stepper only steps through the expressions >>>> +in the definitions window, and does not allow the user to enter >>>> +additional expressions. So, for instance, a definitions buffer >>>> +which contains only procedure definitions will not result in >>>> +any reductions. >>>> + >>>> +@section{How Does the Stepper work?} >>>> + >>>> +In order to discover all of the steps that occur during the evaluation >>>> +of your code, the Stepper rewrites (or "instruments") your code. >>>> +The inserted code uses a mechanism called "continuation marks" to >>>> +store information about the program's execution as it is running, >>>> +and makes calls to the Stepper before, after and during the evaluation >>>> +of each expression, indicating the current shape of the program. >>>> + >>>> +What does this instrumented code look like? For the curious, here's the >>>> +expanded version of @racket[(define (f x) (+ 3 x))] in the beginner >>>> +language [*]: >>>> + >>>> +@racketblock[ >>>> +(module #%htdp (lib "lang/htdp-beginner.ss") >>>> + (#%plain-module-begin >>>> + (define-syntaxes (f) >>>> + (#%app make-first-order-function >>>> + (quote procedure) >>>> + (quote 1) >>>> + (quote-syntax f) >>>> + (quote-syntax #%app))) >>>> + (define-values (test~object) (#%app namespace-variable-value (quote >>>> test~object))) >>>> + (begin >>>> + (define-values (f) >>>> + (with-continuation-mark "#<debug-key-struct>" >>>> + (#%plain-lambda () (#%plain-app >>>> "#<procedure:...rivate/marks.rkt:70:2>")) >>>> + (#%plain-app >>>> + call-with-values >>>> + (#%plain-lambda () >>>> + (with-continuation-mark "#<debug-key-struct>" >>>> + (#%plain-lambda () (#%plain-app >>>> + "#<procedure:...rivate/marks.rkt:70:2>" >>>> + (#%plain-lambda () beginner:+))) >>>> + (#%plain-app >>>> + "#<procedure:closure-storing-proc>" >>>> + (#%plain-lambda (x) >>>> + (begin >>>> + (let-values (((arg0-1643 arg1-1644 arg2-1645) >>>> + (#%plain-app >>>> + values >>>> + "#<*unevaluated-struct*>" >>>> + "#<*unevaluated-struct*>" >>>> + "#<*unevaluated-struct*>"))) >>>> + (with-continuation-mark "#<debug-key-struct>" >>>> + (#%plain-lambda () >>>> + (#%plain-app >>>> + "#<procedure:...rivate/marks.rkt:70:2>" >>>> + (#%plain-lambda () beginner:+) >>>> + (#%plain-lambda () x) >>>> + (#%plain-lambda () arg0-1643) >>>> + (#%plain-lambda () arg1-1644) >>>> + (#%plain-lambda () arg2-1645))) >>>> + (begin >>>> + (#%plain-app "#<procedure:result-exp-break>") >>>> + (begin >>>> + (set! arg0-1643 >>>> + (with-continuation-mark >>>> "#<debug-key-struct>" >>>> + (#%plain-lambda () >>>> + (#%plain-app >>>> + >>>> "#<procedure:...rivate/marks.rkt:70:2>")) >>>> + beginner:+)) >>>> + (set! arg1-1644 >>>> + (with-continuation-mark >>>> "#<debug-key-struct>" >>>> + (#%plain-lambda () >>>> + (#%plain-app >>>> + >>>> "#<procedure:...rivate/marks.rkt:70:2>")) >>>> + (quote 3))) >>>> + (set! arg2-1645 >>>> + (with-continuation-mark >>>> "#<debug-key-struct>" >>>> + (#%plain-lambda () >>>> + (#%plain-app >>>> + >>>> "#<procedure:...rivate/marks.rkt:70:2>")) x)) >>>> + (begin >>>> + (#%plain-app "#<procedure:normal-break>") >>>> + (with-continuation-mark "#<debug-key-struct>" >>>> + (#%plain-lambda () >>>> + (#%plain-app >>>> + "#<procedure:...rivate/marks.rkt:70:2>" >>>> + (#%plain-lambda () arg0-1643) >>>> + (#%plain-lambda () arg1-1644) >>>> + (#%plain-lambda () arg2-1645))) >>>> + (if (#%plain-app >>>> + "#<procedure:annotated-proc?>" >>>> + arg0-1643) >>>> + (#%plain-app >>>> + arg0-1643 >>>> + arg1-1644 >>>> + arg2-1645) >>>> + (#%plain-app >>>> + call-with-values >>>> + (#%plain-lambda () >>>> + (#%plain-app arg0-1643 arg1-1644 >>>> arg2-1645)) >>>> + (#%plain-lambda args >>>> + (#%plain-app >>>> + "#<procedure:result-value-break>" >>>> + args) >>>> + (#%plain-app >>>> + "#<procedure:apply>" >>>> + values >>>> + args)))))))))))) >>>> + (#%plain-lambda () >>>> + (#%plain-app >>>> + "#<procedure:...rivate/marks.rkt:70:2>" >>>> + (#%plain-lambda () beginner:+))) #f))) >>>> + (#%plain-lambda args >>>> + (#%plain-app "#<procedure:apply>" values args))))) >>>> + (#%plain-app "#<procedure:exp-finished-break>" >>>> + (#%plain-app >>>> + list >>>> + (#%plain-app >>>> + list >>>> + "#<procedure:...ate/annotate.rkt:1256:93>" >>>> + #f >>>> + (#%plain-lambda () (#%plain-app list f)))))))) >>>> + >>>> +(let-values (((done-already?) (quote #f))) >>>> + (#%app dynamic-wind void >>>> + (lambda () (#%app dynamic-require (quote (quote #%htdp)) (quote >>>> #f))) >>>> + (lambda () (if done-already? >>>> + (#%app void) >>>> + (let-values () >>>> + (set! done-already? (quote #t)) >>>> + (#%app test*) >>>> + (#%app current-namespace >>>> + (#%app module->namespace >>>> + (quote (quote #%htdp)))))))))] >>>> + >>>> + >>>> +[*] : In order to allow things like @verbatim{#<procedure:apply>} in >>>> scribble, I've taken the cheap solution of wrapping them in quotes. These >>>> are not actually strings, they're opaque 3D syntax elements. >>>> \ No newline at end of file >>>> >>>> collects/stepper/stepper+xml-tool.rkt >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- OLD/collects/stepper/stepper+xml-tool.rkt >>>> +++ NEW/collects/stepper/stepper+xml-tool.rkt >>>> @@ -1,25 +1,19 @@ >>>> -(module stepper+xml-tool mzscheme >>>> - (require mzlib/unit >>>> - drscheme/tool >>>> - "stepper-tool.ss" >>>> - "xml-tool.ss" >>>> - "view-controller.ss" >>>> - "private/shared.ss") >>>> +#lang racket >>>> >>>> - (provide tool@) >>>> +(require drracket/tool >>>> + "stepper-tool.rkt" >>>> + "xml-tool.rkt" >>>> + "private/view-controller.rkt") >>>> >>>> - ;; the xml and stepper tools are combined, so that the stepper can >>>> create XML >>>> - ;; snips. note that both of these tools provide 'void' for phase1 and >>>> phase2 >>>> - ;; (which together make up the tool-exports^), so we can provide either >>>> one >>>> - ;; of these for the compound unit. Doesn't matter. >>>> - >>>> - ;; NNNURRRG! This is not true any more. But that should be okay, >>>> because the >>>> - ;; stepper-tool phase1 is the non-void one. -- JBC, 2006-09-28 >>>> +(provide tool@) >>>> >>>> - (define tool@ >>>> - (compound-unit/infer >>>> - (import drscheme:tool^) >>>> - (export STEPPER-TOOL) >>>> - (link xml-tool@ >>>> - view-controller@ >>>> - [((STEPPER-TOOL : drscheme:tool-exports^)) stepper-tool@])))) >>>> +;; the xml and stepper tools are combined, so that the stepper can create >>>> XML >>>> +;; snips. >>>> + >>>> +(define tool@ >>>> + (compound-unit/infer >>>> + (import drracket:tool^) >>>> + (export STEPPER-TOOL) >>>> + (link xml-tool@ >>>> + view-controller@ >>>> + [((STEPPER-TOOL : drracket:tool-exports^)) stepper-tool@]))) >>>> \ No newline at end of file >>>> >>>> collects/stepper/stepper-tool.rkt >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- OLD/collects/stepper/stepper-tool.rkt >>>> +++ NEW/collects/stepper/stepper-tool.rkt >>>> @@ -1,27 +1,26 @@ >>>> #lang racket/unit >>>> >>>> -(require scheme/class >>>> - drscheme/tool >>>> +(require racket/class >>>> + drracket/tool >>>> mred >>>> - mzlib/pconvert >>>> - string-constants >>>> (prefix-in frame: framework) >>>> mrlib/switchable-button >>>> - (file "private/my-macros.ss") >>>> - (prefix-in x: "private/mred-extensions.ss") >>>> - "private/shared.ss" >>>> + mzlib/pconvert >>>> + racket/pretty >>>> + string-constants >>>> lang/stepper-language-interface >>>> - scheme/pretty >>>> - "xml-sig.ss" >>>> + (prefix-in x: "private/mred-extensions.rkt") >>>> + "private/shared.rkt" >>>> + "private/xml-sig.rkt" >>>> "drracket-button.ss") ;; get the stepper-button-callback >>>> private-member-name >>>> >>>> -(import drscheme:tool^ xml^ view-controller^) >>>> -(export drscheme:tool-exports^ stepper-frame^) >>>> +(import drracket:tool^ xml^ view-controller^) >>>> +(export drracket:tool-exports^ stepper-frame^) >>>> >>>> ;; tool magic here: >>>> (define (phase1) >>>> ;; experiment with extending the language... parameter-like fields for >>>> stepper parameters >>>> - (drscheme:language:extend-language-interface >>>> + (drracket:language:extend-language-interface >>>> stepper-language<%> >>>> (lambda (superclass) >>>> (class* superclass (stepper-language<%>) >>>> @@ -67,7 +66,7 @@ >>>> (send definitions-text get-next-settings)) >>>> >>>> (define (settings->language-level settings) >>>> - (drscheme:language-configuration:language-settings-language settings)) >>>> + (drracket:language-configuration:language-settings-language settings)) >>>> >>>> (define (stepper-works-for? language-level) >>>> (or (send language-level stepper:supported?) >>>> @@ -76,10 +75,10 @@ >>>> ;; the stepper's frame: >>>> >>>> (define stepper-frame% >>>> - (class (drscheme:frame:basics-mixin >>>> + (class (drracket:frame:basics-mixin >>>> (frame:frame:standard-menus-mixin frame:frame:basic%)) >>>> >>>> - (init-field drscheme-frame) >>>> + (init-field drracket-tab) >>>> >>>> ;; PRINTING-PROC >>>> ;; I frankly don't think that printing (i.e., to a printer) works >>>> @@ -114,7 +113,7 @@ >>>> (define/augment (on-close) >>>> (when custodian >>>> (custodian-shutdown-all custodian)) >>>> - (send drscheme-frame on-stepper-close) >>>> + (send drracket-tab on-stepper-close) >>>> (inner (void) on-close)) >>>> >>>> ;; WARNING BOXES: >>>> @@ -153,20 +152,91 @@ >>>> [height stepper-initial-height]))) >>>> >>>> >>>> - ;; stepper-unit-frame<%> : the interface that the extended drscheme >>>> frame >>>> + ;; stepper-unit-frame<%> : the interface that the extended drracket >>>> frame >>>> ;; fulfils >>>> - (define stepper-unit-frame<%> >>>> + (define stepper-tab<%> >>>> (interface () >>>> get-stepper-frame >>>> on-stepper-close)) >>>> >>>> - ;; stepper-unit-frame-mixin : the mixin that is applied to the drscheme >>>> - ;; frame to interact with a possible stepper window >>>> + ;; stepper-unit-frame-mixin : the mixin that is applied to the drracket >>>> + ;; frame to interact with a possible stepper window. Specifically, this >>>> + ;; mixin needs to manage the creation and visibility of the stepper >>>> button. >>>> (define (stepper-unit-frame-mixin super%) >>>> - (class* super% (stepper-unit-frame<%>) >>>> + (class* super% () >>>> + (inherit get-button-panel register-toolbar-button get-current-tab >>>> get-tabs) >>>> + >>>> + (super-new) >>>> + >>>> + ;; STEPPER BUTTON >>>> + >>>> + (define/public (get-stepper-button) stepper-button) >>>> + >>>> + (define stepper-button-parent-panel >>>> + (new horizontal-panel% >>>> + [parent (get-button-panel)] >>>> + [stretchable-width #f] >>>> + [stretchable-height #f])) >>>> + >>>> + (define stepper-button >>>> + (new switchable-button% >>>> + [parent stepper-button-parent-panel] >>>> + [label (string-constant stepper-button-label)] >>>> + [bitmap x:foot-img/horizontal] >>>> + [alternate-bitmap x:foot-img/vertical] >>>> + [callback (lambda (dont-care) (send (get-current-tab) >>>> + >>>> stepper-button-callback))])) >>>> + >>>> + (register-toolbar-button stepper-button) >>>> + >>>> + (define (stepper-button-show) >>>> + (unless (send stepper-button is-shown?) >>>> + (send (send stepper-button get-parent) >>>> + add-child stepper-button))) >>>> + >>>> + (define (stepper-button-hide) >>>> + (when (send stepper-button is-shown?) >>>> + (send (send stepper-button get-parent) >>>> + delete-child stepper-button))) >>>> + >>>> + ;; when the window closes, notify all of the stepper frames. >>>> + (define/augment (on-close) >>>> + (for ([tab (in-list (get-tabs))]) >>>> + (define possible-stepper-frame (send tab get-stepper-frame)) >>>> + (when possible-stepper-frame >>>> + (send possible-stepper-frame original-program-gone))) >>>> + (inner (void) on-close)) >>>> + >>>> + ;; when we change tabs, show or hide the stepper button. >>>> + (define/augment (on-tab-change old new) >>>> + (show/hide-stepper-button) >>>> + (inner (void) on-tab-change old new)) >>>> + >>>> + ;; add the stepper button to the button panel: >>>> + (send (get-button-panel) change-children >>>> + (lambda (x) >>>> + (cons stepper-button-parent-panel >>>> + (remq stepper-button-parent-panel x)))) >>>> >>>> - (inherit get-button-panel register-toolbar-button >>>> get-interactions-text get-definitions-text) >>>> + ;; show or hide the stepper button depending >>>> + ;; on the language level >>>> + (define/public (show/hide-stepper-button) >>>> + (cond [(send (get-current-tab) current-lang-supports-stepper?) >>>> + (stepper-button-show)] >>>> + [else >>>> + (stepper-button-hide)])) >>>> >>>> + ;; hide stepper button if it's not supported for the initial >>>> language: >>>> + (show/hide-stepper-button))) >>>> + >>>> + ;; stepper-tab-mixin : the mixin that is applied to drracket tabs, to >>>> + ;; interact with a possible stepper window. >>>> + (define (stepper-tab-mixin super%) >>>> + (class* super% (stepper-tab<%>) >>>> + >>>> + (inherit get-ints get-defs get-frame) >>>> + >>>> + ;; a reference to a possible stepper frame. >>>> (define stepper-frame #f) >>>> (define/public (on-stepper-close) >>>> (set! stepper-frame #f)) >>>> @@ -178,14 +248,14 @@ >>>> ;; definitions window one at a time and calls 'iter' on each one >>>> (define (program-expander init iter) >>>> (let* ([lang-settings >>>> - (send (get-definitions-text) get-next-settings)] >>>> - [lang >>>> (drscheme:language-configuration:language-settings-language lang-settings)] >>>> - [settings >>>> (drscheme:language-configuration:language-settings-settings >>>> lang-settings)]) >>>> - (drscheme:eval:expand-program >>>> - (drscheme:language:make-text/pos >>>> - (get-definitions-text) >>>> + (send (get-defs) get-next-settings)] >>>> + [lang >>>> (drracket:language-configuration:language-settings-language lang-settings)] >>>> + [settings >>>> (drracket:language-configuration:language-settings-settings >>>> lang-settings)]) >>>> + (drracket:eval:expand-program >>>> + (drracket:language:make-text/pos >>>> + (get-defs) >>>> 0 >>>> - (send (get-definitions-text) last-position)) >>>> + (send (get-defs) last-position)) >>>> lang-settings >>>> #f >>>> (lambda () >>>> @@ -203,108 +273,75 @@ >>>> void ; kill >>>> iter))) >>>> >>>> - ;; STEPPER BUTTON >>>> - >>>> - (define/public (get-stepper-button) stepper-button) >>>> - >>>> - (define stepper-button-parent-panel >>>> - (new horizontal-panel% >>>> - [parent (get-button-panel)] >>>> - [stretchable-width #f] >>>> - [stretchable-height #f])) >>>> - >>>> - ;; called from drracket-button.rkt, installed via the #lang >>>> htdp/bsl (& co) reader into drscheme >>>> + >>>> + ;; called from drracket-button.rkt, installed via the #lang >>>> htdp/bsl (& co) reader into drracket >>>> (define/public (stepper-button-callback) >>>> - (if stepper-frame >>>> - (send stepper-frame show #t) >>>> - (let* ([language-level >>>> - (extract-language-level (get-definitions-text))] >>>> - [language-level-name (language-level->name >>>> language-level)]) >>>> - (if (or (stepper-works-for? language-level) >>>> - (is-a? language-level >>>> drscheme:module-language:module-language<%>)) >>>> - (set! stepper-frame >>>> - (go this >>>> - program-expander >>>> - (+ 1 (send (get-definitions-text) >>>> get-start-position)) >>>> - (+ 1 (send (get-definitions-text) >>>> get-end-position)))) >>>> - (message-box >>>> - (string-constant stepper-name) >>>> - (format (string-constant >>>> stepper-language-level-message) >>>> - language-level-name)))))) >>>> + (cond >>>> + [stepper-frame (send stepper-frame show #t)] >>>> + [else (create-new-stepper)])) >>>> >>>> - (define stepper-button >>>> - (new switchable-button% >>>> - [parent stepper-button-parent-panel] >>>> - [label (string-constant stepper-button-label)] >>>> - [bitmap x:foot-img/horizontal] >>>> - [alternate-bitmap x:foot-img/vertical] >>>> - [callback (lambda (dont-care) (stepper-button-callback))])) >>>> + ;; open a new stepper window, start it running >>>> + (define (create-new-stepper) >>>> + (let* ([language-level >>>> + (extract-language-level (get-defs))] >>>> + [language-level-name (language-level->name >>>> language-level)]) >>>> + (if (or (stepper-works-for? language-level) >>>> + (is-a? language-level >>>> drracket:module-language:module-language<%>)) >>>> + (set! stepper-frame >>>> + (go this >>>> + program-expander >>>> + (+ 1 (send (get-defs) get-start-position)) >>>> + (+ 1 (send (get-defs) get-end-position)))) >>>> + (message-box >>>> + (string-constant stepper-name) >>>> + (format (string-constant stepper-language-level-message) >>>> + language-level-name))))) >>>> >>>> - (register-toolbar-button stepper-button) >>>> + (define/override (enable-evaluation) >>>> + (super enable-evaluation) >>>> + (send (send (get-frame) get-stepper-button) enable #t)) >>>> >>>> - (define/augment (enable-evaluation) >>>> - (send stepper-button enable #t) >>>> - (inner (void) enable-evaluation)) >>>> + (define/override (disable-evaluation) >>>> + (super enable-evaluation) >>>> + (send (send (get-frame) get-stepper-button) enable #f)) >>>> >>>> - (define/augment (disable-evaluation) >>>> - (send stepper-button enable #f) >>>> - (inner (void) disable-evaluation)) >>>> + (define/public (current-lang-supports-stepper?) >>>> + (stepper-works-for? (extract-language-level (get-defs)))) >>>> + >>>> + (define/public (notify-stepper-frame-of-change) >>>> + (when stepper-frame >>>> + (send stepper-frame original-program-changed))) >>>> >>>> (define/augment (on-close) >>>> (when stepper-frame >>>> - (send stepper-frame original-program-gone)) >>>> + (send stepper-frame original-program-gone)) >>>> (inner (void) on-close)) >>>> - >>>> - (define/augment (on-tab-change old new) >>>> - (check-current-language-for-stepper) >>>> - (inner (void) on-tab-change old new)) >>>> - >>>> - (define/public (check-current-language-for-stepper) >>>> - (if (stepper-works-for? >>>> - (extract-language-level (get-definitions-text))) >>>> - (unless (send stepper-button is-shown?) >>>> - (send (send stepper-button get-parent) >>>> - add-child stepper-button)) >>>> - (when (send stepper-button is-shown?) >>>> - (send (send stepper-button get-parent) >>>> - delete-child stepper-button)))) >>>> - >>>> - ;; add the stepper button to the button panel: >>>> - (send (get-button-panel) change-children >>>> - (lx (cons stepper-button-parent-panel >>>> - (remq stepper-button-parent-panel _)))) >>>> - >>>> - ;; hide stepper button if it's not supported for the initial >>>> language: >>>> - (check-current-language-for-stepper))) >>>> + >>>> + )) >>>> + >>>> + >>>> >>>> ;; stepper-definitions-text-mixin : a mixin for the definitions text that >>>> ;; alerts thet stepper when the definitions text is altered or destroyed >>>> (define (stepper-definitions-text-mixin %) >>>> (class % >>>> >>>> - (inherit get-top-level-window) >>>> - (define/private (notify-stepper-frame-of-change) >>>> - (let ([win (get-top-level-window)]) >>>> - ;; should only be #f when win is #f >>>> - (when (is-a? win stepper-unit-frame<%>) >>>> - (let ([stepper-window (send win get-stepper-frame)]) >>>> - (when stepper-window >>>> - (send stepper-window original-program-changed)))))) >>>> + (inherit get-tab get-top-level-window) >>>> >>>> (define/augment (on-insert x y) >>>> (unless metadata-changing-now? >>>> - (notify-stepper-frame-of-change)) >>>> + (send (get-tab) notify-stepper-frame-of-change)) >>>> (inner (void) on-insert x y)) >>>> >>>> (define/augment (on-delete x y) >>>> (unless metadata-changing-now? >>>> - (notify-stepper-frame-of-change)) >>>> + (send (get-tab) notify-stepper-frame-of-change)) >>>> (inner (void) on-delete x y)) >>>> >>>> (define/augment (after-set-next-settings s) >>>> (let ([tlw (get-top-level-window)]) >>>> (when tlw >>>> - (send tlw check-current-language-for-stepper))) >>>> + (send tlw show/hide-stepper-button))) >>>> (inner (void) after-set-next-settings s)) >>>> >>>> (define metadata-changing-now? #f) >>>> @@ -321,28 +358,29 @@ >>>> >>>> (super-new))) >>>> >>>> - ;; apply the mixins dynamically to the drscheme unit frame and >>>> + ;; apply the mixins dynamically to the drracket unit frame and >>>> ;; definitions text: >>>> - (drscheme:get/extend:extend-unit-frame stepper-unit-frame-mixin) >>>> - (drscheme:get/extend:extend-definitions-text >>>> stepper-definitions-text-mixin) >>>> + (drracket:get/extend:extend-unit-frame stepper-unit-frame-mixin) >>>> + (drracket:get/extend:extend-definitions-text >>>> stepper-definitions-text-mixin) >>>> + (drracket:get/extend:extend-tab stepper-tab-mixin) >>>> >>>> - ;; COPIED FROM drscheme/private/language.ss >>>> + ;; COPIED FROM drracket/private/language.ss >>>> ;; simple-module-based-language-convert-value : TST STYLE boolean -> TST >>>> (define (simple-module-based-language-convert-value value settings) >>>> - (case (drscheme:language:simple-settings-printing-style settings) >>>> + (case (drracket:language:simple-settings-printing-style settings) >>>> [(print) value] >>>> [(write trad-write) value] >>>> [(constructor) >>>> (parameterize >>>> ([constructor-style-printing #t] >>>> - [show-sharing (drscheme:language:simple-settings-show-sharing >>>> settings)] >>>> + [show-sharing (drracket:language:simple-settings-show-sharing >>>> settings)] >>>> [current-print-convert-hook >>>> (leave-snips-alone-hook (current-print-convert-hook))]) >>>> (stepper-print-convert value))] >>>> [(quasiquote) >>>> (parameterize >>>> ([constructor-style-printing #f] >>>> - [show-sharing (drscheme:language:simple-settings-show-sharing >>>> settings)] >>>> + [show-sharing (drracket:language:simple-settings-show-sharing >>>> settings)] >>>> [current-print-convert-hook >>>> (leave-snips-alone-hook (current-print-convert-hook))]) >>>> (stepper-print-convert value))] >>>> @@ -381,19 +419,19 @@ >>>> [(is-a? exp snip%) >>>> (send exp copy)] >>>> #; >>>> - [((drscheme:rep:use-number-snip) exp) >>>> + [((drracket:rep:use-number-snip) exp) >>>> (let ([number-snip-type >>>> - (drscheme:language:simple-settings-fraction-style >>>> + (drracket:language:simple-settings-fraction-style >>>> simple-settings)]) >>>> (cond >>>> [(eq? number-snip-type 'repeating-decimal) >>>> - (drscheme:number-snip:make-repeating-decimal-snip exp #f)] >>>> + (drracket:number-snip:make-repeating-decimal-snip exp #f)] >>>> [(eq? number-snip-type 'repeating-decimal-e) >>>> - (drscheme:number-snip:make-repeating-decimal-snip exp #t)] >>>> + (drracket:number-snip:make-repeating-decimal-snip exp #t)] >>>> [(eq? number-snip-type 'mixed-fraction) >>>> - (drscheme:number-snip:make-fraction-snip exp #f)] >>>> + (drracket:number-snip:make-fraction-snip exp #f)] >>>> [(eq? number-snip-type 'mixed-fraction-e) >>>> - (drscheme:number-snip:make-fraction-snip exp #t)] >>>> + (drracket:number-snip:make-fraction-snip exp #t)] >>>> [else >>>> (error 'which-number-snip >>>> "expected either 'repeating-decimal, >>>> 'repeating-decimal-e, 'mixed-fraction, or 'mixed-fraction-e got : ~e" >>>> >>>> collects/stepper/tests/test-docs-complete.rkt >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- OLD/collects/stepper/tests/test-docs-complete.rkt >>>> +++ NEW/collects/stepper/tests/test-docs-complete.rkt >>>> @@ -1,6 +1,2 @@ >>>> #lang racket/base >>>> (require tests/utils/docs-complete) >>>> -(check-docs (quote stepper/xml-sig)) >>>> -(check-docs (quote stepper/view-controller)) >>>> -(check-docs (quote stepper/drracket-button)) >>>> -(check-docs (quote stepper/break)) >>>> >>>> collects/stepper/xml-tool.rkt >>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >>>> --- OLD/collects/stepper/xml-tool.rkt >>>> +++ NEW/collects/stepper/xml-tool.rkt >>>> @@ -1,27 +1,26 @@ >>>> +#lang racket >>>> >>>> -(module xml-tool mzscheme >>>> - (require "private/xml-snip-helpers.rkt" >>>> - "private/find-tag.rkt" >>>> - "xml-sig.ss" >>>> - mzlib/unit >>>> - mzlib/contract >>>> - mzlib/class >>>> - mred >>>> - framework >>>> - drscheme/tool >>>> - xml/xml >>>> - string-constants) >>>> +(require "private/xml-snip-helpers.rkt" >>>> + "private/find-tag.rkt" >>>> + "private/xml-sig.ss" >>>> + mred >>>> + framework >>>> + drracket/tool >>>> + xml/xml >>>> + string-constants) >>>> >>>> (provide xml-tool@) >>>> >>>> (define orig (current-output-port)) >>>> (define-unit xml-tool@ >>>> - (import drscheme:tool^) >>>> + (import drracket:tool^) >>>> (export xml^) >>>> - (define (phase1) (void)) >>>> - (define (phase2) (void)) >>>> - >>>> - (preferences:set-default 'drscheme:xml-eliminate-whitespace #t >>>> boolean?) >>>> + >>>> + ;; these were necessary when this was a stand-alone tool: >>>> + #;(define (phase1) (void)) >>>> + #;(define (phase2) (void)) >>>> + >>>> + (preferences:set-default 'drracket:xml-eliminate-whitespace #t >>>> boolean?) >>>> >>>> (define xml-box-color "forest green") >>>> (define scheme-splice-box-color "blue") >>>> @@ -74,7 +73,7 @@ >>>> (define/private (set-eliminate-whitespace-in-empty-tags? new) >>>> (unless (eq? eliminate-whitespace-in-empty-tags? new) >>>> (set! eliminate-whitespace-in-empty-tags? new) >>>> - (preferences:set 'drscheme:xml-eliminate-whitespace new) >>>> + (preferences:set 'drracket:xml-eliminate-whitespace new) >>>> (reset-min-sizes) >>>> (let ([admin (get-admin)]) >>>> (when admin >>>> @@ -109,7 +108,7 @@ >>>> (define/override (make-snip stream-in) >>>> (instantiate xml-snip% () >>>> [eliminate-whitespace-in-empty-tags? >>>> - (preferences:get 'drscheme:xml-eliminate-whitespace)])) >>>> + (preferences:get 'drracket:xml-eliminate-whitespace)])) >>>> (super-instantiate ()))) >>>> >>>> ;; this snipclass is for old, saved files (no snip has it set) >>>> @@ -196,7 +195,7 @@ >>>> (define (get-scheme-box-text%) >>>> (unless scheme-box-text% >>>> (set! scheme-box-text% >>>> - (class ((drscheme:unit:get-program-editor-mixin) >>>> + (class ((drracket:unit:get-program-editor-mixin) >>>> (add-file-keymap-mixin >>>> scheme:text%)) >>>> (inherit copy-self-to) >>>> @@ -306,7 +305,7 @@ >>>> (let ([xml-text% #f]) >>>> (lambda () >>>> (unless xml-text% >>>> - (set! xml-text% (class >>>> ((drscheme:unit:get-program-editor-mixin) >>>> + (set! xml-text% (class >>>> ((drracket:unit:get-program-editor-mixin) >>>> (xml-text-mixin >>>> plain-text%)) >>>> (inherit copy-self-to) >>>> @@ -375,8 +374,8 @@ >>>> (lambda () >>>> (instantiate xml-snip% () >>>> [eliminate-whitespace-in-empty-tags? >>>> - (preferences:get >>>> 'drscheme:xml-eliminate-whitespace)])))))) >>>> - (register-capability-menu-item 'drscheme:special:xml-menus >>>> (get-insert-menu)) >>>> + (preferences:get >>>> 'drracket:xml-eliminate-whitespace)])))))) >>>> + (register-capability-menu-item 'drracket:special:xml-menus >>>> (get-insert-menu)) >>>> (instantiate menu:can-restore-menu-item% () >>>> (label (string-constant xml-tool-insert-scheme-box)) >>>> (parent menu) >>>> @@ -385,7 +384,7 @@ >>>> (lambda (menu evt) >>>> (insert-snip >>>> (lambda () (instantiate scheme-snip% () (splice? >>>> #f))))))) >>>> - (register-capability-menu-item 'drscheme:special:xml-menus >>>> (get-insert-menu)) >>>> + (register-capability-menu-item 'drracket:special:xml-menus >>>> (get-insert-menu)) >>>> (instantiate menu:can-restore-menu-item% () >>>> (label (string-constant xml-tool-insert-scheme-splice-box)) >>>> (parent menu) >>>> @@ -394,10 +393,10 @@ >>>> (lambda (menu evt) >>>> (insert-snip >>>> (lambda () (instantiate scheme-snip% () (splice? >>>> #t))))))) >>>> - (register-capability-menu-item 'drscheme:special:xml-menus >>>> (get-insert-menu))) >>>> + (register-capability-menu-item 'drracket:special:xml-menus >>>> (get-insert-menu))) >>>> >>>> (frame:reorder-menus this))) >>>> >>>> - (drscheme:language:register-capability 'drscheme:special:xml-menus >>>> (flat-contract boolean?) #t) >>>> + (drracket:language:register-capability 'drracket:special:xml-menus >>>> (flat-contract boolean?) #t) >>>> >>>> - (drscheme:get/extend:extend-unit-frame xml-box-frame-extension))) >>>> + (drracket:get/extend:extend-unit-frame xml-box-frame-extension)) >>>> >>>> *** See above for renames and copies *** >>>> >>> >>> _________________________________________________ >>> For list-related administrative tasks: >>> http://lists.racket-lang.org/listinfo/dev >>> >> > _________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/dev
