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

show Step/Debug buttons for suitable languages, only

Browse Source 
svn: r1383
This commit is contained in:
Matthew Flatt 2005-11-23 17:22:40 +00:00
parent 0f9d11bb47
commit 5d8b64df09
3 changed files with 81 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/drscheme/private/unit.ss
View File

@ -86,7 +86,8 @@ module browser threading seems wrong.
(define definitions-text<%> (define definitions-text<%>
(interface () (interface ()
get-tab get-tab
change-mode-to-match)) get-next-settings
after-set-next-settings))
(keymap:add-to-right-button-menu (keymap:add-to-right-button-menu
(let ([old (keymap:add-to-right-button-menu)]) (let ([old (keymap:add-to-right-button-menu)])
@ -420,7 +421,7 @@ module browser threading seems wrong.
get-language-position))]) get-language-position))])
(let loop ([modes (drscheme:modes:get-modes)]) (let loop ([modes (drscheme:modes:get-modes)])
(cond (cond
[(null? modes) (error 'change-mode-to-match-filename [(null? modes) (error 'change-mode-to-match
"didn't find a matching mode")] "didn't find a matching mode")]
[else (let ([mode (car modes)]) [else (let ([mode (car modes)])
(if ((drscheme:modes:mode-matches-language mode) language-name) (if ((drscheme:modes:mode-matches-language mode) language-name)
@ -467,7 +468,11 @@ module browser threading seems wrong.
(define/pubment (get-next-settings) next-settings) (define/pubment (get-next-settings) next-settings)
(define/pubment (set-next-settings _next-settings) (define/pubment (set-next-settings _next-settings)
(set! next-settings _next-settings) (set! next-settings _next-settings)
(change-mode-to-match)) (change-mode-to-match)
(after-set-next-settings _next-settings))
(define/pubment (after-set-next-settings s)
(inner (void) after-set-next-settings s))
(define/public (needs-execution) (define/public (needs-execution)
(or needs-execution-state (or needs-execution-state

40
collects/mztake/debug-tool.ss
View File

@ -15,7 +15,7 @@
"annotator.ss" "annotator.ss"
"load-sandbox.ss" "load-sandbox.ss"
;(lib "framework.ss" "framework") ;(lib "framework.ss" "framework")
#;(lib "string-constant.ss" "string-constants") (lib "string-constant.ss" "string-constants")
) )
(provide tool@) (provide tool@)
@ -31,6 +31,17 @@
(define phase1 void) (define phase1 void)
(define phase2 void) (define phase2 void)
(define (extract-language-level settings)
(let* ([language (drscheme:language-configuration:language-settings-language settings)])
(car (last-pair (send language get-language-position)))))
(define (debugger-does-not-work-for? lang)
(member lang (list (string-constant beginning-student)
(string-constant beginning-student/abbrev)
(string-constant intermediate-student)
(string-constant intermediate-student/lambda)
(string-constant advanced-student))))
(define (break-at bp p) (define (break-at bp p)
(hash-table-get bp p)) (hash-table-get bp p))
@ -404,7 +415,11 @@
[else (send dc set-pen pc-pen) [else (send dc set-pen pc-pen)
(send dc set-brush pc-brush)])) (send dc set-brush pc-brush)]))
(drscheme:arrow:draw-arrow dc xm0 ym0 xr ym dx dy) (drscheme:arrow:draw-arrow dc xm0 ym0 xr ym dx dy)
(loop start-pos (rest marks))))))))))) (loop start-pos (rest marks)))))))))
(define/augment (after-set-next-settings s)
(send (get-top-level-window) check-current-language-for-debugger)
(inner (void) after-set-next-settings s))))
(define (debug-interactions-text-mixin super%) (define (debug-interactions-text-mixin super%)
(class super% (class super%
@ -728,7 +743,7 @@
((bitmap-label-maker ((bitmap-label-maker
"Debug" "Debug"
(build-path (collection-path "mztake" "icons") "icon-small.png")) this) (build-path (collection-path "mztake" "icons") "icon-small.png")) this)
(get-button-panel) (make-object vertical-pane% (get-button-panel))
(lambda (button evt) (lambda (button evt)
(my-execute #t)))) (my-execute #t))))
@ -779,10 +794,25 @@
[parent debug-panel] [parent debug-panel]
[stretchable-width #t])) [stretchable-width #t]))
(define/augment (on-tab-change old new)
(check-current-language-for-debugger)
(inner (void) on-tab-change old new))
(define/public (check-current-language-for-debugger)
(if (debugger-does-not-work-for? (extract-language-level
(send (get-definitions-text) get-next-settings)))
(when (send debug-button is-shown?)
(send (send debug-button get-parent) delete-child debug-button))
(unless (send debug-button is-shown?)
(send (send debug-button get-parent) add-child debug-button))))
(send (get-button-panel) change-children (send (get-button-panel) change-children
(lambda (_) (lambda (_)
(cons debug-button (cons (send debug-button get-parent)
(remq debug-button _)))))) (remq (send debug-button get-parent) _))))
; hide debug button if it's not supported for the initial language:
(check-current-language-for-debugger)))
(drscheme:get/extend:extend-definitions-text debug-definitions-text-mixin) (drscheme:get/extend:extend-definitions-text debug-definitions-text-mixin)
(drscheme:get/extend:extend-interactions-text debug-interactions-text-mixin) (drscheme:get/extend:extend-interactions-text debug-interactions-text-mixin)
(drscheme:get/extend:extend-unit-frame debug-unit-frame-mixin)))) (drscheme:get/extend:extend-unit-frame debug-unit-frame-mixin))))

46
collects/stepper/stepper-tool.ss
View File

@ -49,6 +49,14 @@
(define drscheme-eventspace (current-eventspace)) (define drscheme-eventspace (current-eventspace))
(define (extract-language-level settings)
(let* ([language (drscheme:language-configuration:language-settings-language settings)])
(car (last-pair (send language get-language-position)))))
(define (stepper-works-for? language-level)
(or (member language-level stepper-works-for)
(getenv "PLTSTEPPERUNSAFE")))
;; the stepper's frame: ;; the stepper's frame:
(define stepper-frame% (define stepper-frame%
@ -477,17 +485,15 @@
(define stepper-button (define stepper-button
(make-object button% (make-object button%
(x:stepper-bitmap this) (x:stepper-bitmap this)
(get-button-panel) (make-object vertical-pane% (get-button-panel))
(lambda (button evt) (lambda (button evt)
(if stepper-frame (if stepper-frame
(send stepper-frame show #t) (send stepper-frame show #t)
(let* ([settings (send (get-definitions-text) get-next-settings)] (let ([language-level (extract-language-level
[language (drscheme:language-configuration:language-settings-language settings)] (send (get-definitions-text) get-next-settings))])
[language-level (car (last-pair (send language get-language-position)))]) (if (stepper-works-for? language-level)
(if (or (member language-level stepper-works-for) (set! stepper-frame (view-controller-go this program-expander))
(getenv "PLTSTEPPERUNSAFE")) (message-box (string-constant stepper-name)
(set! stepper-frame (view-controller-go this program-expander))
(message-box (string-constant stepper-name)
(format (string-constant stepper-language-level-message) (format (string-constant stepper-language-level-message)
language-level language-level
(car stepper-works-for) (car stepper-works-for)
@ -507,9 +513,25 @@
(send stepper-frame original-program-gone)) (send stepper-frame original-program-gone))
(inner (void) on-close)) (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
(send (get-definitions-text) get-next-settings)))
(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: ; add the stepper button to the button panel:
(send (get-button-panel) change-children (let ([p (send stepper-button get-parent)])
(lx (cons stepper-button (remq stepper-button _)))))) (send (get-button-panel) change-children
(lx (cons p (remq p _)))))
; 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 ;; stepper-definitions-text-mixin : a mixin for the definitions text that alerts thet stepper when the definitions
;; text is altered or destroyed ;; text is altered or destroyed
@ -532,6 +554,10 @@
(notify-stepper-frame-of-change) (notify-stepper-frame-of-change)
(inner (void) on-delete x y)) (inner (void) on-delete x y))
(define/augment (after-set-next-settings s)
(send (get-top-level-window) check-current-language-for-stepper)
(inner (void) after-set-next-settings s))
(super-instantiate ()))) (super-instantiate ())))
;; COPIED FROM drscheme/private/language.ss ;; COPIED FROM drscheme/private/language.ss