Index: TODO =================================================================== diff -u -r1a79d773d2d60c43bacefd3e6e87ba1ba38f46d5 -r7d7f47ce5d7b7c2d252af5d4499b50996f6475ff --- TODO (.../TODO) (revision 1a79d773d2d60c43bacefd3e6e87ba1ba38f46d5) +++ TODO (.../TODO) (revision 7d7f47ce5d7b7c2d252af5d4499b50996f6475ff) @@ -1017,7 +1017,7 @@ - TODO: info methods shows finally "slots" and "slot". Wanted? Actually no. - removed definition of slots from nx, changed regression tests - examples to to ::attribute instead of -slots + examples from slots to ::attribute - replaced several occurrences of "eval" in nx.tcl and xotcl2.tcl @@ -1560,13 +1560,64 @@ - added NSF_CSC_CALL_IS_TRANSPARENT to handle proc aliases transparently - access self in NsfProcAliasMethod() from tcl->object; +- added public|protected to output of "info method definition" + (needed to make serializer more sane, neccessary on the longer range) +- reduce size of output of serializer +- make nx::Object.serialize public +- XOTcl 2: allow info slots for objects as well + +- serializer: + * added support for ordering on aliases referencing other objects/classes + * provide shared version of the method warn via alias + and removed direct output to stderr + +- slots: + * change name "initcmd" of "experimental slot features" to + "defaultcmd" to avoid naming conflict the the initcmd executed + at the initilization of a slot object (effects XOTcl as well) + * make defaultcmd/valuecmd/valuechangedcmd working for nx + (absence of trace method) + * provide error message, when default/defaultcmd/valuecmd are used + non-exclusively + * make sure to init per-object slots after copy operations + * make nx::Attribute.destroy more definsive + * extend test cases + +- nsf: added flag NSF_DESTROY_CALLED_SUCCESS in addition + to NSF_DESTROY_CALLED to distinguish between attempted + and successful destroy method invocations (important for + cleanup) + TODO: +- handing of xo::at_cleanup in serializer + (either generailization or move to OpenACS/aolserver init/naviserver init) +- cleanup of xotcl-aol +- method-modifiers/attribute-method.002: incorrect result for 'set _ {}' + expected: '::C::A', got '' + in test file ./tests/method-modifiers.tcl + ... => + FinalObjectDeletion obj 0x100915610 activationcount 2 + Assertion failed: (object->activationCount == 0), function FinalObjectDeletion, + file ./generic/nsf.c, line 15788. + +- use term "callprotection" in documentation for public|protected + (to be consistent with info command) + +get definition of ::nsf::methods::object::instvar +should never happen, maybe someone deleted the alias (null) for object ::xo::Attribute +procPtr 0x102ecd1c1 NsfObjDispatch 0x102ebe556 name instvar +alias instvar // ::xo::Attribute public alias instvar ::nsf::methods::object::instvar // + + - extend coro regression test - subcmd * handle subcmd for other method factories * handle absence of -create flag in resolve_method_path (for introspection) + * provide full support in serializer +- serializer: + keep track of defaultMethodProtection - interfaces in documentation for slots (see for more details ::nx::Class#superclass in nx.tcl). Index: doc/next-migration.html =================================================================== diff -u -re2f11549ef70518cca8c9c49b1d78f4383b00a87 -r7d7f47ce5d7b7c2d252af5d4499b50996f6475ff --- doc/next-migration.html (.../next-migration.html) (revision e2f11549ef70518cca8c9c49b1d78f4383b00a87) +++ doc/next-migration.html (.../next-migration.html) (revision 7d7f47ce5d7b7c2d252af5d4499b50996f6475ff) @@ -109,12 +109,12 @@ set :things "" } - :method push {thing} { + :public method push {thing} { set :things [linsert ${:things} 0 $thing] return $thing } - :method pop {} { + :public method pop {} { set top [lindex ${:things} 0] set :things [lrange ${:things} 1 end] return $top @@ -182,7 +182,7 @@ # Define a class using Next Class create C2 { - :method foo {} {puts "hello world"} + :public method foo {} {puts "hello world"} } } @@ -1421,7 +1421,10 @@

Slots

All slot objects (also those in XOTcl) are now always -next-scripting objects of baseclass ::nx::Slot

+next-scripting objects of baseclass ::nx::Slot. +The name of the experimental default-setter initcmd was +changed to defaultcmd. +

Obsolete commands

@@ -1446,6 +1449,6 @@
- Last modified: Sun Sep 26 14:16:38 CEST 2010 + Last modified: Fri Oct 1 11:58:31 CEST 2010 Index: library/nx/nx.tcl =================================================================== diff -u -r51725aa434e18e9e3ce656897011c4f40c98d8dd -r7d7f47ce5d7b7c2d252af5d4499b50996f6475ff --- library/nx/nx.tcl (.../nx.tcl) (revision 51725aa434e18e9e3ce656897011c4f40c98d8dd) +++ library/nx/nx.tcl (.../nx.tcl) (revision 7d7f47ce5d7b7c2d252af5d4499b50996f6475ff) @@ -713,7 +713,7 @@ } # maybe add the following slots at some later time here - # initcmd + # defaultcmd # valuecmd # valuechangedcmd @@ -750,7 +750,8 @@ } ObjectParameterSlot public method destroy {} { - if {${:domain} ne "" && [::nsf::is class ${:domain}]} { + #puts stderr DESTROY-[info exists :domain] + if {[info exists :domain] && ${:domain} ne "" && [::nsf::is class ${:domain}]} { ::nsf::invalidateobjectparameter ${:domain} } ::nsf::next @@ -1060,6 +1061,7 @@ incremental initcmd valuecmd + defaultcmd valuechangedcmd arg allowempty @@ -1068,7 +1070,8 @@ Attribute method __default_from_cmd {obj cmd var sub op} { #puts "GETVAR [::nsf::current method] obj=$obj cmd=$cmd, var=$var, op=$op" - $obj trace remove variable $var $op [list [::nsf::current object] [::nsf::current method] $obj $cmd] + ::nsf::dispatch $obj -objscope \ + ::trace remove variable $var $op [list [::nsf::current object] [::nsf::current method] $obj $cmd] ::nsf::setvar $obj $var [$obj eval $cmd] } Attribute method __value_from_cmd {obj cmd var sub op} { @@ -1081,25 +1084,33 @@ eval $cmd } Attribute protected method init {} { - ::nsf::next ;# do first ordinary slot initialization - # there might be already default values registered on the class + # Do first ordinary slot initialization + ::nsf::next set __initcmd "" + set trace {::nsf::dispatch [::nsf::current object] -objscope ::trace} + # There might be already default values registered on the + # class. If so, defaultcmd is ignored. if {[info exists :default]} { - } elseif [info exists :initcmd] { - append __initcmd ":trace add variable [list ${:name}] read \ - \[list [::nsf::current object] __default_from_cmd \[::nsf::current object\] [list [set :initcmd]]\]\n" + if {[info exists :defaultcmd]} {error "defaultcmd can't be used together with default value"} + if {[info exists :valuecmd]} {error "valuecmd can't be used together with default value"} + } elseif [info exists :defaultcmd] { + if {[info exists :valuecmd]} {error "valuecmd can't be used together with defaultcmd"} + append __initcmd "$trace add variable [list ${:name}] read \ + \[list [::nsf::current object] __default_from_cmd \[::nsf::current object\] [list [set :defaultcmd]]\]\n" } elseif [info exists :valuecmd] { - append __initcmd ":trace add variable [list ${:name}] read \ + append __initcmd "$trace add variable [list ${:name}] read \ \[list [::nsf::current object] __value_from_cmd \[::nsf::current object\] [list [set :valuecmd]]\]" } + if {[info exists :valuechangedcmd]} { + append __initcmd "$trace add variable [list ${:name}] write \ + \[list [::nsf::current object] __value_changed_cmd \[::nsf::current object\] [list [set :valuechangedcmd]]\]" + } + array set "" [:toParameterSyntax ${:name}] - #puts stderr "Attribute.init valueParam for [::nsf::current object] is $(mparam)" if {$(mparam) ne ""} { if {[info exists :multivalued] && ${:multivalued}} { - #puts stderr "adding assign [list obj var value:$(mparam),multivalued] // for [::nsf::current object] with $(mparam)" - - # set variable body to minimize problems with spacing, since + # set variable "body" to minimize problems with spacing, since # the body is literally compared by the slot optimizer. set body {::nsf::setvar $obj $var $value} :public method assign [list obj var value:$(mparam),multivalued,slot=[::nsf::current object]] \ @@ -1110,16 +1121,14 @@ ::nsf::next } } else { - #puts stderr "SV adding assign [list obj var value:$(mparam)] // for [::nsf::current object] with $(mparam)" set body {::nsf::setvar $obj $var $value} :public method assign [list obj var value:$(mparam),slot=[::nsf::current object]] $body } } - if {[info exists :valuechangedcmd]} { - append __initcmd ":trace add variable [list ${:name}] write \ - \[list [::nsf::current object] __value_changed_cmd \[::nsf::current object\] [list [set :valuechangedcmd]]\]" - } if {$__initcmd ne ""} { + if {${:per-object}} { + ${:domain} eval $__initcmd + } set :initcmd $__initcmd } } @@ -1134,7 +1143,6 @@ :public method optimize {} { #puts stderr OPTIMIZER-[info exists :incremental] if {![info exists :methodname]} {return} - set object [expr {${:per-object} ? {object} : {}}] if {${:per-object}} { set perObject -per-object set infokind object @@ -1412,15 +1420,14 @@ } #puts stderr "=====" } - # alter 'domain' and 'manager' in slot objects for classes + # alter 'domain' and 'manager' in slot objects foreach origin [set :targetList] { - if {[::nsf::is class $origin]} { - set dest [:getDest $origin] - foreach oldslot [$origin info slots] { - set newslot [::nx::slotObj $dest [namespace tail $oldslot]] - if {[$oldslot domain] eq $origin} {$newslot domain $cl} - if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot} - } + set dest [:getDest $origin] + foreach oldslot [$origin info slots] { + set newslot [::nx::slotObj $dest [namespace tail $oldslot]] + if {[$oldslot domain] eq $origin} {$newslot domain $dest} + if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot} + $newslot eval :init } } } Index: library/xotcl/tests/slottest.xotcl =================================================================== diff -u -r6e4c477c4fbc7e7c256d0325763546524ee1c676 -r7d7f47ce5d7b7c2d252af5d4499b50996f6475ff --- library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 6e4c477c4fbc7e7c256d0325763546524ee1c676) +++ library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 7d7f47ce5d7b7c2d252af5d4499b50996f6475ff) @@ -10,15 +10,15 @@ # - slots for objects and classes (slot parameter 'per-object' true|false, # when to used on a class object) # - works for mixins/filters/class/superclass (e.g ... superclass add ::M) -# - initcmd and valuecmd -# initcmd: is executed when the instance variable is read the first time +# - defaultcmd and valuecmd +# defaultcmd: is executed when the instance variable is read the first time # valuecmd: is executed whenever the instance variable is read # (implemented via trace; alternate approach for similar behavior # is to define per-object procs for get/assign, see e.g. slots for # class and superclass; slots require methods to be invoked, # not var references; # otoh, trace are somewhat more fragile and harder to debug) -# default, initcmd and valuecmd are to be used mutually exclusively +# default, defaultcmd and valuecmd are to be used mutually exclusively # - valuechangedcmd: executed after the change of an instance variable, # can be used e.g. for validation # @@ -27,19 +27,14 @@ package require nx::serializer ####################################################### -# testing __initcmds set ::hu 0 proc T1 {var sub op} {c1 set $var t1} proc T2 {var sub op} {c1 set $var t2} -#Class C -array set __initcmds { -# x {set x 1} -# y {incr ::hu} -# z {my trace add variable z read T1}} Class C -slots { - Attribute create x -initcmd {set x 1} - Attribute create y -initcmd {incr ::hu} - Attribute create z -initcmd {my trace add variable z read T1} + Attribute create x -defaultcmd {set x 1} + Attribute create y -defaultcmd {incr ::hu} + Attribute create z -defaultcmd {my trace add variable z read T1} } C create c1 @@ -52,8 +47,8 @@ ? {set ::hu} 1 Class D -slots { - Attribute create x -initcmd {set x 2} - Attribute create z -initcmd {my trace add variable z read T2} + Attribute create x -defaultcmd {set x 2} + Attribute create z -defaultcmd {my trace add variable z read T2} } -superclass C D create c1 ? {c1 set x} 2 @@ -427,12 +422,12 @@ ####################################################### -# initcmd via slots +# defaultcmd via slots ####################################################### -Test case initcmd +Test case defaultcmd set ::hu 0 Class C -slots { - Attribute create x -initcmd {incr ::hu; set x 101} + Attribute create x -defaultcmd {incr ::hu; set x 101} } C c1 ? {c1 info vars} "" @@ -513,9 +508,11 @@ ? {llength [[lindex [lsort [$x info children]] 1] info children]} 3 ? {llength [[lindex [lsort [$x info children]] 2] info children]} 0 +# +# test case (bug) posted by Neil Hampton +# - -Class Fred -slots { Attribute create a -initcmd { set _ 4 } } +Class Fred -slots { Attribute create a -defaultcmd { set _ 4 } } ? {Fred x} ::x ? {x a 4} 4 x move y @@ -601,7 +598,7 @@ Slot create Project::fullbudget \ - -initcmd {$obj set __x 100} \ + -defaultcmd {$obj set __x 100} \ -valuechangedcmd { puts "budget is now [$obj set fullbudget]" $obj set __x [$obj set fullbudget] Index: tests/parameters.tcl =================================================================== diff -u -r51725aa434e18e9e3ce656897011c4f40c98d8dd -r7d7f47ce5d7b7c2d252af5d4499b50996f6475ff --- tests/parameters.tcl (.../parameters.tcl) (revision 51725aa434e18e9e3ce656897011c4f40c98d8dd) +++ tests/parameters.tcl (.../parameters.tcl) (revision 7d7f47ce5d7b7c2d252af5d4499b50996f6475ff) @@ -230,7 +230,7 @@ # # ::nx::Attribute -superclass ::xotcl::Slot { # {value_check once} -# initcmd +# defaultcmd # valuecmd # valuechangedcmd # arg @@ -1152,6 +1152,48 @@ ? {f1 metaclassarg ::Foo} {expected metaclass but got "::Foo" for parameter x} } +Test case slot-traces { + ::nx::Object create o { + :attribute a {set :defaultcmd { puts ...init; set _ 4 } } + :attribute b {set :valuecmd { puts ...get-value; set _ 44 } } + :attribute c {set :valuechangedcmd { puts ...changed; ::nsf::setvar $obj $var 999 }} + } + + ? {o a} 4 + ? {o b} 44 + ? {o c 5} 999 + + o copy o2 + + ? {o a} 4 + ? {o b} 44 + ? {o c 5} 999 + + ::nx::Class create C { + :attribute a {set :defaultcmd { puts ...init; set _ 4 } } + :attribute b {set :valuecmd { puts ...get-value; set _ 44 } } + :attribute c {set :valuechangedcmd { ::nsf::setvar $obj $var 999 }} + :create c1 + } + + ? {c1 a} 4 + ? {c1 b} 44 + ? {c1 c 5} 999 + + c1 copy c2 + + ? {c2 a} 4 + ? {c2 b} 44 + ? {c2 c 5} 999 + + C copy D + D create d1 + + ? {d1 a} 4 + ? {d1 b} 44 + ? {d1 c 5} 999 +} + ::nsf::configure checkarguments off Test case check-arguments-nocheck {