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

macro stepper: more iop

Browse Source 
svn: r13134
This commit is contained in:
Ryan Culpepper 2009-01-15 00:10:09 +00:00
parent 92a938dc6d
commit b91874f41c
19 changed files with 215 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -38,7 +38,7 @@
;; mark-manager-mixin
(define mark-manager-mixin
(mixin () (mark-manager<%>)
(init-field [primary-partition (new-bound-partition)])
(init-field: [primary-partition partition<%> (new-bound-partition)])
(super-new)
;; get-primary-partition : -> partition
@ -63,8 +63,8 @@
(new partition% (relation (cdr name+proc)))))))
(listen-secondary-partition
(lambda (p)
(for-each (lambda (d) (send: d display<%> refresh))
displays)))
(for ([d displays])
(send: d display<%> refresh))))
(super-new)))
(define controller%

30
collects/macro-debugger/syntax-browser/display.ss
View File

@ -1,4 +1,3 @@
#lang scheme/base
(require scheme/class
scheme/gui
@ -19,8 +18,8 @@
(define range
(pretty-print-syntax stx output-port
(send: controller controller<%> get-primary-partition)
(send config get-colors)
(send config get-suffix-option)
(send: config config<%> get-colors)
(send: config config<%> get-suffix-option)
columns))
(define output-string (get-output-string output-port))
(define output-length (sub1 (string-length output-string))) ;; skip final newline
@ -55,18 +54,18 @@
;; set-standard-font : text% config number number -> void
(define (set-standard-font text config start end)
(send text change-style
(code-style text (send config get-syntax-font-size))
(code-style text (send: config config<%> get-syntax-font-size))
start end))
;; display%
(define display%
(class* object% (display<%>)
(init-field text)
(init-field controller)
(init-field config)
(init-field range)
(init-field start-position)
(init-field end-position)
(init-field: [controller controller<%>]
[config config<%>]
[range range<%>])
(init-field text
start-position
end-position)
(define extra-styles (make-hasheq))
@ -131,7 +130,7 @@
(send delta set-delta-foreground color)
delta))
(define color-styles
(list->vector (map color-style (send config get-colors))))
(list->vector (map color-style (send: config config<%> get-colors))))
(define overflow-style (color-style "darkgray"))
(define color-partition
(send: controller mark-manager<%> get-primary-partition))
@ -189,7 +188,7 @@
;; draw-secondary-connection : syntax -> void
(define/private (draw-secondary-connection stx2)
(for ([r (send range get-ranges stx2)])
(for ([r (send: range range<%> get-ranges stx2)])
(restyle-range r select-sub-highlight-d)))
;; restyle-range : (cons num num) style-delta% -> void
@ -204,11 +203,11 @@
;; Initialize
(super-new)
(send controller add-syntax-display this)))
(send: controller controller<%> add-syntax-display this)))
;; fixup-parentheses : string range -> void
(define (fixup-parentheses string range)
(define (fixup r)
(for ([r (send: range range<%> all-ranges)])
(let ([stx (range-obj r)]
[start (range-start r)]
[end (range-end r)])
@ -219,8 +218,7 @@
(string-set! string (sub1 end) #\]))
((#\{)
(string-set! string start #\{)
(string-set! string (sub1 end) #\}))))))
(for-each fixup (send range all-ranges)))
(string-set! string (sub1 end) #\})))))))
(define (open-output-string/count-lines)
(let ([os (open-output-string)])

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

@ -1,8 +1,10 @@
#lang scheme/base
(require scheme/class
macro-debugger/util/class-iop
scheme/gui
framework/framework
scheme/list
"interfaces.ss"
"partition.ss"
"prefs.ss"
"widget.ss")
@ -20,8 +22,9 @@
(define (browse-syntaxes stxs)
(let ((w (make-syntax-browser)))
(for ([stx stxs])
(send w add-syntax stx)
(send w add-separator))))
(send*: w syntax-browser<%>
(add-syntax stx)
(add-separator)))))
;; make-syntax-browser : -> syntax-browser<%>
(define (make-syntax-browser)
@ -32,21 +35,23 @@
;; syntax-browser-frame%
(define syntax-browser-frame%
(class* frame% ()
(init-field [config (new syntax-prefs%)])
(inherit get-width
get-height)
(init-field: [config config<%> (new syntax-prefs%)])
(super-new (label "Syntax Browser")
(width (send config pref:width))
(height (send config pref:height)))
(define widget
(width (send: config config<%> get-width))
(height (send: config config<%> get-height)))
(define: widget syntax-browser<%>
(new syntax-widget/controls%
(parent this)
(config config)))
(define/public (get-widget) widget)
(define/augment (on-close)
(send config pref:width (send this get-width))
(send config pref:height (send this get-height))
(send*: config config<%>
(set-width (get-width))
(set-height (get-height)))
(send widget shutdown)
(inner (void) on-close))
))
(inner (void) on-close))))
;; syntax-widget/controls%
(define syntax-widget/controls%
@ -72,23 +77,23 @@
(choices (map car -identifier=-choices))
(callback
(lambda (c e)
(send (get-controller) set-identifier=?
(assoc (send c get-string-selection)
-identifier=-choices))))))
(send: (get-controller) controller<%> set-identifier=?
(assoc (send c get-string-selection)
-identifier=-choices))))))
(new button%
(label "Clear")
(parent -control-panel)
(callback (lambda _ (send (get-controller) select-syntax #f))))
(callback (lambda _ (send: (get-controller) controller<%> set-selected-syntax #f))))
(new button%
(label "Properties")
(parent -control-panel)
(callback
(lambda _
(send config set-props-shown?
(not (send config get-props-shown?))))))
(send: config config<%> set-props-shown?
(not (send: config config<%> get-props-shown?))))))
(send (get-controller) listen-identifier=?
(lambda (name+func)
(send -choice set-selection
(or (send -choice find-string (car name+func)) 0))))
(send: (get-controller) controller<%> listen-identifier=?
(lambda (name+func)
(send -choice set-selection
(or (send -choice find-string (car name+func)) 0))))
))

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

@ -1,8 +1,19 @@
#lang scheme/base
(require scheme/class
macro-debugger/util/class-iop)
macro-debugger/util/class-iop
"../util/notify.ss")
(provide (all-defined-out))
;; config<%>
(define-interface config<%> ()
((methods:notify suffix-option
syntax-font-size
colors
width
height
props-percentage
props-shown?)))
;; displays-manager<%>
(define-interface displays-manager<%> ()
(;; add-syntax-display : display<%> -> void
@ -13,10 +24,8 @@
;; selection-manager<%>
(define-interface selection-manager<%> ()
(;; selected-syntax : syntax/#f
set-selected-syntax
get-selected-syntax
listen-selected-syntax))
(;; selected-syntax : notify-box of syntax/#f
(methods:notify selected-syntax)))
;; mark-manager<%>
;; Manages marks, mappings from marks to colors
@ -29,23 +38,10 @@
;; secondary-partition<%>
(define-interface secondary-partition<%> ()
(;; get-secondary-partition : -> partition<%>
get-secondary-partition
;; set-secondary-partition : partition<%> -> void
set-secondary-partition
;; listen-secondary-partition : (partition<%> -> void) -> void
listen-secondary-partition
;; get-identifier=? : -> (cons string procedure)
get-identifier=?
;; set-identifier=? : (cons string procedure) -> void
set-identifier=?
;; listen-identifier=? : ((cons string procedure) -> void) -> void
listen-identifier=?))
(;; secondary-partition : notify-box of partition<%>
;; identifier=? : notify-box of (cons string procedure)
(methods:notify secondary-partition
identifier=?)))
;; controller<%>
(define-interface controller<%> (displays-manager<%>
@ -143,6 +139,7 @@
add-clickback
add-separator
erase-all
get-controller
get-text))
(define-interface partition<%> ()

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

@ -42,7 +42,7 @@
(super-new)))
(define syntax-prefs-base%
(class prefs-base%
(class* prefs-base% (config<%>)
;; width, height : number
(notify-methods width)
(notify-methods height)

14
collects/macro-debugger/syntax-browser/pretty-helper.ss
View File

@ -1,7 +1,9 @@
#lang scheme/base
(require scheme/class
syntax/stx)
macro-debugger/util/class-iop
syntax/stx
"interfaces.ss")
(provide (all-defined-out))
;; Problem: If stx1 and stx2 are two distinguishable syntax objects, it
@ -45,10 +47,10 @@
(case suffixopt
((never) (unintern (syntax-e id)))
((always)
(let ([n (send partition get-partition id)])
(let ([n (send: partition partition<%> get-partition id)])
(if (zero? n) (unintern (syntax-e id)) (suffix (syntax-e id) n))))
((over-limit)
(let ([n (send partition get-partition id)])
(let ([n (send: partition partition<%> get-partition id)])
(if (<= n limit)
(unintern (syntax-e id))
(suffix (syntax-e id) n))))))
@ -61,7 +63,7 @@
=> (lambda (datum) datum)]
[(and partition (identifier? obj))
(when (and (eq? suffixopt 'all-if-over-limit)
(> (send partition count) limit))
(> (send: partition partition<%> count) limit))
(call-with-values (lambda () (table stx partition #f 'always))
escape))
(let ([lp-datum (make-identifier-proxy obj)])
@ -70,7 +72,7 @@
lp-datum)]
[(and (syntax? obj) (check+convert-special-expression obj))
=> (lambda (newobj)
(when partition (send partition get-partition obj))
(when partition (send: partition partition<%> get-partition obj))
(let* ([inner (cadr newobj)]
[lp-inner-datum (loop inner)]
[lp-datum (list (car newobj) lp-inner-datum)])
@ -80,7 +82,7 @@
(hash-set! stx=>flat obj lp-datum)
lp-datum))]
[(syntax? obj)
(when partition (send partition get-partition obj))
(when partition (send: partition partition<%> get-partition obj))
(let ([lp-datum (loop (syntax-e obj))])
(hash-set! flat=>stx lp-datum obj)
(hash-set! stx=>flat obj lp-datum)

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

@ -1,6 +1,7 @@
#lang scheme/base
(require scheme/class
macro-debugger/util/class-iop
scheme/match
scheme/list
mzlib/string
@ -205,8 +206,8 @@
(define/public (read-special src line col pos)
(send the-syntax-snip read-special src line col pos))
(send config listen-props-shown?
(lambda (?) (refresh-contents)))
(send: config config<%> listen-props-shown?
(lambda (?) (refresh-contents)))
(super-new)
(set-snipclass snip-class)

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

@ -43,6 +43,7 @@
(define/public (setup-keymap)
(new syntax-keymap%
(editor -text)
(controller controller)
(config config)))
(send -text set-styles-sticky #f)
@ -54,7 +55,7 @@
(define/private (internal-show-props show?)
(if show?
(unless (send -props-panel is-shown?)
(let ([p (send config get-props-percentage)])
(let ([p (send: config config<%> get-props-percentage)])
(send -split-panel add-child -props-panel)
(update-props-percentage p))
(send -props-panel show #t))
@ -81,8 +82,8 @@
(define/public (shutdown)
(when (props-panel-shown?)
(send config set-props-percentage
(cadr (send -split-panel get-percentages)))))
(send: config config<%> set-props-percentage
(cadr (send -split-panel get-percentages)))))
;; syntax-browser<%> Methods
@ -202,7 +203,7 @@
display)))
(define/private (calculate-columns)
(define style (code-style -text (send config get-syntax-font-size)))
(define style (code-style -text (send: config config<%> get-syntax-font-size)))
(define char-width (send style get-text-width (send -ecanvas get-dc)))
(define-values (canvas-w canvas-h) (send -ecanvas get-client-size))
(sub1 (inexact->exact (floor (/ canvas-w char-width)))))
@ -211,13 +212,13 @@
(super-new)
(setup-keymap)
(send config listen-props-shown?
(lambda (show?)
(show-props show?)))
(send config listen-props-percentage
(lambda (p)
(update-props-percentage p)))
(internal-show-props (send config get-props-shown?))))
(send: config config<%> listen-props-shown?
(lambda (show?)
(show-props show?)))
(send: config config<%> listen-props-percentage
(lambda (p)
(update-props-percentage p)))
(internal-show-props (send: config config<%> get-props-shown?))))
(define clickback-style

32
collects/macro-debugger/util/class-ct.ss
View File

@ -14,7 +14,15 @@
checked-binding-iface
checked-binding
static-interface)
static-interface
interface-expander?
make-interface-expander
interface-expander-proc
interface-expander
method-entry)
(define-struct static-interface (dynamic members)
#:omit-define-syntaxes
@ -60,6 +68,11 @@
(define (checked-binding-iface x)
(raw-checked-binding-iface (set!-transformer-procedure x)))
(define-struct interface-expander (proc)
#:omit-define-syntaxes)
;; Syntax
(define-syntax-class static-interface
@ -71,3 +84,20 @@
(pattern x
#:declare x (static-of 'checked-binding checked-binding?)
#:with value #'x.value))
(define-syntax-class interface-expander
(pattern x
#:declare x (static-of 'interface-expander interface-expander?)
#:with value #'x.value))
(define-syntax-class method-entry
(pattern method:id
#:with methods (list #'method))
(pattern (macro:interface-expander . args)
#:with methods
(apply append
(for/list ([m ((interface-expander-proc #'macro.value)
#'(macro . args))])
(syntax-parse m
[m:method-entry #'m.methods])))))

27
collects/macro-debugger/util/class-iop.ss
View File

@ -5,6 +5,7 @@
"class-ct.ss"))
(provide define-interface
define-interface/dynamic
define-interface-expander
send:
send*:
@ -26,13 +27,14 @@
;; Defines NAME as an interface.
(define-syntax (define-interface stx)
(syntax-parse stx
[(_ name:id (super:static-interface ...) (mname:id ...))
[(_ name:id (super:static-interface ...) (m:method-entry ...))
(with-syntax ([((super-method ...) ...)
(map static-interface-members
(syntax->datum #'(super.value ...)))])
(syntax->datum #'(super.value ...)))]
[((mname ...) ...) #'(m.methods ...)])
#'(define-interface/dynamic name
(let ([name (interface (super ...) mname ...)]) name)
(super-method ... ... mname ...)))]))
(let ([name (interface (super ...) mname ... ...)]) name)
(super-method ... ... mname ... ...)))]))
;; define-interface/dynamic SYNTAX
;; (define-interface/dynamic NAME EXPR (IDENTIFIER ...))
@ -54,6 +56,11 @@
(define-syntax name
(make-static-interface #'dynamic-name '(mname ...)))))]))
(define-syntax (define-interface-expander stx)
(syntax-parse stx
[(_ name:id rhs:expr)
#'(define-syntax name (make-interface-expander rhs))]))
;; Helper
(begin-for-syntax
@ -173,19 +180,19 @@
;; FIXME: unsafe due to mutation
(define-syntax (init-field: stx)
(syntax-parse stx
[(_ (name:id iface:static-interface) ...)
#'(begin (init1: init-field name iface) ...)]))
[(_ (name:id iface:static-interface . default) ...)
#'(begin (init1: init-field name iface . default) ...)]))
(define-syntax (init: stx)
(syntax-parse stx
[(_ (name:id iface:static-interface) ...)
#'(begin (init1: init name iface) ...)]))
[(_ (name:id iface:static-interface . default) ...)
#'(begin (init1: init name iface . default) ...)]))
(define-syntax (init1: stx)
(syntax-parse stx
[(_ init name:id iface:static-interface)
[(_ init name:id iface:static-interface . default)
(with-syntax ([(name-internal) (generate-temporaries #'(name))])
#'(begin (init ((name-internal name)))
#'(begin (init ((name-internal name) . default))
(void (check-object<:interface init: name-internal iface))
(define-syntax name
(make-checked-binding

18
collects/macro-debugger/util/notify.ss
View File

@ -3,6 +3,7 @@
(require (for-syntax scheme/base)
scheme/list
scheme/class
macro-debugger/util/class-iop
scheme/gui)
(provide define/listen
field/notify
@ -15,7 +16,9 @@
menu-option/notify-box
menu-group/notify-box
check-box/notify-box
choice/notify-box)
choice/notify-box
methods:notify)
(define-for-syntax (join . args)
(define (->string x)
@ -71,6 +74,19 @@
(define/public-final (listen-name listener)
(send name listen listener))))]))
(define-interface-expander methods:notify
(lambda (stx)
(syntax-case stx ()
[(_ name ...)
(apply append
(for/list ([name (syntax->list #'(name ...))])
(list ;; (join "init-" #'name)
(join "get-" name)
(join "set-" name)
(join "listen-" name))))])))
(define-syntax (connect-to-pref stx)
(syntax-case stx ()
[(connect-to-pref name pref)

4
collects/macro-debugger/view/debug.ss
View File

@ -2,6 +2,8 @@
#lang scheme/base
(require scheme/pretty
scheme/class
macro-debugger/util/class-iop
"interfaces.ss"
"debug-format.ss"
"prefs.ss"
"view.ss")
@ -30,5 +32,5 @@
(pretty-print msg)
(pretty-print ctx)
(let* ([w (make-stepper)])
(send w add-trace events)
(send: w widget<%> add-trace events)
w)))

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

@ -42,8 +42,8 @@
get-help-menu)
(super-new (label (make-label))
(width (send config get-width))
(height (send config get-height)))
(width (send: config config<%> get-width))
(height (send: config config<%> get-height)))
(define/private (make-label)
(if filename
@ -54,8 +54,8 @@
"Macro stepper"))
(define/override (on-size w h)
(send config set-width w)
(send config set-height h)
(send: config config<%> set-width w)
(send: config config<%> set-height h)
(send: widget widget<%> update/preserve-view))
(define warning-panel
@ -143,7 +143,7 @@
(eq? (car name+func) (car p)))))))
(sb:identifier=-choices)))
(let ([identifier=? (send config get-identifier=?)])
(let ([identifier=? (send: config config<%> get-identifier=?)])
(when identifier=?
(let ([p (assoc identifier=? (sb:identifier=-choices))])
(send: controller sb:controller<%> set-identifier=? p))))
@ -178,10 +178,10 @@
(parent extras-menu)
(callback
(lambda (i e)
(send config set-suffix-option
(if (send i is-checked?)
'always
'over-limit))
(send: config config<%> set-suffix-option
(if (send i is-checked?)
'always
'over-limit))
(send: widget widget<%> update/preserve-view))))
(menu-option/notify-box extras-menu
"Highlight redex/contractum"

12
collects/macro-debugger/view/hiding-panel.ss
View File

@ -79,7 +79,7 @@
(style '(deleted))))
(define/private (get-mode)
(send config get-macro-hiding-mode))
(send: config config<%> get-macro-hiding-mode))
(define/private (macro-hiding-enabled?)
(let ([mode (get-mode)])
@ -89,7 +89,7 @@
(define/private (ensure-custom-mode)
(unless (equal? (get-mode) mode:custom)
(send config set-macro-hiding-mode mode:custom)))
(send: config config<%> set-macro-hiding-mode mode:custom)))
(define/private (update-visibility)
(let ([customizing (equal? (get-mode) mode:custom)])
@ -104,10 +104,10 @@
(list customize-panel)
null))))))
(send config listen-macro-hiding-mode
(lambda (value)
(update-visibility)
(force-refresh)))
(send: config config<%> listen-macro-hiding-mode
(lambda (value)
(update-visibility)
(force-refresh)))
(define box:hiding
(new check-box%

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

@ -1,8 +1,23 @@
#lang scheme/base
(require macro-debugger/util/class-iop)
(require macro-debugger/util/class-iop
"../util/notify.ss"
(prefix-in sb: "../syntax-browser/interfaces.ss"))
(provide (all-defined-out))
(define-interface config<%> (sb:config<%>)
((methods:notify macro-hiding-mode
show-hiding-panel?
identifier=?
highlight-foci?
highlight-frontier?
show-rename-steps?
suppress-warnings?
one-by-one?
extra-navigation?
debug-catch-errors?
force-letrec-transformation?)))
(define-interface widget<%> ()
(get-config
get-controller

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

@ -2,6 +2,7 @@
#lang scheme/base
(require scheme/class
framework/framework
"interfaces.ss"
"../syntax-browser/prefs.ss"
"../util/notify.ss"
"../util/misc.ss")
@ -43,7 +44,7 @@
(pref:get/set pref:force-letrec-transformation? MacroStepper:ForceLetrecTransformation?)
(define macro-stepper-config-base%
(class syntax-prefs-base%
(class* syntax-prefs-base% (config<%>)
(notify-methods macro-hiding-mode)
(notify-methods show-hiding-panel?)
(notify-methods identifier=?)

6
collects/macro-debugger/view/step-display.ss
View File

@ -41,7 +41,7 @@
(define step-display%
(class* object% (step-display<%>)
(init-field config)
(init-field: (config config<%>))
(init-field ((sbview syntax-widget)))
(super-new)
@ -194,8 +194,8 @@
;; insert-syntax/color
(define/private (insert-syntax/color stx foci binders shift-table
definites frontier hi-color)
(define highlight-foci? (send config get-highlight-foci?))
(define highlight-frontier? (send config get-highlight-frontier?))
(define highlight-foci? (send: config config<%> get-highlight-foci?))
(define highlight-frontier? (send: config config<%> get-highlight-frontier?))
(send: sbview sb:syntax-browser<%> add-syntax stx
#:definites (or definites null)
#:binder-table binders

42
collects/macro-debugger/view/stepper.ss
View File

@ -86,7 +86,7 @@
(let ([term (focused-term)])
(when term
(let ([new-stepper (send: director director<%> new-stepper '(no-new-traces))])
(send: new-stepper widget<%> add-deriv (send term get-raw-deriv))
(send: new-stepper widget<%> add-deriv (send: term term-record<%> get-raw-deriv))
(void)))))
;; duplicate-stepper : -> void
@ -138,7 +138,7 @@
(config config)
(syntax-widget sbview)))
(define: sbc sb:controller<%>
(send sbview get-controller))
(send: sbview sb:syntax-browser<%> get-controller))
(define control-pane
(new vertical-panel% (parent area) (stretchable-height #f)))
(define: macro-hiding-prefs hiding-prefs<%>
@ -147,22 +147,24 @@
(stepper this)
(config config)))
(send config listen-show-hiding-panel?
(lambda (show?) (show-macro-hiding-panel show?)))
(send sbc listen-selected-syntax
(lambda (stx) (send: macro-hiding-prefs hiding-prefs<%> set-syntax stx)))
(send config listen-highlight-foci?
(lambda (_) (update/preserve-view)))
(send config listen-highlight-frontier?
(lambda (_) (update/preserve-view)))
(send config listen-show-rename-steps?
(lambda (_) (refresh/re-reduce)))
(send config listen-one-by-one?
(lambda (_) (refresh/re-reduce)))
(send config listen-force-letrec-transformation?
(lambda (_) (refresh/resynth)))
(send config listen-extra-navigation?
(lambda (show?) (show-extra-navigation show?)))
(send: sbc sb:controller<%>
listen-selected-syntax
(lambda (stx) (send: macro-hiding-prefs hiding-prefs<%> set-syntax stx)))
(send*: config config<%>
(listen-show-hiding-panel?
(lambda (show?) (show-macro-hiding-panel show?)))
(listen-highlight-foci?
(lambda (_) (update/preserve-view)))
(listen-highlight-frontier?
(lambda (_) (update/preserve-view)))
(listen-show-rename-steps?
(lambda (_) (refresh/re-reduce)))
(listen-one-by-one?
(lambda (_) (refresh/re-reduce)))
(listen-force-letrec-transformation?
(lambda (_) (refresh/resynth)))
(listen-extra-navigation?
(lambda (show?) (show-extra-navigation show?))))
(define nav:up
(new button% (label "Previous term") (parent navigator)
@ -400,8 +402,8 @@
;; Initialization
(super-new)
(show-macro-hiding-panel (send config get-show-hiding-panel?))
(show-extra-navigation (send config get-extra-navigation?))
(show-macro-hiding-panel (send: config config<%> get-show-hiding-panel?))
(show-extra-navigation (send: config config<%> get-extra-navigation?))
(refresh/move)
))

7
collects/macro-debugger/view/term-record.ss
View File

@ -33,7 +33,8 @@
(class* object% (term-record<%>)
(init-field: (stepper widget<%>))
(define config (send stepper get-config))
(define: config config<%>
(send: stepper widget<%> get-config))
(define: displayer step-display<%>
(send: stepper widget<%> get-step-displayer))
@ -173,12 +174,12 @@
(set! steps
(and raw-steps
(let* ([filtered-steps
(if (send config get-show-rename-steps?)
(if (send: config config<%> get-show-rename-steps?)
raw-steps
(filter (lambda (x) (not (rename-step? x)))
raw-steps))]
[processed-steps
(if (send config get-one-by-one?)
(if (send: config config<%> get-one-by-one?)
(reduce:one-by-one filtered-steps)
filtered-steps)])
(cursor:new processed-steps))))