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; }
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 2) return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0]))); _t *data = (_t *)clientData; if ( ! data->started) return fw_error_obj(interp, Tcl_ObjPrintf("audio-tap %s is not running", Tcl_GetString(objv[0]))); // figure out where to read from while (1) { // start with no choice buffer_t *choice = NULL; // look for the oldest unread buffer for (int i = 0; i < data->buff_n; i += 1) if ( ! data->buffs[i].bread && (choice == NULL || choice->bframe > data->buffs[i].bframe)) choice = &data->buffs[i]; // if nothing was found, return an empty string if (choice == NULL) { Tcl_Obj *result[] = { Tcl_NewLongObj(0), Tcl_NewStringObj("", -1), NULL }; return fw_success_obj(interp, Tcl_NewListObj(2, result)); } // attempt to grab the choice Tcl_IncrRefCount(choice->buff); // if it's now marked as read, then the process callback grabbed it // loop back and try again if (choice->bread) { Tcl_DecrRefCount(choice->buff); continue; } // it's ours now that the ref count incremented Tcl_Obj *result[] = { Tcl_NewLongObj(choice->bframe), choice->buff, NULL }; Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); Tcl_DecrRefCount(choice->buff); choice->bread = 1; return TCL_OK; } }
void TkpGetSubFonts( Tcl_Interp *interp, Tk_Font tkfont) { Tcl_Obj *objv[3], *listPtr, *resultPtr; UnixFtFont *fontPtr = (UnixFtFont *) tkfont; FcPattern *pattern; char *family = "Unknown", **familyPtr = &family; char *foundry = "Unknown", **foundryPtr = &foundry; char *encoding = "Unknown", **encodingPtr = &encoding; int i; resultPtr = Tcl_NewListObj(0, NULL); for (i = 0; i < fontPtr->nfaces ; ++i) { pattern = FcFontRenderPrepare(0, fontPtr->pattern, fontPtr->faces[i].source); XftPatternGetString(pattern, XFT_FAMILY, 0, familyPtr); XftPatternGetString(pattern, XFT_FOUNDRY, 0, foundryPtr); XftPatternGetString(pattern, XFT_ENCODING, 0, encodingPtr); objv[0] = Tcl_NewStringObj(family, -1); objv[1] = Tcl_NewStringObj(foundry, -1); objv[2] = Tcl_NewStringObj(encoding, -1); listPtr = Tcl_NewListObj(3, objv); Tcl_ListObjAppendElement(NULL, resultPtr, listPtr); } Tcl_SetObjResult(interp, resultPtr); }
static TclObject parameterToListObj (const Parameter ¶meter) { TclObject list(Tcl_NewListObj(0, 0)); // Put parameter passing modes. TclObject modes(Tcl_NewListObj(0, 0)); if (parameter.flags() & PARAMFLAG_FIN) { modes.lappend(Tcl_NewStringObj("in", -1)); } if (parameter.flags() & PARAMFLAG_FOUT) { modes.lappend(Tcl_NewStringObj("out", -1)); } list.lappend(modes); // Put parameter type. list.lappend(typeToListObj(parameter.type())); // Put parameter name. list.lappend( Tcl_NewStringObj(const_cast<char *>(parameter.name().c_str()), -1)); return list; }
void TclTextInterp::graph_label_cb(const char *type, const int *ids, int n) { Tcl_Obj *itemlist = Tcl_NewListObj(0, NULL); for (int i=0; i<n; i++) { Tcl_Obj *item = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, item, Tcl_NewStringObj(type, -1)); Tcl_ListObjAppendElement(interp, item, Tcl_NewIntObj(ids[i])); Tcl_ListObjAppendElement(interp, itemlist, item); } Tcl_Obj *varname = Tcl_NewStringObj("vmd_graph_label", -1); if (!Tcl_ObjSetVar2(interp, varname, NULL, itemlist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY)) { msgErr << "Error graphing labels: " << Tcl_GetStringResult(interp) << sendmsg; } }
void TkpGetFontFamilies( Tcl_Interp *interp, /* Interp to hold result. */ Tk_Window tkwin) /* For display to query. */ { Tcl_Obj *resultPtr; XftFontSet *list; int i; resultPtr = Tcl_NewListObj(0, NULL); list = XftListFonts(Tk_Display(tkwin), Tk_ScreenNumber(tkwin), (char*)0, /* pattern elements */ XFT_FAMILY, (char*)0); /* fields */ for (i = 0; i < list->nfont; i++) { char *family, **familyPtr = &family; if (XftPatternGetString(list->fonts[i], XFT_FAMILY, 0, familyPtr) == XftResultMatch) { Tcl_Obj *strPtr = Tcl_NewStringObj(family, -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } } XftFontSetDestroy(list); Tcl_SetObjResult(interp, resultPtr); }
/* usage: async_exec_names Return list of names of registered async executors */ static int Async_Exec_Names_Cmd(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]) { TCL_ARGS(1); turbine_code tc; const int names_size = TURBINE_ASYNC_EXEC_LIMIT; const char *names[names_size]; int n; tc = turbine_async_exec_names(names, names_size, &n); TCL_CONDITION(tc == TURBINE_SUCCESS, "Error enumerating executors"); assert(n >= 0 && n <= names_size); Tcl_Obj * name_objs[n]; for (int i = 0; i < n; i++) { const char *exec_name = names[i]; assert(exec_name != NULL); name_objs[i] = Tcl_NewStringObj(exec_name, -1); TCL_CONDITION(name_objs[i] != NULL, "Error allocating string"); } Tcl_SetObjResult(interp, Tcl_NewListObj(n, name_objs)); return TCL_OK; }
static int alsa_pcm_list(ClientData clientData, Tcl_Interp *interp) { void **hints, **n; Tcl_Obj *pcm = Tcl_NewListObj(0, NULL); if (snd_device_name_hint(-1, "pcm", &hints) >= 0) { n = hints; while (*n != NULL) { char *name, *descr, *io; name = snd_device_name_get_hint(*n, "NAME"); descr = snd_device_name_get_hint(*n, "DESC"); io = snd_device_name_get_hint(*n, "IOID"); Tcl_ListObjAppendElement(interp, pcm, Tcl_ObjPrintf("%s %s %s", name?name:"(null)", descr?descr:"(null)", io?io:"(null)")); if (name != NULL) free(name); if (descr != NULL) free(descr); if (io != NULL) free(io); n++; } snd_device_name_free_hint(hints); } Tcl_SetObjResult(interp, pcm); 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; }
static Tcl_Obj *ObjFromPtr(void *p, char *name) { Tcl_Obj *objs[2]; objs[0] = Tcl_NewWideIntObj((Tcl_WideInt)p); objs[1] = Tcl_NewStringObj(name ? name : "void*", -1); return Tcl_NewListObj(2, objs); }
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 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 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; }
/* + style element options $element -- * Return list of element options for specified element */ static int StyleElementOptionsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { StylePackageData *pkgPtr = clientData; Ttk_Theme theme = pkgPtr->currentTheme; const char *elementName; Ttk_ElementClass *elementClass; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "element"); return TCL_ERROR; } elementName = Tcl_GetString(objv[3]); elementClass = Ttk_GetElement(theme, elementName); if (elementClass) { Ttk_ElementSpec *specPtr = elementClass->specPtr; Ttk_ElementOptionSpec *option = specPtr->options; Tcl_Obj *result = Tcl_NewListObj(0,0); while (option->optionName) { Tcl_ListObjAppendElement( interp, result, Tcl_NewStringObj(option->optionName,-1)); ++option; } Tcl_SetObjResult(interp, result); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "element %s not found", elementName)); Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL); return TCL_ERROR; }
void Sv_RegisterListCommands(void) { static int initialized = 0; if (initialized == 0) { Tcl_MutexLock(&initMutex); if (initialized == 0) { /* Create list with 1 empty element. */ Tcl_Obj *listobj = Tcl_NewObj(); listobj = Tcl_NewListObj(1, &listobj); Sv_RegisterObjType(listobj->typePtr, DupListObjShared); Tcl_DecrRefCount(listobj); Sv_RegisterCommand("lpop", SvLpopObjCmd, NULL, 0); Sv_RegisterCommand("lpush", SvLpushObjCmd, NULL, 0); Sv_RegisterCommand("lappend", SvLappendObjCmd, NULL, 0); Sv_RegisterCommand("lreplace", SvLreplaceObjCmd, NULL, 0); Sv_RegisterCommand("linsert", SvLinsertObjCmd, NULL, 0); Sv_RegisterCommand("llength", SvLlengthObjCmd, NULL, 0); Sv_RegisterCommand("lindex", SvLindexObjCmd, NULL, 0); Sv_RegisterCommand("lrange", SvLrangeObjCmd, NULL, 0); Sv_RegisterCommand("lsearch", SvLsearchObjCmd, NULL, 0); Sv_RegisterCommand("lset", SvLsetObjCmd, NULL, 0); initialized = 1; } Tcl_MutexUnlock(&initMutex); } }
static void get_register_types (int regnum, map_arg arg) { struct type *reg_vtype; int i,n; reg_vtype = register_type (get_current_arch (), regnum); if (TYPE_CODE (reg_vtype) == TYPE_CODE_UNION) { n = TYPE_NFIELDS (reg_vtype); /* limit to 16 types */ if (n > 16) n = 16; for (i = 0; i < n; i++) { Tcl_Obj *ar[3], *list; char *buff; buff = xstrprintf ("%lx", (long)TYPE_FIELD_TYPE (reg_vtype, i)); ar[0] = Tcl_NewStringObj (TYPE_FIELD_NAME (reg_vtype, i), -1); ar[1] = Tcl_NewStringObj (buff, -1); if (TYPE_CODE (TYPE_FIELD_TYPE (reg_vtype, i)) == TYPE_CODE_FLT) ar[2] = Tcl_NewStringObj ("float", -1); else ar[2] = Tcl_NewStringObj ("int", -1); list = Tcl_NewListObj (3, ar); Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, list); xfree (buff); } } else { Tcl_Obj *ar[3], *list; char *buff; buff = xstrprintf ("%lx", (long)reg_vtype); ar[0] = Tcl_NewStringObj (TYPE_NAME(reg_vtype), -1); ar[1] = Tcl_NewStringObj (buff, -1); if (TYPE_CODE (reg_vtype) == TYPE_CODE_FLT) ar[2] = Tcl_NewStringObj ("float", -1); else ar[2] = Tcl_NewStringObj ("int", -1); list = Tcl_NewListObj (3, ar); xfree (buff); Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, list); } }
/**** * implementation of shape2list (from RFshape creates a list { {a p} {a p} ... } ****/ int tclShape2List(ClientData data,Tcl_Interp* interp,int argc, char *argv[]) { Tcl_Obj *lptr1, *lptr2; Tcl_Obj *elemptr[2]; int i, slot; if (argc != 2) return TclError(interp,"Usage: <list> shape2list <RFshape>"); if (Tcl_GetInt(interp,argv[1],&slot) == TCL_ERROR) return TclError(interp,"shape2list: argument must be integer <RFshape>"); /* check for RFshape existence */ if (!RFshapes[slot]) return TclError(interp,"shape2list: trying to acces non-existing RFshape"); /* create list objects */ lptr1 = Tcl_NewListObj(0,NULL); if (!lptr1) return TclError(interp,"shape2list unable to create outer list"); for (i=1; i<=RFshapes_len(slot); i++) { elemptr[0] = Tcl_NewDoubleObj(RFshapes[slot][i].ampl); if (!elemptr[0]) { /* Tcl_Free(lptr2); Tcl_Free(lptr1); */ return TclError(interp,"shape2list unable to create double from RFshape amplitude element %d",i); } elemptr[1] = Tcl_NewDoubleObj(RFshapes[slot][i].phase); if (!elemptr[1]) { /* Tcl_Free(lptr2); Tcl_Free(lptr1); */ return TclError(interp,"shape2list unable to create double from RFshape amplitude element %d",i); } lptr2 = Tcl_NewListObj(2,elemptr); if (!lptr2) return TclError(interp,"shape2list unable to create inner list"); if ( Tcl_ListObjAppendElement(interp,lptr1,lptr2) != TCL_OK ) { /* Tcl_Free(lptr2); Tcl_Free(lptr1); */ return TclError(interp,"shape2list unable to append element %d to oute list",i); } } Tcl_SetObjResult(interp,lptr1); return TCL_OK; }
void TclTextInterp::mouse_pos_cb(float x, float y, int buttondown) { Tcl_Obj *poslist = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(x)); Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(y)); Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown)); Tcl_Obj *varname = Tcl_NewStringObj("vmd_mouse_pos", -1); Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY); }
Tcl_Obj* TclUtils::toListOfDouble(Tcl_Interp *interp, const std::vector<double>& v) { Tcl_Obj *ret = Tcl_NewListObj(0, NULL); for (std::vector<double>::const_iterator i = v.begin(), end = v.end(); i != end; ++i) { Tcl_ListObjAppendElement(interp, ret, Tcl_NewDoubleObj(*i)); } return ret; }
static Tcl_Obj *ObjFromSqliteValueArray(int argc, sqlite3_value *argv[], VTableDB *vtdbP) { Tcl_Obj *objP = Tcl_NewListObj(0, NULL); int i; for (i = 0; i < argc; ++i) { Tcl_ListObjAppendElement(NULL, objP, ObjFromSqliteValue(argv[i], vtdbP)); } return objP; }
/* helper function: create tcl list from complex number */ static Tcl_Obj *make_list_cpx(Tcl_Interp *interp, Tcl_Obj *list, kiss_fft_cpx *num) { Tcl_Obj *cmplx; cmplx = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, cmplx, Tcl_NewDoubleObj(num->r)); Tcl_ListObjAppendElement(interp, cmplx, Tcl_NewDoubleObj(num->i)); Tcl_ListObjAppendElement(interp, list, cmplx); return list; }
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 2) return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0]))); _t *data = (_t *)clientData; if ( ! data->started) return fw_error_obj(interp, Tcl_ObjPrintf("midi %s is not running", Tcl_GetString(objv[0]))); /* return the collected events */ Tcl_Obj *list = Tcl_NewListObj(0, NULL); jack_nframes_t frame; Tcl_Obj *bytes; while (_read(data, &frame, &bytes)) { Tcl_Obj *element[] = { Tcl_NewIntObj(frame), bytes, NULL }; Tcl_ListObjAppendElement(interp, list, Tcl_NewListObj(2, element)); } Tcl_SetObjResult(interp, list); return TCL_OK; }
TnmSnmp* TnmSnmpCreateSession(Tcl_Interp *interp, char type) { TnmSnmp *session; const char *user; session = (TnmSnmp *) ckalloc(sizeof(TnmSnmp)); memset((char *) session, 0, sizeof(TnmSnmp)); session->interp = interp; session->maddr.sin_family = AF_INET; if (type == TNM_SNMP_GENERATOR || type == TNM_SNMP_NOTIFIER) { session->maddr.sin_addr.s_addr = htonl(INADDR_LOOPBACK); } else { session->maddr.sin_addr.s_addr = htonl(INADDR_ANY); } if (type == TNM_SNMP_LISTENER || type == TNM_SNMP_NOTIFIER) { session->maddr.sin_port = htons((unsigned short) TNM_SNMP_TRAPPORT); } else { session->maddr.sin_port = htons((unsigned short) TNM_SNMP_PORT); } session->version = TNM_SNMPv1; session->domain = TNM_SNMP_UDP_DOMAIN; session->type = type; session->community = Tcl_NewStringObj("public", 6); Tcl_IncrRefCount(session->community); session->context = Tcl_NewStringObj("", 0); Tcl_IncrRefCount(session->context); user = Tcl_GetVar2(interp, "tnm", "user", TCL_GLOBAL_ONLY); if (! user) { user = "******"; } session->user = Tcl_NewStringObj(user, (int) strlen(user)); Tcl_IncrRefCount(session->user); session->engineID = Tcl_NewStringObj("", 0); Tcl_IncrRefCount(session->engineID); session->maxSize = TNM_SNMP_MAXSIZE; session->securityLevel = TNM_SNMP_AUTH_NONE | TNM_SNMP_PRIV_NONE; session->maxSize = TNM_SNMP_MAXSIZE; session->authPassWord = Tcl_NewStringObj("public", 6); Tcl_IncrRefCount(session->authPassWord); session->privPassWord = Tcl_NewStringObj("private", 6); Tcl_IncrRefCount(session->privPassWord); session->retries = TNM_SNMP_RETRIES; session->timeout = TNM_SNMP_TIMEOUT; session->window = TNM_SNMP_WINDOW; session->delay = TNM_SNMP_DELAY; session->tagList = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(session->tagList); TnmOidInit(&session->enterpriseOid); TnmOidFromString(&session->enterpriseOid, "1.3.6.1.4.1.1575"); return session; }
int sasfit_load_plugin(Tcl_Interp * interp, Tcl_Obj * filename_obj, int func_count) { int retcode = 0, i = 0; const char * filename = 0; Tcl_Obj * retlist = 0; Tcl_PackageInitProc * proc = 0; Tcl_FSUnloadFileProc * unload_proc = 0; Tcl_LoadHandle load_handle; sasfit_plugin_api_t plugin_api; if ( !interp || !filename_obj ) { sasfit_err("One of the supplied arguments is NULL!\n"); return TCL_ERROR; } filename = Tcl_GetStringFromObj(filename_obj, 0); sasfit_plugin_api_reset(&plugin_api); for(i=0; i < SASFIT_PLUGIN_API_NUM ;i++) { proc = 0; retcode = Tcl_FSLoadFile(interp, filename_obj, plugin_api.names[i], 0, &proc, 0, &load_handle, &unload_proc); // check for error while loading if ( retcode != TCL_OK || !proc ) { sasfit_err("Could not load function '%s'!\n%s\n", plugin_api.names[i], Tcl_GetStringResult(interp)); if ( !proc && unload_proc ) (*unload_proc)(load_handle); return TCL_ERROR; } sasfit_plugin_api_set(&plugin_api, i, (void *) proc); // sasfit_plugin_api_print(&plugin_api); } retlist = Tcl_NewListObj(0, 0); if ( add_functions_to_db_and_list(interp, &plugin_api, retlist, func_count) == TCL_ERROR ) { if ( unload_proc ) (*unload_proc)(load_handle); Tcl_DecrRefCount(retlist); return TCL_ERROR; } Tcl_SetObjResult(interp, retlist); return TCL_OK; }
// void jackctl_parameter_get_range_constraint(jackctl_parameter_t * parameter, union jackctl_parameter_value * min_ptr, union jackctl_parameter_value * max_ptr); static int _parameter_get_range_constraint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 3) return fw_error_str(interp, "usage: jack-ctl parameter-get-range-constraint parameter"); jackctl_parameter_t * parameter; if (_get_pointer(interp, objv[2], (void**)¶meter) != TCL_OK) return TCL_ERROR; union jackctl_parameter_value min, max; jackctl_parameter_get_range_constraint(parameter, &min, &max); Tcl_Obj *result[] = { _make_value(parameter, min), _make_value(parameter, max), NULL }; return fw_success_obj(interp, Tcl_NewListObj(2, result)); }
static Tcl_Obj* AsObj(PyObject *value) { Tcl_Obj *result; if (PyString_Check(value)) return Tcl_NewStringObj(PyString_AS_STRING(value), PyString_GET_SIZE(value)); else if (PyInt_Check(value)) return Tcl_NewLongObj(PyInt_AS_LONG(value)); else if (PyFloat_Check(value)) return Tcl_NewDoubleObj(PyFloat_AS_DOUBLE(value)); else if (PyTuple_Check(value)) { Tcl_Obj **argv = (Tcl_Obj**) ckalloc(PyTuple_Size(value)*sizeof(Tcl_Obj*)); int i; if(!argv) return 0; for(i=0;i<PyTuple_Size(value);i++) argv[i] = AsObj(PyTuple_GetItem(value,i)); result = Tcl_NewListObj(PyTuple_Size(value), argv); ckfree(FREECAST argv); return result; } else if (PyUnicode_Check(value)) { #if TKMAJORMINOR <= 8001 /* In Tcl 8.1 we must use UTF-8 */ PyObject* utf8 = PyUnicode_AsUTF8String(value); if (!utf8) return 0; result = Tcl_NewStringObj(PyString_AS_STRING(utf8), PyString_GET_SIZE(utf8)); Py_DECREF(utf8); return result; #else /* TKMAJORMINOR > 8001 */ /* In Tcl 8.2 and later, use Tcl_NewUnicodeObj() */ if (sizeof(Py_UNICODE) != sizeof(Tcl_UniChar)) { /* XXX Should really test this at compile time */ PyErr_SetString(PyExc_SystemError, "Py_UNICODE and Tcl_UniChar differ in size"); return 0; } return Tcl_NewUnicodeObj(PyUnicode_AS_UNICODE(value), PyUnicode_GET_SIZE(value)); #endif /* TKMAJORMINOR > 8001 */ } else { PyObject *v = PyObject_Str(value); if (!v) return 0; result = AsObj(v); Py_DECREF(v); return result; } }
/* Ttk_NewTagSetObj -- * Construct a fresh Tcl_Obj * from a tag set. */ Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset) { Tcl_Obj *result = Tcl_NewListObj(0,0); int i; for (i = 0; i < tagset->nTags; ++i) { Tcl_ListObjAppendElement( NULL, result, Tcl_NewStringObj(tagset->tags[i]->tagName, -1)); } return result; }
/* *---------------------------------------------------------------------- * * casstcl_logging_eventProc -- * * this routine is called by the Tcl event handler to process callbacks * we have set up from logging callbacks we've gotten from Cassandra * loop is * * Results: * returns 1 to say we handled the event and the dispatcher can delete it * *---------------------------------------------------------------------- */ int casstcl_logging_eventProc (Tcl_Event *tevPtr, int flags) { // we got called with a Tcl_Event pointer but really it's a pointer to // our casstcl_loggingEvent structure that has the Tcl_Event plus a pointer // to casstcl_sessionClientData, which is our key to the kindgdom. // Go get that. casstcl_loggingEvent *evPtr = (casstcl_loggingEvent *)tevPtr; Tcl_Interp *interp = evPtr->interp; #define CASSTCL_LOG_CALLBACK_LISTCOUNT 12 Tcl_Obj *listObjv[CASSTCL_LOG_CALLBACK_LISTCOUNT]; // probably won't happen but if we get a logging callback and have // no callback object, return 1 saying we handled it and let the // dispatcher delete the message NB this isn't exactly cool if (casstcl_loggingCallbackObj == NULL) { return 1; } // construct a list of key-value pairs representing the log message listObjv[0] = Tcl_NewStringObj ("clock", -1); listObjv[1] = Tcl_NewDoubleObj (evPtr->message.time_ms / 1000.0); listObjv[2] = Tcl_NewStringObj ("severity", -1); listObjv[3] = Tcl_NewStringObj (casstcl_cass_log_level_to_string (evPtr->message.severity), -1); listObjv[4] = Tcl_NewStringObj ("file", -1); listObjv[5] = Tcl_NewStringObj (evPtr->message.file, -1); listObjv[6] = Tcl_NewStringObj ("line", -1); listObjv[7] = Tcl_NewIntObj (evPtr->message.line); listObjv[8] = Tcl_NewStringObj ("function", -1); listObjv[9] = Tcl_NewStringObj (evPtr->message.function, -1); listObjv[10] = Tcl_NewStringObj ("message", -1); int messageLength = strnlen (evPtr->message.message, CASS_LOG_MAX_MESSAGE_SIZE); listObjv[11] = Tcl_NewStringObj (evPtr->message.message, messageLength); Tcl_Obj *listObj = Tcl_NewListObj (CASSTCL_LOG_CALLBACK_LISTCOUNT, listObjv); // even if this fails we still want the event taken off the queue // this function will do the background error thing if there is a tcl // error running the callback casstcl_invoke_callback_with_argument (interp, casstcl_loggingCallbackObj, listObj); // tell the dispatcher we handled it. 0 would mean we didn't deal with // it and don't want it removed from the queue return 1; }
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; }
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 2) return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0]))); _t *data = (_t *)clientData; Tcl_Obj *result[] = { Tcl_NewIntObj(jack_frame_time(data->fw.client)), Tcl_NewDoubleObj(data->sam.pll.freq.f), NULL }; Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; }