Index: generic/gentclAPI.decls =================================================================== diff -u -r558ed9bfabea39f0688b9abe854f6eb7db9f0167 -rdfcec445642ff230e91b3b087322ca02a2cdcceb --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 558ed9bfabea39f0688b9abe854f6eb7db9f0167) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision dfcec445642ff230e91b3b087322ca02a2cdcceb) @@ -162,11 +162,6 @@ objectMethod procsearch XOTclOProcSearchMethod { {-argName "name" -required 1} } -# "set" needed? -#objectMethod set XOTclOSetMethod { -# {-argName "var" -required 1 -type tclobj} -# {-argName "value" -type tclobj} -#} objectMethod requireNamespace XOTclORequireNamespaceMethod { } objectMethod residualargs XOTclOResidualargsMethod { Index: generic/predefined.h =================================================================== diff -u -r044952af84b087821f5bd68570b84b8e3e000851 -rdfcec445642ff230e91b3b087322ca02a2cdcceb --- generic/predefined.h (.../predefined.h) (revision 044952af84b087821f5bd68570b84b8e3e000851) +++ generic/predefined.h (.../predefined.h) (revision dfcec445642ff230e91b3b087322ca02a2cdcceb) @@ -390,13 +390,13 @@ "unset required}\n" "if {$l == 1} {\n" "eval $cmd} elseif {$l == 2} {\n" -"lappend cmd [list -default [lindex $arg 1]]\n" +"lappend cmd -default [lindex $arg 1]\n" "eval $cmd} elseif {$l == 3 && [lindex $arg 1] eq \"-default\"} {\n" -"lappend cmd [list -default [lindex $arg 2]]\n" +"lappend cmd -default [lindex $arg 2]\n" "eval $cmd} else {\n" "set paramstring [string range $arg [expr {[string length $name]+1}] end]\n" "if {[string match {[$\\[]*} $paramstring]} {\n" -"lappend cmd [list -default $paramstring]\n" +"lappend cmd -default $paramstring\n" "eval $cmd\n" "continue}\n" "set po ::xotcl::Class::Parameter\n" Index: generic/predefined.xotcl =================================================================== diff -u -r7a163ed30233e4e7fd241a91879777a918034e96 -rdfcec445642ff230e91b3b087322ca02a2cdcceb --- generic/predefined.xotcl (.../predefined.xotcl) (revision 7a163ed30233e4e7fd241a91879777a918034e96) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision dfcec445642ff230e91b3b087322ca02a2cdcceb) @@ -767,17 +767,16 @@ eval $cmd #puts stderr "parameter $arg without default -> $cmd" } elseif {$l == 2} { - lappend cmd [list -default [lindex $arg 1]] + lappend cmd -default [lindex $arg 1] #puts stderr "parameter $arg with default -> $cmd" eval $cmd } elseif {$l == 3 && [lindex $arg 1] eq "-default"} { - lappend cmd [list -default [lindex $arg 2]] + lappend cmd -default [lindex $arg 2] eval $cmd } else { set paramstring [string range $arg [expr {[string length $name]+1}] end] - #puts stderr "remaining arg = '$paramstring'" if {[string match {[$\[]*} $paramstring]} { - lappend cmd [list -default $paramstring] + lappend cmd -default $paramstring eval $cmd continue } @@ -875,7 +874,7 @@ {dest ""} objLength } - + # targets are all namspaces and objs part-of the copied obj ::xotcl::Object::CopyHandler method makeTargetList t { ::xotcl::my lappend targetList $t Index: generic/xotcl.c =================================================================== diff -u -r558ed9bfabea39f0688b9abe854f6eb7db9f0167 -rdfcec445642ff230e91b3b087322ca02a2cdcceb --- generic/xotcl.c (.../xotcl.c) (revision 558ed9bfabea39f0688b9abe854f6eb7db9f0167) +++ generic/xotcl.c (.../xotcl.c) (revision dfcec445642ff230e91b3b087322ca02a2cdcceb) @@ -8875,7 +8875,7 @@ typedef enum {NO_DASH, SKALAR_DASH, LIST_DASH} dashArgType; static dashArgType -isDashArg(Tcl_Interp *interp, Tcl_Obj *obj, char **methodName, int *objc, Tcl_Obj **objv[]) { +isDashArg(Tcl_Interp *interp, Tcl_Obj *obj, int firstArg, char **methodName, int *objc, Tcl_Obj **objv[]) { char *flag; static Tcl_ObjType CONST86 *listType = NULL; @@ -8898,15 +8898,27 @@ if (Tcl_ListObjGetElements(interp, obj, objc, objv) == TCL_OK && *objc>1) { flag = ObjStr(*objv[0]); /*fprintf(stderr, "we have a list starting with '%s'\n", flag);*/ - if (*flag == '-') { + if (*flag == '-' || *flag == '.') { *methodName = flag+1; return LIST_DASH; } } } flag = ObjStr(obj); /*fprintf(stderr, "we have a scalar '%s'\n", flag);*/ - if (*flag == '-' && isalpha((int)*((flag)+1))) { + if ((*flag == '-' || *flag == '.') && isalpha(*((flag)+1))) { + if (firstArg) { + /* if the argument contains a space, try to split */ + char *p= flag+1; + while (*p && *p != ' ') p++; + if (*p == ' ') { + if (Tcl_ListObjGetElements(interp, obj, objc, objv) == TCL_OK) { + *methodName = ObjStr(*objv[0]); + if (**methodName == '-') {(*methodName)++ ;} + return LIST_DASH; + } + } + } *methodName = flag+1; *objc = 1; return SKALAR_DASH; @@ -8915,16 +8927,17 @@ } static int -callConfigureMethod(Tcl_Interp *interp, XOTclObject *obj, - char *methodName, int argc, Tcl_Obj *CONST argv[]) { +callConfigureMethod(Tcl_Interp *interp, XOTclObject *obj, char *methodName, + int argc, Tcl_Obj *CONST argv[]) { int result; Tcl_Obj *method = Tcl_NewStringObj(methodName,-1); - - /*fprintf(stderr, "callConfigureMethod method %s->'%s' argc %d\n", - objectName(obj), methodName, argc);*/ - - if (isInitString(methodName)) + + /* fprintf(stderr, "callConfigureMethod method %s->'%s' level %d, argc %d\n", + objectName(obj), methodName, level, argc);*/ + + if (isInitString(methodName)) { obj->flags |= XOTCL_INIT_CALLED; + } Tcl_ResetResult(interp); INCR_REF_COUNT(method); @@ -10192,6 +10205,7 @@ return XOTclVarErrMsg(interp, "Cannot resolve 'self', probably called outside the context of an XOTcl Object", (char *) NULL); } + /*fprintf(stderr, "dispatch %s on %s\n",ObjStr(nobjv[0]), objectName(self));*/ return DoDispatch(self, interp, nobjc, nobjv, XOTCL_CM_NO_SHIFT); } @@ -11215,13 +11229,40 @@ static int XOTclOResidualargsMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]) { Tcl_Obj **argv, **nextArgv, *resultObj; - int i, argc, nextArgc, normalArgs, result = TCL_OK, isdasharg = NO_DASH; + int i, start = 1, argc, nextArgc, normalArgs, result = TCL_OK, isdasharg = NO_DASH; char *methodName, *nextMethodName; + /* if we got a single argument, try to split it (unless it starts + * with our magic chars) to distinguish between + * Object create foo {.method foo {} {...}} + * and + * Object create foo { + * {.method foo {} {...}} + * } + */ + if (objc == 2) { + Tcl_Obj **ov; + char *word = ObjStr(objv[1]); + if (*word != '.' && *word != '-') { + char *p = word; + while (*p && *p != ' ') p++; + if (*p) { + fprintf(stderr, "split %s\n",word); + if (Tcl_ListObjGetElements(interp, objv[1], &objc, &ov) == TCL_OK) { + objv = (Tcl_Obj *CONST*)ov; + start = 0; + } else { + return TCL_ERROR; + } + } + } + } + /* find arguments without leading dash */ - for (i=1; i < objc; i++) { - if ((isdasharg = isDashArg(interp, objv[i], &methodName, &argc, &argv))) + for (i=start; i < objc; i++) { + if ((isdasharg = isDashArg(interp, objv[i], 1, &methodName, &argc, &argv))) { break; + } } normalArgs = i-1; @@ -11231,8 +11272,9 @@ case SKALAR_DASH: /* Argument is a skalar with a leading dash */ { int j; for (j = i+1; j < objc; j++, argc++) { - if ((isdasharg = isDashArg(interp, objv[j], &nextMethodName, &nextArgc, &nextArgv))) + if ((isdasharg = isDashArg(interp, objv[j], j==i+1, &nextMethodName, &nextArgc, &nextArgv))) { break; + } } result = callConfigureMethod(interp, obj, methodName, argc+1, objv+i+1); if (result != TCL_OK) { @@ -11243,11 +11285,13 @@ } case LIST_DASH: /* Argument is a list with a leading dash, grouping determined by list */ { i++; - if (icallerVarPtr; + if (!framePtr) { + framePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); + } + } } savedVarFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); Index: generic/xotclStack85.c =================================================================== diff -u -r044952af84b087821f5bd68570b84b8e3e000851 -rdfcec445642ff230e91b3b087322ca02a2cdcceb --- generic/xotclStack85.c (.../xotclStack85.c) (revision 044952af84b087821f5bd68570b84b8e3e000851) +++ generic/xotclStack85.c (.../xotclStack85.c) (revision dfcec445642ff230e91b3b087322ca02a2cdcceb) @@ -2,7 +2,7 @@ #if defined(TCL85STACK) -static void tcl85showStack(Tcl_Interp *interp) { +void tcl85showStack(Tcl_Interp *interp) { Tcl_CallFrame *framePtr; fprintf(stderr, "tcl85showStack framePtr %p varFramePtr %p\n", Tcl_Interp_framePtr(interp), Tcl_Interp_varFramePtr(interp));