summaryrefslogtreecommitdiffstats
path: root/generic/tkOldConfig.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkOldConfig.c')
-rw-r--r--generic/tkOldConfig.c178
1 files changed, 88 insertions, 90 deletions
diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c
index d7a33f7..920d93e 100644
--- a/generic/tkOldConfig.c
+++ b/generic/tkOldConfig.c
@@ -12,7 +12,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tkPort.h"
+#include "tkInt.h"
/*
* Values for "flags" field of Tk_ConfigSpec structures. Be sure to coordinate
@@ -33,12 +33,12 @@ static int DoConfig(Tcl_Interp *interp, Tk_Window tkwin,
Tk_ConfigSpec *specPtr, Tk_Uid value,
int valueIsUid, char *widgRec);
static Tk_ConfigSpec * FindConfigSpec(Tcl_Interp *interp,
- Tk_ConfigSpec *specs, CONST char *argvName,
+ Tk_ConfigSpec *specs, const char *argvName,
int needFlags, int hateFlags);
static char * FormatConfigInfo(Tcl_Interp *interp, Tk_Window tkwin,
- Tk_ConfigSpec *specPtr, char *widgRec);
-static CONST char * FormatConfigValue(Tcl_Interp *interp, Tk_Window tkwin,
- Tk_ConfigSpec *specPtr, char *widgRec,
+ const Tk_ConfigSpec *specPtr, char *widgRec);
+static const char * FormatConfigValue(Tcl_Interp *interp, Tk_Window tkwin,
+ const Tk_ConfigSpec *specPtr, char *widgRec,
char *buffer, Tcl_FreeProc **freeProcPtr);
static Tk_ConfigSpec * GetCachedSpecs(Tcl_Interp *interp,
const Tk_ConfigSpec *staticSpecs);
@@ -72,9 +72,9 @@ Tk_ConfigureWidget(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tk_Window tkwin, /* Window containing widget (needed to set up
* X resources). */
- Tk_ConfigSpec *specs, /* Describes legal options. */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
int argc, /* Number of elements in argv. */
- CONST char **argv, /* Command-line options. */
+ const char **argv, /* Command-line options. */
char *widgRec, /* Record whose fields are to be modified.
* Values must be properly initialized. */
int flags) /* Used to specify additional flags that must
@@ -82,7 +82,7 @@ Tk_ConfigureWidget(
* considered. Also, may have
* TK_CONFIG_ARGV_ONLY set. */
{
- register Tk_ConfigSpec *specPtr;
+ register Tk_ConfigSpec *specPtr, *staticSpecs;
Tk_Uid value; /* Value of option from database. */
int needFlags; /* Specs must contain this set of flags or
* else they are not considered. */
@@ -95,7 +95,8 @@ Tk_ConfigureWidget(
* we're on our way out of the application
*/
- Tcl_AppendResult(interp, "NULL main window", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
return TCL_ERROR;
}
@@ -110,10 +111,10 @@ Tk_ConfigureWidget(
* Get the build of the config for this interpreter.
*/
- specs = GetCachedSpecs(interp, specs);
+ staticSpecs = GetCachedSpecs(interp, specs);
- for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
- specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED;
+ for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED;
}
/*
@@ -122,14 +123,14 @@ Tk_ConfigureWidget(
*/
for ( ; argc > 0; argc -= 2, argv += 2) {
- CONST char *arg;
+ const char *arg;
if (flags & TK_CONFIG_OBJS) {
- arg = Tcl_GetStringFromObj((Tcl_Obj *) *argv, NULL);
+ arg = Tcl_GetString((Tcl_Obj *) *argv);
} else {
arg = *argv;
}
- specPtr = FindConfigSpec(interp, specs, arg, needFlags, hateFlags);
+ specPtr = FindConfigSpec(interp, staticSpecs, arg, needFlags, hateFlags);
if (specPtr == NULL) {
return TCL_ERROR;
}
@@ -139,7 +140,9 @@ Tk_ConfigureWidget(
*/
if (argc < 2) {
- Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", arg));
+ Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL);
return TCL_ERROR;
}
if (flags & TK_CONFIG_OBJS) {
@@ -148,11 +151,8 @@ Tk_ConfigureWidget(
arg = argv[1];
}
if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) {
- char msg[100];
-
- sprintf(msg, "\n (processing \"%.40s\" option)",
- specPtr->argvName);
- Tcl_AddErrorInfo(interp, msg);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (processing \"%.40s\" option)",specPtr->argvName));
return TCL_ERROR;
}
if (!(flags & TK_CONFIG_ARGV_ONLY)) {
@@ -167,7 +167,7 @@ Tk_ConfigureWidget(
*/
if (!(flags & TK_CONFIG_ARGV_ONLY)) {
- for (specPtr=specs; specPtr->type!=TK_CONFIG_END; specPtr++) {
+ for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) {
if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
|| (specPtr->argvName == NULL)
|| (specPtr->type == TK_CONFIG_SYNONYM)) {
@@ -184,12 +184,10 @@ Tk_ConfigureWidget(
if (value != NULL) {
if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
TCL_OK) {
- char msg[200];
-
- sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")",
- "database entry for",
- specPtr->dbName, Tk_PathName(tkwin));
- Tcl_AddErrorInfo(interp, msg);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "database entry for", specPtr->dbName,
+ Tk_PathName(tkwin)));
return TCL_ERROR;
}
} else {
@@ -202,13 +200,10 @@ Tk_ConfigureWidget(
& TK_CONFIG_DONT_SET_DEFAULT)) {
if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
TCL_OK) {
- char msg[200];
-
- sprintf(msg,
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (%s \"%.50s\" in widget \"%.50s\")",
- "default value for",
- specPtr->dbName, Tk_PathName(tkwin));
- Tcl_AddErrorInfo(interp, msg);
+ "default value for", specPtr->dbName,
+ Tk_PathName(tkwin)));
return TCL_ERROR;
}
}
@@ -243,7 +238,7 @@ FindConfigSpec(
Tcl_Interp *interp, /* Used for reporting errors. */
Tk_ConfigSpec *specs, /* Pointer to table of configuration
* specifications for a widget. */
- CONST char *argvName, /* Name (suitable for use in a "config"
+ const char *argvName, /* Name (suitable for use in a "config"
* command) identifying particular option. */
int needFlags, /* Flags that must be present in matching
* entry. */
@@ -275,15 +270,18 @@ FindConfigSpec(
goto gotMatch;
}
if (matchPtr != NULL) {
- Tcl_AppendResult(interp, "ambiguous option \"", argvName,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous option \"%s\"", argvName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL);
return NULL;
}
matchPtr = specPtr;
}
if (matchPtr == NULL) {
- Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown option \"%s\"", argvName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL);
return NULL;
}
@@ -297,8 +295,11 @@ FindConfigSpec(
if (specPtr->type == TK_CONFIG_SYNONYM) {
for (specPtr = specs; ; specPtr++) {
if (specPtr->type == TK_CONFIG_END) {
- Tcl_AppendResult(interp, "couldn't find synonym for option \"",
- argvName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find synonym for option \"%s\"",
+ argvName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,
+ NULL);
return NULL;
}
if ((specPtr->dbName == matchPtr->dbName)
@@ -375,7 +376,7 @@ DoConfig(
if (nullValue) {
newStr = NULL;
} else {
- newStr = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ newStr = ckalloc(strlen(value) + 1);
strcpy(newStr, value);
}
oldStr = *((char **) ptr);
@@ -544,20 +545,17 @@ DoConfig(
break;
}
case TK_CONFIG_CUSTOM:
- if ((*specPtr->customPtr->parseProc)(
- specPtr->customPtr->clientData, interp, tkwin, value,
- widgRec, specPtr->offset) != TCL_OK) {
+ if (specPtr->customPtr->parseProc(specPtr->customPtr->clientData,
+ interp, tkwin, value, widgRec, specPtr->offset)!=TCL_OK) {
return TCL_ERROR;
}
break;
- default: {
- char buf[64 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "bad config table: unknown type %d", specPtr->type);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad config table: unknown type %d", specPtr->type));
+ Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL);
return TCL_ERROR;
}
- }
specPtr++;
} while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
return TCL_OK;
@@ -595,20 +593,20 @@ int
Tk_ConfigureInfo(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tk_Window tkwin, /* Window corresponding to widgRec. */
- Tk_ConfigSpec *specs, /* Describes legal options. */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
char *widgRec, /* Record whose fields contain current values
* for options. */
- CONST char *argvName, /* If non-NULL, indicates a single option
+ const char *argvName, /* If non-NULL, indicates a single option
* whose info is to be returned. Otherwise
* info is returned for all options. */
int flags) /* Used to specify additional flags that must
* be present in config specs for them to be
* considered. */
{
- register Tk_ConfigSpec *specPtr;
+ register Tk_ConfigSpec *specPtr, *staticSpecs;
int needFlags, hateFlags;
char *list;
- char *leader = "{";
+ const char *leader = "{";
needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
if (Tk_Depth(tkwin) <= 1) {
@@ -621,22 +619,23 @@ Tk_ConfigureInfo(
* Get the build of the config for this interpreter.
*/
- specs = GetCachedSpecs(interp, specs);
+ staticSpecs = GetCachedSpecs(interp, specs);
/*
* If information is only wanted for a single configuration spec, then
* handle that one spec specially.
*/
- Tcl_SetResult(interp, NULL, TCL_STATIC);
+ Tcl_ResetResult(interp);
if (argvName != NULL) {
- specPtr = FindConfigSpec(interp, specs, argvName, needFlags,hateFlags);
+ specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags,
+ hateFlags);
if (specPtr == NULL) {
return TCL_ERROR;
}
- Tcl_SetResult(interp,
- FormatConfigInfo(interp, tkwin, specPtr, widgRec),
- TCL_DYNAMIC);
+ list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(list, -1));
+ ckfree(list);
return TCL_OK;
}
@@ -645,7 +644,7 @@ Tk_ConfigureInfo(
* information.
*/
- for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) {
if ((argvName != NULL) && (specPtr->argvName != argvName)) {
continue;
}
@@ -687,13 +686,13 @@ FormatConfigInfo(
Tcl_Interp *interp, /* Interpreter to use for things like
* floating-point precision. */
Tk_Window tkwin, /* Window corresponding to widget. */
- register Tk_ConfigSpec *specPtr,
+ register const Tk_ConfigSpec *specPtr,
/* Pointer to information describing
* option. */
char *widgRec) /* Pointer to record holding current values of
* info for widget. */
{
- CONST char *argv[6];
+ const char *argv[6];
char *result;
char buffer[200];
Tcl_FreeProc *freeProc = NULL;
@@ -722,9 +721,9 @@ FormatConfigInfo(
result = Tcl_Merge(5, argv);
if (freeProc != NULL) {
if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
- ckfree((char *)argv[4]);
+ ckfree((char *) argv[4]);
} else {
- (*freeProc)((char *)argv[4]);
+ freeProc((char *) argv[4]);
}
}
return result;
@@ -750,11 +749,11 @@ FormatConfigInfo(
*----------------------------------------------------------------------
*/
-static CONST char *
+static const char *
FormatConfigValue(
Tcl_Interp *interp, /* Interpreter for use in real conversions. */
Tk_Window tkwin, /* Window corresponding to widget. */
- Tk_ConfigSpec *specPtr, /* Pointer to information describing option.
+ const Tk_ConfigSpec *specPtr, /* Pointer to information describing option.
* Must not point to a synonym option. */
char *widgRec, /* Pointer to record holding current values of
* info for widget. */
@@ -764,7 +763,7 @@ FormatConfigValue(
* function to free the result, or NULL if
* result is static. */
{
- CONST char *ptr, *result;
+ const char *ptr, *result;
*freeProcPtr = NULL;
ptr = widgRec + specPtr->offset;
@@ -873,9 +872,8 @@ FormatConfigValue(
break;
}
case TK_CONFIG_CUSTOM:
- result = (*specPtr->customPtr->printProc)(
- specPtr->customPtr->clientData, tkwin, widgRec,
- specPtr->offset, freeProcPtr);
+ result = specPtr->customPtr->printProc(specPtr->customPtr->clientData,
+ tkwin, widgRec, specPtr->offset, freeProcPtr);
break;
default:
result = "?? unknown type ??";
@@ -907,10 +905,10 @@ int
Tk_ConfigureValue(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tk_Window tkwin, /* Window corresponding to widgRec. */
- Tk_ConfigSpec *specs, /* Describes legal options. */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
char *widgRec, /* Record whose fields contain current values
* for options. */
- CONST char *argvName, /* Gives the command-line name for the option
+ const char *argvName, /* Gives the command-line name for the option
* whose value is to be returned. */
int flags) /* Used to specify additional flags that must
* be present in config specs for them to be
@@ -919,7 +917,7 @@ Tk_ConfigureValue(
Tk_ConfigSpec *specPtr;
int needFlags, hateFlags;
Tcl_FreeProc *freeProc;
- CONST char *result;
+ const char *result;
char buffer[200];
needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
@@ -933,20 +931,20 @@ Tk_ConfigureValue(
* Get the build of the config for this interpreter.
*/
- specs = GetCachedSpecs(interp, specs);
+ specPtr = GetCachedSpecs(interp, specs);
- specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
+ specPtr = FindConfigSpec(interp, specPtr, argvName, needFlags, hateFlags);
if (specPtr == NULL) {
return TCL_ERROR;
}
result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
&freeProc);
- Tcl_SetResult(interp, (char *) result, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
if (freeProc != NULL) {
if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
- ckfree((char *)result);
+ ckfree((char *) result);
} else {
- (*freeProc)((char *)result);
+ freeProc((char *) result);
}
}
return TCL_OK;
@@ -976,7 +974,7 @@ Tk_ConfigureValue(
/* ARGSUSED */
void
Tk_FreeOptions(
- Tk_ConfigSpec *specs, /* Describes legal options. */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
char *widgRec, /* Record whose fields contain current values
* for options. */
Display *display, /* X display; needed for freeing some
@@ -985,7 +983,7 @@ Tk_FreeOptions(
* be present in config specs for them to be
* considered. */
{
- register Tk_ConfigSpec *specPtr;
+ register const Tk_ConfigSpec *specPtr;
char *ptr;
for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
@@ -1073,13 +1071,13 @@ GetCachedSpecs(
* self-initializing code.
*/
- specCacheTablePtr = (Tcl_HashTable *)
+ specCacheTablePtr =
Tcl_GetAssocData(interp, "tkConfigSpec.threadTable", NULL);
if (specCacheTablePtr == NULL) {
- specCacheTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ specCacheTablePtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(specCacheTablePtr, TCL_ONE_WORD_KEYS);
Tcl_SetAssocData(interp, "tkConfigSpec.threadTable",
- DeleteSpecCacheTable, (ClientData) specCacheTablePtr);
+ DeleteSpecCacheTable, specCacheTablePtr);
}
/*
@@ -1109,9 +1107,9 @@ GetCachedSpecs(
* from the master copy.
*/
- cachedSpecs = (Tk_ConfigSpec *) ckalloc(entrySpace);
+ cachedSpecs = ckalloc(entrySpace);
memcpy(cachedSpecs, staticSpecs, entrySpace);
- Tcl_SetHashValue(entryPtr, (ClientData) cachedSpecs);
+ Tcl_SetHashValue(entryPtr, cachedSpecs);
/*
* Finally, go through and replace database names, database classes
@@ -1133,7 +1131,7 @@ GetCachedSpecs(
}
}
} else {
- cachedSpecs = (Tk_ConfigSpec *) Tcl_GetHashValue(entryPtr);
+ cachedSpecs = Tcl_GetHashValue(entryPtr);
}
return cachedSpecs;
@@ -1161,7 +1159,7 @@ DeleteSpecCacheTable(
ClientData clientData,
Tcl_Interp *interp)
{
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
+ Tcl_HashTable *tablePtr = clientData;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
@@ -1171,10 +1169,10 @@ DeleteSpecCacheTable(
* Someone else deallocates the Tk_Uids themselves.
*/
- ckfree((char *) Tcl_GetHashValue(entryPtr));
+ ckfree(Tcl_GetHashValue(entryPtr));
}
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
}
/*
generated by cgit v0.12 at 2024-07-16 11:17:36 (GMT)