Index: ChangeLog =================================================================== diff -u -raeac917db741ab7500d7e976443ac551f191efcd -rd627242b910f2ec0c4a7520089d7ac5f8a9c2395 --- ChangeLog (.../ChangeLog) (revision aeac917db741ab7500d7e976443ac551f191efcd) +++ ChangeLog (.../ChangeLog) (revision d627242b910f2ec0c4a7520089d7ac5f8a9c2395) @@ -1,3 +1,10 @@ +2008-05-28 + * make "info (inst)?forward -definition name" more robust (provide an + error message, if is nog given + * New info subcommands "info parametercmd" + and "info instparametercmd" + * export *parametercmds in Serializer, use "-noinit" on slots as well + 2008-05-26 * fixed bug in info instdefault, when argument is an empty string. Example: Index: generic/xotcl.c =================================================================== diff -u -raeac917db741ab7500d7e976443ac551f191efcd -rd627242b910f2ec0c4a7520089d7ac5f8a9c2395 --- generic/xotcl.c (.../xotcl.c) (revision aeac917db741ab7500d7e976443ac551f191efcd) +++ generic/xotcl.c (.../xotcl.c) (revision d627242b910f2ec0c4a7520089d7ac5f8a9c2395) @@ -6149,7 +6149,7 @@ static int ListMethodKeys(Tcl_Interp *interp, Tcl_HashTable *table, char *pattern, - int noProcs, int noCmds, int noDups, int onlyForwarder) { + int noProcs, int noCmds, int noDups, int onlyForwarder, int onlySetter) { Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0; for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { @@ -6161,6 +6161,7 @@ if (noCmds && proc != RUNTIME_STATE(interp)->objInterpProc) continue; if (noProcs && proc == RUNTIME_STATE(interp)->objInterpProc) continue; if (onlyForwarder && proc != XOTclForwardMethod) continue; + if (onlySetter && proc != XOTclSetterMethod) continue; /* XOTclObjscopedMethod ??? */ if (noDups) { int listc, i; @@ -6191,7 +6192,7 @@ int definition) { int rc; if (definition) { - Tcl_HashEntry *hPtr = table ? Tcl_FindHashEntry(table, pattern) : 0; + Tcl_HashEntry *hPtr = table && pattern ? Tcl_FindHashEntry(table, pattern) : 0; if (hPtr) { Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr); ClientData cd = cmd? Tcl_Command_objClientData(cmd) : NULL; @@ -6227,7 +6228,7 @@ } rc = TCL_OK; } else { - rc = ListMethodKeys(interp, table, pattern, 1, 0, 0, 1); + rc = ListMethodKeys(interp, table, pattern, 1, 0, 0, 1, 0); } return rc; } @@ -6238,7 +6239,7 @@ XOTclClasses *pl; if (obj->nsPtr) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(obj->nsPtr); - ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, 0, 0); + ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, 0, 0, 0); } if (!noMixins) { @@ -6258,7 +6259,7 @@ } if (mixin && guardOk == TCL_OK) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(mixin->nsPtr); - ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, 1, 0); + ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, 1, 0, 0); } ml = ml->next; } @@ -6268,7 +6269,7 @@ /* append per-class filters */ for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->next) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(pl->cl->nsPtr); - ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, 1, 0); + ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, 1, 0, 0); } return TCL_OK; } @@ -8425,10 +8426,14 @@ return XOTclObjErrArgCnt(interp, obj->cmdName, "info forward ?-definition? ?name?"); definition = checkForModifier(objv, modifiers, "-definition"); - if (nsp) - return forwardList(interp, Tcl_Namespace_cmdTable(nsp), pattern, definition); - else + if (definition && argc < 3) + return XOTclObjErrArgCnt(interp, obj->cmdName, + "info forward ?-definition? ?name?"); + if (nsp) { + return forwardList(interp, Tcl_Namespace_cmdTable(nsp), pattern, definition); + } else { return TCL_OK; + } } break; @@ -8534,7 +8539,8 @@ return XOTclObjErrArgCnt(interp, obj->cmdName, "info procs ?pat?"); if (nsp) return ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern, - /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0 ); + /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, + /* onlyForward */0, /* onlySetter */ 0 ); else return TCL_OK; } else if (!strcmp(cmd, "parent")) { @@ -8561,8 +8567,20 @@ return TCL_OK; } else if (!strcmp(cmd, "precedence")) { return ListPrecedence(interp, obj, pattern); + } else if (!strcmp(cmd, "parametercmd")) { + int argc = objc-modifiers; + if (argc < 2) + return XOTclObjErrArgCnt(interp, obj->cmdName, + "info parametercmd"); + if (nsp) { + return ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern, 1, 0, 0, 0, 1); + } else { + return TCL_OK; + } } + break; + case 'v': if (!strcmp(cmd, "vars")) { if (objc > 3 || modifiers > 0) @@ -10796,10 +10814,14 @@ return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info instforward ?-definition? ?name?"); definition = checkForModifier(objv, modifiers, "-definition"); - if (nsp) + if (definition && argc < 3) + return XOTclObjErrArgCnt(interp, cl->object.cmdName, + "info instforward ?-definition? ?name?"); + if (nsp) { return forwardList(interp, Tcl_Namespace_cmdTable(nsp), pattern, definition); - else + } else { return TCL_OK; + } } break; @@ -10921,7 +10943,7 @@ if (objc > 3 || modifiers > 0) return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info instprocs ?pat?"); return ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern, - /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0); + /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0, 0); } else if (!strcmp(cmdTail, "pre")) { XOTclProcAssertion *procs; if (objc != 3 || modifiers > 0) @@ -10942,9 +10964,19 @@ if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); } return TCL_OK; - } - break; - } + } else if (!strcmp(cmdTail, "parametercmd")) { + int argc = objc-modifiers; + if (argc < 2) + return XOTclObjErrArgCnt(interp, cl->object.cmdName, + "info instparametercmd"); + if (nsp) { + return ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern, 1, 0, 0, 0, 1); + } else { + return TCL_OK; + } + } + break; + } } break; Index: library/serialize/Serializer.xotcl =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -rd627242b910f2ec0c4a7520089d7ac5f8a9c2395 --- library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision d627242b910f2ec0c4a7520089d7ac5f8a9c2395) @@ -201,7 +201,8 @@ append cmd [list [$o info class] create [$o self]] # slots needs to be initialized when optimized, since # parametercmds are not serialized - if {![$o istype ::xotcl::Slot]} {append cmd " -noinit"} + #if {![$o istype ::xotcl::Slot]} {append cmd " -noinit"} + append cmd " -noinit" append cmd " \\\n" foreach i [$o info procs] { append cmd " " [my method-serialize $o $i ""] " \\\n" @@ -210,6 +211,9 @@ set fwd [concat [list forward $i] [$o info forward -definition $i]] append cmd \t [my pcmd $fwd] " \\\n" } + foreach i [$o info parametercmd] { + append cmd \t [my pcmd [list parametercmd $i]] " \\\n" + } set vset {} set nrVars 0 foreach v [$o info vars] { @@ -246,6 +250,9 @@ set fwd [concat [list instforward $i] [$o info instforward -definition $i]] append cmd \t [my pcmd $fwd] " \\\n" } + foreach i [$o info instparametercmd] { + append cmd \t [my pcmd [list instparametercmd $i]] " \\\n" + } foreach x {superclass instinvar} { set v [$o info $x] if {$v ne "" && "::xotcl::Object" ne $v } {