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<%>
(interface ()
get-tab
change-mode-to-match))
get-next-settings
after-set-next-settings))
(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))])
(let loop ([modes (drscheme:modes:get-modes)])
(cond
[(null? modes) (error 'change-mode-to-match-filename
[(null? modes) (error 'change-mode-to-match
"didn't find a matching mode")]
[else (let ([mode (car modes)])
(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 (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)
(or needs-execution-state

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

@ -15,7 +15,7 @@
"annotator.ss"
"load-sandbox.ss"
;(lib "framework.ss" "framework")
#;(lib "string-constant.ss" "string-constants")
(lib "string-constant.ss" "string-constants")
)
(provide tool@)
@ -23,13 +23,24 @@
; QUESTIONS/IDEAS
; what is the right way to deal with macros?
; how can the three tool classes communicate with each other safely
(define tool@
(unit/sig drscheme:tool-exports^
(import drscheme:tool^)
(define phase1 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)
(hash-table-get bp p))
@ -404,7 +415,11 @@
[else (send dc set-pen pc-pen)
(send dc set-brush pc-brush)]))
(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%)
(class super%
@ -728,7 +743,7 @@
((bitmap-label-maker
"Debug"
(build-path (collection-path "mztake" "icons") "icon-small.png")) this)
(get-button-panel)
(make-object vertical-pane% (get-button-panel))
(lambda (button evt)
(my-execute #t))))
@ -778,11 +793,26 @@
[label ""]
[parent debug-panel]
[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
(lambda (_)
(cons debug-button
(remq debug-button _))))))
(cons (send debug-button get-parent)
(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-interactions-text debug-interactions-text-mixin)
(drscheme:get/extend:extend-unit-frame debug-unit-frame-mixin))))

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

@ -31,7 +31,7 @@
(string-constant intermediate-student)
(string-constant intermediate-student/lambda)
(string-constant advanced-student)))
(provide stepper-tool@)
(define stepper-tool@
@ -48,6 +48,14 @@
(define stepper-initial-height 500)
(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:
@ -477,17 +485,15 @@
(define stepper-button
(make-object button%
(x:stepper-bitmap this)
(get-button-panel)
(make-object vertical-pane% (get-button-panel))
(lambda (button evt)
(if stepper-frame
(send stepper-frame show #t)
(let* ([settings (send (get-definitions-text) get-next-settings)]
[language (drscheme:language-configuration:language-settings-language settings)]
[language-level (car (last-pair (send language get-language-position)))])
(if (or (member language-level stepper-works-for)
(getenv "PLTSTEPPERUNSAFE"))
(set! stepper-frame (view-controller-go this program-expander))
(message-box (string-constant stepper-name)
(let ([language-level (extract-language-level
(send (get-definitions-text) get-next-settings))])
(if (stepper-works-for? language-level)
(set! stepper-frame (view-controller-go this program-expander))
(message-box (string-constant stepper-name)
(format (string-constant stepper-language-level-message)
language-level
(car stepper-works-for)
@ -506,10 +512,26 @@
(when stepper-frame
(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
(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:
(send (get-button-panel) change-children
(lx (cons stepper-button (remq stepper-button _))))))
(let ([p (send stepper-button get-parent)])
(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
;; text is altered or destroyed
@ -531,6 +553,10 @@
(define/augment (on-delete x y)
(notify-stepper-frame-of-change)
(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 ())))