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

Ported macro-debugger collection to new unit system

Browse Source 
svn: r5123

original commit: 201d34d3c7e319210cc6589beca20b30ba09c596
This commit is contained in:
Ryan Culpepper 2006-12-14 23:29:57 +00:00
parent 9ce9194139
commit 60ab3ffe85
9 changed files with 49 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/macro-debugger/syntax-browser/frame.ss
View File

@ -1,7 +1,7 @@
(module frame mzscheme (module frame mzscheme
(require (lib "class.ss") (require (lib "class.ss")
(lib "unitsig.ss") (lib "unit.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
(lib "list.ss") (lib "list.ss")
@ -10,10 +10,11 @@
(provide frame@) (provide frame@)
(define frame@ (define frame@
(unit/sig browser^ (unit
(import prefs^ (import prefs^
widget^) widget^)
(export browser^)
;; browse-syntax : syntax -> void ;; browse-syntax : syntax -> void
(define (browse-syntax stx) (define (browse-syntax stx)
(browse-syntaxes (list stx))) (browse-syntaxes (list stx)))

6
collects/macro-debugger/syntax-browser/interfaces.ss
View File

@ -1,7 +1,7 @@
(module interfaces mzscheme (module interfaces mzscheme
(require (lib "class.ss") (require (lib "class.ss")
(lib "unitsig.ss")) (lib "unit.ss"))
(provide (all-defined)) (provide (all-defined))
;; Signatures ;; Signatures
@ -55,10 +55,6 @@
(;; syntax-widget% (;; syntax-widget%
syntax-widget%)) syntax-widget%))
(define-signature implementation^
([unit widget : widget^]
[unit snip : snip^]))
;; Class Interfaces ;; Class Interfaces
;; syntax-controller<%> ;; syntax-controller<%>

8
collects/macro-debugger/syntax-browser/keymap.ss
View File

@ -1,7 +1,7 @@
(module keymap mzscheme (module keymap mzscheme
(require (lib "class.ss") (require (lib "class.ss")
(lib "unitsig.ss") (lib "unit.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
"interfaces.ss" "interfaces.ss"
"partition.ss") "partition.ss")
@ -9,8 +9,9 @@
context-menu@) context-menu@)
(define context-menu@ (define context-menu@
(unit/sig context-menu^ (unit
(import) (import)
(export context-menu^)
(define context-menu% (define context-menu%
(class popup-menu% (class popup-menu%
@ -103,8 +104,9 @@
)))) ))))
(define keymap@ (define keymap@
(unit/sig keymap^ (unit
(import context-menu^ snip^) (import context-menu^ snip^)
(export keymap^)
(define syntax-keymap% (define syntax-keymap%
(class keymap% (class keymap%

5
collects/macro-debugger/syntax-browser/prefs.ss
View File

@ -1,6 +1,6 @@
(module prefs mzscheme (module prefs mzscheme
(require (lib "unitsig.ss") (require (lib "unit.ss")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
"interfaces.ss") "interfaces.ss")
(provide prefs@) (provide prefs@)
@ -14,8 +14,9 @@
[(newval) (preferences:set 'prop newval)]))])) [(newval) (preferences:set 'prop newval)]))]))
(define prefs@ (define prefs@
(unit/sig prefs^ (unit
(import) (import)
(export prefs^)
(preferences:set-default 'SyntaxBrowser:Width 700 number?) (preferences:set-default 'SyntaxBrowser:Width 700 number?)
(preferences:set-default 'SyntaxBrowser:Height 600 number?) (preferences:set-default 'SyntaxBrowser:Height 600 number?)

31
collects/macro-debugger/syntax-browser/syntax-snip.ss
View File

@ -1,7 +1,7 @@
(module syntax-snip mzscheme (module syntax-snip mzscheme
(require (lib "class.ss") (require (lib "class.ss")
(lib "unitsig.ss") (lib "unit.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
"interfaces.ss" "interfaces.ss"
@ -12,12 +12,13 @@
snip-keymap-extension@) snip-keymap-extension@)
(define snip@ (define snip@
(unit/sig snip^ (unit
(import prefs^ (import prefs^
keymap^ keymap^
context-menu^ context-menu^
snipclass^) snipclass^)
(export snip^)
;; syntax-snip : syntax -> snip ;; syntax-snip : syntax -> snip
(define (syntax-snip stx) (define (syntax-snip stx)
(new syntax-snip% (syntax stx))) (new syntax-snip% (syntax stx)))
@ -201,9 +202,10 @@
)) ))
(define snip-keymap-extension@ (define snip-keymap-extension@
(unit/sig keymap^ (unit
(import (pre : keymap^)) (import (prefix pre: keymap^))
(export keymap^)
(define syntax-keymap% (define syntax-keymap%
(class pre:syntax-keymap% (class pre:syntax-keymap%
(init-field snip) (init-field snip)
@ -214,23 +216,6 @@
(lambda (i e) (lambda (i e)
(send snip show-props))))))) (send snip show-props)))))))
#;
(define snip-context-menu-extension@
(unit/sig context-menu^
(import (pre : context-menu^))
(define context-menu%
(class pre:context-menu%
(init-field snip)
(define/override (after-selection-items)
(super after-selection-items)
(new menu-item% (label "Show syntax properties")
(parent this)
(callback (lambda _ (send snip show-props))))
(void))
(super-new (controller (send snip get-controller)))))))
(define style:normal (make-object style-delta% 'change-normal)) (define style:normal (make-object style-delta% 'change-normal))

23
collects/macro-debugger/syntax-browser/widget.ss
View File

@ -1,7 +1,7 @@
(module widget mzscheme (module widget mzscheme
(require (lib "class.ss") (require (lib "class.ss")
(lib "unitsig.ss") (lib "unit.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
(lib "list.ss") (lib "list.ss")
@ -17,9 +17,10 @@
widget-context-menu-extension@) widget-context-menu-extension@)
(define widget@ (define widget@
(unit/sig widget^ (unit
(import keymap^) (import keymap^)
(export widget^)
;; syntax-widget% ;; syntax-widget%
;; A syntax-widget creates its own syntax-controller. ;; A syntax-widget creates its own syntax-controller.
(define syntax-widget% (define syntax-widget%
@ -140,9 +141,10 @@
)) ))
(define widget-keymap-extension@ (define widget-keymap-extension@
(unit/sig keymap^ (unit
(import (pre : keymap^)) (import (prefix pre: keymap^))
(export keymap^)
(define syntax-keymap% (define syntax-keymap%
(class pre:syntax-keymap% (class pre:syntax-keymap%
(init-field widget) (init-field widget)
@ -157,14 +159,15 @@
)))) ))))
(define widget-context-menu-extension@ (define widget-context-menu-extension@
(unit/sig context-menu^ (unit
(import (pre : context-menu^)) (import (prefix pre: context-menu^))
(export context-menu^)
(define context-menu% (define context-menu%
(class pre:context-menu% (class pre:context-menu%
(inherit-field keymap) (inherit-field keymap)
(inherit-field props-menu) (inherit-field props-menu)
(define/override (on-demand) (define/override (on-demand)
(send props-menu set-label (send props-menu set-label
(if (send (send keymap get-widget) props-shown?) (if (send (send keymap get-widget) props-shown?)

2
collects/macro-debugger/view/interfaces.ss
View File

@ -1,6 +1,6 @@
(module interfaces mzscheme (module interfaces mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss"))
(provide (all-defined)) (provide (all-defined))
;; Signatures ;; Signatures

5
collects/macro-debugger/view/prefs.ss
View File

@ -1,6 +1,6 @@
(module prefs mzscheme (module prefs mzscheme
(require (lib "unitsig.ss") (require (lib "unit.ss")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
"interfaces.ss") "interfaces.ss")
(provide prefs@) (provide prefs@)
@ -14,8 +14,9 @@
[(newval) (preferences:set 'prop newval)]))])) [(newval) (preferences:set 'prop newval)]))]))
(define prefs@ (define prefs@
(unit/sig prefs^ (unit
(import) (import)
(export prefs^)
(preferences:set-default 'MacroStepper:Frame:Width 700 number?) (preferences:set-default 'MacroStepper:Frame:Width 700 number?)
(preferences:set-default 'MacroStepper:Frame:Height 600 number?) (preferences:set-default 'MacroStepper:Frame:Height 600 number?)

18
collects/macro-debugger/view/view.ss
View File

@ -1,6 +1,6 @@
(module view mzscheme (module view mzscheme
(require (lib "unitsig.ss") (require (lib "unit.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
"interfaces.ss" "interfaces.ss"
@ -8,15 +8,19 @@
(provide (all-defined)) (provide (all-defined))
(define view-base@ (define view-base@
(unit/sig view-base^ (unit
(import) (import)
(export view-base^)
(define base-frame% (define base-frame%
(frame:standard-menus-mixin (frame:basic-mixin frame%))))) (frame:standard-menus-mixin (frame:basic-mixin frame%)))))
(define-values/invoke-unit/sig view^ (define-values/invoke-unit
(compound-unit/sig (compound-unit
(import) (import)
(link [BASE : view-base^ (view-base@)] (link [((BASE : view-base^)) view-base@]
[STEPPER : view^ (pre-stepper@ BASE)]) [((STEPPER : view^)) pre-stepper@ BASE])
(export (open STEPPER)))) (export STEPPER))
(import)
(export view^))
) )