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

3 files changed, 226 insertions, 5 deletions

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);
+    }
+}
+