diff options
Diffstat (limited to 'generic/tkUtil.c')
| -rw-r--r-- | generic/tkUtil.c | 250 |
1 files changed, 228 insertions, 22 deletions
diff --git a/generic/tkUtil.c b/generic/tkUtil.c index bfa5d5c..5282708 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -18,7 +18,7 @@ * object, used for quickly finding a mapping in a TkStateMap. */ -Tcl_ObjType tkStateKeyObjType = { +const Tcl_ObjType tkStateKeyObjType = { "statekey", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ @@ -59,7 +59,7 @@ TkStateParseProc( register Tk_State *statePtr = (Tk_State *) (widgRec + offset); - if(value == NULL || *value == 0) { + if (value == NULL || *value == 0) { *statePtr = TK_STATE_NULL; return TCL_OK; } @@ -121,7 +121,7 @@ TkStateParseProc( *-------------------------------------------------------------- */ -char * +const char * TkStatePrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -179,7 +179,7 @@ TkOrientParseProc( register int *orientPtr = (int *) (widgRec + offset); - if(value == NULL || *value == 0) { + if (value == NULL || *value == 0) { *orientPtr = 0; return TCL_OK; } @@ -222,7 +222,7 @@ TkOrientParseProc( *-------------------------------------------------------------- */ -char * +const char * TkOrientPrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -273,7 +273,7 @@ TkOffsetParseProc( tsoffset.flags = 0; p = value; - switch(value[0]) { + switch (value[0]) { case '#': if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { tsoffset.flags = TK_OFFSET_RELATIVE; @@ -336,7 +336,13 @@ TkOffsetParseProc( tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; goto goodTSOffset; } - if ((q = strchr(p,',')) == NULL) { + + /* + * Check for an extra offset. + */ + + q = strchr(p, ','); + if (q == NULL) { if (PTR2INT(clientData) & TK_OFFSET_INDEX) { if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) { Tcl_ResetResult(interp); @@ -347,6 +353,7 @@ TkOffsetParseProc( } goto badTSOffset; } + *((char *) q) = 0; result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset); *((char *) q) = ','; @@ -357,14 +364,14 @@ TkOffsetParseProc( return TCL_ERROR; } - goodTSOffset: /* * Below is a hack to allow the stipple/tile offset to be stored in the * internal tile structure. Most of the times, offsetPtr is a pointer to * an already existing tile structure. However if this structure is not - * already created, we must do it with Tk_GetTile()!!!!; + * already created, we must do it with Tk_GetTile()!!!! */ + goodTSOffset: memcpy(offsetPtr, &tsoffset, sizeof(Tk_TSOffset)); return TCL_OK; @@ -394,7 +401,7 @@ TkOffsetParseProc( *---------------------------------------------------------------------- */ -char * +const char * TkOffsetPrintProc( ClientData clientData, /* not used */ Tk_Window tkwin, /* not used */ @@ -409,7 +416,7 @@ TkOffsetPrintProc( if (offsetPtr->flags >= INT_MAX) { return "end"; } - p = (char *) ckalloc(32); + p = ckalloc(32); sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX); *freeProcPtr = TCL_DYNAMIC; return p; @@ -439,7 +446,7 @@ TkOffsetPrintProc( return "se"; } } - q = p = (char *) ckalloc(32); + q = p = ckalloc(32); if (offsetPtr->flags & TK_OFFSET_RELATIVE) { *q++ = '#'; } @@ -461,7 +468,7 @@ TkOffsetPrintProc( int TkPixelParseProc( ClientData clientData, /* If non-NULL, negative values are allowed as - * well */ + * well. */ Tcl_Interp *interp, /* Interpreter to send results back to */ Tk_Window tkwin, /* Window on same display as tile */ const char *value, /* Name of image */ @@ -493,7 +500,7 @@ TkPixelParseProc( *---------------------------------------------------------------------- */ -char * +const char * TkPixelPrintProc( ClientData clientData, /* not used */ Tk_Window tkwin, /* not used */ @@ -502,7 +509,7 @@ TkPixelPrintProc( Tcl_FreeProc **freeProcPtr) /* not used */ { double *doublePtr = (double *) (widgRec + offset); - char *p = (char *) ckalloc(24); + char *p = ckalloc(24); Tcl_PrintDouble(NULL, *doublePtr, p); *freeProcPtr = TCL_DYNAMIC; @@ -707,11 +714,10 @@ Tk_GetScrollInfoObj( * scroll, if any. */ { int length; - const char *arg; - - arg = Tcl_GetStringFromObj(objv[2], &length); + const char *arg = Tcl_GetStringFromObj(objv[2], &length); -#define ArgPfxEq(str) ((arg[0]==str[0])&&!strncmp(arg,str,(unsigned)length)) +#define ArgPfxEq(str) \ + ((arg[0] == str[0]) && !strncmp(arg, str, (unsigned)length)) if (ArgPfxEq("moveto")) { if (objc != 4) { @@ -848,14 +854,14 @@ TkComputeAnchor( *--------------------------------------------------------------------------- */ -char * +const char * TkFindStateString( const TkStateMap *mapPtr, /* The state table. */ int numKey) /* The key to try to find in the table. */ { for (; mapPtr->strKey!=NULL ; mapPtr++) { if (numKey == mapPtr->numKey) { - return (char *) mapPtr->strKey; + return mapPtr->strKey; } } return NULL; @@ -948,7 +954,7 @@ TkFindStateNumObj( if (strcmp(key, mPtr->strKey) == 0) { typePtr = keyPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(keyPtr); + typePtr->freeIntRepProc(keyPtr); } keyPtr->internalRep.twoPtrValue.ptr1 = (void *) mapPtr; keyPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(mPtr->numKey); @@ -976,6 +982,206 @@ TkFindStateNumObj( } /* + * ---------------------------------------------------------------------- + * + * TkBackgroundEvalObjv -- + * + * Evaluate a command while ensuring that we do not affect the + * interpreters state. This is important when evaluating script + * during background tasks. + * + * Results: + * A standard Tcl result code. + * + * Side Effects: + * The interpreters variables and code may be modified by the script + * but the result will not be modified. + * + * ---------------------------------------------------------------------- + */ + +int +TkBackgroundEvalObjv( + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv, + int flags) +{ + Tcl_DString errorInfo, errorCode; + Tcl_SavedResult state; + int n, r = TCL_OK; + + Tcl_DStringInit(&errorInfo); + Tcl_DStringInit(&errorCode); + + Tcl_Preserve(interp); + + /* + * Record the state of the interpreter + */ + + Tcl_SaveResult(interp, &state); + Tcl_DStringAppend(&errorInfo, + Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); + Tcl_DStringAppend(&errorCode, + Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); + + /* + * Evaluate the command and handle any error. + */ + + for (n = 0; n < objc; ++n) { + Tcl_IncrRefCount(objv[n]); + } + r = Tcl_EvalObjv(interp, objc, objv, flags); + for (n = 0; n < objc; ++n) { + Tcl_DecrRefCount(objv[n]); + } + if (r == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (background event handler)"); + Tcl_BackgroundException(interp, r); + } + + Tcl_Release(interp); + + /* + * Restore the state of the interpreter + */ + + Tcl_SetVar(interp, "errorInfo", + Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "errorCode", + Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); + Tcl_RestoreResult(interp, &state); + + /* + * Clean up references. + */ + + Tcl_DStringFree(&errorInfo); + Tcl_DStringFree(&errorCode); + + return r; +} + +/* + *---------------------------------------------------------------------- + * + * TkMakeEnsemble -- + * + * Create an ensemble from a table of implementation commands. This may + * be called recursively to create sub-ensembles. + * + * Results: + * Handle for the ensemble, or NULL if creation of it fails. + * + *---------------------------------------------------------------------- + */ + +Tcl_Command +TkMakeEnsemble( + Tcl_Interp *interp, + const char *namespace, + const char *name, + ClientData clientData, + const TkEnsemble map[]) +{ + Tcl_Namespace *namespacePtr = NULL; + Tcl_Command ensemble = NULL; + Tcl_Obj *dictObj = NULL, *nameObj; + Tcl_DString ds; + int i; + + if (map == NULL) { + return NULL; + } + + Tcl_DStringInit(&ds); + + namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0); + if (namespacePtr == NULL) { + namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL); + if (namespacePtr == NULL) { + Tcl_Panic("failed to create namespace \"%s\"", namespace); + } + } + + nameObj = Tcl_NewStringObj(name, -1); + ensemble = Tcl_FindEnsemble(interp, nameObj, 0); + Tcl_DecrRefCount(nameObj); + if (ensemble == NULL) { + ensemble = Tcl_CreateEnsemble(interp, name, namespacePtr, + TCL_ENSEMBLE_PREFIX); + if (ensemble == NULL) { + Tcl_Panic("failed to create ensemble \"%s\"", name); + } + } + + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, namespace, -1); + if (!(strlen(namespace) == 2 && namespace[1] == ':')) { + Tcl_DStringAppend(&ds, "::", -1); + } + Tcl_DStringAppend(&ds, name, -1); + + dictObj = Tcl_NewObj(); + for (i = 0; map[i].name != NULL ; ++i) { + Tcl_Obj *nameObj, *fqdnObj; + + nameObj = Tcl_NewStringObj(map[i].name, -1); + fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_AppendStringsToObj(fqdnObj, "::", map[i].name, NULL); + Tcl_DictObjPut(NULL, dictObj, nameObj, fqdnObj); + if (map[i].proc) { + Tcl_CreateObjCommand(interp, Tcl_GetString(fqdnObj), + map[i].proc, clientData, NULL); + } else if (map[i].subensemble) { + TkMakeEnsemble(interp, Tcl_DStringValue(&ds), + map[i].name, clientData, map[i].subensemble); + } + } + + if (ensemble) { + Tcl_SetEnsembleMappingDict(interp, ensemble, dictObj); + } + + Tcl_DStringFree(&ds); + return ensemble; +} + +/* + *---------------------------------------------------------------------- + * + * TkSendVirtualEvent -- + * + * Send a virtual event notification to the specified target window. + * Equivalent to "event generate $target <<$eventName>>" + * + * Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent, so this + * routine does not reenter the interpreter. + * + *---------------------------------------------------------------------- + */ + +void +TkSendVirtualEvent( + Tk_Window target, + const char *eventName) +{ + union {XEvent general; XVirtualEvent virtual;} event; + + memset(&event, 0, sizeof(event)); + event.general.xany.type = VirtualEvent; + event.general.xany.serial = NextRequest(Tk_Display(target)); + event.general.xany.send_event = False; + event.general.xany.window = Tk_WindowId(target); + event.general.xany.display = Tk_Display(target); + event.virtual.name = Tk_GetUid(eventName); + + Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); +} +/* * Local Variables: * mode: c * c-basic-offset: 4 |