Index: generic/gentclAPI.decls =================================================================== diff -u -r4a478eb598eea7cc8dec70222777d114c55f1ff8 -r901ceb8f58714e31d28ed3277923fc69c085d252 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 4a478eb598eea7cc8dec70222777d114c55f1ff8) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -230,14 +230,14 @@ # # check methods # -checkMethod required XOTclCheckRequiredArgs { - {-argName "name" -required 1} - {-argName "value" -required 0 -type tclobj} -} -checkMethod boolean XOTclCheckBooleanArgs { - {-argName "name" -required 1} - {-argName "value" -required 0 -type tclobj} -} +# checkMethod required XOTclCheckRequiredArgs { +# {-argName "name" -required 1} +# {-argName "value" -required 0 -type tclobj} +# } +# checkMethod boolean XOTclCheckBooleanArgs { +# {-argName "name" -required 1} +# {-argName "value" -required 0 -type tclobj} +# } # # info object methods Index: generic/predefined.h =================================================================== diff -u -r147831f1098cb9b96a28d4d5b0f9f3ccea35b9da -r901ceb8f58714e31d28ed3277923fc69c085d252 --- generic/predefined.h (.../predefined.h) (revision 147831f1098cb9b96a28d4d5b0f9f3ccea35b9da) +++ generic/predefined.h (.../predefined.h) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -150,8 +150,6 @@ "::xotcl::relation ::xotcl::ObjectParameterSlot superclass ::xotcl::Slot\n" "::xotcl::MetaSlot create ::xotcl::MethodParameterSlot\n" "::xotcl::relation ::xotcl::MethodParameterSlot superclass ::xotcl::Slot\n" -"foreach cmd [info command ::xotcl::cmd::MethodParameterSlot::*] {\n" -"::xotcl::alias ::xotcl::MethodParameterSlot [namespace tail $cmd] $cmd}\n" "::xotcl::MethodParameterSlot create ::xotcl::methodParameterSlot\n" "proc createBootstrapAttributeSlots {class definitions} {\n" "if {![::xotcl::is ${class}::slot object]} {\n" @@ -439,7 +437,19 @@ "foreach arg $arglist {\n" "::xotcl::Attribute createFromParameterSyntax [self] {*}$arg}\n" "::xotcl::setinstvar [::xotcl::self]::slot __parameter $arglist}\n" -"proc createBootstrapAttributeSlots {} {}}\n" +"proc createBootstrapAttributeSlots {} {}\n" +"::xotcl::Slot method type=mixin {name value arg} {\n" +"if {![::xotcl::is $value mixin $arg]} {\n" +"error \"Value '$value' of $name has not mixin $arg\"}\n" +"return $value}\n" +"::xotcl::Slot method type=baseclass {name value} {\n" +"if {![::xotcl::is $value baseclass]} {\n" +"error \"Value '$value' of $name is not a baseclass\"}\n" +"return $value}\n" +"::xotcl::Slot method type=metaclass {name value} {\n" +"if {![::xotcl::is $value metaclass]} {\n" +"error \"Value '$value' of $name is not a metaclass\"}\n" +"return $value}}\n" "::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class -parameter {\n" "{withclass ::xotcl2::Object}\n" "container}\n" Index: generic/predefined.xotcl =================================================================== diff -u -r147831f1098cb9b96a28d4d5b0f9f3ccea35b9da -r901ceb8f58714e31d28ed3277923fc69c085d252 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 147831f1098cb9b96a28d4d5b0f9f3ccea35b9da) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -309,16 +309,11 @@ ::xotcl::MetaSlot create ::xotcl::ObjectParameterSlot ::xotcl::relation ::xotcl::ObjectParameterSlot superclass ::xotcl::Slot - # # create class and object for method parameter slots ::xotcl::MetaSlot create ::xotcl::MethodParameterSlot ::xotcl::relation ::xotcl::MethodParameterSlot superclass ::xotcl::Slot - foreach cmd [info command ::xotcl::cmd::MethodParameterSlot::*] { - ::xotcl::alias ::xotcl::MethodParameterSlot [namespace tail $cmd] $cmd - } - # create an object for dispatching ::xotcl::MethodParameterSlot create ::xotcl::methodParameterSlot @@ -842,15 +837,54 @@ ################################################################## # now the slots are defined; now we can defines the Objects or - # classes with parameters more easily. + # classes with parameters more easily than above. ################################################################## + + # remove helper proc proc createBootstrapAttributeSlots {} {} + + ################################################################## + # create user-level converter/checker based on ::xotcl::ls + ################################################################## + # ::xotcl::is supports predicates for objects + # + # ::xotcl::is object + # ::xotcl::is type + # ::xotcl::is class + # ::xotcl::is baseclass + # ::xotcl::is metaclass + # ::xotcl::is mixin + # + # Map these to type checkers. "object" and "class" + # are already predefined, define the rest. + + ::xotcl::Slot method type=mixin {name value arg} { + if {![::xotcl::is $value mixin $arg]} { + error "Value '$value' of $name has not mixin $arg" + } + return $value + } + ::xotcl::Slot method type=baseclass {name value} { + if {![::xotcl::is $value baseclass]} { + error "Value '$value' of $name is not a baseclass" + } + return $value + } + ::xotcl::Slot method type=metaclass {name value} { + if {![::xotcl::is $value metaclass]} { + error "Value '$value' of $name is not a metaclass" + } + return $value + } + } +################################################################## # Create a mixin class to overload method "new" such it does not # allocate new objects in ::xotcl::*, but in the specified object # (without syntactic overhead). -# +################################################################## + ::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class -parameter { {withclass ::xotcl2::Object} container @@ -864,12 +898,14 @@ eval ::xotcl::next -childof $object $args } } -# + +################################################################## # The method 'contains' changes the namespace in which objects with # realtive names are created. Therefore, 'contains' provides a # friendly notation for creating nested object structures. Optionally, # creating new objects in the specified scope can be turned off. -# +################################################################## + ::xotcl2::Object public method contains { {-withnew:boolean true} -object @@ -895,9 +931,10 @@ ::xotcl2::Class forward slots %self contains \ -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot} -# +################################################################## # copy/move implementation -# +################################################################## + ::xotcl2::Class create ::xotcl::CopyHandler -parameter { {targetList ""} {dest ""} Index: generic/tclAPI.h =================================================================== diff -u -rb8af431b779825e6d2cfa7a8b334158da1ea9370 -r901ceb8f58714e31d28ed3277923fc69c085d252 --- generic/tclAPI.h (.../tclAPI.h) (revision b8af431b779825e6d2cfa7a8b334158da1ea9370) +++ generic/tclAPI.h (.../tclAPI.h) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -123,8 +123,6 @@ "::xotcl::cmd::ParameterType", "::xotcl::cmd::Class" }; -static int XOTclCheckBooleanArgsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclCheckRequiredArgsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCAllocMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCCreateMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCDeallocMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -206,8 +204,6 @@ static int XOTclSetterCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclValuecheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclCheckBooleanArgs(Tcl_Interp *interp, char *name, Tcl_Obj *value); -static int XOTclCheckRequiredArgs(Tcl_Interp *interp, char *name, Tcl_Obj *value); static int XOTclCAllocMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name); static int XOTclCCreateMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, int objc, Tcl_Obj *CONST objv[]); static int XOTclCDeallocMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *object); @@ -290,8 +286,6 @@ static int XOTclValuecheckCmd(Tcl_Interp *interp, Tcl_Obj *param, Tcl_Obj *value); enum { - XOTclCheckBooleanArgsIdx, - XOTclCheckRequiredArgsIdx, XOTclCAllocMethodIdx, XOTclCCreateMethodIdx, XOTclCDeallocMethodIdx, @@ -376,44 +370,6 @@ static int -XOTclCheckBooleanArgsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclCheckBooleanArgsIdx].paramDefs, - method_definitions[XOTclCheckBooleanArgsIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - char *name = (char *)pc.clientData[0]; - Tcl_Obj *value = (Tcl_Obj *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclCheckBooleanArgs(interp, name, value); - - } -} - -static int -XOTclCheckRequiredArgsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclCheckRequiredArgsIdx].paramDefs, - method_definitions[XOTclCheckRequiredArgsIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - char *name = (char *)pc.clientData[0]; - Tcl_Obj *value = (Tcl_Obj *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclCheckRequiredArgs(interp, name, value); - - } -} - -static int XOTclCAllocMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); @@ -2000,14 +1956,6 @@ } static methodDefinition method_definitions[] = { -{"::xotcl::cmd::ParameterType::type=boolean", XOTclCheckBooleanArgsStub, 2, { - {"name", 1, 0, convertToString}, - {"value", 0, 0, convertToTclobj}} -}, -{"::xotcl::cmd::ParameterType::type=required", XOTclCheckRequiredArgsStub, 2, { - {"name", 1, 0, convertToString}, - {"value", 0, 0, convertToTclobj}} -}, {"::xotcl::cmd::Class::alloc", XOTclCAllocMethodStub, 1, { {"name", 1, 0, convertToTclobj}} }, Index: generic/xotcl.c =================================================================== diff -u -r0e4d8c600ce1f742ffe04041b7db56bde53c20d6 -r901ceb8f58714e31d28ed3277923fc69c085d252 --- generic/xotcl.c (.../xotcl.c) (revision 0e4d8c600ce1f742ffe04041b7db56bde53c20d6) +++ generic/xotcl.c (.../xotcl.c) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -13336,7 +13336,7 @@ * End Class Methods ***************************/ - +#if 0 /*************************** * Begin check Methods ***************************/ @@ -13372,6 +13372,7 @@ /*************************** * End check Methods ***************************/ +#endif /*************************** Index: library/lib/xotcl1.xotcl =================================================================== diff -u -r48d5751e9aeb6a4f388f6531a9248c1847b22cae -r901ceb8f58714e31d28ed3277923fc69c085d252 --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 48d5751e9aeb6a4f388f6531a9248c1847b22cae) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -97,30 +97,20 @@ return $parameterdefinitions } -# # -# # create class and object for nonpositional argument processing -# Class create ::xotcl::ParameterType -# foreach cmd [info command ::xotcl::cmd::ParameterType::*] { -# ::xotcl::alias ::xotcl::ParameterType [namespace tail $cmd] $cmd -# } -# # register type boolean as checker for "switch" -# ::xotcl::alias ::xotcl::ParameterType type=switch ::xotcl::cmd::ParameterType::type=boolean -# # create an object for dispatching -# ::xotcl::ParameterType create ::xotcl::parameterType + # + # use parameter definition from xotcl2 + # + ::xotcl::alias ::xotcl::Class parameter ::xotcl::classes::xotcl2::Class::parameter # We provide a default value for superclass (when no superclass is # specified explicitely) and metaclass, in case they should differ # from the root classes of the object system. - ::xotcl::alias ::xotcl::Class parameter ::xotcl::classes::xotcl2::Class::parameter ::xotcl::Class parameter { {__default_superclass ::xotcl::Object} {__default_metaclass ::xotcl::Class} } - #xotcl::setinstvar ::xotcl::Class __default_superclass ::xotcl::Object - #xotcl::setinstvar ::xotcl::Class __default_metaclass ::xotcl::Class - ############################################ # system slots ############################################ Index: tests/parameters.xotcl =================================================================== diff -u -r0e4d8c600ce1f742ffe04041b7db56bde53c20d6 -r901ceb8f58714e31d28ed3277923fc69c085d252 --- tests/parameters.xotcl (.../parameters.xotcl) (revision 0e4d8c600ce1f742ffe04041b7db56bde53c20d6) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision 901ceb8f58714e31d28ed3277923fc69c085d252) @@ -506,38 +506,6 @@ C create c1 -mixin M Object create o -# ::xotcl::is supports predicates for objects -# -# ::xotcl::is object -# ::xotcl::is type -# ::xotcl::is class -# ::xotcl::is baseclass -# ::xotcl::is metaclass -# ::xotcl::is mixin -# -# Map these to type checkers. "object" and "class" -# are already predefined, define the rest. -# TODO: should go finally to predefined. - -::xotcl::Slot method type=mixin {name value arg} { - if {![::xotcl::is $value mixin $arg]} { - error "Value '$value' of $name has not mixin $arg" - } - return $value -} -::xotcl::Slot method type=baseclass {name value} { - if {![::xotcl::is $value baseclass]} { - error "Value '$value' of $name is not a baseclass" - } - return $value -} -::xotcl::Slot method type=metaclass {name value} { - if {![::xotcl::is $value metaclass]} { - error "Value '$value' of $name is not a metaclass" - } - return $value -} - D method foo-base {x:baseclass} {return $x} D method foo-class {x:class} {return $x} D method foo-object {x:object} {return $x}