Overview
| Artifact ID: | 43be9b01087c5981f573643700c951d0f01cb78d0659cf5c9a3817278f17e181 |
|---|---|
| Ticket: | 2370575fffffffffffffffffffffffffffffffff |
| Date: | 2019-04-01 09:10:55 |
| User: | dkf |
| Artifact Attached: | a517c812607173cb86ba760f331e83f2020936faa854e947af2aad1377439a11 |
| Filename: | dict-filter.c |
| Description: | dict-filter.c: File extracted from SourceForge |
Content:
/* *---------------------------------------------------------------------- * * DictFilterCmd -- * * This function implements the "dict filter" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal * specification. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int DictFilterCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; static const char *const filters[] = { "key", "script", "value", NULL }; enum FilterTypes { FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES }; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj; Tcl_DictSearch search; int index, varc, done, result, satisfied; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum FilterTypes) index) { case FILTER_KEYS: /* * Create a dictionary whose keys all match at least one * of the given patterns. */ if (Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } resultObj = Tcl_NewDictObj(); while (!done) { int idx; for (idx=3; idx<objc; idx++) { if (Tcl_StringMatch(TclGetString(keyObj), TclGetString(objv[idx]))) { Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); break; } } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; case FILTER_VALUES: /* * Create a dictionary whose values all match at least one * of the given patterns. */ if (Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } resultObj = Tcl_NewDictObj(); while (!done) { int idx; for (idx=3; idx<objc; idx++) { if (Tcl_StringMatch(TclGetString(valueObj), TclGetString(objv[idx]))) { Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); break; } } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; case FILTER_SCRIPT: if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary script {keyVar valueVar} filterScript"); return TCL_ERROR; } /* * Create a dictionary whose key,value pairs all satisfy a script * (i.e. get a true boolean result from its evaluation). Massive * copying from the "dict for" implementation has occurred! */ if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { Tcl_SetResult(interp, "must have exactly two variable names", TCL_STATIC); return TCL_ERROR; } keyVarObj = varv[0]; valueVarObj = varv[1]; scriptObj = objv[4]; /* * Make sure that these objects (which we need throughout the body of * the loop) don't vanish. Note that the dictionary internal rep is * locked internally so that updates, shimmering, etc are not a * problem. */ Tcl_IncrRefCount(keyVarObj); Tcl_IncrRefCount(valueVarObj); Tcl_IncrRefCount(scriptObj); result = Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done); if (result != TCL_OK) { TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); return TCL_ERROR; } resultObj = Tcl_NewDictObj(); while (!done) { /* * Stop the value from getting hit in any way by any traces on the * key variable. */ Tcl_IncrRefCount(keyObj); Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set key variable: \"", TclGetString(keyVarObj), "\"", NULL); result = TCL_ERROR; goto abnormalResult; } if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set value variable: \"", TclGetString(valueVarObj), "\"", NULL); goto abnormalResult; } /* * TIP #280. Make invoking context available to loop body. */ result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4); switch (result) { case TCL_OK: boolObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(boolObj); Tcl_ResetResult(interp); if (Tcl_GetBooleanFromObj(interp, boolObj, &satisfied) != TCL_OK) { TclDecrRefCount(boolObj); result = TCL_ERROR; goto abnormalResult; } TclDecrRefCount(boolObj); if (satisfied) { Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); } break; case TCL_BREAK: /* * Force loop termination by calling Tcl_DictObjDone; this * makes the next Tcl_DictObjNext say there is nothing more to * do. */ Tcl_ResetResult(interp); Tcl_DictObjDone(&search); case TCL_CONTINUE: result = TCL_OK; break; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict filter\" script line %d)", interp->errorLine)); default: goto abnormalResult; } TclDecrRefCount(keyObj); TclDecrRefCount(valueObj); Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } /* * Stop holding a reference to these objects. */ TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_SetObjResult(interp, resultObj); } else { TclDecrRefCount(resultObj); } return result; abnormalResult: Tcl_DictObjDone(&search); TclDecrRefCount(keyObj); TclDecrRefCount(valueObj); TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); TclDecrRefCount(resultObj); return result; } Tcl_Panic("unexpected fallthrough"); /* Control never reaches this point. */ return TCL_ERROR; }