Syncing up.

svn: r13153
This commit is contained in:
Stevie Strickland 2009-01-15 17:57:20 +00:00
commit 9abbdce906
6 changed files with 47 additions and 35 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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])

Binary file not shown.

After

Width:  |  Height:  |  Size: 29 KiB