summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-09-17 21:02:38 (GMT)
committerericm <ericm>2000-09-17 21:02:38 (GMT)
commit8d93216489667aad5317c07fc1dcc992b86b5b56 (patch)
tree38c791d10fe68a382b053bd668de898755e86dd4
parent983b0c27a51acd0f5cb823a959a05058464d05e9 (diff)
downloadtk-8d93216489667aad5317c07fc1dcc992b86b5b56.zip
tk-8d93216489667aad5317c07fc1dcc992b86b5b56.tar.gz
tk-8d93216489667aad5317c07fc1dcc992b86b5b56.tar.bz2
* 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.
-rw-r--r--ChangeLog36
-rw-r--r--doc/SetOptions.3141
-rw-r--r--generic/tk.h38
-rw-r--r--generic/tkConfig.c43
-rw-r--r--generic/tkTest.c150
-rw-r--r--tests/config.test60
6 files changed, 450 insertions, 18 deletions
diff --git a/ChangeLog b/ChangeLog
index 3beee4f..efc06dc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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} {