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

macro stepper:

Browse Source 
add keybinding (c:c;c:m) and menu item for running macro stepper

svn: r16567
This commit is contained in:
Ryan Culpepper 2009-11-05 23:18:00 +00:00
parent c880b2119c
commit 0a8fb1a47f
1 changed files with 55 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/macro-debugger/tool.ss
View File

@ -23,6 +23,14 @@
(interface () (interface ()
enable-macro-stepper?)) enable-macro-stepper?))
(define-local-member-name allow-macro-stepper?)
(define-local-member-name run-macro-stepper)
(define frame/supports-macro-stepper<%>
(interface ()
allow-macro-stepper?
run-macro-stepper))
(define (drscheme-macro-stepper-frame-mixin %) (define (drscheme-macro-stepper-frame-mixin %)
(class % (class %
(define/override (get-macro-stepper-widget%) (define/override (get-macro-stepper-widget%)
@ -72,7 +80,8 @@
(define tool@ (define tool@
(unit (import drscheme:tool^) (unit
(import drscheme:tool^)
(export drscheme:tool-exports^) (export drscheme:tool-exports^)
(define (phase1) (define (phase1)
@ -101,9 +110,10 @@
'png/mask)) 'png/mask))
(define (macro-debugger-unit-frame-mixin %) (define (macro-debugger-unit-frame-mixin %)
(class % (class* % (frame/supports-macro-stepper<%>)
(super-new) (super-new)
(inherit get-button-panel (inherit get-button-panel
get-language-menu
get-interactions-text get-interactions-text
get-definitions-text) get-definitions-text)
@ -118,7 +128,7 @@
(bitmap macro-debugger-bitmap) (bitmap macro-debugger-bitmap)
(alternate-bitmap macro-debugger-up-bitmap) (alternate-bitmap macro-debugger-up-bitmap)
(parent macro-debug-panel) (parent macro-debug-panel)
(callback (λ (button) (execute #t))))) (callback (lambda (button) (run-macro-stepper)))))
(inherit register-toolbar-button) (inherit register-toolbar-button)
(register-toolbar-button macro-debug-button) (register-toolbar-button macro-debug-button)
@ -129,6 +139,17 @@
(send macro-debug-button enable #f) (send macro-debug-button enable #f)
(inner (void) disable-evaluation)) (inner (void) disable-evaluation))
(define macro-debug-menu-item
(let ([lang-menu (get-language-menu)])
(new separator-menu-item% (parent lang-menu))
(new menu-item%
(label "Macro Stepper")
(parent lang-menu)
(callback (lambda _ (run-macro-stepper))))))
(define/public-final (run-macro-stepper)
(execute #t))
(define/override (execute-callback) (define/override (execute-callback)
(execute #f)) (execute #f))
@ -143,13 +164,21 @@
(inner (void) on-tab-change old new)) (inner (void) on-tab-change old new))
(define/public (check-language) (define/public (check-language)
(enable/disable-stuff (allow-macro-stepper?)))
(define/public (allow-macro-stepper?)
(let ([lang (let ([lang
(drscheme:language-configuration:language-settings-language (drscheme:language-configuration:language-settings-language
(send (get-definitions-text) get-next-settings))]) (send (get-definitions-text) get-next-settings))])
(if (send lang enable-macro-stepper?) (send lang enable-macro-stepper?)))
(define/private (enable/disable-stuff enable?)
(if enable?
(begin (send macro-debug-menu-item enable #t)
(unless (send macro-debug-button is-shown?) (unless (send macro-debug-button is-shown?)
(send macro-debug-panel (send macro-debug-panel
add-child macro-debug-button)) add-child macro-debug-button)))
(begin (send macro-debug-menu-item enable #f)
(when (send macro-debug-button is-shown?) (when (send macro-debug-button is-shown?)
(send macro-debug-panel (send macro-debug-panel
delete-child macro-debug-button))))) delete-child macro-debug-button)))))
@ -297,4 +326,18 @@
(drscheme:get/extend:extend-definitions-text (drscheme:get/extend:extend-definitions-text
macro-debugger-definitions-text-mixin) macro-debugger-definitions-text-mixin)
(define (add-macro-stepper-key-bindings keymap)
(send keymap add-function
"macro stepper"
(lambda (obj evt)
(when (is-a? obj editor<%>)
(let ([canvas (send obj get-canvas)])
(when canvas
(let ([frame (send canvas get-top-level-window)])
(when (is-a? frame frame/supports-macro-stepper<%>)
(when (send frame allow-macro-stepper?)
(send frame run-macro-stepper)))))))))
(send keymap map-function "c:c;c:m" "macro stepper"))
(add-macro-stepper-key-bindings (drscheme:rep:get-drs-bindings-keymap))
)) ))