summaryrefslogtreecommitdiffstats
path: root/src/bltConfig.C
diff options
context:
space:
mode:
authorjoye <joye>2014-03-12 22:39:49 (GMT)
committerjoye <joye>2014-03-12 22:39:49 (GMT)
commit12d15eef6a59bd1d463dae1ec1011f44f808049f (patch)
tree498b1ea1bf8cfe01d59fcd95ac3fd24a1f45f48d /src/bltConfig.C
parentfe320cd13c4b61ee54506965ad20b88d619ed59f (diff)
downloadblt-12d15eef6a59bd1d463dae1ec1011f44f808049f.zip
blt-12d15eef6a59bd1d463dae1ec1011f44f808049f.tar.gz
blt-12d15eef6a59bd1d463dae1ec1011f44f808049f.tar.bz2
*** empty log message ***
Diffstat (limited to 'src/bltConfig.C')
-rw-r--r--src/bltConfig.C1281
1 files changed, 0 insertions, 1281 deletions
diff --git a/src/bltConfig.C b/src/bltConfig.C
index 1528135..abdbd1e 100644
--- a/src/bltConfig.C
+++ b/src/bltConfig.C
@@ -36,43 +36,6 @@
* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
-/*
- * This is a Tcl_Obj based replacement for the widget configuration
- * functions in Tk.
- *
- * What not use the new Tk_Option interface?
- *
- * There were design changes in the new Tk_Option interface that
- * make it unwieldy.
- *
- * o You have to dynamically allocate, store, and deallocate
- * your option table.
- * o The Tk_FreeConfigOptions routine requires a tkwin argument.
- * Unfortunately, most widgets save the display pointer and
- * de-reference their tkwin when the window is destroyed.
- * o There's no TK_CONFIG_CUSTOM functionality. This means that
- * save special options must be saved as strings by
- * Tk_ConfigureWidget and processed later, thus losing the
- * benefits of Tcl_Objs. It also make error handling
- * problematic, since you don't pick up certain errors like
- *
- * .widget configure -myoption bad -myoption good
- *
- * You will never see the first "bad" value.
- * o Especially compared to the former Tk_ConfigureWidget calls,
- * the new interface is overly complex. If there was a big
- * performance win, it might be worth the effort. But let's
- * face it, this biggest wins are in processing custom options
- * values with thousands of elements. Most common resources
- * (font, color, etc) have string tokens anyways.
- *
- * On the other hand, the replacement functions in this file fell
- * into place quite easily both from the aspect of API writer and
- * user. The biggest benefit is that you don't need to change lots
- * of working code just to get the benefits of Tcl_Objs.
- *
- */
-
#include <assert.h>
#include <stdarg.h>
@@ -272,1247 +235,3 @@ static Tcl_Obj* ListGetProc(ClientData clientData, Tk_Window tkwin,
return listObjPtr;
};
-
-/* BITMASK */
-
-int ObjToBitmaskProc(ClientData clientData, Tcl_Interp *interp,
- Tk_Window tkwin, Tcl_Obj *objPtr, char *widgRec,
- int offset, int flags)
-{
- unsigned int* bitmaskPtr;
- int bool;
- unsigned int mask, flag;
-
- bitmaskPtr = (unsigned int*)(widgRec + offset);
-
- if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) != TCL_OK) {
- return TCL_ERROR;
- }
- mask = (unsigned int)clientData;
- flag = *bitmaskPtr;
- flag &= ~mask;
- if (bool) {
- flag |= mask;
- }
- *bitmaskPtr = flag;
-
- return TCL_OK;
-}
-
-Tcl_Obj* BitmaskToObjProc(ClientData clientData, Tcl_Interp *interp,
- Tk_Window tkwin, char *widgRec,
- int offset, int flags)
-{
- unsigned int* bitmaskPtr;
- unsigned long flag;
-
- bitmaskPtr = (unsigned int*)(widgRec + offset);
- flag = (*bitmaskPtr) & (unsigned int)clientData;
- return Tcl_NewBooleanObj((flag != 0));
-}
-
-/* LIST */
-
-static Blt_OptionParseProc ObjToListProc;
-static Blt_OptionPrintProc ListToObjProc;
-static Blt_OptionFreeProc ListFreeProc;
-Blt_CustomOption listOption =
-{
- ObjToListProc, ListToObjProc, ListFreeProc, (ClientData)0
-};
-
-static int ObjToListProc(ClientData clientData, Tcl_Interp *interp,
- Tk_Window tkwin, Tcl_Obj *objPtr, char *widgRec,
- int offset, int flags)
-{
- const char*** listPtr;
- const char** argv;
- int argc;
-
- listPtr = (const char***)(widgRec + offset);
- if (Tcl_SplitList(interp, Tcl_GetString(objPtr), &argc, &argv)
- != TCL_OK) {
- return TCL_ERROR;
- }
- if (*listPtr != NULL) {
- Tcl_Free((void*)(*listPtr));
- *listPtr = NULL;
- }
- *listPtr = argv;
-
- return TCL_OK;
-}
-
-static Tcl_Obj* ListToObjProc(ClientData clientData, Tcl_Interp *interp,
- Tk_Window tkwin, char *widgRec,
- int offset, int flags)
-{
- const char*** listPtr;
- Tcl_Obj *objPtr, *listObjPtr;
- const char** p;
-
- listPtr = (const char***)(widgRec + offset);
-
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
- for (p = *listPtr; *p != NULL; p++) {
- objPtr = Tcl_NewStringObj(*p, -1);
- Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
- }
- return listObjPtr;
-}
-
-static void ListFreeProc(ClientData clientData, Display* display,
- char *widgRec, int offset)
-{
- const char*** listPtr;
-
- listPtr = (const char***)(widgRec + offset);
- if (*listPtr != NULL) {
- Tcl_Free((void*)(*listPtr));
- *listPtr = NULL;
- }
-}
-
-/* Configuration option helper routines */
-
-/*
- *---------------------------------------------------------------------------
- *
- * DoConfig --
- *
- * This procedure applies a single configuration option
- * to a widget record.
- *
- * Results:
- * A standard TCL return value.
- *
- * Side effects:
- * WidgRec is modified as indicated by specPtr and value.
- * The old value is recycled, if that is appropriate for
- * the value type.
- *
- *---------------------------------------------------------------------------
- */
-static int
-DoConfig(
- Tcl_Interp *interp, /* Interpreter for error reporting. */
- Tk_Window tkwin, /* Window containing widget (needed to
- * set up X resources). */
- Blt_ConfigSpec *sp, /* Specifier to apply. */
- Tcl_Obj *objPtr, /* Value to use to fill in widgRec. */
- char *widgRec) /* Record whose fields are to be
- * modified. Values must be properly
- * initialized. */
-{
- char *ptr;
- int objIsEmpty;
-
- objIsEmpty = FALSE;
- if (objPtr == NULL) {
- objIsEmpty = TRUE;
- } else if (sp->specFlags & BLT_CONFIG_NULL_OK) {
- int length;
-
- if (objPtr->bytes != NULL) {
- length = objPtr->length;
- } else {
- Tcl_GetStringFromObj(objPtr, &length);
- }
- objIsEmpty = (length == 0);
- }
- do {
- ptr = widgRec + sp->offset;
- switch (sp->type) {
- case BLT_CONFIG_ANCHOR:
- {
- Tk_Anchor anchor;
-
- if (Tk_GetAnchorFromObj(interp, objPtr, &anchor) != TCL_OK) {
- return TCL_ERROR;
- }
- *(Tk_Anchor *)ptr = anchor;
- }
- break;
-
- case BLT_CONFIG_BITMAP:
- {
- Pixmap bitmap;
-
- if (objIsEmpty) {
- bitmap = None;
- } else {
- bitmap = Tk_AllocBitmapFromObj(interp, tkwin, objPtr);
- if (bitmap == None) {
- return TCL_ERROR;
- }
- }
- if (*(Pixmap *)ptr != None) {
- Tk_FreeBitmap(Tk_Display(tkwin), *(Pixmap *)ptr);
- }
- *(Pixmap *)ptr = bitmap;
- }
- break;
-
- case BLT_CONFIG_BOOLEAN:
- {
- int bool;
-
- if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) != TCL_OK) {
- return TCL_ERROR;
- }
- *(int *)ptr = bool;
- }
- break;
-
- case BLT_CONFIG_BORDER:
- {
- Tk_3DBorder border;
-
- if (objIsEmpty) {
- border = NULL;
- } else {
- border = Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr);
- if (border == NULL) {
- return TCL_ERROR;
- }
- }
- if (*(Tk_3DBorder *)ptr != NULL) {
- Tk_Free3DBorder(*(Tk_3DBorder *)ptr);
- }
- *(Tk_3DBorder *)ptr = border;
- }
- break;
-
- case BLT_CONFIG_CAP_STYLE:
- {
- int cap;
- Tk_Uid uid;
-
- uid = Tk_GetUid(Tcl_GetString(objPtr));
- if (Tk_GetCapStyle(interp, uid, &cap) != TCL_OK) {
- return TCL_ERROR;
- }
- *(int *)ptr = cap;
- }
- break;
-
- case BLT_CONFIG_COLOR:
- {
- XColor *color;
-
- if (objIsEmpty) {
- color = NULL;
- } else {
- color = Tk_GetColor(interp, tkwin,
- Tk_GetUid(Tcl_GetString(objPtr)));
- if (color == NULL) {
- return TCL_ERROR;
- }
- }
- if (*(XColor **)ptr != NULL) {
- Tk_FreeColor(*(XColor **)ptr);
- }
- *(XColor **)ptr = color;
- }
- break;
-
- case BLT_CONFIG_CURSOR:
- case BLT_CONFIG_ACTIVE_CURSOR:
- {
- Tk_Cursor cursor;
-
- if (objIsEmpty) {
- cursor = None;
- } else {
- cursor = Tk_AllocCursorFromObj(interp, tkwin, objPtr);
- if (cursor == None) {
- return TCL_ERROR;
- }
- }
- if (*(Tk_Cursor *)ptr != None) {
- Tk_FreeCursor(Tk_Display(tkwin), *(Tk_Cursor *)ptr);
- }
- *(Tk_Cursor *)ptr = cursor;
- if (sp->type == BLT_CONFIG_ACTIVE_CURSOR) {
- Tk_DefineCursor(tkwin, cursor);
- }
- }
- break;
-
- case BLT_CONFIG_CUSTOM:
- if ((*sp->customPtr->parseProc)(sp->customPtr->clientData, interp,
- tkwin, objPtr, widgRec, sp->offset, sp->specFlags) != TCL_OK) {
- return TCL_ERROR;
- }
- break;
-
- case BLT_CONFIG_DOUBLE:
- {
- double value;
-
- if (Tcl_GetDoubleFromObj(interp, objPtr, &value) != TCL_OK) {
- return TCL_ERROR;
- }
- *(double *)ptr = value;
- }
- break;
-
- case BLT_CONFIG_FONT:
- {
- Tk_Font font;
-
- if (objIsEmpty) {
- font = NULL;
- } else {
- font = Tk_AllocFontFromObj(interp, tkwin, objPtr);
- if (font == NULL) {
- return TCL_ERROR;
- }
- }
- if (*(Tk_Font *)ptr != NULL) {
- Tk_FreeFont(*(Tk_Font *)ptr);
- }
- *(Tk_Font *)ptr = font;
- }
- break;
-
- case BLT_CONFIG_INT:
- {
- int value;
-
- if (Tcl_GetIntFromObj(interp, objPtr, &value) != TCL_OK) {
- return TCL_ERROR;
- }
- *(int *)ptr = value;
- }
- break;
-
- case BLT_CONFIG_JOIN_STYLE:
- {
- int join;
- Tk_Uid uid;
-
- uid = Tk_GetUid(Tcl_GetString(objPtr));
- if (Tk_GetJoinStyle(interp, uid, &join) != TCL_OK) {
- return TCL_ERROR;
- }
- *(int *)ptr = join;
- }
- break;
-
- case BLT_CONFIG_JUSTIFY:
- {
- Tk_Justify justify;
-
- if (Tk_GetJustifyFromObj(interp, objPtr, &justify) != TCL_OK) {
- return TCL_ERROR;
- }
- *(Tk_Justify *)ptr = justify;
- }
- break;
-
- case BLT_CONFIG_MM:
- {
- double value;
-
- if (Tk_GetMMFromObj(interp, tkwin, objPtr, &value) != TCL_OK) {
- return TCL_ERROR;
- }
- *(double *)ptr = value;
- }
- break;
-
-
- case BLT_CONFIG_RELIEF:
- {
- int relief;
-
- if (Tk_GetReliefFromObj(interp, objPtr, &relief) != TCL_OK) {
- return TCL_ERROR;
- }
- *(int *)ptr = relief;
- }
- break;
-
- case BLT_CONFIG_STRING:
- {
- char *value;
-
- value = (objIsEmpty) ? NULL :
- Blt_Strdup(Tcl_GetString(objPtr));
- if (*(char **)ptr != NULL) {
- free(*(char **)ptr);
- *((char **) ptr) = NULL;
- }
- *(char **)ptr = value;
- }
- break;
-
- case BLT_CONFIG_WINDOW:
- {
- Tk_Window tkwin2;
-
- if (objIsEmpty) {
- tkwin2 = None;
- } else {
- const char *path;
-
- path = Tcl_GetString(objPtr);
- tkwin2 = Tk_NameToWindow(interp, path, tkwin);
- if (tkwin2 == NULL) {
- return TCL_ERROR;
- }
- }
- *(Tk_Window *)ptr = tkwin2;
- }
- break;
-
- case BLT_CONFIG_PIXELS:
- {
- int value;
-
- if (Tk_GetPixelsFromObj(interp, tkwin, objPtr, &value)
- != TCL_OK) {
- return TCL_ERROR;
- }
- *(int *)ptr = value;
- }
- break;
-
- default:
- Tcl_AppendResult(interp, "bad config table: unknown type ",
- Blt_Itoa(sp->type), (char *)NULL);
- return TCL_ERROR;
- }
- sp++;
- } while ((sp->switchName == NULL) && (sp->type != BLT_CONFIG_END));
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * FormatConfigValue --
- *
- * This procedure formats the current value of a configuration
- * option.
- *
- * Results:
- * The return value is the formatted value of the option given
- * by specPtr and widgRec. If the value is static, so that it
- * need not be freed, *freeProcPtr will be set to NULL; otherwise
- * *freeProcPtr will be set to the address of a procedure to
- * free the result, and the caller must invoke this procedure
- * when it is finished with the result.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static Tcl_Obj *
-FormatConfigValue(
- Tcl_Interp *interp, /* Interpreter for use in real conversions. */
- Tk_Window tkwin, /* Window corresponding to widget. */
- Blt_ConfigSpec *sp, /* Pointer to information describing option.
- * Must not point to a synonym option. */
- char *widgRec) /* Pointer to record holding current
- * values of info for widget. */
-{
- char *ptr;
- const char *string;
-
- ptr = widgRec + sp->offset;
- string = "";
- switch (sp->type) {
- case BLT_CONFIG_ANCHOR:
- string = Tk_NameOfAnchor(*(Tk_Anchor *)ptr);
- break;
-
- case BLT_CONFIG_BITMAP:
- if (*(Pixmap *)ptr != None) {
- string = Tk_NameOfBitmap(Tk_Display(tkwin), *(Pixmap *)ptr);
- }
- break;
-
- case BLT_CONFIG_BOOLEAN:
- return Tcl_NewBooleanObj(*(int *)ptr);
-
- case BLT_CONFIG_BORDER:
- if (*(Tk_3DBorder *)ptr != NULL) {
- string = Tk_NameOf3DBorder(*(Tk_3DBorder *)ptr);
- }
- break;
-
- case BLT_CONFIG_CAP_STYLE:
- string = Tk_NameOfCapStyle(*(int *)ptr);
- break;
-
- case BLT_CONFIG_COLOR:
- if (*(XColor **)ptr != NULL) {
- string = Tk_NameOfColor(*(XColor **)ptr);
- }
- break;
-
- case BLT_CONFIG_CURSOR:
- case BLT_CONFIG_ACTIVE_CURSOR:
- if (*(Tk_Cursor *)ptr != None) {
- string = Tk_NameOfCursor(Tk_Display(tkwin), *(Tk_Cursor *)ptr);
- }
- break;
-
- case BLT_CONFIG_CUSTOM:
- return (*sp->customPtr->printProc)
- (sp->customPtr->clientData, interp, tkwin, widgRec,
- sp->offset, sp->specFlags);
-
- case BLT_CONFIG_DOUBLE:
- return Tcl_NewDoubleObj(*(double *)ptr);
-
- case BLT_CONFIG_FONT:
- if (*(Tk_Font *)ptr != NULL) {
- string = Tk_NameOfFont(*(Tk_Font *)ptr);
- }
- break;
-
- case BLT_CONFIG_INT:
- return Tcl_NewIntObj(*(int *)ptr);
-
- case BLT_CONFIG_JOIN_STYLE:
- string = Tk_NameOfJoinStyle(*(int *)ptr);
- break;
-
- case BLT_CONFIG_JUSTIFY:
- string = Tk_NameOfJustify(*(Tk_Justify *)ptr);
- break;
-
- case BLT_CONFIG_MM:
- return Tcl_NewDoubleObj(*(double *)ptr);
-
- case BLT_CONFIG_PIXELS:
- return Tcl_NewIntObj(*(int *)ptr);
-
- case BLT_CONFIG_RELIEF:
- string = Tk_NameOfRelief(*(int *)ptr);
- break;
-
- case BLT_CONFIG_STRING:
- if (*(char **)ptr != NULL) {
- string = *(char **)ptr;
- }
- break;
-
- default:
- string = "?? unknown type ??";
- }
- return Tcl_NewStringObj(string, -1);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * FormatConfigInfo --
- *
- * Create a valid TCL list holding the configuration information
- * for a single configuration option.
- *
- * Results:
- * A TCL list, dynamically allocated. The caller is expected to
- * arrange for this list to be freed eventually.
- *
- * Side effects:
- * Memory is allocated.
- *
- *---------------------------------------------------------------------------
- */
-static Tcl_Obj *
-FormatConfigInfo(
- Tcl_Interp *interp, /* Interpreter to use for things
- * like floating-point precision. */
- Tk_Window tkwin, /* Window corresponding to widget. */
- Blt_ConfigSpec *sp, /* Pointer to information describing
- * option. */
- char *widgRec) /* Pointer to record holding current
- * values of info for widget. */
-{
- Tcl_Obj *listObjPtr;
-
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
- if (sp->switchName != NULL) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(sp->switchName, -1));
- } else {
- Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("", -1));
- }
- if (sp->dbName != NULL) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(sp->dbName, -1));
- } else {
- Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("", -1));
- }
- if (sp->type == BLT_CONFIG_SYNONYM) {
- return listObjPtr;
- }
- if (sp->dbClass != NULL) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(sp->dbClass, -1));
- } else {
- Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("", -1));
- }
- if (sp->defValue != NULL) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(sp->defValue, -1));
- } else {
- Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("", -1));
- }
- Tcl_ListObjAppendElement(interp, listObjPtr,
- FormatConfigValue(interp, tkwin, sp, widgRec));
- return listObjPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * FindConfigSpec --
- *
- * Search through a table of configuration specs, looking for
- * one that matches a given switchName.
- *
- * Results:
- * The return value is a pointer to the matching entry, or NULL
- * if nothing matched. In that case an error message is left
- * in the interp's result.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static Blt_ConfigSpec *
-FindConfigSpec(
- Tcl_Interp *interp, /* Used for reporting errors. */
- Blt_ConfigSpec *specs, /* Pointer to table of configuration
- * specifications for a widget. */
- Tcl_Obj *objPtr, /* Name (suitable for use in a "config"
- * command) identifying particular option. */
- int needFlags, /* Flags that must be present in matching
- * entry. */
- int hateFlags) /* Flags that must NOT be present in
- * matching entry. */
-{
- Blt_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
- Blt_ConfigSpec *sp;
- const char *string;
- char c; /* First character of current argument. */
- int length;
-
- string = Tcl_GetStringFromObj(objPtr, &length);
- c = string[1];
- matchPtr = NULL;
- for (sp = specs; sp->type != BLT_CONFIG_END; sp++) {
- if (sp->switchName == NULL) {
- continue;
- }
- if ((sp->switchName[1] != c) ||
- (strncmp(sp->switchName, string, length) != 0)) {
- continue;
- }
- if (((sp->specFlags & needFlags) != needFlags) ||
- (sp->specFlags & hateFlags)) {
- continue;
- }
- if (sp->switchName[length] == 0) {
- matchPtr = sp;
- goto gotMatch;
- }
- if (matchPtr != NULL) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "ambiguous option \"", string, "\"",
- (char *)NULL);
- }
- return (Blt_ConfigSpec *)NULL;
- }
- matchPtr = sp;
- }
-
- if (matchPtr == NULL) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "unknown option \"", string, "\"",
- (char *)NULL);
- }
- return (Blt_ConfigSpec *)NULL;
- }
-
- /*
- * Found a matching entry. If it's a synonym, then find the
- * entry that it's a synonym for.
- */
-
- gotMatch:
- sp = matchPtr;
- if (sp->type == BLT_CONFIG_SYNONYM) {
- for (sp = specs; /*empty*/; sp++) {
- if (sp->type == BLT_CONFIG_END) {
- if (interp != NULL) {
- Tcl_AppendResult(interp,
- "couldn't find synonym for option \"", string, "\"",
- (char *)NULL);
- }
- return (Blt_ConfigSpec *) NULL;
- }
- if ((sp->dbName == matchPtr->dbName) &&
- (sp->type != BLT_CONFIG_SYNONYM) &&
- ((sp->specFlags & needFlags) == needFlags) &&
- !(sp->specFlags & hateFlags)) {
- break;
- }
- }
- }
- return sp;
-}
-
-/* Public routines */
-
-/*
- *---------------------------------------------------------------------------
- *
- * Blt_ConfigureWidgetFromObj --
- *
- * Process command-line options and database options to
- * fill in fields of a widget record with resources and
- * other parameters.
- *
- * Results:
- * A standard TCL return value. In case of an error,
- * the interp's result will hold an error message.
- *
- * Side effects:
- * The fields of widgRec get filled in with information
- * from argc/argv and the option database. Old information
- * in widgRec's fields gets recycled.
- *
- *---------------------------------------------------------------------------
- */
-int
-Blt_ConfigureWidgetFromObj(
- Tcl_Interp *interp, /* Interpreter for error reporting. */
- Tk_Window tkwin, /* Window containing widget (needed to
- * set up X resources). */
- Blt_ConfigSpec *specs, /* Describes legal options. */
- int objc, /* Number of elements in argv. */
- Tcl_Obj *const *objv, /* 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 be present in config specs
- * for them to be considered. Also,
- * may have BLT_CONFIG_OBJV_ONLY set. */
-{
- Blt_ConfigSpec *sp;
- int needFlags; /* Specs must contain this set of flags
- * or else they are not considered. */
- int hateFlags; /* If a spec contains any bits here, it's
- * not considered. */
- int result;
-
- if (tkwin == NULL) {
- /*
- * Either we're not really in Tk, or the main window was destroyed and
- * we're on our way out of the application
- */
- Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
- return TCL_ERROR;
- }
-
- needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
- if (Tk_Depth(tkwin) <= 1) {
- hateFlags = BLT_CONFIG_COLOR_ONLY;
- } else {
- hateFlags = BLT_CONFIG_MONO_ONLY;
- }
-
- /*
- * Pass one: scan through all the option specs, replacing strings
- * with Tk_Uid structs (if this hasn't been done already) and
- * clearing the BLT_CONFIG_OPTION_SPECIFIED flags.
- */
-
- for (sp = specs; sp->type != BLT_CONFIG_END; sp++) {
- if (!(sp->specFlags & INIT) && (sp->switchName != NULL)) {
- if (sp->dbName != NULL) {
- sp->dbName = Tk_GetUid(sp->dbName);
- }
- if (sp->dbClass != NULL) {
- sp->dbClass = Tk_GetUid(sp->dbClass);
- }
- if (sp->defValue != NULL) {
- sp->defValue = Tk_GetUid(sp->defValue);
- }
- }
- sp->specFlags = (sp->specFlags & ~BLT_CONFIG_OPTION_SPECIFIED) | INIT;
- }
-
- /*
- * Pass two: scan through all of the arguments, processing those
- * that match entries in the specs.
- */
- while (objc > 0) {
- sp = FindConfigSpec(interp, specs, objv[0], needFlags, hateFlags);
- if (sp == NULL) {
- return TCL_ERROR;
- }
-
- /* Process the entry. */
- if (objc < 2) {
- Tcl_AppendResult(interp, "value for \"", Tcl_GetString(objv[0]),
- "\" missing", (char *)NULL);
- return TCL_ERROR;
- }
- if (DoConfig(interp, tkwin, sp, objv[1], widgRec) != TCL_OK) {
- char msg[100];
-
- sprintf_s(msg, 100, "\n (processing \"%.40s\" option)",
- sp->switchName);
- Tcl_AddErrorInfo(interp, msg);
- return TCL_ERROR;
- }
- sp->specFlags |= BLT_CONFIG_OPTION_SPECIFIED;
- objc -= 2, objv += 2;
- }
-
- /*
- * Pass three: scan through all of the specs again; if no
- * command-line argument matched a spec, then check for info
- * in the option database. If there was nothing in the
- * database, then use the default.
- */
-
- if ((flags & BLT_CONFIG_OBJV_ONLY) == 0) {
- Tcl_Obj *objPtr;
-
- for (sp = specs; sp->type != BLT_CONFIG_END; sp++) {
- if ((sp->specFlags & BLT_CONFIG_OPTION_SPECIFIED) ||
- (sp->switchName == NULL) || (sp->type == BLT_CONFIG_SYNONYM)) {
- continue;
- }
- if (((sp->specFlags & needFlags) != needFlags) ||
- (sp->specFlags & hateFlags)) {
- continue;
- }
- objPtr = NULL;
- if (sp->dbName != NULL) {
- Tk_Uid value;
-
- /* If a resource name was specified, check if there's
- * also a value was associated with it. This
- * overrides the default value. */
- value = Tk_GetOption(tkwin, sp->dbName, sp->dbClass);
- if (value != NULL) {
- objPtr = Tcl_NewStringObj(value, -1);
- }
- }
-
- if (objPtr != NULL) {
- Tcl_IncrRefCount(objPtr);
- result = DoConfig(interp, tkwin, sp, objPtr, widgRec);
- Tcl_DecrRefCount(objPtr);
- if (result != TCL_OK) {
- char msg[200];
-
- sprintf_s(msg, 200,
- "\n (%s \"%.50s\" in widget \"%.50s\")",
- "database entry for", sp->dbName, Tk_PathName(tkwin));
- Tcl_AddErrorInfo(interp, msg);
- return TCL_ERROR;
- }
- } else if ((sp->defValue != NULL) &&
- ((sp->specFlags & BLT_CONFIG_DONT_SET_DEFAULT) == 0)) {
-
- /* No resource value is found, use the default value. */
- objPtr = Tcl_NewStringObj(sp->defValue, -1);
- Tcl_IncrRefCount(objPtr);
- result = DoConfig(interp, tkwin, sp, objPtr, widgRec);
- Tcl_DecrRefCount(objPtr);
- if (result != TCL_OK) {
- char msg[200];
-
- sprintf_s(msg, 200,
- "\n (%s \"%.50s\" in widget \"%.50s\")",
- "default value for", sp->dbName, Tk_PathName(tkwin));
- Tcl_AddErrorInfo(interp, msg);
- return TCL_ERROR;
- }
- }
- }
- }
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Blt_ConfigureInfoFromObj --
- *
- * Return information about the configuration options
- * for a window, and their current values.
- *
- * Results:
- * Always returns TCL_OK. The interp's result will be modified
- * hold a description of either a single configuration option
- * available for "widgRec" via "specs", or all the configuration
- * options available. In the "all" case, the result will
- * available for "widgRec" via "specs". The result will
- * be a list, each of whose entries describes one option.
- * Each entry will itself be a list containing the option's
- * name for use on command lines, database name, database
- * class, default value, and current value (empty string
- * if none). For options that are synonyms, the list will
- * contain only two values: name and synonym name. If the
- * "name" argument is non-NULL, then the only information
- * returned is that for the named argument (i.e. the corresponding
- * entry in the overall list is returned).
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-Blt_ConfigureInfoFromObj(
- Tcl_Interp *interp, /* Interpreter for error reporting. */
- Tk_Window tkwin, /* Window corresponding to widgRec. */
- Blt_ConfigSpec *specs, /* Describes legal options. */
- char *widgRec, /* Record whose fields contain current
- * values for options. */
- Tcl_Obj *objPtr, /* 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. */
-{
- Blt_ConfigSpec *sp;
- Tcl_Obj *listObjPtr, *valueObjPtr;
- const char *string;
- int needFlags, hateFlags;
-
- needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
- if (Tk_Depth(tkwin) <= 1) {
- hateFlags = BLT_CONFIG_COLOR_ONLY;
- } else {
- hateFlags = BLT_CONFIG_MONO_ONLY;
- }
-
- /*
- * If information is only wanted for a single configuration
- * spec, then handle that one spec specially.
- */
-
- Tcl_SetResult(interp, (char *)NULL, TCL_STATIC);
- if (objPtr != NULL) {
- sp = FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags);
- if (sp == NULL) {
- return TCL_ERROR;
- }
- valueObjPtr = FormatConfigInfo(interp, tkwin, sp, widgRec);
- Tcl_SetObjResult(interp, valueObjPtr);
- return TCL_OK;
- }
-
- /*
- * Loop through all the specs, creating a big list with all
- * their information.
- */
- string = NULL; /* Suppress compiler warning. */
- if (objPtr != NULL) {
- string = Tcl_GetString(objPtr);
- }
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
- for (sp = specs; sp->type != BLT_CONFIG_END; sp++) {
- if ((objPtr != NULL) && (sp->switchName != string)) {
- continue;
- }
- if (((sp->specFlags & needFlags) != needFlags) ||
- (sp->specFlags & hateFlags)) {
- continue;
- }
- if (sp->switchName == NULL) {
- continue;
- }
- valueObjPtr = FormatConfigInfo(interp, tkwin, sp, widgRec);
- Tcl_ListObjAppendElement(interp, listObjPtr, valueObjPtr);
- }
- Tcl_SetObjResult(interp, listObjPtr);
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Blt_ConfigureValueFromObj --
- *
- * This procedure returns the current value of a configuration
- * option for a widget.
- *
- * Results:
- * The return value is a standard TCL completion code (TCL_OK or
- * TCL_ERROR). The interp's result will be set to hold either the value
- * of the option given by objPtr (if TCL_OK is returned) or
- * an error message (if TCL_ERROR is returned).
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-int
-Blt_ConfigureValueFromObj(
- Tcl_Interp *interp, /* Interpreter for error reporting. */
- Tk_Window tkwin, /* Window corresponding to widgRec. */
- Blt_ConfigSpec *specs, /* Describes legal options. */
- char *widgRec, /* Record whose fields contain current
- * values for options. */
- Tcl_Obj *objPtr, /* 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 considered. */
-{
- Blt_ConfigSpec *sp;
- int needFlags, hateFlags;
-
- needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
- if (Tk_Depth(tkwin) <= 1) {
- hateFlags = BLT_CONFIG_COLOR_ONLY;
- } else {
- hateFlags = BLT_CONFIG_MONO_ONLY;
- }
- sp = FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags);
- if (sp == NULL) {
- return TCL_ERROR;
- }
- objPtr = FormatConfigValue(interp, tkwin, sp, widgRec);
- Tcl_SetObjResult(interp, objPtr);
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Blt_FreeOptions --
- *
- * Free up all resources associated with configuration options.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Any resource in widgRec that is controlled by a configuration
- * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
- * fashion.
- *
- *---------------------------------------------------------------------------
- */
-void
-Blt_FreeOptions(
- Blt_ConfigSpec *specs, /* Describes legal options. */
- char *widgRec, /* Record whose fields contain current
- * values for options. */
- Display *display, /* X display; needed for freeing some
- * resources. */
- int needFlags) /* Used to specify additional flags
- * that must be present in config specs
- * for them to be considered. */
-{
- Blt_ConfigSpec *sp;
-
- for (sp = specs; sp->type != BLT_CONFIG_END; sp++) {
- char *ptr;
-
- if ((sp->specFlags & needFlags) != needFlags) {
- continue;
- }
- ptr = widgRec + sp->offset;
- switch (sp->type) {
- case BLT_CONFIG_STRING:
- if (*((char **) ptr) != NULL) {
- free(*((char **) ptr));
- *((char **) ptr) = NULL;
- }
- break;
-
- case BLT_CONFIG_COLOR:
- if (*((XColor **) ptr) != NULL) {
- Tk_FreeColor(*((XColor **) ptr));
- *((XColor **) ptr) = NULL;
- }
- break;
-
- case BLT_CONFIG_FONT:
- if (*((Tk_Font *) ptr) != None) {
- Tk_FreeFont(*((Tk_Font *) ptr));
- *((Tk_Font *) ptr) = NULL;
- }
- break;
-
- case BLT_CONFIG_BITMAP:
- if (*((Pixmap *) ptr) != None) {
- Tk_FreeBitmap(display, *((Pixmap *) ptr));
- *((Pixmap *) ptr) = None;
- }
- break;
-
- case BLT_CONFIG_BORDER:
- if (*((Tk_3DBorder *) ptr) != NULL) {
- Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
- *((Tk_3DBorder *) ptr) = NULL;
- }
- break;
-
- case BLT_CONFIG_CURSOR:
- case BLT_CONFIG_ACTIVE_CURSOR:
- if (*((Tk_Cursor *) ptr) != None) {
- Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
- *((Tk_Cursor *) ptr) = None;
- }
- break;
-
- case BLT_CONFIG_CUSTOM:
- if ((sp->customPtr->freeProc != NULL) && (*(char **)ptr != NULL)) {
- (*sp->customPtr->freeProc)(sp->customPtr->clientData,
- display, widgRec, sp->offset);
- }
- break;
-
- }
- }
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Blt_ConfigModified --
- *
- * Given the configuration specifications and one or more option
- * patterns (terminated by a NULL), indicate if any of the matching
- * configuration options has been reset.
- *
- * Results:
- * Returns 1 if one of the options has changed, 0 otherwise.
- *
- *---------------------------------------------------------------------------
- */
-int
-Blt_ConfigModified TCL_VARARGS_DEF(Blt_ConfigSpec *, arg1)
-{
- va_list argList;
- Blt_ConfigSpec *specs;
- Blt_ConfigSpec *sp;
- const char *option;
-
- specs = TCL_VARARGS_START(Blt_ConfigSpec *, arg1, argList);
- while ((option = va_arg(argList, const char *)) != NULL) {
- for (sp = specs; sp->type != BLT_CONFIG_END; sp++) {
- if ((Tcl_StringMatch(sp->switchName, option)) &&
- (sp->specFlags & BLT_CONFIG_OPTION_SPECIFIED)) {
- va_end(argList);
- return 1;
- }
- }
- }
- va_end(argList);
- return 0;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Blt_ConfigureComponentFromObj --
- *
- * Configures a component of a widget. This is useful for
- * widgets that have multiple components which aren't uniquely
- * identified by a Tk_Window. It allows us, for example, set
- * resources for axes of the graph widget. The graph really has
- * only one window, but its convenient to specify components in a
- * hierarchy of options.
- *
- * *graph.x.logScale yes
- * *graph.Axis.logScale yes
- * *graph.temperature.scaleSymbols yes
- * *graph.Element.scaleSymbols yes
- *
- * This is really a hack to work around the limitations of the Tk
- * resource database. It creates a temporary window, needed to
- * call Tk_ConfigureWidget, using the name of the component.
- *
- * Results:
- * A standard TCL result.
- *
- * Side Effects:
- * A temporary window is created merely to pass to Tk_ConfigureWidget.
- *
- *---------------------------------------------------------------------------
- */
-int
-Blt_ConfigureComponentFromObj(
- Tcl_Interp *interp,
- Tk_Window parent, /* Window to associate with component */
- const char *name, /* Name of component */
- const char *className,
- Blt_ConfigSpec *sp,
- int objc,
- Tcl_Obj *const *objv,
- char *widgRec,
- int flags)
-{
- Tk_Window tkwin;
- int result;
- char *tmpName;
- int isTemporary = FALSE;
-
- tmpName = Blt_Strdup(name);
-
- /* Window name can't start with an upper case letter */
- tmpName[0] = tolower(name[0]);
-
- /*
- * Create component if a child window by the component's name
- * doesn't already exist.
- */
- {
- TkWindow *winPtr;
- TkWindow *parentPtr = (TkWindow *)parent;
-
- for (winPtr = parentPtr->childList; winPtr != NULL;
- winPtr = winPtr->nextPtr) {
- if (strcmp(tmpName, winPtr->nameUid) == 0) {
- tkwin = (Tk_Window)winPtr;
- }
- }
- tkwin = NULL;
- }
-
- if (tkwin == NULL) {
- tkwin = Tk_CreateWindow(interp, parent, tmpName, (char *)NULL);
- isTemporary = TRUE;
- }
- if (tkwin == NULL) {
- Tcl_AppendResult(interp, "can't find window in \"",
- Tk_PathName(parent), "\"", (char *)NULL);
- return TCL_ERROR;
- }
- assert(Tk_Depth(tkwin) == Tk_Depth(parent));
- free(tmpName);
-
- Tk_SetClass(tkwin, className);
- result = Blt_ConfigureWidgetFromObj(interp, tkwin, sp, objc, objv, widgRec,
- flags);
-
- if (isTemporary) {
- Tk_DestroyWindow(tkwin);
- }
-
- return result;
-}