Index: TODO =================================================================== diff -u -rb8c0176cfeae7f18490e9d6887ece97b713f0fe0 -r50b5699927f9d34e2ab7a14e29ccf8dc1f569095 --- TODO (.../TODO) (revision b8c0176cfeae7f18490e9d6887ece97b713f0fe0) +++ TODO (.../TODO) (revision 50b5699927f9d34e2ab7a14e29ccf8dc1f569095) @@ -3316,6 +3316,11 @@ are used to refer to methods in the current mixin order. * extended regression test +- nx.tcl: + * made "/cls/ class ..." using ensemble methods and therefore extensible. + * This introduces some definition order dependencies in nx.tcl and + some redundancy ("class filter" and "class mixin"), but maybe + this can be eliminated. TODO: - nx: Index: library/nx/nx.tcl =================================================================== diff -u -rca508a05de8e3783d432b8de2db2ae3e61ae271e -r50b5699927f9d34e2ab7a14e29ccf8dc1f569095 --- library/nx/nx.tcl (.../nx.tcl) (revision ca508a05de8e3783d432b8de2db2ae3e61ae271e) +++ library/nx/nx.tcl (.../nx.tcl) (revision 50b5699927f9d34e2ab7a14e29ccf8dc1f569095) @@ -215,51 +215,11 @@ } ###################################################################### - # Define method modifiers "class", and class level "unknown" + # Define method "unknown" ###################################################################### Class eval { - # method-modifier for object specific methos - :method class {what args} { - if {$what in [list "alias" "property" "forward" "method" "variable"]} { - return [::nsf::object::dispatch [::nsf::self] ::nsf::classes::nx::Object::$what {*}$args] - } - if {$what in [list "info"]} { - return [::nsf::object::dispatch [::nsf::self] ::nx::Object::slot::__info \ - [lindex $args 0] {*}[lrange $args 1 end]] - } - if {$what in [list "filter" "mixin"]} { - # - # It would be much easier, to do a - # - # return [:object-$what {*}$args] - # - # here. However, since we removed "object-mixin" and friends - # from the registered methods, we have to emulate the work of - # the forwarder. - # - switch [llength $args] { - 0 {return [::nsf::relation [::nsf::self] object-$what]} - 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]} - default {return [::nx::Object::slot::$what [lindex $args 0] \ - [::nsf::self] object-$what \ - {*}[lrange $args 1 end]] - } - } - } - - if {$what in [list "filterguard" "mixinguard"]} { - return [::nsf::object::dispatch [::nsf::self] ::nsf::methods::object::$what {*}$args] - } - - if {$what eq "delete"} { - return [::nsf::object::dispatch [::nsf::self] \ - ::nx::Object::slot::__delete::[lindex $args 0] {*}[lrange $args 1 end]] - } - - error "'$what' not allowed to be modified by 'class'" - } # define unknown handler for class :method unknown {m args} { error "Method '$m' unknown for [::nsf::self].\ @@ -360,7 +320,7 @@ } ###################################################################### - # Provde method "alias" + # Provide method "alias" # # -frame object|method make only sense for c-defined cmds, ###################################################################### @@ -574,6 +534,15 @@ array set "" [:__resolve_method_path $name] ::nsf::method::delete $(object) $(methodName) } + + # + # provide aliases for "class delete" + # + ::nx::Class eval { + :alias "class delete property" ::nx::Object::slot::__delete::property + :alias "class delete variable" ::nx::Object::slot::__delete::variable + :alias "class delete method" ::nx::Object::slot::__delete::method + } ###################################################################### # Info definition @@ -763,7 +732,44 @@ # } # } + # + # Provide basic "class ...." functionality. The aliases require the + # RHS to be defined. + # + ::nx::Class eval { + + :alias "class alias" ::nsf::classes::nx::Object::alias + :alias "class forward" ::nsf::classes::nx::Object::forward + :alias "class method" ::nsf::classes::nx::Object::method + :alias "class info" ::nx::Object::slot::__info + + :method "class filter" args { + set what filter + switch [llength $args] { + 0 {return [::nsf::relation [::nsf::self] object-$what]} + 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]} + default {return [::nx::Object::slot::$what [lindex $args 0] \ + [::nsf::self] object-$what \ + {*}[lrange $args 1 end]] + } + } + } + :method "class mixin" args { + set what mixin + switch [llength $args] { + 0 {return [::nsf::relation [::nsf::self] object-$what]} + 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]} + default {return [::nx::Object::slot::$what [lindex $args 0] \ + [::nsf::self] object-$what \ + {*}[lrange $args 1 end]] + } + } + } + :alias "class filterguard" ::nsf::methods::object::filterguard + :alias "class mixinguard" ::nsf::methods::object::mixinguard + } + ###################################################################### # MetaSlot definitions # @@ -1792,7 +1798,15 @@ return $r } + # + # provide aliases for "class property" and "class variable" + # + ::nx::Class eval { + :alias "class property" ::nsf::classes::nx::Object::property + :alias "class variable" ::nsf::classes::nx::Object::variable + } + ###################################################################### # Define method "attributes" for convenience to define multiple # attributes based on a list of parameter specifications. @@ -1813,6 +1827,7 @@ # } # return "" # } + ###################################################################### # Minimal definition of a value checker that permits every value Index: tests/methods.test =================================================================== diff -u -ra467cf37f204cc977b7af7519a0994c65f9ed10f -r50b5699927f9d34e2ab7a14e29ccf8dc1f569095 --- tests/methods.test (.../methods.test) (revision a467cf37f204cc977b7af7519a0994c65f9ed10f) +++ tests/methods.test (.../methods.test) (revision 50b5699927f9d34e2ab7a14e29ccf8dc1f569095) @@ -397,8 +397,9 @@ "'object' is not a method defining method" ? {C object method bar {x} {return $x}} \ {Method 'object' unknown for ::C. Consider '::C create object method bar x {return $x}' instead of '::C object method bar x {return $x}'} + #? {C public class object method bar {x} {return $x}} "'object' not allowed to be modified by 'class'" ? {C public class object method bar {x} {return $x}} \ - "'object' not allowed to be modified by 'class'" + {Unable to dispatch sub-method "object" of ::C class; valid are: class alias, class delete method, class delete property, class delete variable, class filter, class filterguard, class forward, class info children, class info class, class info filter guard, class info filter methods, class info has mixin, class info has namespace, class info has type, class info info, class info is, class info lookup filter, class info lookup method, class info lookup methods, class info lookup slots, class info method, class info methods, class info mixin classes, class info mixin guard, class info parent, class info precedence, class info properties, class info slot definition, class info slot name, class info slot objects, class info vars, class method, class mixin, class mixinguard, class property, class variable} } #