static int ScaleCoordsCommand( void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Scale *scalePtr = recordPtr; double value; int r = TCL_OK; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); return TCL_ERROR; } if (objc == 3) { r = Tcl_GetDoubleFromObj(interp, objv[2], &value); } else { r = Tcl_GetDoubleFromObj(interp, scalePtr->scale.valueObj, &value); } if (r == TCL_OK) { Tcl_Obj *point[2]; XPoint pt = ValueToPoint(scalePtr, value); point[0] = Tcl_NewIntObj(pt.x); point[1] = Tcl_NewIntObj(pt.y); Tcl_SetObjResult(interp, Tcl_NewListObj(2, point)); } return r; }
Tcl_Obj * TkDebugColor( Tk_Window tkwin, /* The window in which the color will be used * (not currently used). */ char *name) /* Name of the desired color. */ { Tcl_HashEntry *hashPtr; Tcl_Obj *resultPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name); if (hashPtr != NULL) { TkColor *tkColPtr = Tcl_GetHashValue(hashPtr); if (tkColPtr == NULL) { Tcl_Panic("TkDebugColor found empty hash table entry"); } for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { Tcl_Obj *objPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(tkColPtr->resourceRefCount)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(tkColPtr->objRefCount)); Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); } } return resultPtr; }
static int PrologToTclResult(Tcl_Interp *interp, AP_World *w, AP_Result prolog_result) { switch (prolog_result) { case AP_SUCCESS: default: Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); return TCL_OK; break; case AP_FAIL: Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return TCL_OK; break; case AP_EXCEPTION: { AP_Obj term_to_string, string; term_to_string = AP_NewInitStructure(w, AP_NewSymbolFromStr(w, "term_to_string"), 2, AP_GetException(w), AP_UNBOUND_OBJ); AP_Call(w, tcltk_module, &term_to_string); // ignore result string = AP_GetArgument(w, term_to_string, 2); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "prolog exception: ", AP_GetAtomStr(w, string), NULL); return TCL_ERROR; break; } } }
static Tcl_Obj *_make_value(jackctl_parameter_t *parameter, union jackctl_parameter_value value) { switch (jackctl_parameter_get_type(parameter)) { case JackParamInt: return Tcl_NewIntObj(value.i); case JackParamUInt: return Tcl_NewIntObj(value.ui); case JackParamChar: return Tcl_NewStringObj(&value.c, 1); case JackParamString: return Tcl_NewStringObj(value.str, -1); case JackParamBool: return Tcl_NewBooleanObj(value.b); default: return Tcl_ObjPrintf("unknown type %d returned by jackctl_parameter_get_type", jackctl_parameter_get_type(parameter)); } }
static int _version(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { _t *dp = (_t *)clientData; if (argc != 2) return fw_error_str(interp, "jack-client version"); int major, minor, micro, proto; jack_get_version(&major, &minor, µ, &proto); Tcl_Obj *result[] = { Tcl_NewIntObj(major), Tcl_NewIntObj(minor), Tcl_NewIntObj(micro), Tcl_NewIntObj(proto), NULL }; Tcl_SetObjResult(interp, Tcl_NewListObj(4, result)); return TCL_OK; }
Tcl_Obj * Ttk_NewBoxObj(Ttk_Box box) { Tcl_Obj *result[4]; result[0] = Tcl_NewIntObj(box.x); result[1] = Tcl_NewIntObj(box.y); result[2] = Tcl_NewIntObj(box.width); result[3] = Tcl_NewIntObj(box.height); return Tcl_NewListObj(4, result); }
/* Sets up a Tcl interpreter for the game. Adds commands to implement our scripting interface. */ void InitScripting(void) { /* First, create an interpreter and make sure it's valid. */ interp = Tcl_CreateInterp(); if (interp == NULL) { fprintf(stderr, "Unable to initialize Tcl.\n"); exit(1); } /* Add the "fireWeapon" command. */ if (Tcl_CreateObjCommand(interp, "fireWeapon", HandleFireWeaponCmd, (ClientData) 0, NULL) == NULL) { fprintf(stderr, "Error creating Tcl command.\n"); exit(1); } /* Link the important parts of our player data structures to global variables in Tcl. (Ignore the char * typecast; Tcl will treat the data as the requested type, in this case double.) */ Tcl_LinkVar(interp, "player_x", (char *) &player.world_x, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "player_y", (char *) &player.world_y, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "player_angle", (char *) &player.angle, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "player_accel", (char *) &player.accel, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_x", (char *) &opponent.world_x, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_y", (char *) &opponent.world_y, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_angle", (char *) &opponent.angle, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_accel", (char *) &opponent.accel, TCL_LINK_DOUBLE); /* Make the constants in gamedefs.h available to the script. The script should play by the game's rules, just like the human player. Tcl_SetVar2Ex is part of the Tcl_SetVar family of functions, which you can read about in the manpage. It simply sets a variable to a new value given by a Tcl_Obj structure. */ Tcl_SetVar2Ex(interp, "world_width", NULL, Tcl_NewIntObj(WORLD_WIDTH), 0); Tcl_SetVar2Ex(interp, "world_height", NULL, Tcl_NewIntObj(WORLD_HEIGHT), 0); Tcl_SetVar2Ex(interp, "player_forward_thrust", NULL, Tcl_NewIntObj(PLAYER_FORWARD_THRUST), 0); Tcl_SetVar2Ex(interp, "player_reverse_thrust", NULL, Tcl_NewIntObj(PLAYER_REVERSE_THRUST), 0); }
int MkView::RestrictCmd() { int index = asIndex(view, objv[2], false); int pos = tcl_GetIntFromObj(objv[3]); int count = tcl_GetIntFromObj(objv[4]); int result = view.RestrictSearch(view[index], pos, count); Tcl_Obj *r = tcl_GetObjResult(); tcl_ListObjAppendElement(r, Tcl_NewIntObj(result)); tcl_ListObjAppendElement(r, Tcl_NewIntObj(pos)); tcl_ListObjAppendElement(r, Tcl_NewIntObj(count)); return _error; }
int NS(pErrorFromMq) ( Tcl_Interp * interp, struct MqS * const mqctx ) { Tcl_Obj *objv[4]; objv[0] = Tcl_NewStringObj ("TCLMSGQUE", -1); objv[1] = Tcl_NewIntObj (MqErrorGetNumI(mqctx)); objv[2] = Tcl_NewIntObj (MqErrorGetCodeI(mqctx)); objv[3] = Tcl_NewStringObj (MqErrorGetText(mqctx), -1); Tcl_SetObjErrorCode (interp, Tcl_NewListObj (4, objv)); Tcl_SetResult(interp, (MQ_STR) MqErrorGetText(mqctx), TCL_VOLATILE); MqErrorReset(mqctx); return TCL_ERROR; }
static int TestwinclockCmd( ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; /* The Posix epoch, expressed as a Windows * FILETIME */ Tcl_Time tclTime; /* Tcl clock */ FILETIME sysTime; /* System clock */ Tcl_Obj *result; /* Result of the command */ LARGE_INTEGER t1, t2; LARGE_INTEGER p1, p2; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } QueryPerformanceCounter(&p1); Tcl_GetTime(&tclTime); GetSystemTimeAsFileTime(&sysTime); t1.LowPart = posixEpoch.dwLowDateTime; t1.HighPart = posixEpoch.dwHighDateTime; t2.LowPart = sysTime.dwLowDateTime; t2.HighPart = sysTime.dwHighDateTime; t2.QuadPart -= t1.QuadPart; QueryPerformanceCounter(&p2); result = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) (t2.QuadPart / 10000000))); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000))); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart)); Tcl_SetObjResult(interp, result); return TCL_OK; }
int xFilter(sqlite3_vtab_cursor *cursorP, int idx, const char *idxstrP, int argc, sqlite3_value **argv) { VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab; Tcl_Obj *objv[4]; Tcl_Interp *interp; int i; if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) { /* Should not really happen */ SetVTableError(vtabP, gNullInterpError); return SQLITE_ERROR; } objv[0] = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*"); objv[1] = Tcl_NewIntObj(idx); objv[2] = Tcl_NewStringObj(idxstrP ? idxstrP : "", -1); objv[3] = Tcl_NewListObj(0, NULL); for (i = 0; i < argc; ++i) { Tcl_ListObjAppendElement(NULL, objv[3], ObjFromSqliteValue(argv[i], vtabP->vtdbP)); } if (VTableInvokeCmd(interp, vtabP, "xFilter", 4 , objv) != TCL_OK) { SetVTableErrorFromInterp(vtabP, interp); return SQLITE_ERROR; } return SQLITE_OK; }
static int rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewLongObj(offset)); Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(seekMode)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK && Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK) chan->_watchMask = chan->_validMask; Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); if (n < 0) *errorCodePtr = EINVAL; return n; }
static int rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; if (chan->_validMask & TCL_READABLE) { Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(toRead)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) { void* s = Tcl_GetByteArrayFromObj(Tcl_GetObjResult(ip), &n); if (0 <= n && n <= toRead) if (n > 0) memcpy(buf, s, n); else chan->_watchMask &= ~TCL_READABLE; else n = -1; } Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); } if (n < 0) *errorCodePtr = EINVAL; return n; }
/* * Tcl callback to allow reading of game configuration variables from Tcl. */ static int get_param_cb ( ClientData cd, Tcl_Interp *ip, int argc, const char *argv[]) { int i; int num_params; struct param *parm; if ( argc != 2 ) { Tcl_AppendResult(ip, argv[0], ": invalid number of arguments\n", "Usage: ", argv[0], " <parameter name>", (char *)0 ); return TCL_ERROR; } /* Search for parameter */ parm = NULL; num_params = sizeof(Params)/sizeof(struct param); for (i=0; i<num_params; i++) { parm = (struct param*)&Params + i; if ( strcmp( parm->name, argv[1] ) == 0 ) { break; } } /* If can't find parameter, report error */ if ( parm == NULL || i == num_params ) { Tcl_AppendResult(ip, argv[0], ": invalid parameter `", argv[1], "'", (char *)0 ); return TCL_ERROR; } /* Get value of parameter */ switch ( parm->type ) { case PARAM_STRING: fetch_param_string( parm ); Tcl_SetObjResult( ip, Tcl_NewStringObj( parm->val.string_val, -1 ) ); break; case PARAM_CHAR: fetch_param_char( parm ); Tcl_SetObjResult( ip, Tcl_NewStringObj( &parm->val.char_val, 1 ) ); break; case PARAM_INT: fetch_param_int( parm ); Tcl_SetObjResult( ip, Tcl_NewIntObj( parm->val.int_val ) ); break; case PARAM_BOOL: fetch_param_bool( parm ); Tcl_SetObjResult( ip, Tcl_NewBooleanObj( parm->val.bool_val ) ); break; default: code_not_reached(); } return TCL_OK; }
static int Tcl_DoOneEventCmd(ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int index, result; enum {EVENT_WAIT, EVENT_DONT_WAIT}; const char *eventOptions[] = {"wait", "dont_wait", NULL}; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, (char *)"option"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], eventOptions, (char *)"option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case EVENT_WAIT: result = Tcl_DoOneEvent(0); break; case EVENT_DONT_WAIT: result = Tcl_DoOneEvent(TCL_DONT_WAIT); break; default: result = 0; break; } Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); return TCL_OK; }
static int _list_ports(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 2) return fw_error_str(interp, "jack-client list-ports"); _t *dp = (_t *)clientData; Tcl_Obj *dict = Tcl_NewDictObj(); const char **portv[] = { jack_get_ports (dp->fw.client, NULL, JACK_DEFAULT_AUDIO_TYPE, 0), jack_get_ports (dp->fw.client, NULL, JACK_DEFAULT_MIDI_TYPE, 0) }; for (int p = 0; p < 2; p += 1) if (portv[p] != NULL) { for (int i = 0; portv[p][i] != NULL; i += 1) { jack_port_t *port = jack_port_by_name(dp->fw.client, portv[p][i]); if (port != NULL) { Tcl_Obj *pdict = Tcl_NewDictObj(); int flags = jack_port_flags(port); Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("direction", -1), flags & JackPortIsInput ? Tcl_NewStringObj("input", -1) : Tcl_NewStringObj("output", -1) ); Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("physical", -1), Tcl_NewIntObj(flags & JackPortIsPhysical ? 1 : 0)); Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("type", -1), p == 0 ? Tcl_NewStringObj("audio", -1) : Tcl_NewStringObj("midi", -1)); const char **connv = jack_port_get_all_connections(dp->fw.client, port); Tcl_Obj *list = Tcl_NewListObj(0, NULL); if (connv != NULL) { for (int j = 0; connv[j] != NULL; j += 1) Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(connv[j], -1)); jack_free(connv); } Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("connections", -1), list); Tcl_DictObjPut(interp, dict, Tcl_NewStringObj(portv[p][i], -1), pdict); } } jack_free(portv[p]); } Tcl_SetObjResult(interp, dict); return TCL_OK; }
/** \brief Description yet to be added. **/ static int notebookNext ( GtkNotebook *notebook, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[], int isNext ) { int cur = gtk_notebook_get_current_page ( notebook ); int num = 1; /* widget next ?count? */ if ( objc < 2 || objc > 3 ) { Tcl_WrongNumArgs ( interp, 2, objv, "?count?" ); return TCL_ERROR; } if ( objc == 3 && Tcl_GetIntFromObj ( interp, objv[2], &num ) != TCL_OK ) return TCL_ERROR; if ( isNext ) { cur = gtk_notebook_get_current_page ( notebook ); gtk_notebook_set_current_page ( notebook, cur + num ); } else if ( objc == 3 ) /* current val */ gtk_notebook_set_current_page ( notebook, num ); cur = gtk_notebook_get_current_page ( notebook ); Tcl_SetObjResult ( interp, Tcl_NewIntObj ( cur ) ); return TCL_OK; }
void TclGetAndDetachPids( Tcl_Interp *interp, /* Interpreter to append the PIDs to. */ Tcl_Channel chan) /* Handle for the pipeline. */ { PipeState *pipePtr; const Tcl_ChannelType *chanTypePtr; Tcl_Obj *pidsObj; int i; /* * Punt if the channel is not a command channel. */ chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { return; } pipePtr = Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj( PTR2INT(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; } }
int xColumn(sqlite3_vtab_cursor *cursorP, sqlite3_context *ctxP, int colindex) { VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab; Tcl_Obj *objv[2]; Tcl_Interp *interp; if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) { /* Should not really happen */ SetVTableError(vtabP, gNullInterpError); return SQLITE_ERROR; } objv[0] = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*"); objv[1] = Tcl_NewIntObj(colindex); switch (VTableInvokeCmd(interp, vtabP, "xColumn", 2, objv)) { case TCL_OK: ObjToSqliteContextValue(Tcl_GetObjResult(interp), ctxP); return SQLITE_OK; case TCL_RETURN: /* Treat as SQL NULL value. Simply don't call any sqlite3_result_* */ return SQLITE_OK; default: sqlite3_result_error(ctxP, Tcl_GetStringResult(interp), -1); return SQLITE_ERROR; } }
static int _state(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { _t *data = (_t *)clientData; if (argc != 2) return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s state", Tcl_GetString(objv[0]))); Tcl_SetObjResult(interp, Tcl_NewIntObj(data->started)); return TCL_OK; }
static void get_register_size (int regnum, map_arg arg) { Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, Tcl_NewIntObj (register_size (get_current_arch (), regnum))); }
int NS(ReadGetNumItems) (NS_ARGS) { SETUP_mqctx CHECK_NOARGS Tcl_SetObjResult(interp, Tcl_NewIntObj(MqReadGetNumItems(mqctx))); RETURN_TCL }
/************************************************************************* * FUNCTION : RPMPRoblem_Obj::Get_part * * ARGUMENTS : enum of part to get * * RETURNS : part as a Tcl_Obj with a 0 refcount * * EXCEPTIONS : none * * PURPOSE : Get a part of the problem report * *************************************************************************/ Tcl_Obj *RPMPRoblem_Obj::Get_part(PARTS x) { switch (x) { case PACKAGE: return Tcl_NewStringObj(problem.pkgNEVR?problem.pkgNEVR:"",-1); case ALT: return Tcl_NewStringObj(problem.altNEVR?problem.altNEVR:"",-1); case KEY: return Tcl_NewLongObj((long)problem.key); case TYPE: return Tcl_NewStringObj(Prob_to_string(problem.type),-1); case IGNORE: return Tcl_NewIntObj(problem.ignoreProblem); case STRING: return Tcl_NewStringObj(problem.str1?problem.str1:"",-1); case INT: return Tcl_NewLongObj(problem.ulong1); } return 0; }
/* ** sqlite3BitvecBuiltinTest SIZE PROGRAM ** ** Invoke the SQLITE_TESTCTRL_BITVEC_TEST operator on test_control. ** See comments on sqlite3BitvecBuiltinTest() for additional information. */ static int testBitvecBuiltinTest( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ int sz, rc; int nProg = 0; int aProg[100]; const char *z; if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " SIZE PROGRAM\"", (void*)0); } if( Tcl_GetInt(interp, argv[1], &sz) ) return TCL_ERROR; z = argv[2]; while( nProg<99 && *z ){ while( *z && !sqlite3Isdigit(*z) ){ z++; } if( *z==0 ) break; aProg[nProg++] = atoi(z); while( sqlite3Isdigit(*z) ){ z++; } } aProg[nProg] = 0; rc = sqlite3_test_control(SQLITE_TESTCTRL_BITVEC_TEST, sz, aProg); Tcl_SetObjResult(interp, Tcl_NewIntObj(rc)); return TCL_OK; }
static int TestwincpuidCmd( ClientData dummy, Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int status, index, i; unsigned int regs[4]; Tcl_Obj *regsObjs[4]; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "eax"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { return TCL_ERROR; } status = TclWinCPUID((unsigned) index, regs); if (status != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operation not available", -1)); return status; } for (i=0 ; i<4 ; ++i) { regsObjs[i] = Tcl_NewIntObj((int) regs[i]); } Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); return TCL_OK; }
static TclObject methodToListObj (const Method &method) { TclObject list(Tcl_NewListObj(0, 0)); // Put member id. list.lappend(Tcl_NewIntObj(method.memberid())); // Put return type. list.lappend(typeToListObj(method.type())); // Put method name. list.lappend( Tcl_NewStringObj(const_cast<char *>(method.name().c_str()), -1)); // Put parameters. TclObject parameterList(Tcl_NewListObj(0, 0)); const Method::Parameters ¶meters = method.parameters(); for (Method::Parameters::const_iterator p = parameters.begin(); p != parameters.end(); ++p) { parameterList.lappend(parameterToListObj(*p)); } list.lappend(parameterList); return list; }
/* ** Write data to an tvfs-file. */ static int tvfsWrite( sqlite3_file *pFile, const void *zBuf, int iAmt, sqlite_int64 iOfst ){ int rc = SQLITE_OK; TestvfsFd *pFd = tvfsGetFd(pFile); Testvfs *p = (Testvfs *)pFd->pVfs->pAppData; if( p->pScript && p->mask&TESTVFS_WRITE_MASK ){ tvfsExecTcl(p, "xWrite", Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, Tcl_NewWideIntObj(iOfst), Tcl_NewIntObj(iAmt) ); tvfsResultCode(p, &rc); } if( rc==SQLITE_OK && tvfsInjectFullerr(p) ){ rc = SQLITE_FULL; } if( rc==SQLITE_OK && p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){ rc = SQLITE_IOERR; } if( rc==SQLITE_OK ){ rc = sqlite3OsWrite(pFd->pReal, zBuf, iAmt, iOfst); } return rc; }
/** \brief Load and configure widget styles using a resource (.rsc) file. \author William j Giddings \date 25-FEB-2009 **/ int gnoclResourceFileCmd ( ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[] ) { g_print ( "gnoclResourceFileCmd\n" ) ; int nMax = 500; int n; if ( objc != 2 ) { Tcl_WrongNumArgs ( interp, 1, objv, NULL ); return TCL_ERROR; } char * str = Tcl_GetString ( objv[1] ); gtk_rc_parse ( str ); Tcl_SetObjResult ( interp, Tcl_NewIntObj ( n ) ); return TCL_OK; }
//----------------------------------------------------------------------- extern "C" int If_SetInt(const char *name, int val) { if (!theInterp) return IF_ERROR; #if 0 // unfortunately Tcl_EvalObjv was not available under Tcl 8.0 Tcl_Obj *objv[2]; objv[0] = Tcl_NewStringObj((char *)name, -1); objv[1] = Tcl_NewIntObj(val); int retcode; retcode = Tcl_EvalObjv(theInterp, 2, objv, 0); Tcl_DecrRefCount(objv[0]); Tcl_DecrRefCount(objv[1]); if (retcode != TCL_OK) return IF_ERROR; #else char valstr[50]; sprintf(valstr, "%d", val); if (Tcl_VarEval(theInterp, (char *)name, " ", valstr, NULL) != TCL_OK) return IF_ERROR; #endif Tcl_ResetResult(theInterp); // reset result as val was accepted return IF_OK; }
static int TestforkObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { pid_t pid; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } pid = fork(); if (pid == -1) { Tcl_AppendResult(interp, "Cannot fork", NULL); return TCL_ERROR; } /* Only needed when pthread_atfork is not present, * should not hurt otherwise. */ if (pid==0) { Tcl_InitNotifier(); } Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); return TCL_OK; }