diff options
| -rw-r--r-- | ChangeLog | 36 | ||||
| -rw-r--r-- | doc/SetOptions.3 | 141 | ||||
| -rw-r--r-- | generic/tk.h | 38 | ||||
| -rw-r--r-- | generic/tkConfig.c | 43 | ||||
| -rw-r--r-- | generic/tkTest.c | 150 | ||||
| -rw-r--r-- | tests/config.test | 60 |
6 files changed, 450 insertions, 18 deletions
@@ -1,3 +1,27 @@ +2000-09-17 Eric Melski <ericm@ajubasolutions.com> + + * generic/tk.h: Added declaration of Tk_ObjCustomOption structure, + used for TK_OPTION_CUSTOM, and typedef's of the functions + Tk_CustomOptionSetProc, Tk_CustomOptionGetProc, + Tk_CustomOptionRestoreProc, and Tk_CustomOptionFreeProc, used for + TK_OPTION_CUSTOM. + + * doc/SetOptions.3: Added documentation of TK_OPTION_CUSTOM, and + section "CUSTOM OPTION TYPES" explaining how to create and use + custom options. + + * tests/config.test: Added tests for custom option type. + + * generic/tkTest.c: Added test support for TK_OPTION_CUSTOM to + TestobjconfigObjCmd. Added CustomOption* functions to implement a + test custom option. + + * generic/tkConfig.c: Added new option type TK_OPTION_CUSTOM, + which allows the definition of custom option types by creating + parsing, printing, freeing, and restoring procedures for a custom + option. This is needed by the text and canvas widgets if they are + to be fully objectified. + 2000-09-07 Jeff Hobbs <hobbs@scriptics.com> * doc/Tk_Init.3: @@ -6,6 +30,18 @@ 2000-09-06 Eric Melski <ericm@ajubasolutions.com> + * doc/HWNDToWindow.3: + * doc/GetHWND.3: Changed synopsis to indicate the tkPlatDecls.h + should be included, not tk.h. + + * generic/tkPlatDecls.h: Removed #include <windows.h> for Windows, + a better solution for now is to update the docs and have extension + authors #include <tkPlatDecls.h>. + + * generic/tk.h: Removed '#include "tkPlatDecls.h"', as the + incorrect inclusion order between windows.h/tkPlatDecls.h causes + build conflicts on Windows. + * generic/tkPlatDecls.h: Added #include <windows.h> for Windows, so that HWND, etc., are defined properly. diff --git a/doc/SetOptions.3 b/doc/SetOptions.3 index 16d645c..bef4ed5 100644 --- a/doc/SetOptions.3 +++ b/doc/SetOptions.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: SetOptions.3,v 1.5 2000/08/15 21:30:32 hobbs Exp $ +'\" RCS: @(#) $Id: SetOptions.3,v 1.6 2000/09/17 21:02:39 ericm Exp $ '\" .so man.macros .TH Tk_SetOptions 3 8.1 Tk "Tk Library Procedures" @@ -368,6 +368,11 @@ such as \fBTk_SetOptions\fR, and when the option is set the cursor for the window is changed by calling \fBXDefineCursor\fR. This option type also supports the TK_OPTION_NULL_OK flag. .TP +\fBTK_OPTION_CUSTOM\fR +This option allows applications to define new option types. The +clientData field of the entry points to a structure defining the new +option type. See the section CUSTOM OPTION TYPES below for details. +.TP \fBTK_OPTION_DOUBLE\fR The string value must be a floating-point number in the format accepted by \fBstrtol\fR. The internal form is a C @@ -496,11 +501,143 @@ on retrievals exists only for TK_OPTION_PIXELS options. .PP The second reason to use the \fIobjOffset\fR field is in order to implement new types of options not supported by these procedures. -To implement a new type of option, use TK_OPTION_STRING as +To implement a new type of option, you can use TK_OPTION_STRING as the type in the Tk_OptionSpec structure and set the \fIobjOffset\fR field but not the \fIinternalOffset\fR field. Then, after calling \fBTk_SetOptions\fR, convert the object to internal form yourself. +.SH "CUSTOM OPTION TYPES" +.PP +Applications can extend the built-in configuration types with +additional configuration types by writing procedures to parse, print, +free, and restore saved copies of the type and creating a structure +pointing to those procedures: +.CS +typedef struct Tk_ObjCustomOption { + char *name; + Tk_CustomOptionSetProc *\fIsetProc\fR; + Tk_CustomOptionGetProc *\fIgetProc\fR; + Tk_CustomOptionRestoreProc *\fIrestoreProc\fR; + Tk_CustomOptionFreeProc *\fIfreeProc\fR; + ClientData \fIclientData\fR; +} Tk_ObjCustomOption; + +typedef int Tk_CustomOptionSetProc( + ClientData \fIclientData\fR, + Tcl_Interp *\fIinterp\fR, + Tk_Window \fItkwin\fR, + Tcl_Obj **\fIvaluePtr\fR, + char *\fIinternalPtr\fR, + char *\fIsaveInternalPtr\fR, + int \fIflags\fR); + +typedef Tcl_Obj *Tk_CustomOptionGetProc( + ClientData \fIclientData\fR, + Tk_Window \fItkwin\fR, + char *\fIinternalPtr\fR); + +typedef void Tk_CustomOptionRestoreProc( + ClientData \fIclientData\fR, + Tk_Window \fItkwin\fR, + char *\fIinternalPtr\fR, + char *\fIsaveInternalPtr\fR); + +typedef void Tk_CustomOptionFreeProc( + ClientData \fIclientData\fR, + Tk_Window \fItkwin\fR, + char *\fIinternalPtr\fR); +.CE +.PP +The Tk_ObjCustomOption structure contains six fields: a name +for the custom option type; pointers to the four procedures; and a +\fIclientData\fR value to be passed to those procedures when they are +invoked. The \fIclientData\fR value typically points to a structure +containing information that is needed by the procedures when they are +parsing and printing options. +.PP +The \fIsetProc\fR procedure is invoked by \fBTk_SetOptions\fR to +convert a Tcl_Obj into an internal representation and store the +resulting value in the widget record. The arguments are: +.RS +.TP +\fIclientData\fR +A copy of the \fIclientData\fR field in the Tk_ObjCustomOption +structure. +.TP +\fIinterp\fR +A pointer to a Tcl interpreter, used for error reporting. +.TP +\fITkwin\fR +A copy of the \fItkwin\fR argument to \fBTk_SetOptions\fR +.TP +\fIvaluePtr\fR +A pointer to a reference to a Tcl_Obj describing the new value for the +option; it could have been specified explicitly in the call to +\fBTk_SetOptions\fR or it could come from the option database or a +default. If the objOffset for the option is non-negative (the option +value is stored as a (Tcl_Obj *) in the widget record), the Tcl_Obj +pointer referenced by \fIvaluePtr\fR is the pointer that will be +stored at the objOffset for the option. \fISetProc\fR may modify the +value if necessary; for example, \fIsetProc\fR may change the value to +NULL to support the TK_OPTION_NULL_OK flag. +.TP +\fIinternalPtr\fR +A pointer to the internal storage allocated for the option +in the widget record. The value referenced by \fIinternalPtr\fR +should be set to the internal representation of the new option value. +.TP +\fIsaveInternalPtr\fR +A pointer to storage allocated in a Tk_SavedOptions structure for the +internal representation of the original option value. Before setting +\fIinternalPtr\fR to its new value, \fIsetProc\fR should set the value +referenced by \fIsaveInternalPtr\fR to the original value of the +option in order to support \fBTk_RestoreSavedOptions\fR. +.TP +\fIflags\fR +A copy of the \fIflags\fR field in the Tk_OptionSpec structure for the +option +.RE +.PP +\fISetProc\fR returns a standard Tcl result: TCL_OK to indicate successful +processing, or TCL_ERROR to indicate a failure of any kind. An error +message may be left in the Tcl interpreter given by \fIinterp\fR in +the case of an error. +.PP +The \fIgetProc\fR procedure is invoked by \fBTk_GetOptionValue\fR and +\fBTk_GetOptionInfo\fR to retrieve a Tcl_Obj representation of the +internal representation of an option. The \fIclientData\fR argument +is a copy of the \fIclientData\fR field in the Tk_ObjCustomOption +structure. \fITkwin\fR is a copy of the \fItkwin\fR argument to +\fBTk_GetOptionValue\fR or \fBTk_GetOptionInfo\fR. \fIInternalPtr\fR +is a pointer to the internal representation of the option value. +\fIGetProc\fR must return a pointer to a Tcl_Obj representing the +value of the option. +.PP +The \fIrestoreProc\fR procedure is invoked by +\fBTk_RestoreSavedOptions\fR to restore a previously saved internal +representation of a custom option value. The \fIclientData\fR argument +is a copy of the \fIclientData\fR field in the Tk_ObjCustomOption +structure. \fITkwin\fR is a copy of the \fItkwin\fR argument to +\fBTk_GetOptionValue\fR or \fBTk_GetOptionInfo\fR. \fIInternalPtr\fR +is a pointer to the internal representation of the option value. +\fISaveInternalPtr\fR is a pointer to the saved value. +\fIRestoreProc\fR must copy the value from \fIsaveInternalPtr\fR to +\fIinternalPtr\fR to restore the value. \fIRestoreProc\fR need not +free any memory associated with either \fIinternalPtr\fR or +\fIsaveInternalPtr\fR; \fIfreeProc\fR will be invoked to free that +memory if necessary. \fIRestoreProc\fR has no return value. +.PP +The \fIfreeProc\fR procedure is invoked by \fBTk_SetOptions\fR and +\fBTk_FreeSavedOptions\fR to free any storage allocated for the +internal representation of a custom option. The \fIclientData\fR argument +is a copy of the \fIclientData\fR field in the Tk_ObjCustomOption +structure. \fITkwin\fR is a copy of the \fItkwin\fR argument to +\fBTk_GetOptionValue\fR or \fBTk_GetOptionInfo\fR. \fIInternalPtr\fR +is a pointer to the internal representation of the option value. +The \fIfreeProc\fR must free any storage associated with the option. +\fIFreeProc\fR has no return value. + + .SH KEYWORDS anchor, bitmap, boolean, border, color, configuration option, cursor, double, font, integer, justify, diff --git a/generic/tk.h b/generic/tk.h index cb93773..bbecf6a 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk.h,v 1.49 2000/09/07 00:28:38 ericm Exp $ + * RCS: @(#) $Id: tk.h,v 1.50 2000/09/17 21:02:39 ericm Exp $ */ #ifndef _TK @@ -145,7 +145,8 @@ typedef enum { TK_OPTION_SYNONYM, TK_OPTION_PIXELS, TK_OPTION_WINDOW, - TK_OPTION_END + TK_OPTION_END, + TK_OPTION_CUSTOM } Tk_OptionType; /* @@ -205,6 +206,39 @@ typedef struct Tk_OptionSpec { #define TK_OPTION_DONT_SET_DEFAULT (1 << 3) /* + * The following structure and function types are used by TK_OPTION_CUSTOM + * options; the structure holds pointers to the functions needed by the Tk + * option config code to handle a custom option. + */ + +typedef int (Tk_CustomOptionSetProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj **value, + char *internalPtr, char *saveInternalPtr, int flags)); +typedef Tcl_Obj *(Tk_CustomOptionGetProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr)); +typedef void (Tk_CustomOptionRestoreProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr, char *saveInternalPtr)); +typedef void (Tk_CustomOptionFreeProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr)); + +typedef struct Tk_ObjCustomOption { + char *name; /* Name of the custom option. */ + Tk_CustomOptionSetProc *setProc; /* Function to use to set a record's + * option value from a Tcl_Obj */ + Tk_CustomOptionGetProc *getProc; /* Function to use to get a Tcl_Obj + * representation from an internal + * representation of an option. */ + Tk_CustomOptionRestoreProc *restoreProc; /* Function to use to restore a + * saved value for the internal + * representation. */ + Tk_CustomOptionFreeProc *freeProc; /* Function to use to free the internal + * representation of an option. */ + ClientData clientData; /* Arbitrary one-word value passed to + * the handling procs. */ +} Tk_ObjCustomOption; + + +/* * Macro to use to fill in "offset" fields of the Tk_OptionSpec. * struct. Computes number of bytes from beginning of structure * to a given field. diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 28ebf98..116a271 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkConfig.c,v 1.10 2000/08/10 00:21:07 ericm Exp $ + * RCS: @(#) $Id: tkConfig.c,v 1.11 2000/09/17 21:02:39 ericm Exp $ */ /* @@ -66,6 +66,7 @@ typedef struct TkOption { * use on monochrome displays. */ struct TkOption *synonymPtr; /* For synonym options, this points to * the master entry. */ + struct Tk_ObjCustomOption *custom; /* For TK_OPTION_CUSTOM. */ } extra; int flags; /* Miscellaneous flag values; see * below for definitions. */ @@ -279,6 +280,14 @@ Tk_CreateOptionTable(interp, templatePtr) Tcl_NewStringObj((char *) specPtr->clientData, -1); Tcl_IncrRefCount(optionPtr->extra.monoColorPtr); } + + if (specPtr->type == TK_OPTION_CUSTOM) { + /* + * Get the custom parsing, etc., functions. + */ + optionPtr->extra.custom = + (Tk_ObjCustomOption *)specPtr->clientData; + } } if (((specPtr->type == TK_OPTION_STRING) && (specPtr->internalOffset >= 0)) @@ -286,7 +295,8 @@ Tk_CreateOptionTable(interp, templatePtr) || (specPtr->type == TK_OPTION_FONT) || (specPtr->type == TK_OPTION_BITMAP) || (specPtr->type == TK_OPTION_BORDER) - || (specPtr->type == TK_OPTION_CURSOR)) { + || (specPtr->type == TK_OPTION_CURSOR) + || (specPtr->type == TK_OPTION_CUSTOM)) { optionPtr->flags |= OPTION_NEEDS_FREEING; } } @@ -905,6 +915,16 @@ DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr) } break; } + case TK_OPTION_CUSTOM: { + Tk_ObjCustomOption *custom = optionPtr->extra.custom; + if (custom->setProc(custom->clientData, interp, tkwin, + &valuePtr, (char *)internalPtr, (char *)oldInternalPtr, + optionPtr->specPtr->flags) != TCL_OK) { + return TCL_ERROR; + } + break; + } + default: { char buf[40+TCL_INTEGER_SPACE]; sprintf(buf, "bad config table: unknown type %d", @@ -1409,6 +1429,13 @@ Tk_RestoreSavedOptions(savePtr) = *((Tk_Window *) &savePtr->items[i].internalForm); break; } + case TK_OPTION_CUSTOM: { + Tk_ObjCustomOption *custom = optionPtr->extra.custom; + custom->restoreProc(custom->clientData, savePtr->tkwin, + internalPtr, + (char *)&savePtr->items[i].internalForm); + break; + } default: { panic("bad option type in Tk_RestoreSavedOptions"); } @@ -1619,6 +1646,13 @@ FreeResources(optionPtr, objPtr, internalPtr, tkwin) Tk_FreeCursorFromObj(tkwin, objPtr); } break; + case TK_OPTION_CUSTOM: { + Tk_ObjCustomOption *custom = optionPtr->extra.custom; + if (internalFormExists && custom->freeProc != NULL) { + custom->freeProc(custom->clientData, tkwin, internalPtr); + } + break; + } default: break; } @@ -1903,6 +1937,11 @@ GetObjectForOption(recordPtr, optionPtr, tkwin) } break; } + case TK_OPTION_CUSTOM: { + Tk_ObjCustomOption *custom = optionPtr->extra.custom; + objPtr = custom->getProc(custom->clientData, tkwin, internalPtr); + break; + } default: { panic("bad option type in GetObjectForOption"); } diff --git a/generic/tkTest.c b/generic/tkTest.c index d64dfcc..b7a5652 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTest.c,v 1.12 2000/04/04 08:09:15 hobbs Exp $ + * RCS: @(#) $Id: tkTest.c,v 1.13 2000/09/17 21:02:40 ericm Exp $ */ #include "tkInt.h" @@ -188,6 +188,17 @@ static int TestmetricsCmd _ANSI_ARGS_((ClientData dummy, static int TestobjconfigObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); +static int CustomOptionSet _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, Tk_Window tkwin, + Tcl_Obj **value, char *internalPtr, + char *saveInternalPtr, int flags)); +static Tcl_Obj *CustomOptionGet _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr)); +static void CustomOptionRestore _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr, + char *saveInternalPtr)); +static void CustomOptionFree _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr)); static int TestpropCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestsendCmd _ANSI_ARGS_((ClientData dummy, @@ -639,6 +650,14 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) * created by commands below; indexed * with same values as "options" * array. */ + static Tk_ObjCustomOption CustomOption = { + "custom option", + CustomOptionSet, + CustomOptionGet, + CustomOptionRestore, + CustomOptionFree, + (ClientData) 1 + }; Tk_Window mainWin = (Tk_Window) clientData; Tk_Window tkwin; int index, result = TCL_OK; @@ -696,6 +715,7 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) Tcl_Obj *anchorPtr; Tcl_Obj *pixelPtr; Tcl_Obj *mmPtr; + Tcl_Obj *customPtr; } TypesRecord; TypesRecord *recordPtr; static char *stringTable[] = {"one", "two", "three", "four", @@ -761,6 +781,10 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) "-pixel", "pixel", "Pixel", "1", Tk_Offset(TypesRecord, pixelPtr), -1, TK_CONFIG_NULL_OK, 0, 0x2000}, + {TK_OPTION_CUSTOM, + "-custom", (char *) NULL, (char *) NULL, + "", Tk_Offset(TypesRecord, customPtr), -1, + TK_CONFIG_NULL_OK, &CustomOption, 0x4000}, {TK_OPTION_SYNONYM, "-synonym", (char *) NULL, (char *) NULL, (char *) NULL, 0, -1, 0, (ClientData) "-color", @@ -798,6 +822,7 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) recordPtr->pixelPtr = NULL; recordPtr->mmPtr = NULL; recordPtr->stringTablePtr = NULL; + recordPtr->customPtr = NULL; result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, tkwin); if (result == TCL_OK) { @@ -1005,6 +1030,7 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) int pixels; double mm; Tk_Window tkwin; + char *custom; } InternalRecord; InternalRecord *recordPtr; static char *internalStringTable[] = { @@ -1071,6 +1097,10 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) "-window", "window", "Window", (char *) NULL, -1, Tk_Offset(InternalRecord, tkwin), TK_CONFIG_NULL_OK, 0, 0}, + {TK_OPTION_CUSTOM, + "-custom", (char *) NULL, (char *) NULL, + "", -1, Tk_Offset(InternalRecord, custom), + TK_CONFIG_NULL_OK, &CustomOption, 0x4000}, {TK_OPTION_SYNONYM, "-synonym", (char *) NULL, (char *) NULL, (char *) NULL, -1, -1, 0, (ClientData) "-color", @@ -1108,6 +1138,7 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) recordPtr->pixels = 0; recordPtr->mm = 0.0; recordPtr->tkwin = NULL; + recordPtr->custom = NULL; result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, tkwin); if (result == TCL_OK) { @@ -2381,3 +2412,120 @@ TestwrapperCmd(clientData, interp, argc, argv) return TCL_OK; } #endif + +/* + *---------------------------------------------------------------------- + * + * CustomOptionSet, CustomOptionGet, CustomOptionRestore, CustomOptionFree -- + * + * Handlers for object-based custom configuration options. See + * Testobjconfigcommand. + * + * Results: + * See user documentation for expected results from these functions. + * CustomOptionSet Standard Tcl Result. + * CustomOptionGet Tcl_Obj * containing value. + * CustomOptionRestore None. + * CustomOptionFree None. + * + * Side effects: + * Depends on the function. + * CustomOptionSet Sets option value to new setting. + * CustomOptionGet Creates a new Tcl_Obj. + * CustomOptionRestore Resets option value to original value. + * CustomOptionFree Free storage for internal rep of + * option. + * + *---------------------------------------------------------------------- + */ + +static int +CustomOptionSet(clientData,interp, tkwin, value, internalPtr, + saveInternalPtr, flags) + ClientData clientData; + Tcl_Interp *interp; + Tk_Window tkwin; + Tcl_Obj **value; + char *internalPtr; + char *saveInternalPtr; + int flags; +{ + int objEmpty, length; + char *new, *string; + + objEmpty = 0; + /* + * See if the object is empty. + */ + if (value == NULL) { + objEmpty = 1; + } else { + if ((*value)->bytes != NULL) { + objEmpty = ((*value)->length == 0); + } else { + Tcl_GetStringFromObj((*value), &length); + objEmpty = (length == 0); + } + } + + if ((flags & TK_OPTION_NULL_OK) && objEmpty) { + *value = NULL; + } else { + string = Tcl_GetStringFromObj((*value), &length); + Tcl_UtfToUpper(string); + if (objEmpty) { + Tcl_SetResult(interp, "expected good value, got \"\"", TCL_STATIC); + return TCL_ERROR; + } + if (strncmp(string, "BAD", (size_t)length) == 0) { + Tcl_SetResult(interp, "expected good value, got \"BAD\"", + TCL_STATIC); + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + if ((*value) != NULL) { + string = Tcl_GetStringFromObj((*value), &length); + new = ckalloc((size_t) (length + 1)); + strcpy(new, string); + } else { + new = NULL; + } + *((char **) saveInternalPtr) = *((char **) internalPtr); + *((char **) internalPtr) = new; + } + + return TCL_OK; +} + +static Tcl_Obj * +CustomOptionGet(clientData, tkwin, internalPtr) + ClientData clientData; + Tk_Window tkwin; + char *internalPtr; +{ + return (Tcl_NewStringObj(*(char **)internalPtr, -1)); +} + +static void +CustomOptionRestore(clientData, tkwin, internalPtr, saveInternalPtr) + ClientData clientData; + Tk_Window tkwin; + char *internalPtr; + char *saveInternalPtr; +{ + *(char **)internalPtr = *(char **)saveInternalPtr; + return; +} + +static void +CustomOptionFree(clientData, tkwin, internalPtr) + ClientData clientData; + Tk_Window tkwin; + char *internalPtr; +{ + if (*(char **)internalPtr != NULL) { + ckfree(*(char **)internalPtr); + } +} + diff --git a/tests/config.test b/tests/config.test index a12ecb5..078c3f5 100644 --- a/tests/config.test +++ b/tests/config.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: config.test,v 1.3 2000/03/02 21:52:25 hobbs Exp $ +# RCS: @(#) $Id: config.test,v 1.4 2000/09/17 21:02:40 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -50,7 +50,7 @@ test config-1.1 {Tk_CreateOptionTable - reference counts} { lappend x [testobjconfig info alltypes] eval destroy [winfo children .] set x -} {{1 15 -boolean} {2 15 -boolean}} +} {{1 16 -boolean} {2 16 -boolean}} test config-1.2 {Tk_CreateOptionTable - synonym initialization} { eval destroy [winfo children .] testobjconfig alltypes .a -synonym green @@ -458,9 +458,11 @@ test config-4.64 {DoObjConfig - releasing old values} { catch {rename .foo {}} testobjconfig alltypes .foo -string {Test string} -color yellow \ - -font {Courier 18} -bitmap questhead -border green -cursor cross + -font {Courier 18} -bitmap questhead -border green -cursor cross \ + -custom foobar .foo configure -string {new string} -color brown \ - -font {Times 8} -bitmap gray75 -border pink -cursor watch + -font {Times 8} -bitmap gray75 -border pink -cursor watch \ + -custom barbaz concat {} } {} test config-4.65 {DoObjConfig - releasing old values} { @@ -470,11 +472,26 @@ test config-4.65 {DoObjConfig - releasing old values} { catch {rename .foo {}} testobjconfig internal .foo -string {Test string} -color yellow \ - -font {Courier 18} -bitmap questhead -border green -cursor cross + -font {Courier 18} -bitmap questhead -border green -cursor cross \ + -custom foobar .foo configure -string {new string} -color brown \ - -font {Times 8} -bitmap gray75 -border pink -cursor watch + -font {Times 8} -bitmap gray75 -border pink -cursor watch \ + -custom barbaz concat {} } {} +test config-4.66 {DoObjConfig - custom} { + catch {destroy .foo} + list [catch {testobjconfig alltypes .foo -custom test} msg] $msg [catch {.foo cget -custom} result] $result [destroy .foo] +} {0 .foo 0 TEST {}} +test config-4.67 {DoObjConfig - null custom} { + catch {destroy .foo} + list [catch {testobjconfig alltypes .foo -custom {}} msg] $msg [catch {.foo cget -custom} result] $result [destroy .foo] +} {0 .foo 0 {} {}} +test config-4.68 {DoObjConfig - custom internal value} { + catch {rename .foo {}} + testobjconfig internal .foo -custom "this is a test" + .foo cget -custom +} {THIS IS A TEST} test config-5.1 {ObjectIsEmpty - object is already string} { catch {destroy .foo} @@ -550,6 +567,12 @@ test config-7.7 {Tk_SetOptions - synonym name in error message} { test config-7.8 {Tk_SetOptions - returning mask} { format %x [.a configure -color red -int 7 -relief raised -double 3.14159] } {226} +test config-7.9 {Tk_SetOptions - error in DoObjConfig with custom option} { + list [catch {.a configure -custom bad} msg] $msg $errorInfo +} {1 {expected good value, got "BAD"} {expected good value, got "BAD" + (processing "-custom" option) + invoked from within +".a configure -custom bad"}} test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} { eval destroy [winfo children .] @@ -636,6 +659,11 @@ test config-8.16 {Tk_RestoreSavedOptions - window internal form} { testobjconfig internal .a -window .a list [catch {.a csave -window .a -color bogus}] [.a cget -window] } {1 .a} +test config-8.17 {Tk_RestoreSavedOptions - custom internal form} { + eval destroy [winfo children .] + testobjconfig internal .a -custom "foobar" + list [catch {.a csave -custom "barbaz" -color bogus}] [.a cget -custom] +} {1 FOOBAR} # Most of the tests below will cause memory leakage if there is a # problem. This may not be evident unless the tests are run in @@ -713,6 +741,12 @@ test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} { .foo configure -integer [format 27] destroy .foo } {} +test config-9.13 {Tk_FreeConfigOptions/FreeResources - custom internal form} { + catch {destroy .fpp} + testobjconfig internal .foo + .foo configure -custom "foobar" + destroy .foo +} {} test config-10.1 {Tk_GetOptionInfo - one item} { catch {destroy .foo} @@ -730,7 +764,7 @@ test config-10.3 {Tk_GetOptionInfo - all items} { catch {destroy .foo} testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563 .foo configure -} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-synonym -color}} +} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-custom {} {} {} {}} {-synonym -color}} test config-10.4 {Tk_GetOptionInfo - chaining through tables} { catch {destroy .foo} testobjconfig chain2 .foo -one asdf -three xyzzy @@ -811,12 +845,16 @@ test config-12.15 {GetObjectForOption - window} { .a configure -window .a .a cget -window } {.a} -test config-12.16 {GetObjectForOption - null values} { +test config-12.16 {GetObjectForOption -custom} { + .a configure -custom foobar + .a cget -custom +} {FOOBAR} +test config-12.17 {GetObjectForOption - null values} { .a configure -string {} -color {} -font {} -bitmap {} -border {} \ - -cursor {} -window {} + -cursor {} -window {} -custom {} list [.a cget -string] [.a cget -color] [.a cget -font] \ - [.a cget -string] [.a cget -bitmap] [.a cget -border] \ - [.a cget -cursor] [.a cget -window] + [.a cget -bitmap] [.a cget -border] [.a cget -cursor] \ + [.a cget -window] [.a cget -custom] } {{} {} {} {} {} {} {} {}} test config-13.1 {proper cleanup of options with widget destroy} { |