Example #1
0
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;
}
Example #2
0
/** 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;
}
Example #3
0
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;
}
Example #5
0
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);
}
Example #6
0
/*
 * 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;
}
Example #7
0
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;
}
Example #8
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);
}
Example #9
0
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;
}
Example #10
0
/* 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;
}
Example #11
0
/*
** 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;
}
Example #12
0
/**
 * 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;
}
Example #13
0
/* 
 * 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;
    }
}
Example #14
0
/*
 * 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);
}
Example #15
0
// 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;
}
Example #16
0
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;
  }
}
Example #17
0
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
}
Example #18
0
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;
}
Example #19
0
/**
 * 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;
}
Example #20
0
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);
}
Example #21
0
/*
 * 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);
}
Example #22
0
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;
}
Example #23
0
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
Example #24
0
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
Example #25
0
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;
}
Example #26
0
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;
}
Example #27
0
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;
}
Example #28
0
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);
}
Example #29
0
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;
}
Example #30
0
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;
}