diff --git a/collects/racket/private/class-internal.rkt b/collects/racket/private/class-internal.rkt index 7a9260c140..11d13babee 100644 --- a/collects/racket/private/class-internal.rkt +++ b/collects/racket/private/class-internal.rkt @@ -36,7 +36,8 @@ object% object? externalizable<%> printable<%> writable<%> equal<%> object=? new make-object instantiate - send send/apply send/keyword-apply send* class-field-accessor class-field-mutator with-method + send send/apply send/keyword-apply send* dynamic-send + class-field-accessor class-field-mutator with-method get-field set-field! field-bound? field-names private* public* pubment* override* overment* @@ -3853,6 +3854,13 @@ ;; send/keyword-apply send/keyword-apply))) +(define dynamic-send + (make-keyword-procedure + (lambda (kws kw-vals obj method-name . args) + (unless (object? obj) (raise-type-error 'dynamic-send "object" obj)) + (unless (symbol? method-name) (raise-type-error 'dynamic-send "symbol" method-name)) + (keyword-apply (find-method/who 'dynamic-send obj method-name) kws kw-vals obj args)))) + (define-syntaxes (send* send*-traced) (let* ([core-send* (lambda (traced?) @@ -4818,7 +4826,8 @@ object% object? object=? externalizable<%> printable<%> writable<%> equal<%> new make-object instantiate get-field set-field! field-bound? field-names - send send/apply send/keyword-apply send* class-field-accessor class-field-mutator with-method + send send/apply send/keyword-apply send* dynamic-send + class-field-accessor class-field-mutator with-method private* public* pubment* override* overment* augride* augment* diff --git a/collects/scribblings/reference/class.scrbl b/collects/scribblings/reference/class.scrbl index 41ff561635..b88dd550ef 100644 --- a/collects/scribblings/reference/class.scrbl +++ b/collects/scribblings/reference/class.scrbl @@ -1105,6 +1105,15 @@ be any expression.} Like @racket[send/apply], but with expressions for keyword and argument lists like @racket[keyword-apply].} +@defproc[(dynamic-send [obj object?] + [method-name symbol?] + [v any/c] ... + [#: kw-arg any/c] ...) any]{ + +Calls the method on @racket[obj] whose name matches +@racket[method-name], passing along all given @racket[v]s and +@racket[kw-arg]s.} + @defform/subs[(send* obj-expr msg ...) ([msg (method-id arg ...) diff --git a/collects/tests/racket/object.rktl b/collects/tests/racket/object.rktl index 2841da62ee..a165d1aadc 100644 --- a/collects/tests/racket/object.rktl +++ b/collects/tests/racket/object.rktl @@ -793,6 +793,12 @@ (test '(2 12) 'dotted (send/keyword-apply dotted h null null (list 2))) (test '(3 8) 'dotted (send/keyword-apply dotted h '(#:y) (list 8) (list 3))) +(test '(c b a) dynamic-send dotted 'f 'a 'b 'c) +(test '(c b a) apply dynamic-send dotted 'f 'a '(b c)) +(test '(e 12) apply dynamic-send dotted 'h '(e)) +(test '(f 13) 'dotted (apply dynamic-send dotted 'h '(f) #:y 13)) +(test '(g 14) keyword-apply dynamic-send '(#:y) '(14) dotted 'h '(g)) + (syntax-test #'(send/apply dotted f 2 . l)) ;; ------------------------------------------------------------ diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 851dcc51e3..347252b224 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -4,6 +4,7 @@ Regexps are `equal?' when they have the same source [byte] string Numbers, characters, strings, byte strings, and regexps are interned by read and datum->syntax Added read-intern-literal +racket/class: added send/keyword-apply and dynamic-send racket/draw: added get-names to color-database<%> mzlib/pconvert: added add-make-prefix-to-constructor parameter, which changes the default constructor-style printing in DrRacket