C++ Tcl_GetCommandInfo函数代码示例

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;
}

/* 
 * 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;
  }
}