* 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.

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} {