Merged a few more changes from the trunk (which I think will affect planet package compatibility).
svn: r17957
This commit is contained in:
Carl Eastlund
commit
73407bed63
|
|
@ -6,7 +6,6 @@
|
|||
scheme/string
|
||||
scheme/list
|
||||
"drsig.ss"
|
||||
macro-debugger/capability
|
||||
string-constants
|
||||
mred
|
||||
framework
|
||||
|
|
@ -1338,7 +1337,7 @@
|
|||
(super-new)
|
||||
(define/augment (capability-value key)
|
||||
(cond
|
||||
[(eq? key macro-stepper-capability-key) #t]
|
||||
[(eq? key 'macro-stepper:enabled) #t]
|
||||
[else (inner (drscheme:language:get-capability-default key)
|
||||
capability-value key)]))))
|
||||
|
||||
|
|
|
|||
|
|
@ -239,15 +239,30 @@
|
|||
(string-constant case-sensitive-label)
|
||||
input-panel
|
||||
void))]
|
||||
[debugging (new radio-box%
|
||||
(label #f)
|
||||
(choices
|
||||
(list (string-constant no-debugging-or-profiling)
|
||||
(string-constant debugging)
|
||||
(string-constant debugging-and-profiling)
|
||||
(string-constant test-coverage)))
|
||||
(parent dynamic-panel)
|
||||
(callback debugging-radio-box-callback))]
|
||||
[debugging-panel (new horizontal-panel%
|
||||
[parent dynamic-panel]
|
||||
[stretchable-height #f]
|
||||
[alignment '(left center)])]
|
||||
[debugging-left (new radio-box%
|
||||
(label #f)
|
||||
(choices
|
||||
(list (string-constant no-debugging-or-profiling)
|
||||
(string-constant debugging)))
|
||||
(parent debugging-panel)
|
||||
(callback
|
||||
(λ (a b)
|
||||
(send debugging-right set-selection #f)
|
||||
(debugging-radio-box-callback a b))))]
|
||||
[debugging-right (new radio-box%
|
||||
(label #f)
|
||||
(choices
|
||||
(list (string-constant debugging-and-profiling)
|
||||
(string-constant test-coverage)))
|
||||
(parent debugging-panel)
|
||||
(callback
|
||||
(λ (a b)
|
||||
(send debugging-left set-selection #f)
|
||||
(debugging-radio-box-callback a b))))]
|
||||
[output-style (make-object radio-box%
|
||||
(string-constant output-style-label)
|
||||
(list (string-constant constructor-printing-style)
|
||||
|
|
@ -272,7 +287,7 @@
|
|||
(string-constant use-pretty-printer-label)
|
||||
output-panel
|
||||
void)])
|
||||
(get-debugging-radio-box debugging)
|
||||
(get-debugging-radio-box debugging-left debugging-right)
|
||||
(dynamic-panel-extras dynamic-panel)
|
||||
|
||||
(case-lambda
|
||||
|
|
@ -290,11 +305,13 @@
|
|||
'mixed-fraction-e)
|
||||
(send show-sharing get-value)
|
||||
(send insert-newlines get-value)
|
||||
(case (send debugging get-selection)
|
||||
(case (send debugging-left get-selection)
|
||||
[(0) 'none]
|
||||
[(1) 'debug]
|
||||
[(2) 'debug/profile]
|
||||
[(3) 'test-coverage]))]
|
||||
[(#f)
|
||||
(case (send debugging-right get-selection)
|
||||
[(0) 'debug/profile]
|
||||
[(1) 'test-coverage])]))]
|
||||
[(settings)
|
||||
(when case-sensitive
|
||||
(send case-sensitive set-value
|
||||
|
|
@ -308,12 +325,11 @@
|
|||
'repeating-decimal-e))
|
||||
(send show-sharing set-value (simple-settings-show-sharing settings))
|
||||
(send insert-newlines set-value (simple-settings-insert-newlines settings))
|
||||
(send debugging set-selection
|
||||
(case (simple-settings-annotations settings)
|
||||
[(none) 0]
|
||||
[(debug) 1]
|
||||
[(debug/profile) 2]
|
||||
[(test-coverage) 3]))])))
|
||||
(case (simple-settings-annotations settings)
|
||||
[(none) (send debugging-right set-selection #f) (send debugging-left set-selection 0)]
|
||||
[(debug) (send debugging-right set-selection #f) (send debugging-left set-selection 1)]
|
||||
[(debug/profile) (send debugging-left set-selection #f) (send debugging-right set-selection 0)]
|
||||
[(test-coverage) (send debugging-left set-selection #f) (send debugging-right set-selection 1)])])))
|
||||
|
||||
;; simple-module-based-language-render-value/format : TST settings port (union #f (snip% -> void)) (union 'infinity number) -> void
|
||||
(define (simple-module-based-language-render-value/format value settings port width)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@
|
|||
framework
|
||||
string-constants
|
||||
planet/config
|
||||
macro-debugger/capability
|
||||
"drsig.ss"
|
||||
"rep.ss")
|
||||
|
||||
|
|
@ -86,7 +85,7 @@
|
|||
(cond
|
||||
[(eq? key 'drscheme:autocomplete-words)
|
||||
(drscheme:language-configuration:get-all-manual-keywords)]
|
||||
[(eq? key macro-stepper-capability-key) #t]
|
||||
[(eq? key 'macro-stepper:enabled) #t]
|
||||
[else (drscheme:language:get-capability-default key)]))
|
||||
|
||||
;; config-panel : as in super class
|
||||
|
|
@ -408,17 +407,18 @@
|
|||
(define compilation-on-check-box #f)
|
||||
(define compilation-on? #t)
|
||||
(define save-stacktrace-on-check-box #f)
|
||||
(define debugging-radio-box #f)
|
||||
(define left-debugging-radio-box #f)
|
||||
(define right-debugging-radio-box #f)
|
||||
(define simple-case-lambda
|
||||
(drscheme:language:simple-module-based-language-config-panel
|
||||
new-parent
|
||||
#:case-sensitive #t
|
||||
|
||||
#:get-debugging-radio-box (λ (rb) (set! debugging-radio-box rb))
|
||||
#:get-debugging-radio-box (λ (rb-l rb-r) (set! left-debugging-radio-box rb-l) (set! right-debugging-radio-box rb-r))
|
||||
|
||||
#:debugging-radio-box-callback
|
||||
(λ (debugging-radio-box evt)
|
||||
(update-compilation-checkbox debugging-radio-box))
|
||||
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box))
|
||||
|
||||
#:dynamic-panel-extras
|
||||
(λ (dynamic-panel)
|
||||
|
|
@ -431,14 +431,14 @@
|
|||
(set! save-stacktrace-on-check-box (new check-box%
|
||||
[label (string-constant preserve-stacktrace-information)]
|
||||
[parent dynamic-panel])))))
|
||||
(define (update-compilation-checkbox debugging-radio-box)
|
||||
(case (send debugging-radio-box get-selection)
|
||||
[(2 3)
|
||||
(send compilation-on-check-box enable #f)
|
||||
(send compilation-on-check-box set-value #f)]
|
||||
(define (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)
|
||||
(case (send left-debugging-radio-box get-selection)
|
||||
[(0 1)
|
||||
(send compilation-on-check-box enable #t)
|
||||
(send compilation-on-check-box set-value compilation-on?)]))
|
||||
(send compilation-on-check-box set-value compilation-on?)]
|
||||
[(#f)
|
||||
(send compilation-on-check-box enable #f)
|
||||
(send compilation-on-check-box set-value #f)]))
|
||||
|
||||
(define cp-panel (new group-box-panel%
|
||||
[parent new-parent]
|
||||
|
|
@ -586,7 +586,7 @@
|
|||
(install-collection-paths '(default))
|
||||
(update-buttons)
|
||||
(install-auto-text default-auto-text)
|
||||
(update-compilation-checkbox debugging-radio-box)
|
||||
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)
|
||||
|
||||
(case-lambda
|
||||
[()
|
||||
|
|
@ -597,9 +597,9 @@
|
|||
(list (get-collection-paths)
|
||||
(get-command-line-args)
|
||||
(get-auto-text)
|
||||
(case (send debugging-radio-box get-selection)
|
||||
[(2 3) #f]
|
||||
[(0 1) compilation-on?])
|
||||
(case (send left-debugging-radio-box get-selection)
|
||||
[(0 1) compilation-on?]
|
||||
[(#f) #f])
|
||||
(send save-stacktrace-on-check-box get-value)))))]
|
||||
[(settings)
|
||||
(simple-case-lambda settings)
|
||||
|
|
@ -608,7 +608,7 @@
|
|||
(install-auto-text (module-language-settings-auto-text settings))
|
||||
(set! compilation-on? (module-language-settings-compilation-on? settings))
|
||||
(send compilation-on-check-box set-value (module-language-settings-compilation-on? settings))
|
||||
(update-compilation-checkbox debugging-radio-box)
|
||||
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)
|
||||
(send save-stacktrace-on-check-box set-value (module-language-settings-full-trace? settings))
|
||||
(update-buttons)]))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +0,0 @@
|
|||
#lang scheme/base
|
||||
|
||||
(provide macro-stepper-capability-key)
|
||||
|
||||
(define macro-stepper-capability-key
|
||||
(string->uninterned-symbol "Enable Macro Stepper"))
|
||||
|
||||
|
|
@ -8,7 +8,6 @@
|
|||
drscheme/tool
|
||||
mrlib/switchable-button
|
||||
string-constants
|
||||
"capability.ss"
|
||||
"model/trace.ss"
|
||||
"model/deriv.ss"
|
||||
"model/deriv-util.ss"
|
||||
|
|
@ -17,6 +16,8 @@
|
|||
"view/stepper.ss"
|
||||
"view/prefs.ss")
|
||||
|
||||
;; Capability name: 'macro-stepper:enabled
|
||||
|
||||
(provide tool@)
|
||||
|
||||
(define-local-member-name allow-macro-stepper?)
|
||||
|
|
@ -82,7 +83,7 @@
|
|||
|
||||
(define (phase1)
|
||||
(drscheme:language:register-capability
|
||||
macro-stepper-capability-key
|
||||
'macro-stepper:enabled
|
||||
boolean?
|
||||
#f))
|
||||
(define (phase2) (void))
|
||||
|
|
@ -163,7 +164,7 @@
|
|||
(let ([lang
|
||||
(drscheme:language-configuration:language-settings-language
|
||||
(send (get-definitions-text) get-next-settings))])
|
||||
(send lang capability-value macro-stepper-capability-key)))
|
||||
(send lang capability-value 'macro-stepper:enabled)))
|
||||
|
||||
(define/private (enable/disable-stuff enable?)
|
||||
(if enable?
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@
|
|||
mzlib/list
|
||||
mred
|
||||
net/sendurl
|
||||
macro-debugger/capability
|
||||
string-constants)
|
||||
(provide tool@)
|
||||
|
||||
|
|
@ -37,7 +36,7 @@
|
|||
(super-instantiate ()))))
|
||||
(define/augment (capability-value key)
|
||||
(cond
|
||||
[(eq? key macro-stepper-capability-key) #t]
|
||||
[(eq? key 'macro-stepper:enabled) #t]
|
||||
[else (inner (drscheme:language:get-capability-default key)
|
||||
capability-value key)]))
|
||||
(define/override (use-namespace-require/copy?) #t)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user