Index: TODO =================================================================== diff -u -r03f10dbb9c8ba72bcfa1695183d7d5ee56663bf7 -ra35803ea84148ebadd79d8527830dcbdebd8873e --- TODO (.../TODO) (revision 03f10dbb9c8ba72bcfa1695183d7d5ee56663bf7) +++ TODO (.../TODO) (revision a35803ea84148ebadd79d8527830dcbdebd8873e) @@ -4989,15 +4989,13 @@ - adding a test case - use for output of forward ... -verbose NsfLog(...NSF_LOG_NOTICE...) instead of fprintf() to make it redirect-able +- use in forwarders "-frame object" instead of "-objframe" in nx + for consistency with other calls (e.g. dispatch). Other values for + "-frame" are not allowed. (btw, XOTcl has "-objscope") - ======================================================================== TODO: -- forwarders/aliases: -frame object vs. -objframe: keep -objframe in - forward or introduce -frame object (if -frame method made sense for - forwards --> using next etc.?)? - - Revisit nsf::*::assertion interface? Why does nsf::method::assertion allow for setting invariants. One would rather expect a ::nsf::object|class::assertion or the like? Index: generic/nsf.c =================================================================== diff -u -r572e1a32edadd7868800deb34e8433c034173835 -ra35803ea84148ebadd79d8527830dcbdebd8873e --- generic/nsf.c (.../nsf.c) (revision 572e1a32edadd7868800deb34e8433c034173835) +++ generic/nsf.c (.../nsf.c) (revision a35803ea84148ebadd79d8527830dcbdebd8873e) @@ -18222,7 +18222,8 @@ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-earlybinding", -1)); } if (tcd->objframe) { - Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-objframe", -1)); + Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-frame", 6)); + Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("object", 6)); } Tcl_ListObjAppendElement(interp, listObj, tcd->cmdName); if (tcd->args) { Index: library/nx/nx.tcl =================================================================== diff -u -r8776580a91fa04fd52378dd37143f6c27769c8ab -ra35803ea84148ebadd79d8527830dcbdebd8873e --- library/nx/nx.tcl (.../nx.tcl) (revision 8776580a91fa04fd52378dd37143f6c27769c8ab) +++ library/nx/nx.tcl (.../nx.tcl) (revision a35803ea84148ebadd79d8527830dcbdebd8873e) @@ -339,15 +339,23 @@ Class public method forward { methodName - -default -methodprefix -objframe:switch -onerror -returns -verbose:switch + -default -methodprefix -frame -onerror -returns -verbose:switch target:optional args } { - array set "" [:__resolve_method_path $methodName] + array set "" [:__resolve_method_path $methodName] set arguments [lrange [::nsf::current args] 1 end] + set nrPreArgs [expr {[llength $arguments]-[llength $args]}] + + if {[info exists frame]} { + if {$frame ne "object"} { error "value of parameter -frame must be 'object'" } + set p [lsearch -exact [lrange $arguments 0 $nrPreArgs] -frame] + # search for "-frame" in the arguments before $args and replace it + if {$p > -1} {set arguments [lreplace $arguments $p $p+1 -objframe]} + incr nrPreArgs -1 + } if {[info exists returns]} { - # search for "-returns" in the arguments before $args ... - set p [lsearch -exact [lrange $arguments 0 [expr {[llength $arguments]-[llength $args]}]] -returns] - # ... and remove it if found + # search for "-returns" in the arguments before $args and remove it + set p [lsearch -exact [lrange $arguments 0 $nrPreArgs] -returns] if {$p > -1} {set arguments [lreplace $arguments $p $p+1]} } set r [::nsf::method::forward $(object) $(methodName) {*}$arguments] @@ -529,14 +537,22 @@ :public method "object forward" { methodName - -default -methodprefix -objframe:switch -onerror -returns -verbose:switch + -default -methodprefix -frame -onerror -returns -verbose:switch target:optional args } { array set "" [:__resolve_method_path -per-object $methodName] set arguments [lrange [::nsf::current args] 1 end] + set nrPreArgs [expr {[llength $arguments]-[llength $args]}] + if {[info exists frame]} { + if {$frame ne "object"} { error "value of parameter -frame must be 'object'" } + set p [lsearch -exact [lrange $arguments 0 $nrPreArgs] -frame] + # search for "-frame" in the arguments before $args and replace it + if {$p > -1} {set arguments [lreplace $arguments $p $p+1 -objframe]} + incr nrPreArgs -1 + } if {[info exists returns]} { # search for "-returns" in the arguments before $args ... - set p [lsearch -exact [lrange $arguments 0 [expr {[llength $arguments]-[llength $args]}]] -returns] + set p [lsearch -exact [lrange $arguments 0 $nrPreArgs] -returns] # ... and remove it if found if {$p > -1} {set arguments [lreplace $arguments $p $p+1]} } @@ -546,7 +562,6 @@ if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns} return $r } - } # Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -rc8ed7bfa2eb897f6c3664ac0e7dab6e37a646916 -ra35803ea84148ebadd79d8527830dcbdebd8873e --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision c8ed7bfa2eb897f6c3664ac0e7dab6e37a646916) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision a35803ea84148ebadd79d8527830dcbdebd8873e) @@ -572,16 +572,18 @@ proc ::xotcl::info_forward_options {list} { set result [list] set i 0 - foreach w $list { - switch -glob -- $w { - -objframe {lappend result -objscope} - -* {lappend result $w} + for {set i 0} {$i < [llength $list]} {incr i} { + switch -glob -- [lindex $list $i] { + -frame { + lappend result -objscope + incr i + } + -* {lappend result [lindex $list $i]} default { lappend result {*}[lrange $list $i end] break } } - incr i } return $result } Index: tests/forward.test =================================================================== diff -u -rd83732458061deeda9e0c40d24334a010250cc40 -ra35803ea84148ebadd79d8527830dcbdebd8873e --- tests/forward.test (.../forward.test) (revision d83732458061deeda9e0c40d24334a010250cc40) +++ tests/forward.test (.../forward.test) (revision a35803ea84148ebadd79d8527830dcbdebd8873e) @@ -25,7 +25,7 @@ nx::test case inscope { nx::Class create X { :property {x 1} - :public forward Incr -objframe incr + :public forward Incr -frame object incr } X create x1 -x 100 @@ -116,7 +116,7 @@ nx::test case incr { nx::Object create obj { set :x 1 - :public object forward i1 -objframe incr x + :public object forward i1 -frame object incr x } ? {obj i1} 2 @@ -146,7 +146,7 @@ # check introspection for objects nx::Object create obj { - :public object forward i1 -objframe incr x + :public object forward i1 -frame object incr x :public object forward Mixin mixin %1 %self :public object forward foo target %proc %self %%self %%p :public object forward addOne expr 1 + @@ -156,7 +156,7 @@ ? {obj info object method definition Mixin} "::obj public object forward Mixin mixin %1 %self" ? {obj info object method definition addOne} "::obj public object forward addOne expr 1 +" ? {obj info object method definition foo} "::obj public object forward foo target %proc %self %%self %%p" - ? {obj info object method definition i1} "::obj public object forward i1 -objframe ::incr x" + ? {obj info object method definition i1} "::obj public object forward i1 -frame object ::incr x" } ########################################### @@ -179,7 +179,7 @@ nx::test case optional-target { nx::Object create obj { set :x 2 - :public object forward append -objframe + :public object forward append -frame object } ? {obj append x y z} 2yz @@ -303,11 +303,12 @@ obj public object forward foo list {%@end %::proc} ? {obj foo 1 2 3} {wrong # args: should be "::proc name args body"} - obj public object forward foo list {%@end %::self} - ? {obj foo 1 2 3} [list 1 2 3 ::obj] + # the next test does not work unless called from nxsh, which imports ::nx::self + #obj public object forward foo list {%@end %::self} + #? {obj foo 1 2 3} [list 1 2 3 ::obj] obj public object forward foo list {%@end %::nx::self} - ? {obj foo 1 2 3} [list 1 2 3 ::obj] + ? {obj foo 1 2 3} [list 1 2 3 ::obj] "fully qualified self" obj public object forward foo list {%@end %::1} ? {obj foo 1 2 3} {invalid command name "::1"} @@ -450,7 +451,7 @@ # forward to expr + callstack ########################################### nx::test case callstack { - nx::Object public forward expr -objframe + nx::Object public forward expr -frame object nx::Class create C { :method xx {} {current}