Index: ChangeLog =================================================================== diff -u -r9908c8760bc77e7801e462c525f37cefc13dbdcc -rbffe84bd5dccc0ed0d466bbf2d93bac783d49796 --- ChangeLog (.../ChangeLog) (revision 9908c8760bc77e7801e462c525f37cefc13dbdcc) +++ ChangeLog (.../ChangeLog) (revision bffe84bd5dccc0ed0d466bbf2d93bac783d49796) @@ -1,7 +1,13 @@ -2008-06-03 - * check in guards for boolean values, not for - integer values, such that a guard {true} means - success (many thanks to Neophytos for reporting) +2008-06-23 + * remove pattern argument from "info class" + * additional argument for "info precedence": "-intrinsic" + Syntax: + info precedence ?-intrinsic? ?pattern? + If "-intrinsic" is specified, only the classes of the + superclass type hierarchy are returnd. Otherwise, + the precedence contains mixin classes as well. + * Check results for guards to be boolean instead + of int (now, guards are allowed to return e.g. "true") 2008-05-30 * updating language reference Index: generic/xotcl.c =================================================================== diff -u -r9908c8760bc77e7801e462c525f37cefc13dbdcc -rbffe84bd5dccc0ed0d466bbf2d93bac783d49796 --- generic/xotcl.c (.../xotcl.c) (revision 9908c8760bc77e7801e462c525f37cefc13dbdcc) +++ generic/xotcl.c (.../xotcl.c) (revision bffe84bd5dccc0ed0d466bbf2d93bac783d49796) @@ -2847,9 +2847,7 @@ checkConditionInScope(Tcl_Interp *interp, Tcl_Obj *condition) { int result, success; Tcl_Obj *ov[2]; - ov [1] = condition; - INCR_REF_COUNT(condition); result = XOTcl_ExprObjCmd(NULL, interp, 2, ov); DECR_REF_COUNT(condition); @@ -6267,26 +6265,10 @@ return TCL_OK; } -static int XOTclCInfoMethod(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST v[]); - static int -ListClass(Tcl_Interp *interp, XOTclObject *obj, char *pattern, - int objc, Tcl_Obj *CONST objv[]) { - if (pattern == NULL) { - Tcl_SetObjResult(interp, obj->cl->object.cmdName); - return TCL_OK; - } else { - int result; - ALLOC_ON_STACK(Tcl_Obj*, objc, ov); - - memcpy(ov, objv, sizeof(Tcl_Obj *)*objc); - ov[1] = Tcl_NewStringObj("superclass", 10); - INCR_REF_COUNT(ov[1]); - result = XOTclCInfoMethod((ClientData)obj->cl, interp, objc, ov); - DECR_REF_COUNT(ov[1]); - FREE_ON_STACK(ov); - return result; - } +ListClass(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]) { + Tcl_SetObjResult(interp, obj->cl->object.cmdName); + return TCL_OK; } static int @@ -6301,21 +6283,24 @@ } static int -ListPrecedence(Tcl_Interp *interp, XOTclObject *obj, char *pattern) { +ListPrecedence(Tcl_Interp *interp, XOTclObject *obj, char *pattern, int intrinsicOnly) { XOTclClasses *pl; Tcl_ResetResult(interp); - if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) - MixinComputeDefined(interp, obj); - if (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { - XOTclCmdList *ml = obj->mixinOrder; - for(; ml; ml = ml->next) { - XOTclClass *mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); - AppendMatchingElement(interp, mixin->object.cmdName, pattern); + if (!intrinsicOnly) { + if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) + MixinComputeDefined(interp, obj); + + if (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { + XOTclCmdList *ml = obj->mixinOrder; + for (; ml; ml = ml->next) { + XOTclClass *mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); + AppendMatchingElement(interp, mixin->object.cmdName, pattern); + } } } - pl = ComputeOrder(obj->cl, obj->cl->order, Super); - for (; pl != 0; pl = pl->next) { + + for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl != 0; pl = pl->next) { AppendMatchingElement(interp, pl->cl->object.cmdName, pattern); } return TCL_OK; @@ -8350,19 +8335,19 @@ case 'c': if (isClassString(cmd)) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, obj->cmdName, "info class ?class?"); - return ListClass(interp, obj, pattern, objc, objv); + if (objc > 3 || modifiers > 0 || pattern) + return XOTclObjErrArgCnt(interp, obj->cmdName, "info class"); + return ListClass(interp, obj, objc, objv); } else if (!strcmp(cmd, "commands")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, obj->cmdName, "info commands ?pat?"); + return XOTclObjErrArgCnt(interp, obj->cmdName, "info commands ?pattern?"); if (nsp) return ListKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern); else return TCL_OK; } else if (!strcmp(cmd, "children")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, obj->cmdName, "info children ?pat?"); + return XOTclObjErrArgCnt(interp, obj->cmdName, "info children ?pattern?"); return ListChildren(interp, obj, pattern, 0); } else if (!strcmp(cmd, "check")) { if (objc != 2 || modifiers > 0) @@ -8397,7 +8382,7 @@ int withGuards = 0, withOrder = 0; if (objc-modifiers > 3) return XOTclObjErrArgCnt(interp, obj->cmdName, - "info filter ?-guards? ?-order? ?pat?"); + "info filter ?-guards? ?-order? ?pattern?"); if (modifiers > 0) { withGuards = checkForModifier(objv, modifiers, "-guards"); withOrder = checkForModifier(objv, modifiers, "-order"); @@ -8505,7 +8490,7 @@ int noprocs = 0, nocmds = 0, nomixins = 0, inContext = 0; if (objc-modifiers > 3) return XOTclObjErrArgCnt(interp, obj->cmdName, - "info methods ?-noprocs? ?-nocmds? ?-nomixins? ?-incontext? ?pat?"); + "info methods ?-noprocs? ?-nocmds? ?-nomixins? ?-incontext? ?pattern?"); if (modifiers > 0) { noprocs = checkForModifier(objv, modifiers, "-noprocs"); nocmds = checkForModifier(objv, modifiers, "-nocmds"); @@ -8517,7 +8502,7 @@ #ifdef XOTCL_METADATA else if (!strcmp(cmd, "metadata")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, obj->cmdName, "info metadata ?pat?"); + return XOTclObjErrArgCnt(interp, obj->cmdName, "info metadata ?pattern?"); return ListKeys(interp, &obj->metaData, pattern); } #endif @@ -8541,7 +8526,7 @@ case 'p': if (!strcmp(cmd, "procs")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, obj->cmdName, "info procs ?pat?"); + return XOTclObjErrArgCnt(interp, obj->cmdName, "info procs ?pattern?"); if (nsp) return ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern, /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, @@ -8571,7 +8556,12 @@ } return TCL_OK; } else if (!strcmp(cmd, "precedence")) { - return ListPrecedence(interp, obj, pattern); + int intrinsic = 0; + if (objc-modifiers > 3 || modifiers > 1) + return XOTclObjErrArgCnt(interp, obj->cmdName, "info precedence ?-intrinsic? ?pattern?"); + + intrinsic = checkForModifier(objv, modifiers, "-intrinsic"); + return ListPrecedence(interp, obj, pattern, intrinsic); } else if (!strcmp(cmd, "parametercmd")) { int argc = objc-modifiers; if (argc < 2) @@ -8589,7 +8579,7 @@ case 'v': if (!strcmp(cmd, "vars")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, obj->cmdName, "info vars ?pat?"); + return XOTclObjErrArgCnt(interp, obj->cmdName, "info vars ?pattern?"); return ListVars(interp, obj, pattern); } break; @@ -10692,7 +10682,7 @@ case 'c': if (!strcmp(cmd, "classchildren")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info classchildren ?pat?"); + return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info classchildren ?pattern?"); return ListChildren(interp, (XOTclObject*) cl, pattern, 1); } else if (!strcmp(cmd, "classparent")) { if (objc > 2 || modifiers > 0) @@ -10704,7 +10694,7 @@ case 'h': if (!strcmp(cmd, "heritage")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info heritage ?pat?"); + return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info heritage ?pattern?"); return ListHeritage(interp, cl, pattern); } break; @@ -10769,7 +10759,7 @@ if (!strcmp(cmdTail, "commands")) { if (objc > 3 || modifiers > 0) return XOTclObjErrArgCnt(interp, cl->object.cmdName, - "info instcommands ?pat?"); + "info instcommands ?pattern?"); return ListKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern); } break; @@ -10798,7 +10788,7 @@ int withGuards = 0; if (objc-modifiers > 3) return XOTclObjErrArgCnt(interp, cl->object.cmdName, - "info instfilter ?-guards? ?pat?"); + "info instfilter ?-guards? ?pattern?"); if (modifiers > 0) { withGuards = checkForModifier(objv, modifiers, "-guards"); if (withGuards == 0) @@ -10946,7 +10936,7 @@ case 'p': if (!strcmp(cmdTail, "procs")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info instprocs ?pat?"); + return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info instprocs ?pattern?"); return ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), pattern, /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0, 0); } else if (!strcmp(cmdTail, "pre")) {