suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

housekeeping, changed to drracket-tool, moved files to private

Browse Source
This commit is contained in:
John Clements 2011-04-28 11:36:08 -07:00
parent 437baf905a
commit e4a834e9b0
8 changed files with 96 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/stepper/break.rkt
View File

@ -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))))

12
collects/stepper/info.rkt
View File

@ -1,16 +1,10 @@
#lang setup/infotab #lang setup/infotab
(define tools '(("stepper+xml-tool.ss") (define drracket-tools '(("stepper+xml-tool.ss")))
;; ("debugger-tool.ss")
))
(define tool-names (list "The Stepper" (define drracket-tool-names (list "The Stepper"))
;; "The Debugger"
))
(define tool-icons (list '("foot-up.png" "icons") (define drracket-tool-icons (list '("foot-up.png" "icons")))
;; #f
))
(define compile-omit-paths '("debugger-tool.ss")) (define compile-omit-paths '("debugger-tool.ss"))

24
collects/stepper/view-controller.rkt → collects/stepper/private/view-controller.rkt
View File

@ -6,21 +6,21 @@
(require racket/class (require racket/class
racket/match racket/match
racket/list racket/list
drscheme/tool drracket/tool
mred mred
string-constants string-constants
racket/async-channel racket/async-channel
(prefix-in model: "private/model.ss") (prefix-in model: "model.ss")
(prefix-in x: "private/mred-extensions.ss") (prefix-in x: "mred-extensions.ss")
"private/shared.ss" "shared.ss"
"private/model-settings.ss" "model-settings.ss"
"xml-sig.ss") "xml-sig.ss")
(import drscheme:tool^ xml^ stepper-frame^) (import drracket:tool^ xml^ stepper-frame^)
(export view-controller^) (export view-controller^)
(define drscheme-eventspace (current-eventspace)) (define drracket-eventspace (current-eventspace))
(define (definitions-text->settings definitions-text) (define (definitions-text->settings definitions-text)
(send definitions-text get-next-settings)) (send definitions-text get-next-settings))
@ -28,12 +28,12 @@
;; the stored representation of a step ;; the stored representation of a step
(define-struct step (text kind posns) #:transparent) (define-struct step (text kind posns) #:transparent)
(define (go drscheme-frame program-expander selection-start selection-end) (define (go drracket-frame program-expander selection-start selection-end)
;; get the language-level: ;; get the language-level:
(define language-settings (definitions-text->settings (send drscheme-frame get-definitions-text))) (define language-settings (definitions-text->settings (send drracket-frame get-definitions-text)))
(define language-level (drscheme:language-configuration:language-settings-language language-settings)) (define language-level (drracket:language-configuration:language-settings-language language-settings))
(define simple-settings (drscheme:language-configuration:language-settings-settings language-settings)) (define simple-settings (drracket:language-configuration:language-settings-settings language-settings))
;; VALUE CONVERSION CODE: ;; VALUE CONVERSION CODE:
@ -211,7 +211,7 @@
;; GUI ELEMENTS: ;; GUI ELEMENTS:
(define s-frame (define s-frame
(make-object stepper-frame% drscheme-frame)) (make-object stepper-frame% drracket-frame))
(define button-panel (define button-panel
(make-object horizontal-panel% (send s-frame get-area-container))) (make-object horizontal-panel% (send s-frame get-area-container)))
(define (add-button name fun) (define (add-button name fun)

0
collects/stepper/xml-sig.rkt → collects/stepper/private/xml-sig.rkt
View File

24
collects/stepper/stepper+xml-tool.rkt
View File

@ -1,25 +1,19 @@
(module stepper+xml-tool mzscheme #lang racket
(require mzlib/unit
drscheme/tool (require drracket/tool
"stepper-tool.ss" "stepper-tool.rkt"
"xml-tool.ss" "xml-tool.rkt"
"view-controller.ss" "private/view-controller.rkt")
"private/shared.ss")
(provide tool@) (provide tool@)
;; the xml and stepper tools are combined, so that the stepper can create XML ;; 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 ;; snips.
;; (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
(define tool@ (define tool@
(compound-unit/infer (compound-unit/infer
(import drscheme:tool^) (import drracket:tool^)
(export STEPPER-TOOL) (export STEPPER-TOOL)
(link xml-tool@ (link xml-tool@
view-controller@ view-controller@
[((STEPPER-TOOL : drscheme:tool-exports^)) stepper-tool@])))) [((STEPPER-TOOL : drracket:tool-exports^)) stepper-tool@])))

78
collects/stepper/stepper-tool.rkt
View File

@ -1,27 +1,26 @@
#lang racket/unit #lang racket/unit
(require scheme/class (require racket/class
drscheme/tool drracket/tool
mred mred
mzlib/pconvert
string-constants
(prefix-in frame: framework) (prefix-in frame: framework)
mrlib/switchable-button mrlib/switchable-button
(file "private/my-macros.ss") mzlib/pconvert
(prefix-in x: "private/mred-extensions.ss") racket/pretty
"private/shared.ss" string-constants
lang/stepper-language-interface lang/stepper-language-interface
scheme/pretty (prefix-in x: "private/mred-extensions.rkt")
"xml-sig.ss" "private/shared.rkt"
"private/xml-sig.rkt"
"drracket-button.ss") ;; get the stepper-button-callback private-member-name "drracket-button.ss") ;; get the stepper-button-callback private-member-name
(import drscheme:tool^ xml^ view-controller^) (import drracket:tool^ xml^ view-controller^)
(export drscheme:tool-exports^ stepper-frame^) (export drracket:tool-exports^ stepper-frame^)
;; tool magic here: ;; tool magic here:
(define (phase1) (define (phase1)
;; experiment with extending the language... parameter-like fields for stepper parameters ;; experiment with extending the language... parameter-like fields for stepper parameters
(drscheme:language:extend-language-interface (drracket:language:extend-language-interface
stepper-language<%> stepper-language<%>
(lambda (superclass) (lambda (superclass)
(class* superclass (stepper-language<%>) (class* superclass (stepper-language<%>)
@ -67,7 +66,7 @@
(send definitions-text get-next-settings)) (send definitions-text get-next-settings))
(define (settings->language-level 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) (define (stepper-works-for? language-level)
(or (send language-level stepper:supported?) (or (send language-level stepper:supported?)
@ -76,10 +75,10 @@
;; the stepper's frame: ;; the stepper's frame:
(define stepper-frame% (define stepper-frame%
(class (drscheme:frame:basics-mixin (class (drracket:frame:basics-mixin
(frame:frame:standard-menus-mixin frame:frame:basic%)) (frame:frame:standard-menus-mixin frame:frame:basic%))
(init-field drscheme-frame) (init-field drracket-frame)
;; PRINTING-PROC ;; PRINTING-PROC
;; I frankly don't think that printing (i.e., to a printer) works ;; I frankly don't think that printing (i.e., to a printer) works
@ -114,7 +113,7 @@
(define/augment (on-close) (define/augment (on-close)
(when custodian (when custodian
(custodian-shutdown-all custodian)) (custodian-shutdown-all custodian))
(send drscheme-frame on-stepper-close) (send drracket-frame on-stepper-close)
(inner (void) on-close)) (inner (void) on-close))
;; WARNING BOXES: ;; WARNING BOXES:
@ -153,14 +152,14 @@
[height stepper-initial-height]))) [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 ;; fulfils
(define stepper-unit-frame<%> (define stepper-unit-frame<%>
(interface () (interface ()
get-stepper-frame get-stepper-frame
on-stepper-close)) on-stepper-close))
;; stepper-unit-frame-mixin : the mixin that is applied to the drscheme ;; stepper-unit-frame-mixin : the mixin that is applied to the drracket
;; frame to interact with a possible stepper window ;; frame to interact with a possible stepper window
(define (stepper-unit-frame-mixin super%) (define (stepper-unit-frame-mixin super%)
(class* super% (stepper-unit-frame<%>) (class* super% (stepper-unit-frame<%>)
@ -179,10 +178,10 @@
(define (program-expander init iter) (define (program-expander init iter)
(let* ([lang-settings (let* ([lang-settings
(send (get-definitions-text) get-next-settings)] (send (get-definitions-text) get-next-settings)]
[lang (drscheme:language-configuration:language-settings-language lang-settings)] [lang (drracket:language-configuration:language-settings-language lang-settings)]
[settings (drscheme:language-configuration:language-settings-settings lang-settings)]) [settings (drracket:language-configuration:language-settings-settings lang-settings)])
(drscheme:eval:expand-program (drracket:eval:expand-program
(drscheme:language:make-text/pos (drracket:language:make-text/pos
(get-definitions-text) (get-definitions-text)
0 0
(send (get-definitions-text) last-position)) (send (get-definitions-text) last-position))
@ -213,7 +212,7 @@
[stretchable-width #f] [stretchable-width #f]
[stretchable-height #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) (define/public (stepper-button-callback)
(if stepper-frame (if stepper-frame
(send stepper-frame show #t) (send stepper-frame show #t)
@ -221,7 +220,7 @@
(extract-language-level (get-definitions-text))] (extract-language-level (get-definitions-text))]
[language-level-name (language-level->name language-level)]) [language-level-name (language-level->name language-level)])
(if (or (stepper-works-for? language-level) (if (or (stepper-works-for? language-level)
(is-a? language-level drscheme:module-language:module-language<%>)) (is-a? language-level drracket:module-language:module-language<%>))
(set! stepper-frame (set! stepper-frame
(go this (go this
program-expander program-expander
@ -271,8 +270,9 @@
;; add the stepper button to the button panel: ;; add the stepper button to the button panel:
(send (get-button-panel) change-children (send (get-button-panel) change-children
(lx (cons stepper-button-parent-panel (lambda (x)
(remq stepper-button-parent-panel _)))) (cons stepper-button-parent-panel
(remq stepper-button-parent-panel x))))
;; hide stepper button if it's not supported for the initial language: ;; hide stepper button if it's not supported for the initial language:
(check-current-language-for-stepper))) (check-current-language-for-stepper)))
@ -321,28 +321,28 @@
(super-new))) (super-new)))
;; apply the mixins dynamically to the drscheme unit frame and ;; apply the mixins dynamically to the drracket unit frame and
;; definitions text: ;; definitions text:
(drscheme:get/extend:extend-unit-frame stepper-unit-frame-mixin) (drracket:get/extend:extend-unit-frame stepper-unit-frame-mixin)
(drscheme:get/extend:extend-definitions-text stepper-definitions-text-mixin) (drracket:get/extend:extend-definitions-text stepper-definitions-text-mixin)
;; COPIED FROM drscheme/private/language.ss ;; COPIED FROM drracket/private/language.ss
;; simple-module-based-language-convert-value : TST STYLE boolean -> TST ;; simple-module-based-language-convert-value : TST STYLE boolean -> TST
(define (simple-module-based-language-convert-value value settings) (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] [(print) value]
[(write trad-write) value] [(write trad-write) value]
[(constructor) [(constructor)
(parameterize (parameterize
([constructor-style-printing #t] ([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 [current-print-convert-hook
(leave-snips-alone-hook (current-print-convert-hook))]) (leave-snips-alone-hook (current-print-convert-hook))])
(stepper-print-convert value))] (stepper-print-convert value))]
[(quasiquote) [(quasiquote)
(parameterize (parameterize
([constructor-style-printing #f] ([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 [current-print-convert-hook
(leave-snips-alone-hook (current-print-convert-hook))]) (leave-snips-alone-hook (current-print-convert-hook))])
(stepper-print-convert value))] (stepper-print-convert value))]
@ -381,19 +381,19 @@
[(is-a? exp snip%) [(is-a? exp snip%)
(send exp copy)] (send exp copy)]
#; #;
[((drscheme:rep:use-number-snip) exp) [((drracket:rep:use-number-snip) exp)
(let ([number-snip-type (let ([number-snip-type
(drscheme:language:simple-settings-fraction-style (drracket:language:simple-settings-fraction-style
simple-settings)]) simple-settings)])
(cond (cond
[(eq? number-snip-type 'repeating-decimal) [(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) [(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) [(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) [(eq? number-snip-type 'mixed-fraction-e)
(drscheme:number-snip:make-fraction-snip exp #t)] (drracket:number-snip:make-fraction-snip exp #t)]
[else [else
(error 'which-number-snip (error 'which-number-snip
"expected either 'repeating-decimal, 'repeating-decimal-e, 'mixed-fraction, or 'mixed-fraction-e got : ~e" "expected either 'repeating-decimal, 'repeating-decimal-e, 'mixed-fraction, or 'mixed-fraction-e got : ~e"

4
collects/stepper/tests/test-docs-complete.rkt
View File

@ -1,6 +1,2 @@
#lang racket/base #lang racket/base
(require tests/utils/docs-complete) (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))

39
collects/stepper/xml-tool.rkt
View File

@ -1,14 +1,11 @@
#lang racket
(module xml-tool mzscheme
(require "private/xml-snip-helpers.rkt" (require "private/xml-snip-helpers.rkt"
"private/find-tag.rkt" "private/find-tag.rkt"
"xml-sig.ss" "private/xml-sig.ss"
mzlib/unit
mzlib/contract
mzlib/class
mred mred
framework framework
drscheme/tool drracket/tool
xml/xml xml/xml
string-constants) string-constants)
@ -16,12 +13,14 @@
(define orig (current-output-port)) (define orig (current-output-port))
(define-unit xml-tool@ (define-unit xml-tool@
(import drscheme:tool^) (import drracket:tool^)
(export xml^) (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 xml-box-color "forest green")
(define scheme-splice-box-color "blue") (define scheme-splice-box-color "blue")
@ -74,7 +73,7 @@
(define/private (set-eliminate-whitespace-in-empty-tags? new) (define/private (set-eliminate-whitespace-in-empty-tags? new)
(unless (eq? eliminate-whitespace-in-empty-tags? new) (unless (eq? eliminate-whitespace-in-empty-tags? new)
(set! 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) (reset-min-sizes)
(let ([admin (get-admin)]) (let ([admin (get-admin)])
(when admin (when admin
@ -109,7 +108,7 @@
(define/override (make-snip stream-in) (define/override (make-snip stream-in)
(instantiate xml-snip% () (instantiate xml-snip% ()
[eliminate-whitespace-in-empty-tags? [eliminate-whitespace-in-empty-tags?
(preferences:get 'drscheme:xml-eliminate-whitespace)])) (preferences:get 'drracket:xml-eliminate-whitespace)]))
(super-instantiate ()))) (super-instantiate ())))
;; this snipclass is for old, saved files (no snip has it set) ;; this snipclass is for old, saved files (no snip has it set)
@ -196,7 +195,7 @@
(define (get-scheme-box-text%) (define (get-scheme-box-text%)
(unless scheme-box-text% (unless scheme-box-text%
(set! 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 (add-file-keymap-mixin
scheme:text%)) scheme:text%))
(inherit copy-self-to) (inherit copy-self-to)
@ -306,7 +305,7 @@
(let ([xml-text% #f]) (let ([xml-text% #f])
(lambda () (lambda ()
(unless xml-text% (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 (xml-text-mixin
plain-text%)) plain-text%))
(inherit copy-self-to) (inherit copy-self-to)
@ -375,8 +374,8 @@
(lambda () (lambda ()
(instantiate xml-snip% () (instantiate xml-snip% ()
[eliminate-whitespace-in-empty-tags? [eliminate-whitespace-in-empty-tags?
(preferences:get 'drscheme:xml-eliminate-whitespace)])))))) (preferences:get 'drracket:xml-eliminate-whitespace)]))))))
(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% () (instantiate menu:can-restore-menu-item% ()
(label (string-constant xml-tool-insert-scheme-box)) (label (string-constant xml-tool-insert-scheme-box))
(parent menu) (parent menu)
@ -385,7 +384,7 @@
(lambda (menu evt) (lambda (menu evt)
(insert-snip (insert-snip
(lambda () (instantiate scheme-snip% () (splice? #f))))))) (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% () (instantiate menu:can-restore-menu-item% ()
(label (string-constant xml-tool-insert-scheme-splice-box)) (label (string-constant xml-tool-insert-scheme-splice-box))
(parent menu) (parent menu)
@ -394,10 +393,10 @@
(lambda (menu evt) (lambda (menu evt)
(insert-snip (insert-snip
(lambda () (instantiate scheme-snip% () (splice? #t))))))) (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))) (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))