From d7a70751627660bb7343dab5abda94a068388dd1 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 14 Oct 2008 13:24:32 +0000 Subject: Added new utility function: TkNewWindowObj() --- ChangeLog | 128 +++++++++++++++++++++++++++++--------------------------- generic/tkInt.h | 3 +- generic/tkObj.c | 117 +++++++++++++++++++++++++++++++-------------------- 3 files changed, 141 insertions(+), 107 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8085a52..a765a27 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2008-10-14 Donal K. Fellows + + * generic/tkObj.c (TkNewWindowObj): Added utility function for making + a Tcl_Obj from a Tk_Window reference. Candidate for future exposure to + third-party code I suppose, but useful internal to Tk for sure. + 2008-10-11 Donal K. Fellows * generic/tkCanvas.c (CanvasWidgetCmd): Corrected result generation. @@ -19,23 +25,22 @@ 2008-10-08 Jan Nijtmans - * unix/tcl.m4: fix for bug [2073255] - * unix/configure: regenerated + * unix/tcl.m4: Fix for bug [2073255] + * unix/configure: regenerated 2008-10-08 Don Porter - * tests/textDisp.test (textDisp-16.34): Update test that tested - string equality of double values based on an assumption of - tcl_precision==12. Test now does its own formatting. + * tests/textDisp.test (textDisp-16.34): Update test that tested string + equality of double values based on an assumption of tcl_precision==12. + Test now does its own formatting. - * tests/scrollbar.test: Revised testing of the cget subcommand so - that it tests consistency with the configure subcommand and not - agreement with a hardcoded value that will change as tastes in - GUIs evolve. + * tests/scrollbar.test: Revised testing of the cget subcommand so that + it tests consistency with the configure subcommand and not agreement + with a hardcoded value that will change as tastes in GUIs evolve. - * tests/canvText.test (canvText-17.1): Update expected result to - match revised PostScript output due to more predictable formatting - of floating point values. + * tests/canvText.test (canvText-17.1): Update expected result to match + revised PostScript output due to more predictable formatting of + floating point values. * unix/tkUnixWm.c: Restored consistency of error messages from * macosx/tkMacOSXWm.c: [wm iconphoto] with the test suite and across @@ -45,13 +50,13 @@ * tests/canvImg.test: Removed dependency on precision in results * tests/canvRect.test: - * tests/canvText.test: - * tests/entry.test: - * tests/listbox.test: - * tests/scrollbar.test: + * tests/canvText.test: + * tests/entry.test: + * tests/listbox.test: + * tests/scrollbar.test: * tests/spinbox.test: * tests/winWm.test: Fixed incorrect error strings - * tests/wm.test: + * tests/wm.test: 2008-10-06 Pat Thoyts @@ -61,27 +66,27 @@ 2008-10-05 Donal K. Fellows * win/tkWinWm.c (WmAttributesCmd, WmOverrideredirectCmd) - (WmStackorderCmd): - * win/tkWinSendCom.c (Async): - * win/tkWinSend.c (Tk_SendObjCmd): - * win/tkWinFont.c (TkpGetFontFamilies, TkpGetSubFonts): - * unix/tkUnixWm.c (WmOverrideredirectCmd, WmStackorderCmd): - * unix/tkUnixFont.c (TkpGetFontFamilies, TkpGetSubFonts): - * macosx/tkMacOSXWm.c (WmOverrideredirectCmd, WmStackorderCmd): - * generic/tkTextIndex.c (SetTextIndexFromAny): - * generic/tkTest.c (TrivialConfigObjCmd): - * generic/tkSelect.c (HandleTclCommand): + (WmStackorderCmd): + * win/tkWinSendCom.c (Async): + * win/tkWinSend.c (Tk_SendObjCmd): + * win/tkWinFont.c (TkpGetFontFamilies, TkpGetSubFonts): + * unix/tkUnixWm.c (WmOverrideredirectCmd, WmStackorderCmd): + * unix/tkUnixFont.c (TkpGetFontFamilies, TkpGetSubFonts): + * macosx/tkMacOSXWm.c (WmOverrideredirectCmd, WmStackorderCmd): + * generic/tkTextIndex.c (SetTextIndexFromAny): + * generic/tkTest.c (TrivialConfigObjCmd): + * generic/tkSelect.c (HandleTclCommand): * generic/tkPanedWindow.c (Tk_PanedWindowObjCmd) - (PanedWindowSashCommand, PanedWindowProxyCommand): - * generic/tkMenubutton.c (Tk_MenubuttonObjCmd): - * generic/tkMenu.c (MenuWidgetObjCmd): - * generic/tkListbox.c (ListboxWidgetObjCmd): + (PanedWindowSashCommand, PanedWindowProxyCommand): + * generic/tkMenubutton.c (Tk_MenubuttonObjCmd): + * generic/tkMenu.c (MenuWidgetObjCmd): + * generic/tkListbox.c (ListboxWidgetObjCmd): * generic/tkImgPhoto.c (ImgPhotoCmd): (mostly) - * generic/tkImage.c (Tk_ImageObjCmd): - * generic/tkFont.c (Tk_FontObjCmd, GetAttributeInfoObj): - * generic/tkEntry.c (EntryWidgetObjCmd, SpinboxWidgetObjCmd): - * generic/tkConfig.c (SetOptionFromAny, Tk_SetOptions): - * generic/tkCmds.c (Tk_TkObjCmd, Tk_WinfoObjCmd, TkGetDisplayOf): + * generic/tkImage.c (Tk_ImageObjCmd): + * generic/tkFont.c (Tk_FontObjCmd, GetAttributeInfoObj): + * generic/tkEntry.c (EntryWidgetObjCmd, SpinboxWidgetObjCmd): + * generic/tkConfig.c (SetOptionFromAny, Tk_SetOptions): + * generic/tkCmds.c (Tk_TkObjCmd, Tk_WinfoObjCmd, TkGetDisplayOf): * generic/tkButton.c (ButtonCreate): Get rid of code that insists on non-idiomatically writing to the object in the interpreter result. @@ -320,7 +325,7 @@ 2008-08-14 Daniel Steffen - * unix/tcl.m4 (SC_PATH_X): check for libX11.dylib in addition to + * unix/tcl.m4 (SC_PATH_X): Check for libX11.dylib in addition to libX11.so et al. * unix/configure: autoconf-2.59 @@ -410,7 +415,7 @@ 2008-07-24 Jan Nijtmans - * generic/*.c: fix inconsistant "wrong # args" messages. [Bug 2021443] + * generic/*.c: Fix inconsistant "wrong # args" messages. [Bug 2021443] * macosx/tkMacOSXSend.c * macosx/tkMacOSXWm.c * unix/tkUnixSend.c @@ -432,7 +437,7 @@ * library/ttk/aquaTheme.tcl: Use system color names and TIP145 named font instead of hardcoded color values and deprecated native font name - * macosx/tkMacOSXHLEvents.c: factor out common code; formatting. + * macosx/tkMacOSXHLEvents.c: Factor out common code; formatting. 2008-07-08 Pat Thoyts @@ -526,26 +531,26 @@ 2008-06-12 Daniel Steffen - * generic/tkPointer.c (Tk_UpdatePointer): fix failure to restore a + * generic/tkPointer.c (Tk_UpdatePointer): Fix failure to restore a global grab capture and to release the restrict window capture when releasing a button grab. Fixes segfault due to dangling reference to restrict window inside TkpSetCapture() implementation. [Bug 1991932] - * generic/ttk/ttkTreeview.c: fix warning. + * generic/ttk/ttkTreeview.c: Fix warning. - * unix/tcl.m4 (SunOS-5.11): fix 64bit amd64 support with gcc & Sun cc. + * unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc. * unix/configure: autoconf-2.59 - * macosx/tkMacOSXXStubs.c (Tk_ResetUserInactiveTime): use UsrActivity + * macosx/tkMacOSXXStubs.c (Tk_ResetUserInactiveTime): Use UsrActivity instead of OverallAct (which may be ignored in some circumstances). - * macosx/Wish.xcodeproj/project.pbxproj: add tclIORTrans.c; add tclOO + * macosx/Wish.xcodeproj/project.pbxproj: Add tclIORTrans.c; add tclOO * macosx/Wish.xcodeproj/default.pbxuser: files to tktest-X11 target; add debug configs for 64bit and with corefoundation disabled; updates and cleanup for Xcode 3.1 and for Leopard; sync with Tcl.xcodeproj. - * macosx/Wish.xcode/project.pbxproj: sync Wish.xcodeproj changes. + * macosx/Wish.xcode/project.pbxproj: Sync Wish.xcodeproj changes. * macosx/Wish.xcode/default.pbxuser: - * macosx/README: document new build configs. + * macosx/README: Document new build configs. 2008-06-10 Joe English @@ -683,18 +688,18 @@ 2008-04-08 Kevin Kenny - * tkWinEmbed.c: Removed #if 0 code. Trust the revision control system, - if you need it again, you can find it. + * tkWinEmbed.c: Removed #if 0 code. Trust the revision control + system, if you need it again, you can find it. * tkWinSend.c: Added conditional compilation to silence several - compiler warnings. + compiler warnings. 2008-04-07 Jeff Hobbs * generic/tkWindow.c (Initialize): Fix double-free on Tk_ParseArgv * tests/main.test (main-3.*): error. [Bug 1937135] - * generic/tkArgv.c: fix -help mem explosion. [Bug 1936238] (kenny) + * generic/tkArgv.c: Fix -help mem explosion. [Bug 1936238] (kenny) 2008-04-04 Pat Thoyts @@ -784,12 +789,13 @@ 2008-03-27 Jeff Hobbs - * library/safetk.tcl (::safe::tkInterpInit): make sure tk_library and + * library/safetk.tcl (::safe::tkInterpInit): Make sure tk_library and its subdirs (eg, ttk) are on the "safe" access path. 2008-03-27 Daniel Steffen - * unix/tcl.m4 (SunOS-5.1x): fix 64bit support for Sun cc. [Bug 1921166] + * unix/tcl.m4 (SunOS-5.1x): Fix 64bit support for Sun cc. [Bug + 1921166] * unix/configure: autoconf-2.59 @@ -840,9 +846,9 @@ 2008-03-13 Daniel Steffen - * unix/configure.in: Use backslash-quoting instead of double-quoting - * unix/tcl.m4: for lib paths in tkConfig.sh. [Bug 1913622] - * unix/configure: autoconf-2.59 + * unix/configure.in: Use backslash-quoting instead of double-quoting + * unix/tcl.m4: for lib paths in tkConfig.sh. [Bug 1913622] + * unix/configure: autoconf-2.59 2008-03-13 Don Porter @@ -902,7 +908,7 @@ 2008-02-27 Daniel Steffen - * macosx/tkMacOSXDraw.c: workaround leak in Carbon SetPortPenPixPat() + * macosx/tkMacOSXDraw.c: Workaround leak in Carbon SetPortPenPixPat() API [Bug 1863346]; avoid repeated PixPat allocation/deallocation. 2008-02-23 Joe English @@ -945,11 +951,11 @@ 2008-02-02 Daniel Steffen - * macosx/Wish-Info.plist.in: add CFBundleLocalizations key, listing + * macosx/Wish-Info.plist.in: Add CFBundleLocalizations key, listing * unix/configure.in (Darwin): all library/msgs locales. - * unix/configure.in (Darwin): correct Info.plist year substitution in - non-framework builds. + * unix/configure.in (Darwin): Correct Info.plist year substitution + in non-framework builds. * unix/configure: autoconf-2.59 @@ -964,10 +970,10 @@ 2008-01-31 Jeff Hobbs - * library/msgbox.tcl (::tk::MessageBox): don't use ttk::label in low + * library/msgbox.tcl (::tk::MessageBox): Don't use ttk::label in low depth/aqua fallback, as it doesn't support -bitmap. - * win/tkWinDialog.c (Tk_MessageBoxObjCmd): pass "" instead of NULL + * win/tkWinDialog.c (Tk_MessageBoxObjCmd): Pass "" instead of NULL when -title isn't set. [Bug 1881892] 2008-01-31 Donal K. Fellows diff --git a/generic/tkInt.h b/generic/tkInt.h index 039d28e..03ad61d 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.83 2008/04/02 21:32:32 das Exp $ + * RCS: $Id: tkInt.h,v 1.84 2008/10/14 13:24:32 dkf Exp $ */ #ifndef _TKINT @@ -1200,6 +1200,7 @@ MODULE_SCOPE void TkUnderlineCharsInContext(Display *display, int firstByte, int lastByte); MODULE_SCOPE void TkpGetFontAttrsForChar(Tk_Window tkwin, Tk_Font tkfont, Tcl_UniChar c, struct TkFontAttributes *faPtr); +MODULE_SCOPE Tcl_Obj * TkNewWindowObj(Tk_Window tkwin); /* * Unsupported commands. diff --git a/generic/tkObj.c b/generic/tkObj.c index ce1c649..647ea8b 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -8,7 +8,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.20 2008/04/27 22:38:56 dkf Exp $ + * RCS: @(#) $Id: tkObj.c,v 1.21 2008/10/14 13:24:32 dkf Exp $ */ #include "tkInt.h" @@ -36,7 +36,7 @@ typedef struct PixelRep { #define SET_COMPLEXPIXEL(objPtr, repPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = (void *) repPtr + (objPtr)->internalRep.twoPtrValue.ptr2 = repPtr #define GET_COMPLEXPIXEL(objPtr) \ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2) @@ -323,7 +323,7 @@ SetPixelFromAny( typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &pixelObjType; @@ -344,16 +344,8 @@ SetPixelFromAny( error: if (interp != NULL) { - /* - * Must copy string before resetting the result in case a caller is - * trying to convert the interpreter's result to pixels. - */ - - char buf[100]; - - sprintf(buf, "bad screen distance \"%.50s\"", string); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%.50s\"", string)); } return TCL_ERROR; } @@ -400,7 +392,7 @@ Tk_GetMMFromObj( } } - mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; + mmPtr = objPtr->internalRep.otherValuePtr; if (mmPtr->tkwin != tkwin) { d = mmPtr->value; if (mmPtr->units == -1) { @@ -439,7 +431,7 @@ static void FreeMMInternalRep( Tcl_Obj *objPtr) /* MM object with internal rep to free. */ { - ckfree((char *) objPtr->internalRep.otherValuePtr); + ckfree(objPtr->internalRep.otherValuePtr); objPtr->internalRep.otherValuePtr = NULL; objPtr->typePtr = NULL; } @@ -470,13 +462,13 @@ DupMMInternalRep( MMRep *oldPtr, *newPtr; copyPtr->typePtr = srcPtr->typePtr; - oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr; + oldPtr = srcPtr->internalRep.otherValuePtr; newPtr = (MMRep *) ckalloc(sizeof(MMRep)); newPtr->value = oldPtr->value; newPtr->units = oldPtr->units; newPtr->tkwin = oldPtr->tkwin; newPtr->returnValue = oldPtr->returnValue; - copyPtr->internalRep.otherValuePtr = (void *) newPtr; + copyPtr->internalRep.otherValuePtr = newPtr; } /* @@ -506,7 +498,7 @@ UpdateStringOfMM( char buffer[TCL_DOUBLE_SPACE]; register int len; - mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; + mmPtr = objPtr->internalRep.otherValuePtr; /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) { Tcl_Panic("UpdateStringOfMM: false precondition"); @@ -560,7 +552,7 @@ SetMMFromAny( */ tclDoubleObjType = Tcl_GetObjType("double"); - tclIntObjType = Tcl_GetObjType("int"); + tclIntObjType = Tcl_GetObjType("int"); } if (objPtr->typePtr == tclDoubleObjType) { @@ -628,18 +620,18 @@ SetMMFromAny( typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } - objPtr->typePtr = &mmObjType; + objPtr->typePtr = &mmObjType; - mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); - mmPtr->value = d; - mmPtr->units = units; - mmPtr->tkwin = NULL; + mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); + mmPtr->value = d; + mmPtr->units = units; + mmPtr->tkwin = NULL; mmPtr->returnValue = d; - objPtr->internalRep.otherValuePtr = (void *) mmPtr; + objPtr->internalRep.otherValuePtr = mmPtr; return TCL_OK; } @@ -672,7 +664,7 @@ TkGetWindowFromObj( Tcl_Obj *objPtr, /* The object from which to get window. */ Tk_Window *windowPtr) /* Place to store resulting window. */ { - TkMainInfo *mainPtr = ((TkWindow *)tkwin)->mainPtr; + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; register WindowRep *winPtr; int result; @@ -681,26 +673,27 @@ TkGetWindowFromObj( return result; } - winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr; - if ( winPtr->tkwin == NULL - || winPtr->mainPtr == NULL - || winPtr->mainPtr != mainPtr - || winPtr->epoch != mainPtr->deletionEpoch) - { - /* Cache is invalid. + winPtr = objPtr->internalRep.otherValuePtr; + if (winPtr->tkwin == NULL + || winPtr->mainPtr == NULL + || winPtr->mainPtr != mainPtr + || winPtr->epoch != mainPtr->deletionEpoch) { + /* + * Cache is invalid. */ + winPtr->tkwin = Tk_NameToWindow(interp, Tcl_GetStringFromObj(objPtr, NULL), tkwin); + if (winPtr->tkwin == NULL) { + /* ASSERT: Tk_NameToWindow has left error message in interp */ + return TCL_ERROR; + } + winPtr->mainPtr = mainPtr; winPtr->epoch = mainPtr ? mainPtr->deletionEpoch : 0; } *windowPtr = winPtr->tkwin; - - if (winPtr->tkwin == NULL) { - /* ASSERT: Tk_NameToWindow has left error message in interp */ - return TCL_ERROR; - } return TCL_OK; } @@ -739,7 +732,7 @@ SetWindowFromAny( Tcl_GetStringFromObj(objPtr, NULL); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } winPtr = (WindowRep *) ckalloc(sizeof(WindowRep)); @@ -747,7 +740,7 @@ SetWindowFromAny( winPtr->mainPtr = NULL; winPtr->epoch = 0; - objPtr->internalRep.otherValuePtr = (void *) winPtr; + objPtr->internalRep.otherValuePtr = winPtr; objPtr->typePtr = &windowObjType; return TCL_OK; @@ -783,7 +776,7 @@ DupWindowInternalRep( newPtr->tkwin = oldPtr->tkwin; newPtr->mainPtr = oldPtr->mainPtr; newPtr->epoch = oldPtr->epoch; - copyPtr->internalRep.otherValuePtr = (void *) newPtr; + copyPtr->internalRep.otherValuePtr = newPtr; copyPtr->typePtr = srcPtr->typePtr; } @@ -809,13 +802,47 @@ static void FreeWindowInternalRep( Tcl_Obj *objPtr) /* Window object with internal rep to free. */ { - ckfree((char *) objPtr->internalRep.otherValuePtr); + ckfree(objPtr->internalRep.otherValuePtr); objPtr->internalRep.otherValuePtr = NULL; objPtr->typePtr = NULL; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- + * + * TkNewWindowObj -- + * + * This function allocates a new Tcl_Obj that refers to a particular to a + * particular Tk window. + * + * Results: + * A standard Tcl object reference, with refcount 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkNewWindowObj( + Tk_Window tkwin) +{ + Tcl_Obj *objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1); + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; + register WindowRep *winPtr; + + SetWindowFromAny(NULL, objPtr); + + winPtr = objPtr->internalRep.otherValuePtr; + winPtr->tkwin = tkwin; + winPtr->mainPtr = mainPtr; + winPtr->epoch = mainPtr->deletionEpoch; + return objPtr; +} + +/* + *---------------------------------------------------------------------- * * TkParsePadAmount -- * @@ -833,7 +860,7 @@ FreeWindowInternalRep( * An error message is written to the interpreter if something is not * right. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ int -- cgit v0.12