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

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

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

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

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

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

@ -1,6 +1,6 @@
(module prefs mzscheme
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "framework.ss" "framework")
"interfaces.ss")
(provide prefs@)
@ -14,8 +14,9 @@
[(newval) (preferences:set 'prop newval)]))]))
(define prefs@
(unit/sig prefs^
(unit
(import)
(export prefs^)
(preferences:set-default 'SyntaxBrowser:Width 700 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
(require (lib "class.ss")
(lib "unitsig.ss")
(lib "unit.ss")
(lib "mred.ss" "mred")
(lib "framework.ss" "framework")
"interfaces.ss"
@ -12,12 +12,13 @@
snip-keymap-extension@)
(define snip@
(unit/sig snip^
(unit
(import prefs^
keymap^
context-menu^
snipclass^)
(export snip^)
;; syntax-snip : syntax -> snip
(define (syntax-snip stx)
(new syntax-snip% (syntax stx)))
@ -201,9 +202,10 @@
))
(define snip-keymap-extension@
(unit/sig keymap^
(import (pre : keymap^))
(unit
(import (prefix pre: keymap^))
(export keymap^)
(define syntax-keymap%
(class pre:syntax-keymap%
(init-field snip)
@ -214,23 +216,6 @@
(lambda (i e)
(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))

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

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

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

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

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

@ -1,6 +1,6 @@
(module prefs mzscheme
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "framework.ss" "framework")
"interfaces.ss")
(provide prefs@)
@ -14,8 +14,9 @@
[(newval) (preferences:set 'prop newval)]))]))
(define prefs@
(unit/sig prefs^
(unit
(import)
(export prefs^)
(preferences:set-default 'MacroStepper:Frame:Width 700 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
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "mred.ss" "mred")
(lib "framework.ss" "framework")
"interfaces.ss"
@ -8,15 +8,19 @@
(provide (all-defined))
(define view-base@
(unit/sig view-base^
(unit
(import)
(export view-base^)
(define base-frame%
(frame:standard-menus-mixin (frame:basic-mixin frame%)))))
(define-values/invoke-unit/sig view^
(compound-unit/sig
(define-values/invoke-unit
(compound-unit
(import)
(link [BASE : view-base^ (view-base@)]
[STEPPER : view^ (pre-stepper@ BASE)])
(export (open STEPPER))))
(link [((BASE : view-base^)) view-base@]
[((STEPPER : view^)) pre-stepper@ BASE])
(export STEPPER))
(import)
(export view^))
)