TkGetWindowFromObj was useless CPU waster; now caches window names *safely*

1 files changed, 103 insertions, 15 deletions

diff --git a/generic/tkObj.c b/generic/tkObj.c
index 2fdc710..26d5f79 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.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: tkObj.c,v 1.6 2001/08/17 09:38:30 dkf Exp $
+ * RCS: @(#) $Id: tkObj.c,v 1.7 2001/08/21 14:43:08 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -55,6 +55,16 @@ typedef struct MMRep {
 } MMRep;
 
 /*
+ * The following structure is the internal representation for window objects.
+ */
+ 
+typedef struct WindowRep {
+    Tk_Window tkwin;
+    Tk_Window mainwin;
+    long epoch;
+} WindowRep;
+
+/*
  * Prototypes for procedures defined later in this file:
  */
 
@@ -62,8 +72,11 @@ static void		DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
 static void		DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
+static void		DupWindowInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
 static void		FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		FreeWindowInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr));
 static int		SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
@@ -71,7 +84,7 @@ static int		SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
 static int		SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
-			
+
 /*
  * The following structure defines the implementation of the "pixel"
  * Tcl object, used for measuring distances.  The pixel object remembers
@@ -107,8 +120,8 @@ static Tcl_ObjType mmObjType = {
 
 static Tcl_ObjType windowObjType = {
     "window",				/* name */
-    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
-    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    FreeWindowInternalRep,		/* freeIntRepProc */
+    DupWindowInternalRep,		/* dupIntRepProc */
     NULL,				/* updateStringProc */
     SetWindowFromAny			/* setFromAnyProc */
 };
@@ -666,10 +679,12 @@ int
 TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
     Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
     Tk_Window tkwin;		/* A token to get the main window from. */
-    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
+    Tcl_Obj *objPtr;		/* The object from which to get boolean. */
     Tk_Window *windowPtr;	/* Place to store resulting window. */
 {
-    Tk_Window lastWindow;
+    register WindowRep *winPtr;
+    TkDisplay *dispPtr = ((TkWindow *)tkwin)->dispPtr;
+    Tk_Window foundWindow;
 
     if (objPtr->typePtr != &windowObjType) {
 	register int result = SetWindowFromAny(interp, objPtr);
@@ -678,19 +693,27 @@ TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
 	}
     }
 
-    lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;
-    if (tkwin != lastWindow) {
-	Tk_Window foundWindow = Tk_NameToWindow(interp,
-		Tcl_GetStringFromObj(objPtr, NULL), tkwin);
+    winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr;
+    if (winPtr == NULL) {
+	winPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
+	objPtr->internalRep.otherValuePtr = (VOID *) winPtr;
+	goto parseWindowString;
 
+    } else if (tkwin != winPtr->mainwin ||
+	       dispPtr->deletionEpoch != winPtr->epoch) {
+    parseWindowString:
+	foundWindow = Tk_NameToWindow(interp,
+		Tcl_GetStringFromObj(objPtr, NULL), tkwin);
 	if (foundWindow == NULL) {
 	    return TCL_ERROR;
 	}
-	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;
-	objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;
+
+	winPtr->tkwin = foundWindow;
+	winPtr->mainwin = tkwin;
+	winPtr->epoch = dispPtr->deletionEpoch;
     }
-    *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;
 
+    *windowPtr = winPtr->tkwin;
     return TCL_OK;
 }
 
@@ -731,8 +754,7 @@ SetWindowFromAny(interp, objPtr)
 	(*typePtr->freeIntRepProc)(objPtr);
     }
     objPtr->typePtr = &windowObjType;
-    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
 
     return TCL_OK;
 }
@@ -740,6 +762,72 @@ SetWindowFromAny(interp, objPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * DupWindowInternalRep --
+ *
+ *	Initialize the internal representation of a window Tcl_Obj to a
+ *	copy of the internal representation of an existing window object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to refer to the same window as
+ *	srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupWindowInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;
+    register Tcl_Obj *copyPtr;
+{
+    register WindowRep *oldPtr, *newPtr;
+
+    copyPtr->typePtr = srcPtr->typePtr;
+    oldPtr = srcPtr->internalRep.otherValuePtr;
+    if (oldPtr == NULL) {
+	copyPtr->internalRep.otherValuePtr = NULL;
+    } else {
+	newPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
+	newPtr->tkwin = oldPtr->tkwin;
+	newPtr->mainwin = oldPtr->mainwin;
+	newPtr->epoch = oldPtr->epoch;
+	copyPtr->internalRep.otherValuePtr = (VOID *)newPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeWindowInternalRep --
+ *
+ *	Deallocate the storage associated with a window object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees objPtr's internal representation and sets objPtr's
+ *	internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeWindowInternalRep(objPtr)
+    Tcl_Obj *objPtr;		/* Window object with internal rep to free. */
+{
+    if (objPtr->internalRep.otherValuePtr != NULL) {
+	ckfree((char *) objPtr->internalRep.otherValuePtr);
+	objPtr->internalRep.otherValuePtr = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TkRegisterObjTypes --
  *
  *	Registers Tk's Tcl_ObjType structures with the Tcl run-time.