Index: generic/gentclAPI.decls =================================================================== diff -u -r261afd3f6e91b27144e6614a535518bbec6d5cde -r9474936bd01f25c80caa91f9b3164a3072457f66 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 261afd3f6e91b27144e6614a535518bbec6d5cde) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -30,7 +30,7 @@ {-argName "arg" -required 0 -type tclobj} } xotclCmd configure XOTclConfigureCmd { - {-argName "configureoption" -required 1 -type "filter|softrecreate|objectsystems"} + {-argName "configureoption" -required 1 -type "filter|softrecreate|objectsystems|keepinitcmd"} {-argName "value" -required 0 -type tclobj} } xotclCmd createobjectsystem XOTclCreateObjectSystemCmd { Index: generic/predefined.h =================================================================== diff -u -r261afd3f6e91b27144e6614a535518bbec6d5cde -r9474936bd01f25c80caa91f9b3164a3072457f66 --- generic/predefined.h (.../predefined.h) (revision 261afd3f6e91b27144e6614a535518bbec6d5cde) +++ generic/predefined.h (.../predefined.h) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -152,7 +152,9 @@ "if {![::xotcl::objectproperty ${slotParent} object]} {\n" "::xotcl2::Object create ${slotParent}}\n" "return ${slotParent}::$name}\n" -"::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch {-initblock \"\"} value default:optional} {\n" +"::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch\n" +"{-initblock \"\"}\n" +"value default:optional} {\n" "set opts [list]\n" "set colonPos [string first : $value]\n" "if {$colonPos == -1} {\n" @@ -308,7 +310,7 @@ "array set \"\" [$slot toParameterSyntax]\n" "lappend parameterdefinitions -$(oparam)}\n" "return $parameterdefinitions}\n" -"::xotcl2::Object protected method objectparameter {{lastparameter arg:initcmd,optional}} {\n" +"::xotcl2::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} {\n" "set parameterdefinitions [::xotcl::parametersFromSlots [::xotcl::current object]]\n" "if {[::xotcl::objectproperty [::xotcl::current object] class]} {\n" "lappend parameterdefinitions -parameter:method,optional}\n" Index: generic/predefined.xotcl =================================================================== diff -u -r261afd3f6e91b27144e6614a535518bbec6d5cde -r9474936bd01f25c80caa91f9b3164a3072457f66 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 261afd3f6e91b27144e6614a535518bbec6d5cde) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -302,7 +302,9 @@ return ${slotParent}::$name } - ::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch {-initblock ""} value default:optional} { + ::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch + {-initblock ""} + value default:optional} { set opts [list] set colonPos [string first : $value] if {$colonPos == -1} { @@ -548,7 +550,7 @@ if {${:methodname} ne ${:name}} { lappend objopts arg=${:methodname} lappend methodopts arg=${:methodname} - #puts stderr "..... setting arg for methodname: $slot has arg arg=${:methodname}" + #puts stderr "..... setting arg for methodname: [::xotcl::current object] has arg arg=${:methodname}" } } if {$type ne ""} { @@ -584,7 +586,7 @@ return $parameterdefinitions } - ::xotcl2::Object protected method objectparameter {{lastparameter arg:initcmd,optional}} { + ::xotcl2::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} { #puts stderr "... objectparameter [::xotcl::current object]" set parameterdefinitions [::xotcl::parametersFromSlots [::xotcl::current object]] if {[::xotcl::objectproperty [::xotcl::current object] class]} { @@ -745,7 +747,7 @@ #puts stderr "adding add method for [::xotcl::current object] with value:$(mparam)" :method add [list obj prop value:$(mparam),slot=[::xotcl::current object] {pos 0}] {next} } else { - #puts stderr "adding assign [list obj var value:$(mparam)] // for [::xotcl::current object] with $(mparam)" + #puts stderr "SV adding assign [list obj var value:$(mparam)] // for [::xotcl::current object] with $(mparam)" :method assign [list obj var value:$(mparam),slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value} #::xotcl::setter ${:domain} ${:name}:$(mparam),slot=[::xotcl::current object] #puts stderr "::xotcl::setter ${:domain} ${:name}:$(mparam),slot=[::xotcl::current object]" Index: generic/tclAPI.h =================================================================== diff -u -r533853e3ec6ac529b38d1d48e2fdb82ff7135429 -r9474936bd01f25c80caa91f9b3164a3072457f66 --- generic/tclAPI.h (.../tclAPI.h) (revision 533853e3ec6ac529b38d1d48e2fdb82ff7135429) +++ generic/tclAPI.h (.../tclAPI.h) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -57,13 +57,13 @@ static int convertToConfigureoption(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; - static CONST char *opts[] = {"filter", "softrecreate", "objectsystems", NULL}; + static CONST char *opts[] = {"filter", "softrecreate", "objectsystems", "keepinitcmd", NULL}; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "configureoption", 0, &index); *clientData = (ClientData) INT2PTR(index + 1); *outObjPtr = objPtr; return result; } -enum ConfigureoptionIdx {ConfigureoptionNULL, ConfigureoptionFilterIdx, ConfigureoptionSoftrecreateIdx, ConfigureoptionObjectsystemsIdx}; +enum ConfigureoptionIdx {ConfigureoptionNULL, ConfigureoptionFilterIdx, ConfigureoptionSoftrecreateIdx, ConfigureoptionObjectsystemsIdx, ConfigureoptionKeepinitcmdIdx}; static int convertToCurrentoption(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { Index: generic/xotcl.c =================================================================== diff -u -rd337d1f94a287b8d694b50c4b1000151de21098c -r9474936bd01f25c80caa91f9b3164a3072457f66 --- generic/xotcl.c (.../xotcl.c) (revision d337d1f94a287b8d694b50c4b1000151de21098c) +++ generic/xotcl.c (.../xotcl.c) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -6361,7 +6361,8 @@ static int ParamOptionParse(Tcl_Interp *interp, CONST char *option, int length, int disallowedOptions, XOTclParam *paramPtr) { int result = TCL_OK; - /*fprintf(stderr, "ParamOptionParse name %s, option '%s' (%d) disallowed %.6x\n", paramPtr->name, option, length, disallowedOptions);*/ + /*fprintf(stderr, "ParamOptionParse name %s, option '%s' (%d) disallowed %.6x\n", + paramPtr->name, option, length, disallowedOptions);*/ if (strncmp(option, "required", MAX(3,length)) == 0) { paramPtr->flags |= XOTCL_ARG_REQUIRED; } else if (strncmp(option, "optional", MAX(3,length)) == 0) { @@ -6385,7 +6386,7 @@ } paramPtr->flags |= XOTCL_ARG_NOARG; paramPtr->nrArgs = 0; - } else if (length >= 5 && strncmp(option, "arg=", 4) == 0) { + } else if (length >= 4 && strncmp(option, "arg=", 4) == 0) { if ((paramPtr->flags & (XOTCL_ARG_METHOD|XOTCL_ARG_RELATION)) == 0 && paramPtr->converter != convertViaCmd) return XOTclVarErrMsg(interp, @@ -6423,7 +6424,7 @@ INCR_REF_COUNT(paramPtr->slotObj); } else { int i, found = -1; - + for (i=0; stringTypeOpts[i]; i++) { /* Do not allow abbreviations, so the additional strlen checks for a full match */ @@ -6484,7 +6485,7 @@ paramPtr->flags |= XOTCL_ARG_REQUIRED; /* positional arguments are required unless we have a default */ } - /*fprintf(stderr, "... parsing '%s', name '%s' \n", ObjStr(arg), argName);*/ + /* fprintf(stderr, "... parsing '%s', name '%s' \n", ObjStr(arg), argName);*/ /* find the first ':' */ for (j=0; jconverter != convertViaCmd && - strcmp(ObjStr(paramPtr->slotObj),XOTclGlobalStrings[XOTE_METHOD_PARAMETER_SLOT_OBJ]) != 0) { + strcmp(ObjStr(paramPtr->slotObj), + XOTclGlobalStrings[XOTE_METHOD_PARAMETER_SLOT_OBJ]) != 0) { /* todo remove me */ fprintf(stderr, "**** checker method %s defined on %s shadows built-in converter\n", converterNameString, objectName(paramObj)); @@ -10662,7 +10664,7 @@ /* xotclCmd configure XOTclConfigureCmd { - {-argName "configureoption" -required 1 -type "filter|softrecreate|objectsystems"} + {-argName "configureoption" -required 1 -type "filter|softrecreate|objectsystems|keepinitcmd"} {-argName "value" -required 0 -type tclobj} } */ @@ -10703,6 +10705,13 @@ if (valueObj) RUNTIME_STATE(interp)->doSoftrecreate = bool; break; + + case ConfigureoptionKeepinitcmdIdx: + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), + (RUNTIME_STATE(interp)->doKeepinitcmd)); + if (valueObj) + RUNTIME_STATE(interp)->doKeepinitcmd = bool; + break; } return TCL_OK; } @@ -12582,6 +12591,11 @@ parseContextRelease(&pc); goto configure_exit; } + + if (paramPtr->flags & XOTCL_ARG_INITCMD && RUNTIME_STATE(interp)->doKeepinitcmd) { + Tcl_ObjSetVar2(interp, paramPtr->nameObj, NULL, newValue, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); + } + /* done with init command handling */ continue; } Index: generic/xotclInt.h =================================================================== diff -u -r533853e3ec6ac529b38d1d48e2fdb82ff7135429 -r9474936bd01f25c80caa91f9b3164a3072457f66 --- generic/xotclInt.h (.../xotclInt.h) (revision 533853e3ec6ac529b38d1d48e2fdb82ff7135429) +++ generic/xotclInt.h (.../xotclInt.h) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -657,6 +657,7 @@ int unknown; int doFilters; int doSoftrecreate; + int doKeepinitcmd; int exitHandlerDestroyRound; int returnCode; int overloadedMethods; Index: tests/parameters.xotcl =================================================================== diff -u -rb9eae4f9d548939af915f0f27141389d18172485 -r9474936bd01f25c80caa91f9b3164a3072457f66 --- tests/parameters.xotcl (.../parameters.xotcl) (revision b9eae4f9d548939af915f0f27141389d18172485) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) @@ -165,13 +165,13 @@ C create c1 ? {C eval {:objectparameter}} \ - "-object-mixin:relation,slot=::xotcl2::Class::slot::object-mixin -mixin:relation,arg=class-mixin,slot=::xotcl2::Class::slot::mixin -superclass:relation,slot=::xotcl2::Class::slot::superclass -object-filter:relation,slot=::xotcl2::Class::slot::object-filter -filter:relation,arg=class-filter,slot=::xotcl2::Class::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -parameter:method,optional -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" + "-object-mixin:relation,slot=::xotcl2::Class::slot::object-mixin -mixin:relation,arg=class-mixin,slot=::xotcl2::Class::slot::mixin -superclass:relation,slot=::xotcl2::Class::slot::superclass -object-filter:relation,slot=::xotcl2::Class::slot::object-filter -filter:relation,arg=class-filter,slot=::xotcl2::Class::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -parameter:method,optional -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" ? {c1 eval {:objectparameter}} \ - "-a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" + "-a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" } ####################################################### @@ -184,13 +184,13 @@ c1 class Object ? {c1 eval :objectparameter} \ - "-mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" + "-mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" Class create D -superclass C -parameter {d:required} D create d1 -d 100 ? {d1 eval :objectparameter} \ - "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" + "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" } ####################################################### @@ -206,28 +206,28 @@ Class create M2 -parameter {b2} D mixin M ? {d1 eval :objectparameter} \ - "-b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" \ + "-b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ "mixin added" M mixin M2 ? {d1 eval :objectparameter} \ - "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" \ + "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ "transitive mixin added" D mixin "" #we should have again the old interface ? {d1 eval :objectparameter} \ - "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" + "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" C mixin M ? {d1 eval :objectparameter} \ - "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" \ + "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ "mixin added" C mixin "" #we should have again the old interface ? {d1 eval :objectparameter} \ - "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional" + "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" } #######################################################