diff --git a/collects/macro-debugger/syntax-browser/interfaces.ss b/collects/macro-debugger/syntax-browser/interfaces.ss index 9c7ade2634..7c60b40af9 100644 --- a/collects/macro-debugger/syntax-browser/interfaces.ss +++ b/collects/macro-debugger/syntax-browser/interfaces.ss @@ -1,9 +1,33 @@ #lang scheme/base (require scheme/class macro-debugger/util/class-iop - "../util/notify.ss") + (for-syntax scheme/base)) (provide (all-defined-out)) +;; Helpers + +(define-for-syntax (join . args) + (define (->string x) + (cond [(string? x) x] + [(symbol? x) (symbol->string x)] + [(identifier? x) (symbol->string (syntax-e x))] + [else (error '->string)])) + (string->symbol (apply string-append (map ->string args)))) + +;; not in notify.ss because notify depends on scheme/gui +(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))))]))) + +;; Interfaces + ;; config<%> (define-interface config<%> () ((methods:notify suffix-option diff --git a/collects/macro-debugger/util/notify.ss b/collects/macro-debugger/util/notify.ss index 8da4293f64..991bce1263 100644 --- a/collects/macro-debugger/util/notify.ss +++ b/collects/macro-debugger/util/notify.ss @@ -16,9 +16,7 @@ menu-option/notify-box menu-group/notify-box check-box/notify-box - choice/notify-box - - methods:notify) + choice/notify-box) (define-for-syntax (join . args) (define (->string x) @@ -74,19 +72,6 @@ (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) diff --git a/collects/macro-debugger/view/interfaces.ss b/collects/macro-debugger/view/interfaces.ss index d5d75aad3f..4c7ddae67f 100644 --- a/collects/macro-debugger/view/interfaces.ss +++ b/collects/macro-debugger/view/interfaces.ss @@ -1,23 +1,22 @@ #lang scheme/base (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? - split-context?))) + ((sb: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? + split-context?))) (define-interface widget<%> () (get-config diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss index 3b92501f73..a6ae8f06ee 100644 --- a/collects/scheme/private/class-internal.ss +++ b/collects/scheme/private/class-internal.ss @@ -2958,7 +2958,7 @@ (obj-error who "no such field: ~a~a" name (for-class (class-name class)))))]) - (which (cwhich (car p)) (cdr p)))) + (which (cwhich (car p)) (cdr p) name))) (define (make-class-field-accessor class name) (class-field-X 'class-field-accessor diff --git a/collects/scribblings/gui/style-list-class.scrbl b/collects/scribblings/gui/style-list-class.scrbl index b9eef1351f..3aa9361ace 100644 --- a/collects/scribblings/gui/style-list-class.scrbl +++ b/collects/scribblings/gui/style-list-class.scrbl @@ -73,11 +73,15 @@ The @scheme[base-style] argument must be a style within this style Creates a new derived style, or finds an appropriate existing one. The returned style is always unnamed. See @|stylediscuss| for more -information. +information. -The @scheme[base-style] argument must be a style within this style list. - -} +The @scheme[base-style] argument must be a style within this style +list. If @scheme[base-style] is not a join style, if it has no name, +and if its delta can be collapsed with @scheme[delta] (see +@xmethod[style-delta% collapse]), then the collapsed delta is used in +place of @scheme[delta], and the base style of @scheme[base-style] is +used in place of @scheme[base-style]; this collapsing and substitution +of base styles is performed recursively.} @defmethod[(forget-notification [key any/c]) diff --git a/collects/teachpack/universe.png b/collects/teachpack/universe.png new file mode 100644 index 0000000000..ed161af097 Binary files /dev/null and b/collects/teachpack/universe.png differ