summaryrefslogtreecommitdiffstats
path: root/generic/tkUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkUtil.c')
-rw-r--r--generic/tkUtil.c340
1 files changed, 64 insertions, 276 deletions
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 7ff9ecb..bfa5d5c 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -18,7 +18,7 @@
* object, used for quickly finding a mapping in a TkStateMap.
*/
-const Tcl_ObjType tkStateKeyObjType = {
+Tcl_ObjType tkStateKeyObjType = {
"statekey", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
@@ -56,11 +56,10 @@ TkStateParseProc(
int c;
int flags = PTR2INT(clientData);
size_t length;
- Tcl_Obj *msgObj;
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;
}
@@ -85,20 +84,18 @@ TkStateParseProc(
return TCL_OK;
}
- msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal",
- ((flags & 4) ? "-default" : "state"), value);
- if (flags & 1) {
- Tcl_AppendToObj(msgObj, ", active", -1);
+ Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state",
+ " value \"", value, "\": must be normal", NULL);
+ if (flags&1) {
+ Tcl_AppendResult(interp, ", active", NULL);
}
- if (flags & 2) {
- Tcl_AppendToObj(msgObj, ", hidden", -1);
+ if (flags&2) {
+ Tcl_AppendResult(interp, ", hidden", NULL);
}
- if (flags & 3) {
- Tcl_AppendToObj(msgObj, ",", -1);
+ if (flags&3) {
+ Tcl_AppendResult(interp, ",", NULL);
}
- Tcl_AppendToObj(msgObj, " or disabled", -1);
- Tcl_SetObjResult(interp, msgObj);
- Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL);
+ Tcl_AppendResult(interp, " or disabled", NULL);
*statePtr = TK_STATE_NORMAL;
return TCL_ERROR;
}
@@ -124,7 +121,7 @@ TkStateParseProc(
*--------------------------------------------------------------
*/
-const char *
+char *
TkStatePrintProc(
ClientData clientData, /* Ignored. */
Tk_Window tkwin, /* Window containing canvas widget. */
@@ -182,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;
}
@@ -198,10 +195,8 @@ TkOrientParseProc(
*orientPtr = 1;
return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad orientation \"%s\": must be vertical or horizontal",
- value));
- Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL);
+ Tcl_AppendResult(interp, "bad orientation \"", value,
+ "\": must be vertical or horizontal", NULL);
*orientPtr = 0;
return TCL_ERROR;
}
@@ -227,7 +222,7 @@ TkOrientParseProc(
*--------------------------------------------------------------
*/
-const char *
+char *
TkOrientPrintProc(
ClientData clientData, /* Ignored. */
Tk_Window tkwin, /* Window containing canvas widget. */
@@ -270,7 +265,6 @@ TkOffsetParseProc(
Tk_TSOffset tsoffset;
const char *q, *p;
int result;
- Tcl_Obj *msgObj;
if ((value == NULL) || (*value == 0)) {
tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
@@ -279,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;
@@ -342,13 +336,7 @@ TkOffsetParseProc(
tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
goto goodTSOffset;
}
-
- /*
- * Check for an extra offset.
- */
-
- q = strchr(p, ',');
- if (q == NULL) {
+ if ((q = strchr(p,',')) == NULL) {
if (PTR2INT(clientData) & TK_OFFSET_INDEX) {
if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) {
Tcl_ResetResult(interp);
@@ -359,7 +347,6 @@ TkOffsetParseProc(
}
goto badTSOffset;
}
-
*((char *) q) = 0;
result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset);
*((char *) q) = ',';
@@ -370,28 +357,27 @@ 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;
badTSOffset:
- msgObj = Tcl_ObjPrintf("bad offset \"%s\": expected \"x,y\"", value);
+ Tcl_AppendResult(interp, "bad offset \"", value,
+ "\": expected \"x,y\"", NULL);
if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) {
- Tcl_AppendToObj(msgObj, ", \"#x,y\"", -1);
+ Tcl_AppendResult(interp, ", \"#x,y\"", NULL);
}
if (PTR2INT(clientData) & TK_OFFSET_INDEX) {
- Tcl_AppendToObj(msgObj, ", <index>", -1);
+ Tcl_AppendResult(interp, ", <index>", NULL);
}
- Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1);
- Tcl_SetObjResult(interp, msgObj);
- Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL);
+ Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL);
return TCL_ERROR;
}
@@ -408,7 +394,7 @@ TkOffsetParseProc(
*----------------------------------------------------------------------
*/
-const char *
+char *
TkOffsetPrintProc(
ClientData clientData, /* not used */
Tk_Window tkwin, /* not used */
@@ -423,7 +409,7 @@ TkOffsetPrintProc(
if (offsetPtr->flags >= INT_MAX) {
return "end";
}
- p = ckalloc(32);
+ p = (char *) ckalloc(32);
sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX);
*freeProcPtr = TCL_DYNAMIC;
return p;
@@ -453,7 +439,7 @@ TkOffsetPrintProc(
return "se";
}
}
- q = p = ckalloc(32);
+ q = p = (char *) ckalloc(32);
if (offsetPtr->flags & TK_OFFSET_RELATIVE) {
*q++ = '#';
}
@@ -475,7 +461,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 */
@@ -488,9 +474,7 @@ TkPixelParseProc(
result = TkGetDoublePixels(interp, tkwin, value, doublePtr);
if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad screen distance \"%s\"", value));
- Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL);
+ Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL);
return TCL_ERROR;
}
return result;
@@ -509,7 +493,7 @@ TkPixelParseProc(
*----------------------------------------------------------------------
*/
-const char *
+char *
TkPixelPrintProc(
ClientData clientData, /* not used */
Tk_Window tkwin, /* not used */
@@ -518,7 +502,7 @@ TkPixelPrintProc(
Tcl_FreeProc **freeProcPtr) /* not used */
{
double *doublePtr = (double *) (widgRec + offset);
- char *p = ckalloc(24);
+ char *p = (char *) ckalloc(24);
Tcl_PrintDouble(NULL, *doublePtr, p);
*freeProcPtr = TCL_DYNAMIC;
@@ -653,10 +637,8 @@ Tk_GetScrollInfo(
if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) {
if (argc != 4) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s %s %s\"",
- argv[0], argv[1], "moveto fraction"));
- Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " moveto fraction\"", NULL);
return TK_SCROLL_ERROR;
}
if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) {
@@ -666,10 +648,8 @@ Tk_GetScrollInfo(
} else if ((c == 's')
&& (strncmp(argv[2], "scroll", length) == 0)) {
if (argc != 5) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s %s %s\"",
- argv[0], argv[1], "scroll number units|pages"));
- Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " scroll number units|pages\"", NULL);
return TK_SCROLL_ERROR;
}
if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) {
@@ -683,15 +663,12 @@ Tk_GetScrollInfo(
return TK_SCROLL_UNITS;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad argument \"%s\": must be units or pages", argv[4]));
- Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL);
+ Tcl_AppendResult(interp, "bad argument \"", argv[4],
+ "\": must be units or pages", NULL);
return TK_SCROLL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown option \"%s\": must be moveto or scroll", argv[2]));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2],
- NULL);
+ Tcl_AppendResult(interp, "unknown option \"", argv[2],
+ "\": must be moveto or scroll", NULL);
return TK_SCROLL_ERROR;
}
@@ -729,11 +706,12 @@ Tk_GetScrollInfoObj(
int *intPtr) /* Filled in with number of pages or lines to
* scroll, if any. */
{
- const char *arg = Tcl_GetString(objv[2]);
- size_t length = objv[2]->length;
+ int length;
+ const char *arg;
+
+ 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) {
@@ -753,22 +731,19 @@ Tk_GetScrollInfoObj(
return TK_SCROLL_ERROR;
}
- arg = Tcl_GetString(objv[4]);
- length = objv[4]->length;
+ arg = Tcl_GetStringFromObj(objv[4], &length);
if (ArgPfxEq("pages")) {
return TK_SCROLL_PAGES;
} else if (ArgPfxEq("units")) {
return TK_SCROLL_UNITS;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad argument \"%s\": must be units or pages", arg));
- Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL);
+ Tcl_AppendResult(interp, "bad argument \"", arg,
+ "\": must be units or pages", NULL);
return TK_SCROLL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown option \"%s\": must be moveto or scroll", arg));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL);
+ Tcl_AppendResult(interp, "unknown option \"", arg,
+ "\": must be moveto or scroll", NULL);
return TK_SCROLL_ERROR;
}
@@ -873,14 +848,14 @@ TkComputeAnchor(
*---------------------------------------------------------------------------
*/
-const char *
+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 mapPtr->strKey;
+ return (char *) mapPtr->strKey;
}
}
return NULL;
@@ -932,17 +907,14 @@ TkFindStateNum(
*/
if (interp != NULL) {
- Tcl_Obj *msgObj;
-
mPtr = mapPtr;
- msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be %s",
- option, strKey, mPtr->strKey);
+ Tcl_AppendResult(interp, "bad ", option, " value \"", strKey,
+ "\": must be ", mPtr->strKey, NULL);
for (mPtr++; mPtr->strKey != NULL; mPtr++) {
- Tcl_AppendPrintfToObj(msgObj, ",%s %s",
- ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey);
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, NULL);
}
- Tcl_SetObjResult(interp, msgObj);
- Tcl_SetErrorCode(interp, "TK", "LOOKUP", option, strKey, NULL);
}
return mPtr->numKey;
}
@@ -971,12 +943,12 @@ TkFindStateNumObj(
* Not there. Look in the state map.
*/
- key = Tcl_GetString(keyPtr);
+ key = Tcl_GetStringFromObj(keyPtr, NULL);
for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
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);
@@ -991,203 +963,19 @@ TkFindStateNumObj(
*/
if (interp != NULL) {
- Tcl_Obj *msgObj;
-
mPtr = mapPtr;
- msgObj = Tcl_ObjPrintf(
- "bad %s value \"%s\": must be %s",
- Tcl_GetString(optionPtr), key, mPtr->strKey);
+ Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr),
+ " value \"", key, "\": must be ", mPtr->strKey, NULL);
for (mPtr++; mPtr->strKey != NULL; mPtr++) {
- Tcl_AppendPrintfToObj(msgObj, ",%s %s",
- ((mPtr[1].strKey != NULL) ? "" : " or"), mPtr->strKey);
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, NULL);
}
- Tcl_SetObjResult(interp, msgObj);
- Tcl_SetErrorCode(interp, "TK", "LOOKUP", Tcl_GetString(optionPtr),
- key, NULL);
}
return mPtr->numKey;
}
/*
- * ----------------------------------------------------------------------
- *
- * 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_InterpState state;
- int n, r = TCL_OK;
-
- /*
- * Record the state of the interpreter.
- */
-
- Tcl_Preserve(interp);
- state = Tcl_SaveInterpState(interp, TCL_OK);
-
- /*
- * 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);
- }
-
- /*
- * Restore the state of the interpreter.
- */
-
- (void) Tcl_RestoreInterpState(interp, state);
- Tcl_Release(interp);
-
- 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