Fixed eol properties
Reorganized macro stepper gui Added macro stepper actions to popup menu svn: r4505 original commit: 39145f9c71807baf1e97d66db63f135fbf7e2999
This commit is contained in:
Ryan Culpepper
parent
9599b2253b
commit
df01af09b9
|
|
@ -1,11 +1,15 @@
|
|||
|
||||
(module embed mzscheme
|
||||
(require "interfaces.ss"
|
||||
"widget.ss"
|
||||
"keymap.ss"
|
||||
"implementation.ss"
|
||||
"params.ss"
|
||||
"partition.ss")
|
||||
|
||||
(provide (all-from "interfaces.ss")
|
||||
(all-from "widget.ss")
|
||||
(all-from "keymap.ss")
|
||||
(all-from "implementation.ss")
|
||||
(all-from "params.ss")
|
||||
identifier=-choices))
|
||||
|
|
|
|||
|
|
@ -4,7 +4,9 @@
|
|||
(lib "unitsig.ss")
|
||||
(lib "mred.ss" "mred")
|
||||
(lib "framework.ss" "framework")
|
||||
"interfaces.ss")
|
||||
(lib "list.ss")
|
||||
"interfaces.ss"
|
||||
"partition.ss")
|
||||
(provide frame@)
|
||||
|
||||
(define frame@
|
||||
|
|
@ -47,5 +49,49 @@
|
|||
(send widget save-prefs)
|
||||
(preferences:save)
|
||||
(inner (void) on-close))
|
||||
))))
|
||||
))
|
||||
|
||||
;; syntax-widget/controls%
|
||||
(define syntax-widget/controls%
|
||||
(class* syntax-widget% ()
|
||||
(inherit get-main-panel
|
||||
get-controller
|
||||
toggle-props)
|
||||
(super-new)
|
||||
|
||||
(define -control-panel
|
||||
(new horizontal-pane% (parent (get-main-panel)) (stretchable-height #f)))
|
||||
|
||||
;; Put the control panel up front
|
||||
(send (get-main-panel) change-children
|
||||
(lambda (children)
|
||||
(cons -control-panel (remq -control-panel children))))
|
||||
|
||||
(define -identifier=-choices (identifier=-choices))
|
||||
(define -choice
|
||||
(new choice% (label "identifer=?") (parent -control-panel)
|
||||
(choices (map car -identifier=-choices))
|
||||
(callback (lambda _ (on-update-identifier=?-choice)))))
|
||||
(new button%
|
||||
(label "Clear")
|
||||
(parent -control-panel)
|
||||
(callback (lambda _ (send (get-controller) select-syntax #f))))
|
||||
(new button%
|
||||
(label "Properties")
|
||||
(parent -control-panel)
|
||||
(callback (lambda _ (toggle-props))))
|
||||
|
||||
(define/private (on-update-identifier=?-choice)
|
||||
(cond [(assoc (send -choice get-string-selection)
|
||||
-identifier=-choices)
|
||||
=> (lambda (p)
|
||||
(send (get-controller)
|
||||
on-update-identifier=? (car p) (cdr p)))]
|
||||
[else #f]))
|
||||
(send (get-controller) add-identifier=?-listener
|
||||
(lambda (name func)
|
||||
(send -choice set-selection
|
||||
(or (send -choice find-string name) 0))))))
|
||||
|
||||
))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -16,6 +16,9 @@
|
|||
;; make-syntax-browser : -> syntax-browser<%>
|
||||
make-syntax-browser
|
||||
|
||||
;; syntax-widget/controls%
|
||||
syntax-widget/controls%
|
||||
|
||||
;; syntax-browser-frame%
|
||||
syntax-browser-frame%))
|
||||
|
||||
|
|
@ -50,10 +53,7 @@
|
|||
|
||||
(define-signature widget^
|
||||
(;; syntax-widget%
|
||||
syntax-widget%
|
||||
|
||||
;; syntax-widget/controls%
|
||||
syntax-widget/controls%))
|
||||
syntax-widget%))
|
||||
|
||||
(define-signature implementation^
|
||||
([unit widget : widget^]
|
||||
|
|
@ -97,8 +97,8 @@
|
|||
;; show : boolean -> void
|
||||
#;show
|
||||
|
||||
;; is-shown? : -> boolean
|
||||
#;is-shown?))
|
||||
;; props-shown? : -> boolean
|
||||
props-shown?))
|
||||
|
||||
;; syntax-configuration<%>
|
||||
(define syntax-configuration<%>
|
||||
|
|
|
|||
|
|
@ -49,35 +49,42 @@
|
|||
(init-field controller)
|
||||
(super-new)
|
||||
|
||||
(define copy-menu #f)
|
||||
(define copy-syntax-menu #f)
|
||||
(define clear-menu #f)
|
||||
|
||||
(define/public (add-edit-items)
|
||||
(new menu-item% (label "Copy") (parent this)
|
||||
(callback (lambda (i e)
|
||||
(define stx (send controller get-selected-syntax))
|
||||
(send the-clipboard set-clipboard-string
|
||||
(if stx
|
||||
(format "~s" (syntax-object->datum stx))
|
||||
"")
|
||||
(send e get-time-stamp)))))
|
||||
(new menu-item% (label "Copy syntax") (parent this)
|
||||
(callback (lambda (i e)
|
||||
(define stx (send controller get-selected-syntax))
|
||||
(define t (new text%))
|
||||
(send t insert
|
||||
(new syntax-snip%
|
||||
(syntax stx)
|
||||
#;(controller controller)))
|
||||
(send t select-all)
|
||||
(send t copy))))
|
||||
(set! copy-menu
|
||||
(new menu-item% (label "Copy") (parent this)
|
||||
(callback (lambda (i e)
|
||||
(define stx (send controller get-selected-syntax))
|
||||
(send the-clipboard set-clipboard-string
|
||||
(if stx
|
||||
(format "~s" (syntax-object->datum stx))
|
||||
"")
|
||||
(send e get-time-stamp))))))
|
||||
(set! copy-syntax-menu
|
||||
(new menu-item% (label "Copy syntax") (parent this)
|
||||
(callback (lambda (i e)
|
||||
(define stx (send controller get-selected-syntax))
|
||||
(define t (new text%))
|
||||
(send t insert
|
||||
(new syntax-snip%
|
||||
(syntax stx)
|
||||
#;(controller controller)))
|
||||
(send t select-all)
|
||||
(send t copy)))))
|
||||
(void))
|
||||
|
||||
(define/public (after-edit-items)
|
||||
(void))
|
||||
|
||||
(define/public (add-selection-items)
|
||||
(new menu-item%
|
||||
(label "Clear selection")
|
||||
(parent this)
|
||||
(callback (lambda _ (send controller select-syntax #f))))
|
||||
(set! clear-menu
|
||||
(new menu-item%
|
||||
(label "Clear selection")
|
||||
(parent this)
|
||||
(callback (lambda _ (send controller select-syntax #f)))))
|
||||
(void))
|
||||
|
||||
(define/public (after-selection-items)
|
||||
|
|
@ -106,7 +113,14 @@
|
|||
|
||||
(define/public (add-separator)
|
||||
(new separator-menu-item% (parent this)))
|
||||
|
||||
|
||||
(define/override (on-demand)
|
||||
(define stx (send controller get-selected-syntax))
|
||||
(send copy-menu enable (and stx #t))
|
||||
(send copy-syntax-menu enable (and stx #t))
|
||||
(send clear-menu enable (and stx #t))
|
||||
(super on-demand))
|
||||
|
||||
;; Initialization
|
||||
(add-edit-items)
|
||||
(after-edit-items)
|
||||
|
|
|
|||
|
|
@ -105,8 +105,8 @@
|
|||
|
||||
(define -outer (new text%))
|
||||
(super-new (editor -outer) (with-border? #f))
|
||||
(set-margin 2 0 0 0)
|
||||
(set-inset 3 0 0 0)
|
||||
(set-margin 0 0 0 0)
|
||||
(set-inset 0 0 0 0)
|
||||
(set-snipclass snip-class)
|
||||
(send -outer select-all)
|
||||
(send -outer change-style (make-object style-delta% 'change-alignment 'top)
|
||||
|
|
@ -195,7 +195,7 @@
|
|||
(send pv set-syntax stx))
|
||||
(define/public (show ?)
|
||||
(send parent show ?))
|
||||
(define/public (is-shown?)
|
||||
(define/public (props-shown?)
|
||||
(send parent is-shown?))
|
||||
(super-new)))
|
||||
))
|
||||
|
|
@ -207,7 +207,7 @@
|
|||
(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")
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@
|
|||
"typesetter.ss"
|
||||
"hrule-snip.ss"
|
||||
"properties.ss"
|
||||
"partition.ss"
|
||||
"util.ss")
|
||||
(provide widget@
|
||||
widget-context-menu-extension@)
|
||||
|
|
@ -40,9 +39,12 @@
|
|||
(new syntax-controller%
|
||||
(properties-controller this)))
|
||||
|
||||
(define/public (make-context-menu)
|
||||
(new context-menu% (widget this)))
|
||||
|
||||
(new syntax-keymap%
|
||||
(editor -text)
|
||||
(context-menu (new context-menu% (widget this))))
|
||||
(context-menu (make-context-menu)))
|
||||
|
||||
;; FIXME: Why doesn't this work?
|
||||
#;
|
||||
|
|
@ -68,7 +70,7 @@
|
|||
(define/public (show ?)
|
||||
(if ? (show-props) (hide-props)))
|
||||
|
||||
(define/public (is-shown?)
|
||||
(define/public (props-shown?)
|
||||
(send -props-panel is-shown?))
|
||||
|
||||
(define/public (toggle-props)
|
||||
|
|
@ -152,47 +154,6 @@
|
|||
|
||||
(super-new)))
|
||||
|
||||
;; syntax-widget/controls%
|
||||
(define syntax-widget/controls%
|
||||
(class* syntax-widget% ()
|
||||
(inherit get-main-panel
|
||||
get-controller
|
||||
toggle-props)
|
||||
(super-new)
|
||||
|
||||
(define -control-panel
|
||||
(new horizontal-pane% (parent (get-main-panel)) (stretchable-height #f)))
|
||||
|
||||
;; Put the control panel up front
|
||||
(send (get-main-panel) change-children
|
||||
(lambda (children)
|
||||
(cons -control-panel (remq -control-panel children))))
|
||||
|
||||
(define -identifier=-choices (identifier=-choices))
|
||||
(define -choice
|
||||
(new choice% (label "identifer=?") (parent -control-panel)
|
||||
(choices (map car -identifier=-choices))
|
||||
(callback (lambda _ (on-update-identifier=?-choice)))))
|
||||
(new button%
|
||||
(label "Clear")
|
||||
(parent -control-panel)
|
||||
(callback (lambda _ (send (get-controller) select-syntax #f))))
|
||||
(new button%
|
||||
(label "Properties")
|
||||
(parent -control-panel)
|
||||
(callback (lambda _ (toggle-props))))
|
||||
|
||||
(define/private (on-update-identifier=?-choice)
|
||||
(cond [(assoc (send -choice get-string-selection)
|
||||
-identifier=-choices)
|
||||
=> (lambda (p)
|
||||
(send (get-controller)
|
||||
on-update-identifier=? (car p) (cdr p)))]
|
||||
[else #f]))
|
||||
(send (get-controller) add-identifier=?-listener
|
||||
(lambda (name func)
|
||||
(send -choice set-selection
|
||||
(or (send -choice find-string name) 0))))))
|
||||
))
|
||||
|
||||
(define widget-context-menu-extension@
|
||||
|
|
@ -203,13 +164,23 @@
|
|||
(class pre:context-menu%
|
||||
(init-field widget)
|
||||
|
||||
(define props-menu #f)
|
||||
|
||||
(define/override (after-selection-items)
|
||||
(super after-selection-items)
|
||||
(new menu-item% (label "Show/hide syntax properties")
|
||||
(parent this)
|
||||
(callback (lambda _ (send widget toggle-props))))
|
||||
(set! props-menu
|
||||
(new menu-item% (label "Show/hide syntax properties")
|
||||
(parent this)
|
||||
(callback (lambda _ (send widget toggle-props)))))
|
||||
(void))
|
||||
|
||||
(define/override (on-demand)
|
||||
(send props-menu set-label
|
||||
(if (send widget props-shown?)
|
||||
"Hide syntax properties"
|
||||
"Show syntax properties"))
|
||||
(super on-demand))
|
||||
|
||||
(super-new (controller (send widget get-controller)))))))
|
||||
|
||||
(define browser-text% (editor:standard-style-list-mixin text:basic%))
|
||||
|
|
|
|||
223
collects/macro-debugger/view/hiding-panel.ss
Normal file
223
collects/macro-debugger/view/hiding-panel.ss
Normal file
|
|
@ -0,0 +1,223 @@
|
|||
|
||||
(module hiding-panel mzscheme
|
||||
(require (lib "class.ss")
|
||||
(lib "mred.ss" "mred")
|
||||
(lib "list.ss")
|
||||
(lib "boundmap.ss" "syntax")
|
||||
"../model/hiding-policies.ss"
|
||||
"../syntax-browser/util.ss")
|
||||
(provide macro-hiding-prefs-widget%)
|
||||
|
||||
;; macro-hiding-prefs-widget%
|
||||
(define macro-hiding-prefs-widget%
|
||||
(class object%
|
||||
(init parent)
|
||||
(init-field stepper)
|
||||
(init-field policy)
|
||||
(init-field (enabled? #f))
|
||||
|
||||
(define stx #f)
|
||||
(define stx-name #f)
|
||||
(define stx-module #f)
|
||||
|
||||
(define super-pane
|
||||
(new horizontal-pane%
|
||||
(parent parent)
|
||||
(stretchable-height #f)))
|
||||
(define left-pane
|
||||
(new vertical-pane%
|
||||
(parent super-pane)
|
||||
(stretchable-width #f)
|
||||
(alignment '(left top))))
|
||||
(define right-pane
|
||||
(new vertical-pane%
|
||||
(parent super-pane)))
|
||||
|
||||
(define enable-ctl
|
||||
(new check-box%
|
||||
(label "Enable macro hiding?")
|
||||
(parent left-pane)
|
||||
(value enabled?)
|
||||
(callback
|
||||
(lambda _
|
||||
(set! enabled? (send enable-ctl get-value))
|
||||
(force-refresh)))))
|
||||
|
||||
(define kernel-ctl
|
||||
(new check-box%
|
||||
(label "Hide mzscheme syntax")
|
||||
(parent left-pane)
|
||||
(value (hiding-policy-opaque-kernel policy))
|
||||
(callback (lambda _
|
||||
(if (send kernel-ctl get-value)
|
||||
(policy-hide-kernel policy)
|
||||
(policy-unhide-kernel policy))
|
||||
(refresh)))))
|
||||
(define libs-ctl
|
||||
(new check-box%
|
||||
(label "Hide library syntax")
|
||||
(parent left-pane)
|
||||
(value (hiding-policy-opaque-libs policy))
|
||||
(callback (lambda _
|
||||
(if (send libs-ctl get-value)
|
||||
(policy-hide-libs policy)
|
||||
(policy-unhide-libs policy))
|
||||
(refresh)))))
|
||||
|
||||
(define look-pane
|
||||
(new horizontal-pane% (parent right-pane) (stretchable-height #f)))
|
||||
(define look-ctl
|
||||
(new list-box% (parent look-pane) (label "") (choices null)))
|
||||
(define delete-ctl
|
||||
(new button% (parent look-pane) (label "Delete")
|
||||
(callback
|
||||
(lambda _
|
||||
(delete-selected)
|
||||
(refresh)))))
|
||||
|
||||
(define add-pane
|
||||
(new horizontal-pane% (parent right-pane) (stretchable-height #f)))
|
||||
(define add-text
|
||||
(new text-field%
|
||||
(label "")
|
||||
(parent add-pane)
|
||||
(stretchable-width #t)))
|
||||
(define add-editor (send add-text get-editor))
|
||||
(define add-hide-module-button
|
||||
(new button% (parent add-pane) (label "Hide module") (enabled #f)
|
||||
(callback (lambda _ (add-hide-module) (refresh)))))
|
||||
(define add-hide-id-button
|
||||
(new button% (parent add-pane) (label "Hide macro") (enabled #f)
|
||||
(callback (lambda _ (add-hide-identifier) (refresh)))))
|
||||
(define add-show-id-button
|
||||
(new button% (parent add-pane) (label "Show macro") (enabled #f)
|
||||
(callback (lambda _ (add-show-identifier) (refresh)))))
|
||||
|
||||
(send add-editor lock #t)
|
||||
|
||||
;; Methods
|
||||
|
||||
;; enable-hiding : boolean -> void
|
||||
;; Called only by stepper, which does it's own refresh
|
||||
(define/public (enable-hiding ok?)
|
||||
(set! enabled? ok?))
|
||||
|
||||
;; get-enabled?
|
||||
(define/public (get-enabled?) enabled?)
|
||||
|
||||
;; get-policy
|
||||
(define/public (get-policy) policy)
|
||||
|
||||
;; refresh
|
||||
(define/private (refresh)
|
||||
(when enabled?
|
||||
(send stepper refresh/resynth)))
|
||||
|
||||
;; force-refresh
|
||||
(define/private (force-refresh)
|
||||
(send stepper refresh/resynth))
|
||||
|
||||
;; set-syntax : syntax/#f -> void
|
||||
(define/public (set-syntax lstx)
|
||||
(set! stx lstx)
|
||||
(send add-editor lock #f)
|
||||
(send add-editor erase)
|
||||
(unless (identifier? stx)
|
||||
(send add-hide-module-button enable #f))
|
||||
(when (identifier? stx)
|
||||
(let ([binding (identifier-binding stx)])
|
||||
(send add-hide-module-button enable (pair? binding))
|
||||
(if (pair? binding)
|
||||
(begin
|
||||
(set! stx-name (cadr binding))
|
||||
(set! stx-module (car binding)))
|
||||
(begin
|
||||
(set! stx-name (syntax-e stx))
|
||||
(set! stx-module #f)))
|
||||
(update-add-text)))
|
||||
(send add-editor lock #t)
|
||||
(send add-show-id-button enable (identifier? lstx))
|
||||
(send add-hide-id-button enable (identifier? lstx)))
|
||||
|
||||
(define/private (update-add-text)
|
||||
(send add-editor lock #f)
|
||||
(when (identifier? stx)
|
||||
(send add-editor insert (identifier-text "" stx)))
|
||||
(send add-editor lock #t))
|
||||
|
||||
(define/public (add-hide-module)
|
||||
(when stx-module
|
||||
(policy-hide-module policy stx-module)
|
||||
(update-list-view)))
|
||||
|
||||
(define/public (add-hide-identifier)
|
||||
(when (identifier? stx)
|
||||
(policy-hide-id policy stx)
|
||||
(update-list-view)))
|
||||
|
||||
(define/public (add-show-identifier)
|
||||
(when (identifier? stx)
|
||||
(policy-show-id policy stx)
|
||||
(update-list-view)))
|
||||
|
||||
(define/private (delete-selected)
|
||||
(for-each (lambda (n)
|
||||
(let ([d (send look-ctl get-data n)])
|
||||
(case (car d)
|
||||
((identifier) (policy-unhide-id policy (cdr d)))
|
||||
((show-identifier) (policy-unshow-id policy (cdr d)))
|
||||
((module) (policy-unhide-module policy (cdr d))))))
|
||||
(send look-ctl get-selections))
|
||||
(update-list-view))
|
||||
|
||||
(define/private (identifier-text prefix id)
|
||||
(let ([b (identifier-binding id)])
|
||||
(cond [(pair? b)
|
||||
(let ([name (cadr b)]
|
||||
[mod (car b)])
|
||||
(format "~a'~s' from module ~a"
|
||||
prefix
|
||||
name
|
||||
(mpi->string mod)))]
|
||||
[(eq? b 'lexical)
|
||||
(format "~alexically bound '~s'"
|
||||
prefix
|
||||
(syntax-e id))]
|
||||
[(not b)
|
||||
(format "~aglobal or unbound '~s'" prefix (syntax-e id))])))
|
||||
|
||||
(define/private (update-list-view)
|
||||
(let ([opaque-modules
|
||||
(hash-table-map (hiding-policy-opaque-modules policy)
|
||||
(lambda (k v) k))]
|
||||
[opaque-ids
|
||||
(filter values
|
||||
(module-identifier-mapping-map
|
||||
(hiding-policy-opaque-ids policy)
|
||||
(lambda (k v) (and v k))))]
|
||||
[transparent-ids
|
||||
(filter values
|
||||
(module-identifier-mapping-map
|
||||
(hiding-policy-transparent-ids policy)
|
||||
(lambda (k v) (and v k))))])
|
||||
(define (om s)
|
||||
(cons (format "hide from module ~a" (mpi->string s))
|
||||
(cons 'module s)))
|
||||
(define (*i prefix tag id)
|
||||
(cons (identifier-text prefix id)
|
||||
(cons tag id)))
|
||||
(define (oid id) (*i "hide " 'identifier id))
|
||||
(define (tid id) (*i "show " 'show-identifier id))
|
||||
(let ([choices
|
||||
(sort (append (map om opaque-modules)
|
||||
(map oid opaque-ids)
|
||||
(map tid transparent-ids))
|
||||
(lambda (a b)
|
||||
(string<=? (car a) (car b))))])
|
||||
(send look-ctl clear)
|
||||
(for-each (lambda (c) (send look-ctl append (car c) (cdr c)))
|
||||
choices))))
|
||||
|
||||
(super-new)))
|
||||
|
||||
)
|
||||
28
collects/macro-debugger/view/interfaces.ss
Normal file
28
collects/macro-debugger/view/interfaces.ss
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
|
||||
(module interfaces mzscheme
|
||||
(require (lib "unitsig.ss"))
|
||||
(provide (all-defined))
|
||||
|
||||
;; Signatures
|
||||
|
||||
(define-signature view^
|
||||
(macro-stepper-frame%
|
||||
macro-stepper-widget%
|
||||
make-macro-stepper
|
||||
go
|
||||
go/deriv))
|
||||
|
||||
(define-signature view-base^
|
||||
(base-frame%))
|
||||
|
||||
(define-signature prefs^
|
||||
(pref:width
|
||||
pref:height
|
||||
pref:props-percentage
|
||||
pref:macro-hiding?
|
||||
pref:show-hiding-panel?
|
||||
pref:hide-primitives?
|
||||
pref:hide-libs?
|
||||
pref:identifier=?))
|
||||
|
||||
)
|
||||
|
|
@ -1,5 +1,38 @@
|
|||
|
||||
(module prefs mzscheme
|
||||
(require (lib "framework.ss" "framework"))
|
||||
(require (lib "unitsig.ss")
|
||||
(lib "framework.ss" "framework")
|
||||
"interfaces.ss")
|
||||
(provide prefs@)
|
||||
|
||||
'...)
|
||||
(define-syntax pref:get/set
|
||||
(syntax-rules ()
|
||||
[(_ get/set prop)
|
||||
(define get/set
|
||||
(case-lambda
|
||||
[() (preferences:get 'prop)]
|
||||
[(newval) (preferences:set 'prop newval)]))]))
|
||||
|
||||
(define prefs@
|
||||
(unit/sig prefs^
|
||||
(import)
|
||||
|
||||
(preferences:set-default 'MacroStepper:Frame:Width 700 number?)
|
||||
(preferences:set-default 'MacroStepper:Frame:Height 600 number?)
|
||||
(preferences:set-default 'MacroStepper:PropertiesPanelPercentage 1/3 number?)
|
||||
(preferences:set-default 'MacroStepper:MacroHiding? #t boolean?)
|
||||
(preferences:set-default 'MacroStepper:ShowHidingPanel? #t boolean?)
|
||||
(preferences:set-default 'MacroStepper:HidePrimitives? #t boolean?)
|
||||
(preferences:set-default 'MacroStepper:HideLibs? #t boolean?)
|
||||
(preferences:set-default 'MacroStepper:IdentifierComparison "bound-identifier=?" string?)
|
||||
|
||||
(pref:get/set pref:width MacroStepper:Frame:Width)
|
||||
(pref:get/set pref:height MacroStepper:Frame:Height)
|
||||
(pref:get/set pref:props-percentage MacroStepper:PropertiesPanelPercentage)
|
||||
(pref:get/set pref:macro-hiding? MacroStepper:MacroHiding?)
|
||||
(pref:get/set pref:show-hiding-panel? MacroStepper:ShowHidingPanel?)
|
||||
(pref:get/set pref:hide-primitives? MacroStepper:HidePrimitives?)
|
||||
(pref:get/set pref:hide-libs? MacroStepper:HideLibs?)
|
||||
(pref:get/set pref:identifier=? MacroStepper:IdentifierComparison)
|
||||
))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,16 +1,27 @@
|
|||
|
||||
(module view mzscheme
|
||||
(require (lib "unitsig.ss")
|
||||
(lib "class.ss")
|
||||
(lib "mred.ss" "mred")
|
||||
(lib "framework.ss" "framework")
|
||||
(prefix sb: "../syntax-browser/embed.ss")
|
||||
"interfaces.ss"
|
||||
"prefs.ss"
|
||||
"gui.ss")
|
||||
(provide (all-defined))
|
||||
|
||||
(define view-base@
|
||||
(unit/sig view-base^
|
||||
(import)
|
||||
(define base-frame%
|
||||
(frame:standard-menus-mixin (frame:basic-mixin frame%)))))
|
||||
|
||||
(define-values/invoke-unit/sig view^
|
||||
(compound-unit/sig
|
||||
(import)
|
||||
(link (PREFS : sb:prefs^ (sb:global-prefs@))
|
||||
(link (PREFS : prefs^ (prefs@))
|
||||
(SB : sb:implementation^ (sb:implementation@))
|
||||
(BASE : view-base^ (view-base@))
|
||||
(VIEW : view^ (view@ BASE PREFS SB)))
|
||||
(VIEW : view^ (view@ BASE SB)))
|
||||
(export (open VIEW))))
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user