int QMetaTclQVariant::setFromAny(Tcl_Interp *interp, Tcl_Obj *obj) { if (obj->typePtr == &TclType) return TCL_OK; // cleanup old internal representation if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->typePtr = NULL; // pointer to QMetaTclQVariant is extracted from the Tcl_CmdInfo struct // of the object's command - this only works when that command has not // been renamed or deleted const char *commandName = Tcl_GetStringFromObj(obj, NULL); Tcl_CmdInfo commandInfo; if (!Tcl_GetCommandInfo(interp, commandName, &commandInfo)) { if (interp) Tcl_AppendResult(interp, commandName, " not found", (char *)NULL); return TCL_ERROR; } if (commandInfo.objProc != commandProc) { if (interp) Tcl_AppendResult(interp, commandName, " is not a QVariant", (char *)NULL); return TCL_ERROR; } obj->internalRep.twoPtrValue.ptr1 = commandInfo.clientData; obj->typePtr = &TclType; return TCL_OK; }
/** The function for analyzing a column only. \anchor UWerr */ int UWerr(Tcl_Interp * interp, double ** data, int rows, int cols, int col_to_analyze, int * n_rep, int len, double s_tau, int plot) { Tcl_CmdInfo cmdInfo; char * argv[2]; char * name = "UWerrInternalFunction"; int res; argv[0] = name; argv[1] = (char*)malloc(TCL_INTEGER_SPACE*sizeof(char)); sprintf(argv[1], "%d", col_to_analyze); if (Tcl_CreateCommand(interp, name, UWerr_proj, 0, NULL) == NULL) { Tcl_AppendResult(interp, "could not create command \"", name, "\"", (char *)NULL); return TCL_ERROR; } if (Tcl_GetCommandInfo(interp, name, &cmdInfo) == 0) { Tcl_AppendResult(interp, "could not access command \"", name, "\"", (char *)NULL); return TCL_ERROR; } res = UWerr_f(interp, &cmdInfo, 2, argv, data, rows, cols, n_rep, len, s_tau, plot); Tcl_DeleteCommand(interp, name); free(argv[1]); return res; }
Tcl_CmdInfo *eul_tk_create_widget(char *type, char *name, LispRef listArgs) { struct infoargs infoArgs; ParseArguments2(&infoArgs, type, name, listArgs); Tcl_CmdInfo cmdInfo = FindCreationFn(type); int result = cmdInfo.proc ( cmdInfo.clientData, interp, infoArgs.argc, infoArgs.argv ); Tcl_CmdInfo *newCmdInfo = (Tcl_CmdInfo *)gc_malloc(sizeof(Tcl_CmdInfo)); *newCmdInfo = (Tcl_CmdInfo){0, NULL, 0, NULL, 0, NULL, 0, NULL}; // It isn't clear what should be returned on error so return an empty // structure allocated on free-store if (result == TCL_ERROR) { return newCmdInfo; } result = Tcl_GetCommandInfo ( interp, Tcl_GetString(Tcl_GetObjResult(interp)), newCmdInfo ); return newCmdInfo; }
/* ** usage: btree_from_db DB-HANDLE ** ** This command returns the btree handle for the main database associated ** with the database-handle passed as the argument. Example usage: ** ** sqlite3 db test.db ** set bt [btree_from_db db] */ static int btree_from_db( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ char zBuf[100]; Tcl_CmdInfo info; sqlite3 *db; Btree *pBt; int iDb = 0; if( argc!=2 && argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " DB-HANDLE ?N?\"", 0); return TCL_ERROR; } if( 1!=Tcl_GetCommandInfo(interp, argv[1], &info) ){ Tcl_AppendResult(interp, "No such db-handle: \"", argv[1], "\"", 0); return TCL_ERROR; } if( argc==3 ){ iDb = atoi(argv[2]); } db = *((sqlite3 **)info.objClientData); assert( db ); pBt = db->aDb[iDb].pBt; sqlite3_snprintf(sizeof(zBuf), zBuf, "%p", pBt); Tcl_SetResult(interp, zBuf, TCL_VOLATILE); return TCL_OK; }
void seqed_shutdown(Tcl_Interp *interp, SeqedResult *result) { Tcl_CmdInfo info; tkSeqed *se; char *tmp; #ifdef DEBUG printf("seqed shutdown \n"); #endif Tcl_GetCommandInfo(interp, result->seqed_win, &info); se = (tkSeqed*)info.clientData; if (se->renzDisplayed) { free_lines(); free_r_enzyme(se->r_enzyme, se->num_enzymes); } /* destroy toplevel seqed window */ Tcl_VarEval(interp, "winfo toplevel ", result->seqed_win, NULL); Tcl_VarEval(interp, "destroy ", Tcl_GetStringResult(interp), NULL); tmp = get_default_string(interp, tk_utils_defs, w("RASTER.RESULTS.WIN")); if (TCL_OK != Tcl_VarEval(interp, "seq_result_list_update ", tmp, NULL)){ verror(ERR_WARN, "seqed shutdown", "%s \n", Tcl_GetStringResult(interp)); } xfree(result); }
/* * add sequence to seqed widget */ int add_seq_seqed(Tcl_Interp *interp, char *sequence, char *seqed_win, int seq_num, int pos, int container_id, char *c_win, int element_id) { Tcl_CmdInfo info; tkSeqed *se; char *seq_name; int sequence_type; int seqed_id; Tcl_GetCommandInfo(interp, seqed_win, &info); se = (tkSeqed*)info.clientData; seq_name = GetSeqName(seq_num); sequence_type = GetSeqStructure(seq_num); seqed_add_sequence(se, strlen(sequence), sequence, seq_name, sequence_type, GetSeqId(seq_num), 0, 0); seqed_id = seqed_reg(interp, seqed_win, seq_num, se, pos, container_id, c_win, element_id); return seqed_id; }
int TkMacOSXProcessCommandEvent(TkMacOSXEvent *eventPtr, MacEventStatus * statusPtr) { HICommand command; int menuContext; OSStatus status; switch (eventPtr->eKind) { case kEventCommandProcess: case kEventCommandUpdateStatus: break; default: return 0; break; } status = GetEventParameter(eventPtr->eventRef, kEventParamDirectObject, typeHICommand, NULL, sizeof(command), NULL, &command); if (status == noErr && (command.attributes & kHICommandFromMenu)) { if (eventPtr->eKind == kEventCommandProcess) { status = GetEventParameter(eventPtr->eventRef, kEventParamMenuContext, typeUInt32, NULL, sizeof(menuContext), NULL, &menuContext); if (status == noErr && (menuContext & kMenuContextMenuBar) && (menuContext & kMenuContextMenuBarTracking)) { TkMacOSXHandleMenuSelect(GetMenuID(command.menu.menuRef), command.menu.menuItemIndex, GetCurrentEventKeyModifiers() & optionKey); return 1; } } else { Tcl_CmdInfo dummy; if (command.commandID == kHICommandPreferences && eventPtr->interp) { if (Tcl_GetCommandInfo(eventPtr->interp, "::tk::mac::ShowPreferences", &dummy)) { if (!IsMenuItemEnabled(command.menu.menuRef, command.menu.menuItemIndex)) { EnableMenuItem(command.menu.menuRef, command.menu.menuItemIndex); } } else { if (IsMenuItemEnabled(command.menu.menuRef, command.menu.menuItemIndex)) { DisableMenuItem(command.menu.menuRef, command.menu.menuItemIndex); } } return 1; } } } return 0; }
/* * Superimpose a result onto an existing window */ void SeqSuperimposeResult(Tcl_Interp *interp, char *raster_win, int result_id, double o_wx0, double o_wy0, double o_wx1, double o_wy1) { seq_result *result; out_raster *output; Tcl_CmdInfo cmd_info; Tk_Raster *raster; double wx0, wy0, wx1, wy1; double p2, q2; double m, c; d_line *dim; seq_reg_info info; #ifdef DEBUG printf("SeqSuperimposeResult %d\n", result_id); #endif result = seq_id_to_result(result_id); output = result->output; if (Tcl_GetCommandInfo(interp, raster_win, &cmd_info) == 0) return; raster = (Tk_Raster*)cmd_info.clientData; /* * get the current scroll region for the raster */ RasterGetWorldScroll(raster, &wx0, &wy0, &wx1, &wy1); /* find dimensions of result */ info.job = SEQ_RESULT_INFO; info.op = DIMENSIONS; info.result = NULL; seq_result_notify(result_id, (seq_reg_data *)&info, 0); if (!info.result) { return; } dim = (d_line *)info.result; /* superimpose, update an exising raster */ p2 = (wy1 - wy0) * (dim->y0 - o_wy0) / (o_wy1 - o_wy0) + wy0; q2 = (wy1 - wy0) * (dim->y1 - o_wy0) / (o_wy1 - o_wy0) + wy0; m = (p2 - q2) / (dim->y0 - dim->y1); c = p2 - (m * dim->y0); output->sf_c = (m * output->sf_c) + (c); output->sf_m *= m; /* enlarge x scroll region if necessary */ RasterSetWorldScroll(raster, o_wx0, wy0, o_wx1, wy1); }
static const char * generateCommandName(Tcl_Interp *interp) { static char nameBuffer[64]; Tcl_CmdInfo commandInfo; do { snprintf(nameBuffer, sizeof(nameBuffer), "::qmetatcl::qvariant%u", objectNameCounter); objectNameCounter++; } while (Tcl_GetCommandInfo(interp, nameBuffer, &commandInfo)); return nameBuffer; }
/* parse the range command to get at the data */ static int range_cmd_parse(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec, int offset) { Tcl_CmdInfo info; if (!Tcl_GetCommandInfo(interp, value, &info)) return TCL_ERROR; *(gap_range_t **)(widgRec + offset) = (gap_range_t *)info.objClientData; return TCL_OK; }
/* ** Decode a pointer to an sqlite3 object. */ static int f5tDbPointer(Tcl_Interp *interp, Tcl_Obj *pObj, sqlite3 **ppDb){ struct SqliteDb *p; Tcl_CmdInfo cmdInfo; char *z = Tcl_GetString(pObj); if( Tcl_GetCommandInfo(interp, z, &cmdInfo) ){ p = (struct SqliteDb*)cmdInfo.objClientData; *ppDb = p->db; return TCL_OK; } return TCL_ERROR; }
/** * Generates a unique proc name starting with prefix. * * This function loops through the integers trying to find a name * "<prefix><int>" such that no command with that name exists within the given * Tcl interp context. This behavior is similar to that of the builtin * `interp create` command, and is intended to generate names for created * objects of a similar nature. * * TODO: add a int* parameter so that functions which need large numbers of * unique names can keep track of the lower bound between calls,thereby turning * N^2 to N. It'll be alchemy for the 21st century. */ char* unique_name(Tcl_Interp* interp, char* prefix) { char* result = malloc(strlen(prefix) + TCL_INTEGER_SPACE + 1); Tcl_CmdInfo info; int i; for (i=0; ; i++) { sprintf(result, "%s%d", prefix, i); if (Tcl_GetCommandInfo(interp, result, &info) == 0) { break; } } return result; }
/* * Given a command corresponding to a Sqlite connection, return * the corresponding sqlite3* pointer. This is stored as the clientdata * field for the corresponding Tcl command. */ static int GetSqliteConnPtr(Tcl_Interp *interp, const char *db_cmd, sqlite3 **dbPP){ Tcl_CmdInfo cmdInfo; if( Tcl_GetCommandInfo(interp, db_cmd, &cmdInfo) ){ void *p = cmdInfo.objClientData; /* The sqlite3 pointer is *always* the first field */ *dbPP = *(sqlite3 **)p; return TCL_OK; } else { Tcl_AppendResult(interp, "Unknown database connection '", db_cmd, "'", NULL); return TCL_ERROR; } }
/* * update sequence position */ void update_seqed(Tcl_Interp *interp, char *seqed_win, int pos) { Tcl_CmdInfo info; tkSeqed *se; Tcl_GetCommandInfo(interp, seqed_win, &info); se = (tkSeqed*)info.clientData; /* seqed_redisplay_seq(se, pos); */ seqed_setCursorPos(se, pos); }
// Find and return the requested function details. // TclTk since version 8.3 make you jump through hoops // to get access to the primitive functions. Tcl_CmdInfo FindCreationFn(const char *type) { Tcl_CmdInfo cmdInfo; int result = Tcl_GetCommandInfo ( interp, type, &cmdInfo ); assert(result); return cmdInfo; }
c4_View MkView::View(Tcl_Interp *interp, Tcl_Obj *obj) { const char *name = Tcl_GetStringFromObj(obj, 0); Tcl_CmdInfo ci; if (!Tcl_GetCommandInfo(interp, (char*)name, &ci) || ci.objProc != MkView ::Dispatcher) { //Fail("no such view"); c4_View temp; return temp; } else { MkView *v = (MkView*)ci.objClientData; return v->view; } }
void OpenGLSwapBuffers(Tcl_Interp* interp, char* name) { Tcl_CmdInfo info; OpenGLClientData* OpenGLPtr; if(!Tcl_GetCommandInfo(interp, name, &info)) return; OpenGLPtr=(OpenGLClientData*)info.clientData; #ifndef _WIN32 glXSwapBuffers(OpenGLPtr->display, OpenGLPtr->glx_win); #else SwapBuffers(OpenGLPtr->hDC); #endif }
static int InitCmds(Tcl_Interp *interp, int safe) { CmdInfo *cmdInfoPtr; Tcl_CmdInfo info; for (cmdInfoPtr = tnmCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { /* * Due to some Tcl limitations, we need to remove the Tnm * namespace qualifier if we register the commands in a * safe Tcl interpreter (since we can only hide commands * in the global namespace). This is truely ugly - but Tcl * forces me to do this. */ char *cmdName = cmdInfoPtr->name; if (safe && ! cmdInfoPtr->isSafe) { char *newName = strstr(cmdName, "::"); while (newName) { cmdName = newName + 2; newName = strstr(cmdName, "::"); } } /* * Check if the command already exists and return an error * to ensure we detect name clashes while loading the Tnm * extension. */ if (Tcl_GetCommandInfo(interp, cmdName, &info)) { Tcl_AppendResult(interp, "command \"", cmdName, "\" already exists", (char *) NULL); return TCL_ERROR; } if (cmdInfoPtr->objProc) { Tcl_CreateObjCommand(interp, cmdName, cmdInfoPtr->objProc, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); } /* * Hide all unsafe commands from the interpreter * if it is a safe Tcl interpreter. */ if (safe && ! cmdInfoPtr->isSafe) { if (Tcl_HideCommand(interp, cmdName, cmdName) != TCL_OK) { return TCL_ERROR; } } } return TCL_OK; }
/** * Generates a unique proc name starting with prefix. * * This function loops through the integers trying to find a name * "<prefix><int>" such that no command with that name exists within the given * Tcl interp context. This behavior is similar to that of the builtin * `interp create` command, and is intended to generate names for created * objects of a similar nature. * * TODO: add a int* parameter so that functions which need large numbers of * unique names can keep track of the lower bound between calls,thereby turning * N^2 to N. It'll be alchemy for the 21st century. */ char* unique_name(Tcl_Interp* interp, char* prefix) { int result_size = strlen(prefix) + TCL_INTEGER_SPACE + 1; char* result = malloc(result_size); Tcl_CmdInfo info; int i; if (!result) return NULL; for (i=0; ; i++) { snprintf(result, result_size, "%s%d", prefix, i); if (Tcl_GetCommandInfo(interp, result, &info) == 0) { break; } } return result; }
void seqed_move_cursor(Tcl_Interp *interp, char *seqed_win, int pos) { Tcl_CmdInfo info; tkSeqed *se; /* printf("seqed move cursor %s %d %d \n", seqed_win, seqed_id, pos); */ Tcl_GetCommandInfo(interp, seqed_win, &info); se = (tkSeqed*)info.clientData; se->cursorPos = pos; seqed_showCursor(se, se->cursorSeq, se->cursorPos); }
/* * Add a consensus trace to the trace display. */ void cons_edc_trace(EdStruct *xx, int start, int end, int strand, int match, int exception) { Read *r; char *pname; char buf[1024]; Tcl_Interp *interp = EDINTERP(xx->ed); int exists; tman_dc *ed; DisplayContext *dc; static int cons_counter = 0; Tcl_CmdInfo info; int pos; /* Produce the read structure */ if (NULL == (r = cons_trace(xx, start, end, strand, match, exception))) { bell(); return; } /* Create a trace display */ pname = get_default_string(interp, gap_defs, "TRACE_DISPLAY.WIN"); Tcl_VarEval(interp, "trace_create ", Tk_PathName(EDTKWIN(xx->ed)), pname, " ", Tk_PathName(EDTKWIN(xx->ed)), " consensus", NULL); pname = interp->result; /* Fill out the tman_dc and DisplayContext structures */ sprintf(buf, "Cons %d", cons_counter++); dc = getTDisplay(xx, buf, 0, 0, &exists); strcpy(dc->path, pname); ed = find_free_edc(); ed->dc = dc; ed->pos = start-1; ed->xx = xx; ed->seq = 0; ed->type = TRACE_TYPE_CON; /* Add the Read to the trace widget */ Tcl_GetCommandInfo(interp, interp->result, &info); trace_memory_load((DNATrace *)info.clientData, r); dc->tracePtr = (DNATrace *)info.clientData; /* Adjust position */ Tcl_Eval(interp, "update idletasks"); pos = positionInContig(xx, xx->cursorSeq, xx->cursorPos) - start; repositionSeq(xx, dc, pos); }
static OSErr PrefsHandler( const AppleEvent *event, AppleEvent *reply, long handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){ if (Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences") != TCL_OK) { Tcl_BackgroundError(interp); } } return noErr; }
/* *---------------------------------------------------------------------- * * mongotcl_cmdNameObjToBson -- * * Take a command name, find the Tcl command info structure, return * a pointer to the bson embedded in the clientData of the object. * *---------------------------------------------------------------------- */ int mongotcl_cmdNameObjToBson (Tcl_Interp *interp, Tcl_Obj *commandNameObj, bson **bson) { Tcl_CmdInfo cmdInfo; if (!Tcl_GetCommandInfo (interp, Tcl_GetString(commandNameObj), &cmdInfo)) { goto lookup_error; } if (cmdInfo.objClientData == NULL || ((mongotcl_bsonClientData *)cmdInfo.objClientData)->bson_magic != MONGOTCL_BSON_MAGIC) { lookup_error: Tcl_AppendResult (interp, "Error: '", Tcl_GetString (commandNameObj), "' is not a bson object", NULL); return TCL_ERROR; } *bson = ((mongotcl_bsonClientData *)cmdInfo.objClientData)->bson; return TCL_OK; }
/* *---------------------------------------------------------------------- * * mongotcl_cmdNameObjToCursor -- * * Take a command name, find the Tcl command info structure, return * a pointer to the bson embedded in the clientData of the object. * *---------------------------------------------------------------------- */ int mongotcl_cmdNameObjToCursor (Tcl_Interp *interp, Tcl_Obj *commandNameObj, mongo_cursor **cursor) { Tcl_CmdInfo cmdInfo; if (!Tcl_GetCommandInfo (interp, Tcl_GetString(commandNameObj), &cmdInfo)) { goto lookup_error; } if (cmdInfo.objClientData == NULL || ((mongotcl_cursorClientData *)cmdInfo.objClientData)->cursor_magic != MONGOTCL_CURSOR_MAGIC) { lookup_error: Tcl_AppendResult (interp, "Error: '", Tcl_GetString (commandNameObj), "' is not a mongo cursor object", NULL); return TCL_ERROR; } *cursor = ((mongotcl_cursorClientData *)cmdInfo.objClientData)->cursor; return TCL_OK; }
static int ReallyKillMe( Tcl_Event *eventPtr, int flags) { Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp; Tcl_CmdInfo dummy; int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy); if (Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit") != TCL_OK) { /* * Should be never reached... */ Tcl_BackgroundError(interp); } return 1; }
static OSErr PrefsHandler( const AppleEvent *event, AppleEvent *reply, SRefCon handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){ int code = Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences"); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } } return noErr; }
static OSErr OappHandler( const AppleEvent *event, AppleEvent *reply, SRefCon handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){ int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication"); if (code != TCL_OK) { Tcl_BackgroundError(interp); } } return noErr; }
tkSeqed *seqed_id_to_se(Tcl_Interp *interp, int seqed_id) { Tcl_CmdInfo info; tkSeqed *se; seq_reg_info info1; char *seqed_win; info1.job = SEQ_RESULT_INFO; info1.op = WINDOW; info1.result = NULL; seq_result_notify(seqed_id, (seq_reg_data *)&info1, 0); seqed_win = (char *)info1.result; Tcl_GetCommandInfo(interp, seqed_win, &info); se = (tkSeqed*)info.clientData; return(se); }
static OSErr RappHandler( const AppleEvent *event, AppleEvent *reply, long handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; ProcessSerialNumber thePSN = {0, kCurrentProcess}; OSStatus err = ChkErr(SetFrontProcess, &thePSN); if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ReopenApplication", &dummy)) { if (Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication") != TCL_OK){ Tcl_BackgroundError(interp); } } return err; }
static int echoFindFunction( sqlite3_vtab *vtab, int nArg, const char *zFuncName, void (**pxFunc)(sqlite3_context*,int,sqlite3_value**), void **ppArg ){ echo_vtab *pVtab = (echo_vtab *)vtab; Tcl_Interp *interp = pVtab->interp; Tcl_CmdInfo info; if( strcmp(zFuncName,"glob")!=0 ){ return 0; } if( Tcl_GetCommandInfo(interp, "::echo_glob_overload", &info)==0 ){ return 0; } *pxFunc = overloadedGlobFunction; *ppArg = interp; return 1; }