housekeeping, changed to drracket-tool, moved files to private
This commit is contained in:
John Clements
parent
437baf905a
commit
e4a834e9b0
|
|
@ -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))))
|
||||
|
|
@ -1,16 +1,10 @@
|
|||
#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"))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,21 +6,21 @@
|
|||
(require racket/class
|
||||
racket/match
|
||||
racket/list
|
||||
drscheme/tool
|
||||
drracket/tool
|
||||
mred
|
||||
string-constants
|
||||
racket/async-channel
|
||||
(prefix-in model: "private/model.ss")
|
||||
(prefix-in x: "private/mred-extensions.ss")
|
||||
"private/shared.ss"
|
||||
"private/model-settings.ss"
|
||||
(prefix-in model: "model.ss")
|
||||
(prefix-in x: "mred-extensions.ss")
|
||||
"shared.ss"
|
||||
"model-settings.ss"
|
||||
"xml-sig.ss")
|
||||
|
||||
|
||||
(import drscheme:tool^ xml^ stepper-frame^)
|
||||
(import drracket:tool^ xml^ stepper-frame^)
|
||||
(export view-controller^)
|
||||
|
||||
(define drscheme-eventspace (current-eventspace))
|
||||
(define drracket-eventspace (current-eventspace))
|
||||
|
||||
(define (definitions-text->settings definitions-text)
|
||||
(send definitions-text get-next-settings))
|
||||
|
|
@ -28,12 +28,12 @@
|
|||
;; the stored representation of a step
|
||||
(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:
|
||||
(define language-settings (definitions-text->settings (send drscheme-frame get-definitions-text)))
|
||||
(define language-level (drscheme:language-configuration:language-settings-language language-settings))
|
||||
(define simple-settings (drscheme:language-configuration:language-settings-settings language-settings))
|
||||
(define language-settings (definitions-text->settings (send drracket-frame get-definitions-text)))
|
||||
(define language-level (drracket:language-configuration:language-settings-language language-settings))
|
||||
(define simple-settings (drracket:language-configuration:language-settings-settings language-settings))
|
||||
|
||||
;; VALUE CONVERSION CODE:
|
||||
|
||||
|
|
@ -211,7 +211,7 @@
|
|||
|
||||
;; GUI ELEMENTS:
|
||||
(define s-frame
|
||||
(make-object stepper-frame% drscheme-frame))
|
||||
(make-object stepper-frame% drracket-frame))
|
||||
(define button-panel
|
||||
(make-object horizontal-panel% (send s-frame get-area-container)))
|
||||
(define (add-button name fun)
|
||||
|
|
@ -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@])))
|
||||
|
|
@ -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-frame)
|
||||
|
||||
;; 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-frame on-stepper-close)
|
||||
(inner (void) on-close))
|
||||
|
||||
;; WARNING BOXES:
|
||||
|
|
@ -153,14 +152,14 @@
|
|||
[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<%>
|
||||
(interface ()
|
||||
get-stepper-frame
|
||||
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
|
||||
(define (stepper-unit-frame-mixin super%)
|
||||
(class* super% (stepper-unit-frame<%>)
|
||||
|
|
@ -179,10 +178,10 @@
|
|||
(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
|
||||
[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-definitions-text)
|
||||
0
|
||||
(send (get-definitions-text) last-position))
|
||||
|
|
@ -213,7 +212,7 @@
|
|||
[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)
|
||||
|
|
@ -221,7 +220,7 @@
|
|||
(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<%>))
|
||||
(is-a? language-level drracket:module-language:module-language<%>))
|
||||
(set! stepper-frame
|
||||
(go this
|
||||
program-expander
|
||||
|
|
@ -271,8 +270,9 @@
|
|||
|
||||
;; 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 _))))
|
||||
(lambda (x)
|
||||
(cons stepper-button-parent-panel
|
||||
(remq stepper-button-parent-panel x))))
|
||||
|
||||
;; hide stepper button if it's not supported for the initial language:
|
||||
(check-current-language-for-stepper)))
|
||||
|
|
@ -321,28 +321,28 @@
|
|||
|
||||
(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)
|
||||
|
||||
;; 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 +381,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"
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user