diff options
140 files changed, 6467 insertions, 5269 deletions
@@ -1,3 +1,13 @@ +2012-08-27 Donal K. Fellows <dkf@users.sf.net> + + * (very many files): Reworked the generation of error messages and + postscript so that they no longer made nearly as much use of the Tcl + interpreter's string result code, in the process substantially + reducing the amount of ad-hoc stack buffers used for message + generation. There should be no observable changes from this except + that Tk now causes the ::errorCode variable to be set meaningfully in + virtually all places where errors are generated. + 2012-08-24 Donal K. Fellows <dkf@users.sf.net> * library/tkfbox.tcl (GlobFiltered): [Bug 3558535]: Factor out the diff --git a/carbon/tkMacOSXButton.c b/carbon/tkMacOSXButton.c index b39696d..a7ef5b8 100644 --- a/carbon/tkMacOSXButton.c +++ b/carbon/tkMacOSXButton.c @@ -978,7 +978,7 @@ TkMacOSXDrawControl( SetControlValue(mbPtr->control, 0); } - active = ((mbPtr->flags & ACTIVE) != 0); + active = !!(mbPtr->flags & ACTIVE); if (active != IsControlActive(mbPtr->control)) { if (active) { ChkErr(ActivateControl, mbPtr->control); @@ -1395,7 +1395,7 @@ ButtonEventProc( } else { mbPtr->flags &= ~ACTIVE; } - if ((buttonPtr->flags & REDRAW_PENDING) == 0) { + if (!(buttonPtr->flags & REDRAW_PENDING)) { Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) buttonPtr); buttonPtr->flags |= REDRAW_PENDING; } diff --git a/carbon/tkMacOSXClipboard.c b/carbon/tkMacOSXClipboard.c index 420ccf7..a57ec58 100644 --- a/carbon/tkMacOSXClipboard.c +++ b/carbon/tkMacOSXClipboard.c @@ -61,8 +61,10 @@ TkSelGetSelection( err = ChkErr(GetCurrentScrap, &scrapRef); if (err != noErr) { - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " GetCurrentScrap failed.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s GetCurrentScrap failed.", + Tk_GetAtomName(tkwin, selection))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "SCRAP", NULL); return TCL_ERROR; } @@ -79,8 +81,8 @@ TkSelGetSelection( buf = ckalloc(length + 2); buf[length] = 0; buf[length+1] = 0; /* 2-byte unicode null */ - err = ChkErr(GetScrapFlavorData, scrapRef, kScrapFlavorTypeUnicode, - &length, buf); + err = ChkErr(GetScrapFlavorData, scrapRef, + kScrapFlavorTypeUnicode, &length, buf); if (err == noErr) { Tcl_DStringInit(&ds); Tcl_UniCharToUtfDString((Tcl_UniChar *) buf, @@ -99,8 +101,10 @@ TkSelGetSelection( err = ChkErr(GetScrapFlavorSize, scrapRef, 'TEXT', &length); if (err != noErr) { - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " GetScrapFlavorSize failed.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s GetScrapFlavorSize failed.", + Tk_GetAtomName(tkwin, selection))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "FLAVORSIZE", NULL); return TCL_ERROR; } if (length > 0) { @@ -111,9 +115,12 @@ TkSelGetSelection( buf[length] = 0; err = ChkErr(GetScrapFlavorData, scrapRef, 'TEXT', &length, buf); if (err != noErr) { - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " GetScrapFlavorData failed.", NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s GetScrapFlavorData failed.", + Tk_GetAtomName(tkwin, selection))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "FLAVORDATA", + NULL); + return TCL_ERROR; } /* @@ -136,9 +143,10 @@ TkSelGetSelection( } } - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), Tk_GetAtomName(tkwin, target))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL); return TCL_ERROR; } diff --git a/carbon/tkMacOSXCursor.c b/carbon/tkMacOSXCursor.c index c465764..423b4ff 100644 --- a/carbon/tkMacOSXCursor.c +++ b/carbon/tkMacOSXCursor.c @@ -265,7 +265,9 @@ TkGetCursorByName( if (macCursorPtr->macCursor == NULL) { ckfree(macCursorPtr); - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); return NULL; } return (TkCursor *) macCursorPtr; diff --git a/carbon/tkMacOSXDialog.c b/carbon/tkMacOSXDialog.c index 8097f2c..d3ea74e 100644 --- a/carbon/tkMacOSXDialog.c +++ b/carbon/tkMacOSXDialog.c @@ -89,7 +89,8 @@ static int NavServicesGetFile(Tcl_Interp *interp, Tk_Window parent); static int HandleInitialDirectory(Tcl_Interp *interp, char *initialFile, char *initialDir, FSRef *dirRef, - AEDescList *selectDescPtr, AEDesc *dirDescPtr); + AEDescList *selectDescPtr, AEDesc *dirDescPtr, + const char *dlgType); /* * Have we initialized the file dialog subsystem @@ -104,7 +105,7 @@ static int fileDlgInited = 0; static NavObjectFilterUPP openFileFilterUPP; static NavEventUPP openFileEventUPP; - + /* *---------------------------------------------------------------------- * @@ -152,16 +153,16 @@ Tk_ChooseColorObjCmd( for (i = 1; i < objc; i += 2) { int index; - const char *option, *value; + const char *value; if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - option = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", option, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL); goto end; } value = Tcl_GetString(objv[i + 1]); @@ -225,7 +226,7 @@ Tk_ChooseColorObjCmd( end: return result; } - + /* *---------------------------------------------------------------------- * @@ -282,7 +283,6 @@ Tk_GetOpenFileObjCmd( for (i = 1; i < objc; i += 2) { char *choice; int index, choiceLen; - char *string; Tcl_Obj *types; if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option", @@ -290,9 +290,9 @@ Tk_GetOpenFileObjCmd( goto end; } if (i + 1 == objc) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } @@ -355,7 +355,7 @@ Tk_GetOpenFileObjCmd( } if (HandleInitialDirectory(interp, initialFile, initialDir, &dirRef, - &selectDesc, &initialDesc) != TCL_OK) { + &selectDesc, &initialDesc, "FILEDIALOG") != TCL_OK) { goto end; } if (initialDesc.descriptorType == typeFSRef) { @@ -394,7 +394,7 @@ Tk_GetOpenFileObjCmd( } return result; } - + /* *---------------------------------------------------------------------- * @@ -446,7 +446,7 @@ Tk_GetSaveFileObjCmd( ofd.usePopup = 0; for (i = 1; i < objc; i += 2) { - char *choice, *string; + char *choice; int index, choiceLen; Tcl_Obj *types; @@ -455,9 +455,9 @@ Tk_GetSaveFileObjCmd( goto end; } if (i + 1 == objc) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -473,7 +473,7 @@ Tk_GetSaveFileObjCmd( choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen); /* empty strings should be like no selection given */ if (choiceLen && HandleInitialDirectory(interp, NULL, choice, - &dirRef, NULL, &initialDesc) != TCL_OK) { + &dirRef, NULL, &initialDesc, "FILEDIALOG") != TCL_OK) { goto end; } break; @@ -533,7 +533,7 @@ Tk_GetSaveFileObjCmd( } return result; } - + /* *---------------------------------------------------------------------- * @@ -578,7 +578,7 @@ Tk_ChooseDirectoryObjCmd( } for (i = 1; i < objc; i += 2) { - char *string, *choice; + char *choice; int index, choiceLen; if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option", @@ -586,16 +586,16 @@ Tk_ChooseDirectoryObjCmd( goto end; } if (i + 1 == objc) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); goto end; } switch (index) { case CHOOSE_INITDIR: choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen); if (choiceLen && HandleInitialDirectory(interp, NULL, choice, - &dirRef, NULL, &initialDesc) != TCL_OK) { + &dirRef, NULL, &initialDesc, "DIRDIALOG") != TCL_OK) { goto end; } break; @@ -645,7 +645,7 @@ Tk_ChooseDirectoryObjCmd( } return result; } - + /* *---------------------------------------------------------------------- * @@ -669,7 +669,8 @@ HandleInitialDirectory( char *initialDir, FSRef *dirRef, AEDescList *selectDescPtr, - AEDesc *dirDescPtr) + AEDesc *dirDescPtr, + const char *dlgType) { Tcl_DString ds; OSStatus err; @@ -685,13 +686,16 @@ HandleInitialDirectory( err = ChkErr(FSPathMakeRef, (unsigned char *) dirName, dirRef, &isDirectory); if (err != noErr) { - Tcl_AppendResult(interp, "bad directory \"", initialDir, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad directory \"%s\"", initialDir)); + Tcl_SetErrorCode(interp, "TK", dlgType, "NO_INITDIR", NULL); goto end; } if (!isDirectory) { - Tcl_AppendResult(interp, "-intialdir \"", initialDir, "\"" - " is a file, not a directory.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-intialdir \"%s\" is a file, not a directory.", + initialDir)); + Tcl_SetErrorCode(interp, "TK", dlgType, "BAD_INITDIR", NULL); goto end; } ChkErr(AECreateDesc, typeFSRef, dirRef, sizeof(*dirRef), dirDescPtr); @@ -715,8 +719,10 @@ HandleInitialDirectory( err = ChkErr(FSPathMakeRef, (unsigned char *) namePtr, &fileRef, &isDirectory); if (err != noErr) { - Tcl_AppendResult(interp, "bad initialfile \"", initialFile, - "\" file does not exist.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad initialfile \"%s\" file does not exist.", + initialFile)); + Tcl_SetErrorCode(interp, "TK", dlgType, "NO_INITFILE", NULL); goto end; } ChkErr(AECreateDesc, typeFSRef, &fileRef, sizeof(fileRef), &fileDesc); @@ -730,7 +736,7 @@ HandleInitialDirectory( } return result; } - + /* *---------------------------------------------------------------------- * @@ -754,7 +760,7 @@ InitFileDialogs(void) openFileFilterUPP = NewNavObjectFilterUPP(OpenFileFilterProc); openFileEventUPP = NewNavEventUPP(OpenEventProc); } - + /* *---------------------------------------------------------------------- * @@ -1039,7 +1045,7 @@ NavServicesGetFile( } return result; } - + /* *---------------------------------------------------------------------- * @@ -1124,7 +1130,7 @@ OpenEventProc( break; } } - + /* *---------------------------------------------------------------------- * @@ -1221,7 +1227,7 @@ OpenFileFilterProc( } return (result == MATCHED); } - + /* *---------------------------------------------------------------------- * @@ -1338,7 +1344,7 @@ MatchOneType( return UNMATCHED; } - + /* *---------------------------------------------------------------------- * @@ -1377,7 +1383,7 @@ TkAboutDlg(void) DisposeDialog(aboutDlog); SelectWindow(ActiveNonFloatingWindow()); } - + /* *---------------------------------------------------------------------- * @@ -1486,16 +1492,15 @@ Tk_MessageBoxObjCmd( for (i = 1; i < objc; i += 2) { int iconIndex; - char *string; if (Tcl_GetIndexFromObj(interp, objv[i], movableAlertStrings, "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL); goto end; } @@ -1624,6 +1629,7 @@ Tk_MessageBoxObjCmd( if (defaultNativeButtonIndex == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Illegal default option", -1)); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL); goto end; } paramCFStringRec.defaultButton = defaultNativeButtonIndex; @@ -1705,7 +1711,7 @@ Tk_MessageBoxObjCmd( } return result; } - + /* *---------------------------------------------------------------------- * @@ -2033,6 +2039,7 @@ FontchooserConfigureCmd( for (i = 1; i < objc; i += 2) { int optionIndex, len; + if (Tcl_GetIndexFromObj(interp, objv[i], fontchooserOptionStrings, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; @@ -2043,91 +2050,93 @@ FontchooserConfigureCmd( return TCL_OK; } if (i + 1 == objc) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(objv[i]), "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL); return TCL_ERROR; } switch (optionIndex) { - case FontchooserVisible: { - const char *msg = "cannot change read-only option " + case FontchooserVisible: { + const char *msg = "cannot change read-only option " "\"-visible\": use the show or hide command"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, sizeof(msg)-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL); + return TCL_ERROR; + } + case FontchooserParent: { + Tk_Window parent = Tk_NameToWindow(interp, + Tcl_GetString(objv[i+1]), tkwin); + + if (parent == None) { return TCL_ERROR; } - case FontchooserParent: { - Tk_Window parent = Tk_NameToWindow(interp, - Tcl_GetString(objv[i+1]), tkwin); - if (parent == None) { - return TCL_ERROR; - } - if (fcdPtr->parent) { - Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, - FontchooserParentEventHandler, fcdPtr); - } - fcdPtr->parent = parent; - Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + if (fcdPtr->parent) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, FontchooserParentEventHandler, fcdPtr); - break; } - case FontchooserTitle: - if (fcdPtr->titleObj) { - Tcl_DecrRefCount(fcdPtr->titleObj); - } - Tcl_GetStringFromObj(objv[i+1], &len); - if (len) { - fcdPtr->titleObj = objv[i+1]; - if (Tcl_IsShared(fcdPtr->titleObj)) { - fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj); - } - Tcl_IncrRefCount(fcdPtr->titleObj); - } else { - fcdPtr->titleObj = NULL; + fcdPtr->parent = parent; + Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + break; + } + case FontchooserTitle: + if (fcdPtr->titleObj) { + Tcl_DecrRefCount(fcdPtr->titleObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->titleObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->titleObj)) { + fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj); } - break; - case FontchooserFont: { - - Tcl_GetStringFromObj(objv[i+1], &len); - if (len) { - Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]); - if (f) { - ATSUStyle atsuStyle; - - TkMacOSXFMFontInfoForFont(f, &fontPanelFontFamily, - &fontPanelFontStyle, &fontPanelFontSize, - &atsuStyle); - ChkErr(SetFontInfoForSelection, - kFontSelectionATSUIType, 1, &atsuStyle, NULL); - Tk_FreeFont(f); - } else { - return TCL_ERROR; - } + Tcl_IncrRefCount(fcdPtr->titleObj); + } else { + fcdPtr->titleObj = NULL; + } + break; + case FontchooserFont: + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]); + + if (f) { + ATSUStyle atsuStyle; + + TkMacOSXFMFontInfoForFont(f, &fontPanelFontFamily, + &fontPanelFontStyle, &fontPanelFontSize, + &atsuStyle); + ChkErr(SetFontInfoForSelection, kFontSelectionATSUIType, + 1, &atsuStyle, NULL); + Tk_FreeFont(f); } else { - fontPanelFontFamily = kInvalidFontFamily; - ChkErr(SetFontInfoForSelection, - kFontSelectionATSUIType, 0, NULL, NULL); - } - if (FPIsFontPanelVisible()) { - TkSendVirtualEvent(fcdPtr->parent, - "TkFontchooserFontChanged"); + return TCL_ERROR; } - break; + } else { + fontPanelFontFamily = kInvalidFontFamily; + ChkErr(SetFontInfoForSelection, kFontSelectionATSUIType, 0, + NULL, NULL); } - case FontchooserCmd: - if (fcdPtr->cmdObj) { - Tcl_DecrRefCount(fcdPtr->cmdObj); - } - Tcl_GetStringFromObj(objv[i+1], &len); - if (len) { - fcdPtr->cmdObj = objv[i+1]; - if (Tcl_IsShared(fcdPtr->cmdObj)) { - fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj); - } - Tcl_IncrRefCount(fcdPtr->cmdObj); - } else { - fcdPtr->cmdObj = NULL; + if (FPIsFontPanelVisible()) { + TkSendVirtualEvent(fcdPtr->parent, + "TkFontchooserFontChanged"); + } + break; + case FontchooserCmd: + if (fcdPtr->cmdObj) { + Tcl_DecrRefCount(fcdPtr->cmdObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->cmdObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->cmdObj)) { + fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj); } - break; + Tcl_IncrRefCount(fcdPtr->cmdObj); + } else { + fcdPtr->cmdObj = NULL; + } + break; } } return TCL_OK; diff --git a/carbon/tkMacOSXEmbed.c b/carbon/tkMacOSXEmbed.c index ad9e3da..39e9aaa 100644 --- a/carbon/tkMacOSXEmbed.c +++ b/carbon/tkMacOSXEmbed.c @@ -208,8 +208,9 @@ TkpUseWindow( Container *containerPtr; if (winPtr->window != None) { - Tcl_AppendResult(interp, "can't modify container after widget is " - "created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } @@ -227,12 +228,12 @@ TkpUseWindow( } usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, (Window) parent); - if (usePtr != NULL) { - if (!(usePtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, "window \"", usePtr->pathName, - "\" doesn't have -container option set", NULL); - return TCL_ERROR; - } + if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); + return TCL_ERROR; } /* @@ -312,8 +313,10 @@ TkpUseWindow( if (tkMacOSXEmbedHandler == NULL || tkMacOSXEmbedHandler->registerWinProc((int) parent, (Tk_Window) winPtr) != TCL_OK) { - Tcl_AppendResult(interp, "The window ID ", string, - " does not correspond to a valid Tk Window.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "The window ID %s does not correspond to a valid Tk Window", + string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "HANDLE", NULL); return TCL_ERROR; } else { containerPtr = ckalloc(sizeof(Container)); diff --git a/carbon/tkMacOSXMenu.c b/carbon/tkMacOSXMenu.c index 31bb20e..b02c289 100644 --- a/carbon/tkMacOSXMenu.c +++ b/carbon/tkMacOSXMenu.c @@ -531,8 +531,10 @@ TkMacOSXGetNewMenuID( } if (!found) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "No more menus can be allocated.", NULL); + Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj( + "No more menus can be allocated.", -1)); + Tcl_SetErrorCode(menuPtr->interp, "TK", "MENU", "SYSTEM_RESOURCES", + NULL); return TCL_ERROR; } Tcl_SetHashValue(commandEntryPtr, menuPtr); @@ -682,21 +684,25 @@ TkpNewMenu( err = ChkErr(CreateNewMenu, menuID, kMenuAttrDoNotUseUserCommandKeys, &macMenuHdl); if (err != noErr) { - Tcl_AppendResult(menuPtr->interp, "CreateNewMenu failed.", NULL); + Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj( + "CreateNewMenu failed.", -1)); + Tcl_SetErrorCode(menuPtr->interp, "TK", "MENU", "CREATE", NULL); return TCL_ERROR; } cfStr = CFStringCreateWithCString(NULL, Tk_PathName(menuPtr->tkwin), kCFStringEncodingUTF8); if (!cfStr) { - Tcl_AppendResult(menuPtr->interp, "CFStringCreateWithCString failed.", - NULL); + Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj( + "CFStringCreateWithCString failed.", -1)); + Tcl_SetErrorCode(menuPtr->interp, "TK", "MENU", "CREATE_STRING",NULL); return TCL_ERROR; } err = ChkErr(SetMenuTitleWithCFString, macMenuHdl, cfStr); CFRelease(cfStr); if (err != noErr) { - Tcl_AppendResult(menuPtr->interp, "SetMenuTitleWithCFString failed.", - NULL); + Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj( + "SetMenuTitleWithCFString failed.", -1)); + Tcl_SetErrorCode(menuPtr->interp, "TK", "MENU", "SET_TITLE", NULL); return TCL_ERROR; } @@ -1546,8 +1552,9 @@ TkpPostMenu( int result; if (inPostMenu > 0) { - Tcl_AppendResult(interp, - "Cannot call post menu while already posting menu", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot call post menu while already posting menu", -1)); + Tcl_SetErrorCode(interp, "TK", "MENU", "POSTING", NULL); result = TCL_ERROR; } else { short menuID; @@ -2248,7 +2255,7 @@ TkMacOSXDispatchMenuEvent( Tcl_HashEntry *commandEntryPtr = Tcl_FindHashEntry(&commandTable, (char*)(intptr_t)menuID); if (commandEntryPtr != NULL) { - TkMenu *menuPtr = (TkMenu *) Tcl_GetHashValue(commandEntryPtr); + TkMenu *menuPtr = Tcl_GetHashValue(commandEntryPtr); if ((currentAppleMenuID == menuID) && (index > menuPtr->numEntries + 1)) { @@ -2365,7 +2372,7 @@ GetMenuAccelGeometry ( CFRelease(cfStr); } } - if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) { + if (!(mePtr->entryFlags & ENTRY_ACCEL_MASK)) { if (!geometryPtr->accelGlyph) { width = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } @@ -2629,7 +2636,7 @@ DrawMenuEntryAccelerator( drawState = kThemeStateActive; break; } - if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) { + if (!(mePtr->entryFlags & ENTRY_ACCEL_MASK)) { leftEdge -= geometryPtr->modifierWidth; } if (geometryPtr->accelGlyph) { diff --git a/carbon/tkMacOSXMenubutton.c b/carbon/tkMacOSXMenubutton.c index 9846d13..58fc787 100644 --- a/carbon/tkMacOSXMenubutton.c +++ b/carbon/tkMacOSXMenubutton.c @@ -934,7 +934,7 @@ MenuButtonEventProc( if (eventPtr->type == ActivateNotify || eventPtr->type == DeactivateNotify) { - if ((buttonPtr->tkwin == NULL) || (!Tk_IsMapped(buttonPtr->tkwin))) { + if ((buttonPtr->tkwin == NULL) || !Tk_IsMapped(buttonPtr->tkwin)) { return; } if (eventPtr->type == ActivateNotify) { @@ -942,8 +942,8 @@ MenuButtonEventProc( } else { mbPtr->flags &= ~ACTIVE; } - if ((buttonPtr->flags & REDRAW_PENDING) == 0) { - Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) buttonPtr); + if (!(buttonPtr->flags & REDRAW_PENDING)) { + Tcl_DoWhenIdle(TkpDisplayMenuButton, buttonPtr); buttonPtr->flags |= REDRAW_PENDING; } } diff --git a/carbon/tkMacOSXWindowEvent.c b/carbon/tkMacOSXWindowEvent.c index 2f46026..99ab918 100644 --- a/carbon/tkMacOSXWindowEvent.c +++ b/carbon/tkMacOSXWindowEvent.c @@ -885,10 +885,9 @@ TkWmProtocolEventProc( Tcl_Preserve(interp); result = Tcl_GlobalEval(interp, protPtr->command); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, - Tk_GetAtomName((Tk_Window) winPtr, protocol)); - Tcl_AddErrorInfo(interp, "\" window manager protocol)"); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + Tk_GetAtomName((Tk_Window) winPtr, protocol))); Tcl_BackgroundException(interp, result); } Tcl_Release(interp); diff --git a/carbon/tkMacOSXWm.c b/carbon/tkMacOSXWm.c index 0ec8d74..d4b7665 100644 --- a/carbon/tkMacOSXWm.c +++ b/carbon/tkMacOSXWm.c @@ -209,7 +209,7 @@ static void GetMaxSize(TkWindow *winPtr, int *maxWidthPtr, int *maxHeightPtr); static void RemapWindows(TkWindow *winPtr, MacDrawable *parentWin); - + /* *---------------------------------------------------------------------- * @@ -305,7 +305,7 @@ TkWmNewWindow( Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0); } - + /* *---------------------------------------------------------------------- * @@ -404,7 +404,7 @@ TkWmMapWindow( XMapWindow(winPtr->display, winPtr->window); } - + /* *---------------------------------------------------------------------- * @@ -429,7 +429,7 @@ TkWmUnmapWindow( { XUnmapWindow(winPtr->display, winPtr->window); } - + /* *---------------------------------------------------------------------- * @@ -500,7 +500,7 @@ TkWmDeadWindow( ckfree(wmPtr); winPtr->wmInfoPtr = NULL; } - + /* *---------------------------------------------------------------------- * @@ -526,7 +526,7 @@ TkWmSetClass( { return; } - + /* *---------------------------------------------------------------------- * @@ -585,13 +585,13 @@ Tk_WmObjCmd( argv1 = Tcl_GetStringFromObj(objv[1], &length); if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0) - && (length >= 3)) { + && (length >= 3)) { if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(wmTracing)); return TCL_OK; } return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing); @@ -607,13 +607,15 @@ Tk_WmObjCmd( } if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -687,7 +689,7 @@ Tk_WmObjCmd( /* This should not happen */ return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -723,12 +725,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *aspect[4]; - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + aspect[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + aspect[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + aspect[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + aspect[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, aspect)); } return TCL_OK; } @@ -743,7 +746,9 @@ WmAspectCmd( } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -756,7 +761,7 @@ WmAspectCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -932,7 +937,7 @@ WmSetAttribute( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1007,7 +1012,7 @@ WmGetAttribute( } return result; } - + /* *---------------------------------------------------------------------- * @@ -1045,16 +1050,16 @@ WmAttributesCmd( macWindow = TkMacOSXDrawableWindow(winPtr->window); if (objc == 3) { /* wm attributes $win */ - Tcl_Obj *result = Tcl_NewListObj(0,0); + Tcl_Obj *result = Tcl_NewObj(); for (attribute = 0; attribute < _WMATT_LAST_ATTRIBUTE; ++attribute) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(WmAttributeNames[attribute], -1)); - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, WmGetAttribute(winPtr, macWindow, attribute)); } Tcl_SetObjResult(interp, result); - } else if (objc == 4) { /* wm attributes $win -attribute */ + } else if (objc == 4) { /* wm attributes $win -attribute */ if (Tcl_GetIndexFromObj(interp, objv[3], WmAttributeNames, "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; @@ -1065,7 +1070,7 @@ WmAttributesCmd( for (i = 3; i < objc; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } if (WmSetAttribute(winPtr, macWindow, interp, attribute, objv[i+1]) @@ -1079,7 +1084,7 @@ WmAttributesCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1115,7 +1120,8 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } @@ -1134,7 +1140,7 @@ WmClientCmd( strcpy(wmPtr->clientMachine, argv3); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1161,10 +1167,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2; + TkWindow **cmapList, *winPtr2; int i, windowObjc, gotToplevel = 0; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1172,17 +1177,20 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) - && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { + && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } cmapList = ckalloc((windowObjc+1) * sizeof(TkWindow*)); @@ -1221,7 +1229,7 @@ WmColormapwindowsCmd( return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1258,8 +1266,8 @@ WmCommandCmd( } if (objc == 3) { if (wmPtr->cmdArgv != NULL) { - argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - Tcl_SetResult(interp, argv3, TCL_VOLATILE); + argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); + Tcl_SetObjResult(interp, Tcl_NewStringObj(argv3, -1)); ckfree(argv3); } return TCL_OK; @@ -1282,7 +1290,7 @@ WmCommandCmd( wmPtr->cmdArgv = cmdArgv; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1315,20 +1323,24 @@ WmDeiconifyCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, TkMacOSXIsWindowZoomed(winPtr) ? ZoomState : NormalState); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1366,8 +1378,8 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } @@ -1382,7 +1394,7 @@ WmFocusmodelCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1409,7 +1421,9 @@ WmForgetCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { #if 1 - Tcl_AppendResult(interp, "wm forget is not yet supported", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wm forget is not yet supported", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "UNSUPPORTED", NULL); return TCL_ERROR; #else register Tk_Window frameWin = (Tk_Window)winPtr; @@ -1444,7 +1458,7 @@ WmForgetCmd( return TCL_OK; #endif } - + /* *---------------------------------------------------------------------- * @@ -1472,7 +1486,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1482,11 +1495,10 @@ WmFrameCmd( if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(buf, "0x%x", (unsigned) window); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) window)); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1522,8 +1534,6 @@ WmGeometryCmd( return TCL_ERROR; } if (objc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1535,9 +1545,8 @@ WmGeometryCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(buf, "%dx%d%c%d%c%d", - width, height, xSign, wmPtr->x, ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d", + width, height, xSign, wmPtr->x, ySign, wmPtr->y)); return TCL_OK; } argv3 = Tcl_GetString(objv[3]); @@ -1549,7 +1558,7 @@ WmGeometryCmd( } return ParseGeometry(interp, argv3, winPtr); } - + /* *---------------------------------------------------------------------- * @@ -1577,6 +1586,7 @@ WmGridCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; + const char *errorMsg; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -1585,12 +1595,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *grid[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + grid[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + grid[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + grid[2] = Tcl_NewIntObj(wmPtr->widthInc); + grid[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, grid)); } return TCL_OK; } @@ -1617,20 +1628,17 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); - return TCL_ERROR; - } - if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); - return TCL_ERROR; + errorMsg = "baseWidth can't be < 0"; + goto error; + } else if (reqHeight < 0) { + errorMsg = "baseHeight can't be < 0"; + goto error; + } else if (widthInc <= 0) { + errorMsg = "widthInc can't be <= 0"; + goto error; + } else if (heightInc <= 0) { + errorMsg = "heightInc can't be <= 0"; + goto error; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, heightInc); @@ -1638,8 +1646,13 @@ WmGridCmd( wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; -} + error: + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMsg, -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "GRID", NULL); + return TCL_ERROR; +} + /* *---------------------------------------------------------------------- * @@ -1676,7 +1689,7 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } @@ -1702,7 +1715,7 @@ WmGroupCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1739,8 +1752,9 @@ WmIconbitmapCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char*)Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display, + wmPtr->hints.icon_pixmap), -1)); } return TCL_OK; } @@ -1770,7 +1784,7 @@ WmIconbitmapCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1801,30 +1815,37 @@ WmIconifyCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; - } - if (wmPtr->master != None) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + } else if (wmPtr->master != None) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; - } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + } else if (wmPtr->iconFor != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an embedded window", NULL); + } else if (winPtr->flags & TK_EMBEDDED) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } + TkpWmSetState(winPtr, IconicState); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1860,8 +1881,9 @@ WmIconmaskCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_mask), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display, + wmPtr->hints.icon_mask), -1)); } return TCL_OK; } @@ -1881,7 +1903,7 @@ WmIconmaskCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1933,7 +1955,7 @@ WmIconnameCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1985,8 +2007,10 @@ WmIconphotoCmd( for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -1999,7 +2023,7 @@ WmIconphotoCmd( return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2034,11 +2058,11 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *pos[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + pos[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + pos[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, pos)); } return TCL_OK; } @@ -2046,7 +2070,7 @@ WmIconpositionCmd( wmPtr->hints.flags &= ~IconPositionHint; } else { if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ + || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ return TCL_ERROR; } wmPtr->hints.icon_x = x; @@ -2055,7 +2079,7 @@ WmIconpositionCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2091,7 +2115,7 @@ WmIconwindowCmd( } if (objc == 3) { if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon)); } return TCL_OK; } @@ -2108,15 +2132,19 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tk_PathName(tkwin2))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "TOPLEVEL", + NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { @@ -2138,7 +2166,7 @@ WmIconwindowCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2165,7 +2193,9 @@ WmManageCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { #if 1 - Tcl_AppendResult(interp, "wm manage is not yet supported", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wm manage is not yet supported", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "UNSUPPORTED", NULL); return TCL_ERROR; #else register Tk_Window frameWin = (Tk_Window)winPtr; @@ -2176,9 +2206,11 @@ WmManageCmd( MacDrawable *macWin = (MacDrawable *) winPtr->window; if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", - Tk_PathName(frameWin), "\" is not manageable: must be " - "a frame, labelframe or toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a" + " frame, labelframe or toplevel", + Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -2206,7 +2238,7 @@ WmManageCmd( return TCL_OK; #endif } - + /* *---------------------------------------------------------------------- * @@ -2240,15 +2272,16 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *size[2]; GetMaxSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + size[0] = Tcl_NewIntObj(width); + size[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, size)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } wmPtr->maxWidth = width; @@ -2257,7 +2290,7 @@ WmMaxsizeCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2291,11 +2324,12 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *size[2]; GetMinSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + size[0] = Tcl_NewIntObj(width); + size[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, size)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2308,7 +2342,7 @@ WmMinsizeCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2354,7 +2388,7 @@ WmOverrideredirectCmd( ApplyMasterOverrideChanges(winPtr, NULL); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2393,9 +2427,9 @@ WmPositionfromCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("user", -1)); } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("program", -1)); } return TCL_OK; } @@ -2418,7 +2452,7 @@ WmPositionfromCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2449,6 +2483,7 @@ WmProtocolCmd( Atom protocol; char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -2459,11 +2494,13 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -2475,7 +2512,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -2510,7 +2548,7 @@ WmProtocolCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2545,16 +2583,15 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *resize[2]; - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + resize[0] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)); + resize[1] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resize)); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) - || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { + || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } if (width) { @@ -2578,15 +2615,14 @@ WmResizableCmd( } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (wmPtr->scrollWinPtr != NULL) { - TkScrollbarEventuallyRedraw((TkScrollbar *) - wmPtr->scrollWinPtr->instanceData); + TkScrollbarEventuallyRedraw(wmPtr->scrollWinPtr->instanceData); } WmUpdateGeom(wmPtr, winPtr); ApplyWindowClassAttributeChanges(winPtr, NULL, wmPtr->macClass, oldAttributes, 1); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2625,9 +2661,9 @@ WmSizefromCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("user", -1)); } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("program", -1)); } return TCL_OK; } @@ -2651,7 +2687,7 @@ WmSizefromCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2677,11 +2713,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { - "isabove", "isbelow", NULL }; + "isabove", "isbelow", NULL + }; enum options { - OPT_ISABOVE, OPT_ISBELOW }; + OPT_ISABOVE, OPT_ISBELOW + }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -2695,35 +2734,40 @@ WmStackorderCmd( Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } + Tcl_SetObjResult(interp, resultObj); ckfree(windows); return TCL_OK; } else { TkWindow *winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; - } - - if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + } else if (!Tk_IsMapped(winPtr2)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -2734,16 +2778,18 @@ WmStackorderCmd( windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "FAIL", NULL); return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = windowPtr - windows; } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = windowPtr - windows; } } if (index1 == -1) { @@ -2769,7 +2815,7 @@ WmStackorderCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2808,19 +2854,22 @@ WmStateCmd( } if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't change state of ", - winPtr->pathName, ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "EMBEDDED", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + &index) != TCL_OK) { return TCL_ERROR; } @@ -2833,13 +2882,19 @@ WmStateCmd( */ } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->master != None) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -2849,7 +2904,7 @@ WmStateCmd( TkpWmSetState(winPtr, ZoomState); } } else if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("icon", -1)); } else { if (wmPtr->hints.initial_state == NormalState || wmPtr->hints.initial_state == ZoomState) { @@ -2858,22 +2913,22 @@ WmStateCmd( } switch (wmPtr->hints.initial_state) { case NormalState: - Tcl_SetResult(interp, "normal", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("normal", -1)); break; case IconicState: - Tcl_SetResult(interp, "iconic", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("iconic", -1)); break; case WithdrawnState: - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("withdrawn", -1)); break; case ZoomState: - Tcl_SetResult(interp, "zoomed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("zoomed", -1)); break; } } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2908,8 +2963,8 @@ WmTitleCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (char *)((wmPtr->titleUid != NULL) ? - wmPtr->titleUid : winPtr->nameUid), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->titleUid ? wmPtr->titleUid : winPtr->nameUid, -1)); return TCL_OK; } argv3 = Tcl_GetStringFromObj(objv[3], &length); @@ -2919,7 +2974,7 @@ WmTitleCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2957,7 +3012,8 @@ WmTransientCmd( } if (objc == 3) { if (wmPtr->master != None) { - Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->masterWindowName, -1)); } return TCL_OK; } @@ -2974,9 +3030,10 @@ WmTransientCmd( Tk_MakeWindowExist(master); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } @@ -2984,15 +3041,17 @@ WmTransientCmd( /* Under some circumstances, wmPtr2 is NULL here */ if (wmPtr2 != NULL && wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if ((TkWindow *) master == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } @@ -3007,7 +3066,7 @@ WmTransientCmd( ApplyMasterOverrideChanges(winPtr, NULL); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -3040,14 +3099,16 @@ WmWithdrawCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, WithdrawnState); return TCL_OK; } - + /* * Invoked by those wm subcommands that affect geometry. * Schedules a geometry update. @@ -3063,7 +3124,7 @@ WmUpdateGeom( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3169,7 +3230,7 @@ Tk_SetGrid( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3226,7 +3287,7 @@ Tk_UnsetGrid( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3276,7 +3337,7 @@ TopLevelEventProc( Tcl_Panic("recieved unwanted reparent event"); } } - + /* *---------------------------------------------------------------------- * @@ -3311,7 +3372,7 @@ TopLevelReqProc( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3438,13 +3499,13 @@ UpdateGeometryInfo( x = wmPtr->vRootWidth - wmPtr->x - (width + (wmPtr->parentWidth - winPtr->changes.width)); } else { - x = wmPtr->x; + x = wmPtr->x; } if (wmPtr->flags & WM_NEGATIVE_Y) { y = wmPtr->vRootHeight - wmPtr->y - (height + (wmPtr->parentHeight - winPtr->changes.height)); } else { - y = wmPtr->y; + y = wmPtr->y; } /* @@ -3457,7 +3518,7 @@ UpdateGeometryInfo( if (((width != winPtr->changes.width) || (height != winPtr->changes.height)) && (wmPtr->gridWin == NULL) - && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) { + && !(wmPtr->sizeHintsFlags & (PMinSize|PMaxSize))) { wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) { @@ -3528,7 +3589,7 @@ UpdateGeometryInfo( wmPtr->flags &= ~WM_SYNC_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3554,7 +3615,7 @@ UpdateSizeHints( wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS; } - + /* *---------------------------------------------------------------------- * @@ -3657,7 +3718,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; flags |= WM_UPDATE_SIZE_HINTS; } @@ -3692,10 +3753,12 @@ ParseGeometry( return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -3791,7 +3854,7 @@ Tk_GetRootCoords( *xPtr = x; *yPtr = y; } - + /* *---------------------------------------------------------------------- * @@ -3911,7 +3974,7 @@ Tk_CoordsToWindow( } return (Tk_Window) winPtr; } - + /* *---------------------------------------------------------------------- * @@ -4004,7 +4067,7 @@ Tk_TopCoordsToWindow( *newY = y; return (Tk_Window) winPtr; } - + /* *---------------------------------------------------------------------- * @@ -4071,7 +4134,7 @@ UpdateVRootGeometry( goto noVRoot; } } - + /* *---------------------------------------------------------------------- * @@ -4128,7 +4191,7 @@ Tk_GetVRootGeometry( *widthPtr = wmPtr->vRootWidth; *heightPtr = wmPtr->vRootHeight; } - + /* *---------------------------------------------------------------------- * @@ -4164,7 +4227,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } @@ -4182,7 +4245,7 @@ Tk_MoveToplevelWindow( UpdateGeometryInfo(winPtr); } } - + /* *---------------------------------------------------------------------- * @@ -4296,7 +4359,7 @@ TkWmRestackToplevel( SendBehind(macWindow, otherMacWindow); } } - + /* *---------------------------------------------------------------------- * @@ -4387,7 +4450,7 @@ TkWmAddToColormapWindows( * we don't support colormaps. If we did they would be installed here. */ } - + /* *---------------------------------------------------------------------- * @@ -4456,7 +4519,7 @@ TkWmRemoveFromColormapWindows( } } } - + /* *---------------------------------------------------------------------- * @@ -4484,7 +4547,7 @@ TkGetPointerCoords( { XQueryPointer(NULL, None, NULL, NULL, xPtr, yPtr, NULL, NULL, NULL); } - + /* *---------------------------------------------------------------------- * @@ -4543,7 +4606,7 @@ InitialWindowBounds( geometry->right = wmPtr->x + winPtr->changes.width; geometry->bottom = wmPtr->y + winPtr->changes.height; } - + /* *---------------------------------------------------------------------- * @@ -4583,7 +4646,7 @@ TkMacOSXResizable( return true; } } - + /* *---------------------------------------------------------------------- * @@ -4651,7 +4714,7 @@ TkMacOSXGrowToplevel( if (base < 0) { base = 0; } - limits.top = base + (minHeight * wmPtr->heightInc); + limits.top = base + (minHeight * wmPtr->heightInc); limits.bottom = base + (maxHeight * wmPtr->heightInc); } else { limits.left = minWidth; @@ -4706,7 +4769,7 @@ TkMacOSXGrowToplevel( } return false; } - + /* *---------------------------------------------------------------------- * @@ -4744,7 +4807,7 @@ TkSetWMName( CFRelease(title); } } - + /* *---------------------------------------------------------------------- * @@ -4771,7 +4834,7 @@ TkGetTransientMaster( } return None; } - + /* *---------------------------------------------------------------------- * @@ -4803,7 +4866,7 @@ TkMacOSXGetXWindow( } return (Window) Tcl_GetHashValue(hPtr); } - + /* *---------------------------------------------------------------------- * @@ -4862,7 +4925,7 @@ TkMacOSXIsWindowZoomed( return IsWindowInStandardState(TkMacOSXDrawableWindow(winPtr->window), &idealSize, NULL); } - + /* *---------------------------------------------------------------------- * @@ -4884,7 +4947,7 @@ TkMacOSXIsWindowZoomed( int TkMacOSXZoomToplevel( - void *whichWindow, /* The Macintosh window to zoom. */ + void *whichWindow, /* The Macintosh window to zoom. */ short zoomPart) /* Either inZoomIn or inZoomOut */ { Window window; @@ -4946,7 +5009,7 @@ TkMacOSXZoomToplevel( (zoomPart == inZoomIn ? NormalState : ZoomState); return true; } - + /* *---------------------------------------------------------------------- * @@ -4994,9 +5057,9 @@ TkUnsupported1ObjCmd( return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WINDOWSTYLE", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -5014,7 +5077,7 @@ TkUnsupported1ObjCmd( /* won't be reached */ return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -5142,14 +5205,14 @@ WmWinStyle( Tcl_Panic("invalid class"); } - attributeList = Tcl_NewListObj(0, NULL); + attributeList = Tcl_NewObj(); attributes = wmPtr->attributes; for (i = 0; compositeAttrMap[i].strValue != NULL; i++) { UInt32 intValue = compositeAttrMap[i].intValue; if (intValue && (attributes & intValue) == intValue) { - Tcl_ListObjAppendElement(interp, attributeList, + Tcl_ListObjAppendElement(NULL, attributeList, Tcl_NewStringObj(compositeAttrMap[i].strValue, -1)); attributes &= ~intValue; @@ -5158,11 +5221,11 @@ WmWinStyle( } for (i = 0; attrMap[i].strValue != NULL; i++) { if (attributes & attrMap[i].intValue) { - Tcl_ListObjAppendElement(interp, attributeList, + Tcl_ListObjAppendElement(NULL, attributeList, Tcl_NewStringObj(attrMap[i].strValue, -1)); } } - Tcl_ListObjAppendElement(interp, newResult, attributeList); + Tcl_ListObjAppendElement(NULL, newResult, attributeList); Tcl_SetObjResult(interp, newResult); } } else if (objc == 4) { @@ -5216,7 +5279,7 @@ WmWinStyle( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -5254,7 +5317,7 @@ TkpMakeMenuWindow( winPtr->wmInfoPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; } } - + /* *---------------------------------------------------------------------- * @@ -5359,7 +5422,7 @@ TkMacOSXMakeRealWindowExist( wmPtr->parentWidth = winPtr->changes.width + structureW; wmPtr->parentHeight = winPtr->changes.height + structureH; InitialWindowBounds(winPtr, newWindow, &geometry); - geometry.right += structureW; + geometry.right += structureW; geometry.bottom += structureH; ChkErr(SetWindowBounds, newWindow, kWindowStructureRgn, &geometry); @@ -5405,7 +5468,7 @@ TkMacOSXMakeRealWindowExist( } #endif /* TK_MAC_DEBUG_WINDOWS */ } - + /* *---------------------------------------------------------------------- * @@ -5441,7 +5504,7 @@ TkMacOSXRegisterOffScreenWindow( } Tcl_SetHashValue(valueHashPtr, window); } - + /* *---------------------------------------------------------------------- * @@ -5475,7 +5538,7 @@ TkMacOSXUnregisterMacWindow( Tcl_DeleteHashEntry(entryPtr); } } - + /* *---------------------------------------------------------------------- * @@ -5507,7 +5570,7 @@ TkMacOSXSetScrollbarGrow( winPtr->privatePtr->toplevel->winPtr->wmInfoPtr->scrollWinPtr = NULL; } } - + /* *---------------------------------------------------------------------- * @@ -5540,7 +5603,7 @@ TkWmFocusToplevel( } return winPtr; } - + /* *---------------------------------------------------------------------- * @@ -5570,7 +5633,7 @@ TkpGetWrapperWindow( } return winPtr; } - + /* *---------------------------------------------------------------------- * @@ -5630,7 +5693,7 @@ TkpWmSetState( TkMacOSXZoomToplevel(macWin, inZoomOut); } } - + /* *---------------------------------------------------------------------- * @@ -5660,7 +5723,7 @@ TkpIsWindowFloating( GetWindowClass(wRef, &class); return (class == kFloatingWindowClass); } - + /* *---------------------------------------------------------------------- * @@ -5683,7 +5746,7 @@ TkMacOSXWindowClass( { return winPtr->wmInfoPtr->macClass; } - + /* *-------------------------------------------------------------- * @@ -5718,7 +5781,7 @@ TkMacOSXWindowOffset( *xOffset = winPtr->wmInfoPtr->xInParent; *yOffset = winPtr->wmInfoPtr->yInParent; } - + /* *---------------------------------------------------------------------- * @@ -5744,7 +5807,7 @@ TkpGetMS(void) Tcl_GetTime(&now); return (long) now.sec * 1000 + now.usec / 1000; } - + /* *---------------------------------------------------------------------- * @@ -5772,7 +5835,7 @@ XSetInputFocus( * Don't need to do a thing. Tk manages the focus for us. */ } - + /* *---------------------------------------------------------------------- * @@ -5818,7 +5881,7 @@ TkpChangeFocus( return NextRequest(winPtr->display); } - + /* *---------------------------------------------------------------------- * @@ -5865,7 +5928,7 @@ WmStackorderToplevelWrapperMap( WmStackorderToplevelWrapperMap(childPtr, display, table); } } - + /* *---------------------------------------------------------------------- * @@ -5888,7 +5951,7 @@ TkWmStackorderToplevel( TkWindow *parentPtr) /* Parent toplevel window. */ { WindowRef frontWindow; - TkWindow *childWinPtr, **windows, **window_ptr; + TkWindow *childWinPtr, **windows, **windowPtr; Tcl_HashTable table; Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -5923,17 +5986,17 @@ TkWmStackorderToplevel( ckfree(windows); windows = NULL; } else { - window_ptr = windows + table.numEntries; - *window_ptr-- = NULL; + windowPtr = windows + table.numEntries; + *windowPtr-- = NULL; while (frontWindow != NULL) { hPtr = Tcl_FindHashEntry(&table, (char *) frontWindow); if (hPtr != NULL) { childWinPtr = Tcl_GetHashValue(hPtr); - *window_ptr-- = childWinPtr; + *windowPtr-- = childWinPtr; } frontWindow = GetNextWindow(frontWindow); } - if (window_ptr != (windows-1)) { + if (windowPtr != windows-1) { Tcl_Panic("num matched toplevel windows does not equal num " "children"); } @@ -5943,7 +6006,7 @@ TkWmStackorderToplevel( Tcl_DeleteHashTable(&table); return windows; } - + /* *---------------------------------------------------------------------- * @@ -6034,7 +6097,7 @@ ApplyWindowClassAttributeChanges( + strWidths.bottom; } } - + /* *---------------------------------------------------------------------- * @@ -6100,7 +6163,7 @@ ApplyMasterOverrideChanges( } } } - + /* *---------------------------------------------------------------------- * @@ -6154,7 +6217,7 @@ WmGetWindowGroup( } return group; } - + /* *---------------------------------------------------------------------- * @@ -6182,7 +6245,7 @@ TkMacOSXMakeFullscreen( int result = TCL_OK, wasFullscreen = (wmPtr->flags & WM_FULLSCREEN); if (fullscreen) { - int screenWidth = WidthOfScreen(Tk_Screen(winPtr)); + int screenWidth = WidthOfScreen(Tk_Screen(winPtr)); int screenHeight = HeightOfScreen(Tk_Screen(winPtr)); /* @@ -6192,10 +6255,11 @@ TkMacOSXMakeFullscreen( if ((wmPtr->maxWidth > 0 && wmPtr->maxWidth < screenWidth) || (wmPtr->maxHeight > 0 && wmPtr->maxHeight < screenHeight)) { if (interp) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, - "\": max width/height is too small", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\": max" + " width/height is too small", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "FULLSCREEN", + "CONSTRAINT_FAILURE", NULL); } result = TCL_ERROR; wmPtr->flags &= ~WM_FULLSCREEN; @@ -6239,7 +6303,7 @@ TkMacOSXMakeFullscreen( TkMacOSXEnterExitFullscreen(winPtr, IsWindowActive(window)); return result; } - + /* *---------------------------------------------------------------------- * @@ -6287,7 +6351,7 @@ TkMacOSXEnterExitFullscreen( } } } - + /* *---------------------------------------------------------------------- * @@ -6384,7 +6448,7 @@ GetMinSize( *minWidthPtr = minWidth; *minHeightPtr = minHeight; } - + /* *---------------------------------------------------------------------- * @@ -6440,7 +6504,7 @@ GetMaxSize( *maxHeightPtr = maxHeight; } } - + /* *---------------------------------------------------------------------- * @@ -6486,7 +6550,7 @@ RemapWindows( RemapWindows(childPtr, (MacDrawable *) winPtr->window); } } - + /* * Local Variables: * fill-column: 78 diff --git a/generic/tk3d.c b/generic/tk3d.c index 2920c76..dd7ab2f 100644 --- a/generic/tk3d.c +++ b/generic/tk3d.c @@ -673,11 +673,10 @@ Tk_GetRelief( } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) { *reliefPtr = TK_RELIEF_SUNKEN; } else { - char buf[200]; - - sprintf(buf, "bad relief \"%.50s\": must be %s", - name, "flat, groove, raised, ridge, solid, or sunken"); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("bad relief \"%.50s\": must be %s", + name, "flat, groove, raised, ridge, solid, or sunken")); + Tcl_SetErrorCode(interp, "TK", "VALUE", "RELIEF", NULL); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tkArgv.c b/generic/tkArgv.c index 3f235ad..6c2c5c5 100644 --- a/generic/tkArgv.c +++ b/generic/tkArgv.c @@ -70,7 +70,7 @@ Tk_ParseArgv( register const Tk_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ - const Tk_ArgvInfo *matchPtr; /* Descriptor that matches current argument. */ + const Tk_ArgvInfo *matchPtr;/* Descriptor that matches current argument. */ const char *curArg; /* Current argument */ register char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. @@ -83,6 +83,7 @@ Tk_ParseArgv( * than srcIndex). */ int argc; /* # arguments in argv still to process. */ size_t length; /* Number of characters in current argument. */ + char *endPtr; /* Used for identifying junk in arguments. */ int i; if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) { @@ -139,8 +140,10 @@ Tk_ParseArgv( continue; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", curArg, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "AMBIGUOUS", curArg, + NULL); return TCL_ERROR; } matchPtr = infoPtr; @@ -153,8 +156,10 @@ Tk_ParseArgv( */ if (flags & TK_ARGV_NO_LEFTOVERS) { - Tcl_AppendResult(interp, "unrecognized argument \"", - curArg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unrecognized argument \"%s\"", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "UNRECOGNIZED", curArg, + NULL); return TCL_ERROR; } argv[dstIndex] = curArg; @@ -175,25 +180,23 @@ Tk_ParseArgv( case TK_ARGV_INT: if (argc == 0) { goto missingArg; - } else { - char *endPtr; - - *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0); - if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { - Tcl_AppendResult(interp,"expected integer argument for \"", - infoPtr->key, "\" but got \"", argv[srcIndex], - "\"", NULL); - return TCL_ERROR; - } - srcIndex++; - argc--; } + *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0); + if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s argument for \"%s\" but got \"%s\"", + "integer", infoPtr->key, argv[srcIndex])); + Tcl_SetErrorCode(interp, "TK", "ARG", "INTEGER", curArg,NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_STRING: if (argc == 0) { goto missingArg; } - *((const char **)infoPtr->dst) = argv[srcIndex]; + *((const char **) infoPtr->dst) = argv[srcIndex]; srcIndex++; argc--; break; @@ -201,7 +204,7 @@ Tk_ParseArgv( if (argc == 0) { goto missingArg; } - *((Tk_Uid *)infoPtr->dst) = Tk_GetUid(argv[srcIndex]); + *((Tk_Uid *) infoPtr->dst) = Tk_GetUid(argv[srcIndex]); srcIndex++; argc--; break; @@ -211,19 +214,17 @@ Tk_ParseArgv( case TK_ARGV_FLOAT: if (argc == 0) { goto missingArg; - } else { - char *endPtr; - - *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr); - if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { - Tcl_AppendResult(interp, "expected floating-point ", - "argument for \"", infoPtr->key, "\" but got \"", - argv[srcIndex], "\"", NULL); - return TCL_ERROR; - } - srcIndex++; - argc--; } + *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr); + if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s argument for \"%s\" but got \"%s\"", + "floating-point", infoPtr->key, argv[srcIndex])); + Tcl_SetErrorCode(interp, "TK", "ARG", "FLOAT", curArg, NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_FUNC: { typedef int (ArgvFunc)(char *, const char *, const char *); @@ -249,6 +250,7 @@ Tk_ParseArgv( } case TK_ARGV_HELP: PrintUsage(interp, argTable, flags); + Tcl_SetErrorCode(interp, "TK", "ARG", "HELP", NULL); return TCL_ERROR; case TK_ARGV_CONST_OPTION: Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src, @@ -265,8 +267,11 @@ Tk_ParseArgv( break; case TK_ARGV_OPTION_NAME_VALUE: if (argc < 2) { - Tcl_AppendResult(interp, "\"", curArg, - "\" option requires two following arguments", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires two following arguments", + curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "NAME_VALUE", curArg, + NULL); return TCL_ERROR; } Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1], @@ -274,14 +279,12 @@ Tk_ParseArgv( srcIndex += 2; argc -= 2; break; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad argument type %d in Tk_ArgvInfo", infoPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument type %d in Tk_ArgvInfo", infoPtr->type)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } - } } /* @@ -301,8 +304,9 @@ Tk_ParseArgv( return TCL_OK; missingArg: - Tcl_AppendResult(interp, "\"", curArg, - "\" option requires an additional argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires an additional argument", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "MISSING", curArg, NULL); return TCL_ERROR; } @@ -328,7 +332,7 @@ static void PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ - const Tk_ArgvInfo *argTable, /* Array of command-specific argument + const Tk_ArgvInfo *argTable,/* Array of command-specific argument * descriptions. */ int flags) /* If the TK_ARGV_NO_DEFAULTS bit is set in * this word, then don't generate information @@ -336,7 +340,7 @@ PrintUsage( { register const Tk_ArgvInfo *infoPtr; size_t width, i, numSpaces; - char tmp[TCL_DOUBLE_SPACE]; + Tcl_Obj *message; /* * First, compute the width of the widest option key, so that we can make @@ -348,6 +352,7 @@ PrintUsage( for (infoPtr = i ? defaultTable : argTable; infoPtr->type != TK_ARGV_END; infoPtr++) { size_t length; + if (infoPtr->key == NULL) { continue; } @@ -358,35 +363,35 @@ PrintUsage( } } - Tcl_AppendResult(interp, "Command-specific options:", NULL); + message = Tcl_NewStringObj("Command-specific options:", -1); for (i = 0; ; i++) { for (infoPtr = i ? defaultTable : argTable; infoPtr->type != TK_ARGV_END; infoPtr++) { if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) { - Tcl_AppendResult(interp, "\n", infoPtr->help, NULL); + Tcl_AppendPrintfToObj(message, "\n%s", infoPtr->help); continue; } - Tcl_AppendResult(interp, "\n ", infoPtr->key, ":", NULL); + Tcl_AppendPrintfToObj(message, "\n %s:", infoPtr->key); numSpaces = width + 1 - strlen(infoPtr->key); while (numSpaces-- > 0) { - Tcl_AppendResult(interp, " ", NULL); + Tcl_AppendToObj(message, " ", 1); } - Tcl_AppendResult(interp, infoPtr->help, NULL); + Tcl_AppendToObj(message, infoPtr->help, -1); switch (infoPtr->type) { case TK_ARGV_INT: - sprintf(tmp, "%d", *((int *) infoPtr->dst)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %d", + *((int *) infoPtr->dst)); break; case TK_ARGV_FLOAT: - Tcl_PrintDouble(NULL, *((double *) infoPtr->dst), tmp); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %f", + *((double *) infoPtr->dst)); break; case TK_ARGV_STRING: { char *string = *((char **) infoPtr->dst); if (string != NULL) { - Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string, - "\"", NULL); + Tcl_AppendPrintfToObj(message, + "\n\t\tDefault value: \"%s\"", string); } break; } @@ -398,8 +403,9 @@ PrintUsage( if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) { break; } - Tcl_AppendResult(interp, "\nGeneric options for all commands:", NULL); + Tcl_AppendToObj(message, "\nGeneric options for all commands:", -1); } + Tcl_SetObjResult(interp, message); } /* diff --git a/generic/tkBind.c b/generic/tkBind.c index e58ad4d..7126e24 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -620,7 +620,7 @@ static PatSeq * FindSequence(Tcl_Interp *interp, static void GetAllVirtualEvents(Tcl_Interp *interp, VirtualEventTable *vetPtr); static char * GetField(char *p, char *copy, int size); -static void GetPatternString(PatSeq *psPtr, Tcl_DString *dsPtr); +static Tcl_Obj * GetPatternObj(PatSeq *psPtr); static int GetVirtualEvent(Tcl_Interp *interp, VirtualEventTable *vetPtr, Tcl_Obj *virtName); static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp, @@ -1094,13 +1094,14 @@ Tk_GetAllBindings( { PatSeq *psPtr; Tcl_HashEntry *hPtr; - Tcl_DString ds; + Tcl_Obj *resultObj; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } - Tcl_DStringInit(&ds); + + resultObj = Tcl_NewObj(); for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextObjPtr) { /* @@ -1108,11 +1109,9 @@ Tk_GetAllBindings( * its sequence. */ - Tcl_DStringSetLength(&ds, 0); - GetPatternString(psPtr, &ds); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr)); } - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); } /* @@ -1223,7 +1222,8 @@ Tk_BindEvent( PatSeq *vMatchDetailList, *vMatchNoDetailList; int flags, oldScreen; Tcl_Interp *interp; - Tcl_DString scripts, savedResult; + Tcl_DString scripts; + Tcl_InterpState interpState; Detail detail; char *p, *end; TkWindow *winPtr = (TkWindow *) tkwin; @@ -1453,14 +1453,13 @@ Tk_BindEvent( */ interp = bindPtr->interp; - Tcl_DStringInit(&savedResult); /* * Save information about the current screen, then invoke a script if the * screen has changed. */ - Tcl_DStringGetResult(interp, &savedResult); + interpState = Tcl_SaveInterpState(interp, TCL_OK); screenPtr = &bindInfoPtr->screenInfo; oldDispPtr = screenPtr->curDispPtr; oldScreen = screenPtr->curScreenIndex; @@ -1475,7 +1474,7 @@ Tk_BindEvent( end = p + Tcl_DStringLength(&scripts); /* - * Be carefule when dereferencing screenPtr or bindInfoPtr. If we evaluate + * Be careful when dereferencing screenPtr or bindInfoPtr. If we evaluate * something that destroys ".", bindInfoPtr would have been freed, but we * can tell that by first checking to see if winPtr->mainPtr == NULL. */ @@ -1523,7 +1522,7 @@ Tk_BindEvent( screenPtr->curScreenIndex = oldScreen; ChangeScreen(interp, oldDispPtr->name, oldScreen); } - Tcl_DStringResult(interp, &savedResult); + (void) Tcl_RestoreInterpState(interp, interpState); Tcl_DStringFree(&scripts); Tcl_Release(bindInfoPtr); @@ -2771,10 +2770,10 @@ GetVirtualEvent( Tcl_Obj *virtName) /* String describing virtual event. */ { Tcl_HashEntry *vhPtr; - Tcl_DString ds; int iPhys; PhysicalsOwned *poPtr; Tk_Uid virtUid; + Tcl_Obj *resultObj; virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName)); if (virtUid == NULL) { @@ -2786,15 +2785,13 @@ GetVirtualEvent( return TCL_OK; } - Tcl_DStringInit(&ds); - + resultObj = Tcl_NewObj(); poPtr = Tcl_GetHashValue(vhPtr); for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) { - Tcl_DStringSetLength(&ds, 0); - GetPatternString(poPtr->patSeqs[iPhys], &ds); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, + GetPatternObj(poPtr->patSeqs[iPhys])); } - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -2824,20 +2821,15 @@ GetAllVirtualEvents( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - Tcl_DString ds; - - Tcl_DStringInit(&ds); + Tcl_Obj *resultObj; + resultObj = Tcl_NewObj(); hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, "<<", 2); - Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1); - Tcl_DStringAppend(&ds, ">>", 2); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr))); } - - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); } /* @@ -2924,8 +2916,11 @@ HandleEventGenerate( mainPtr = (TkWindow *) mainWin; if ((tkwin == NULL) || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", Tcl_GetString(objv[0]), - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", + Tcl_GetString(objv[0]), NULL); return TCL_ERROR; } @@ -2939,13 +2934,15 @@ HandleEventGenerate( return TCL_ERROR; } if (count != 1) { - Tcl_SetResult(interp, "Double or Triple modifier not allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Double or Triple modifier not allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL); return TCL_ERROR; } if (*p != '\0') { - Tcl_SetResult(interp, "only one event specification allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "only one event specification allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL); return TCL_ERROR; } @@ -3021,8 +3018,9 @@ HandleEventGenerate( * is missing. */ - Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr), - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL); return TCL_ERROR; } @@ -3163,15 +3161,19 @@ HandleEventGenerate( value = Tcl_GetString(valuePtr); keysym = TkStringToKeysym(value); if (keysym == NoSymbol) { - Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value, NULL); return TCL_ERROR; } TkpSetKeycodeAndState(tkwin, keysym, &event.general); if (event.general.xkey.keycode == 0) { - Tcl_AppendResult(interp, "no keycode for keysym \"", value, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no keycode for keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value, + NULL); return TCL_ERROR; } if (!(flags & KEY) @@ -3400,8 +3402,10 @@ HandleEventGenerate( continue; badopt: - Tcl_AppendResult(interp, name, " event doesn't accept \"", - Tcl_GetString(optionPtr), "\" option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s event doesn't accept \"%s\" option", + name, Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL); return TCL_ERROR; } @@ -3495,7 +3499,9 @@ NameToWindow( return TCL_OK; badWindow: - Tcl_AppendResult(interp, "bad window name/identifier \"",name,"\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window name/identifier \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL); return TCL_ERROR; } @@ -3558,8 +3564,9 @@ GetVirtualEventUid( if (length < 5 || virtString[0] != '<' || virtString[1] != '<' || virtString[length - 2] != '>' || virtString[length - 1] != '>') { - Tcl_AppendResult(interp, "virtual event \"", virtString, - "\" is badly formed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "virtual event \"%s\" is badly formed", virtString)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); return NULL; } virtString[length - 2] = '\0'; @@ -3651,9 +3658,11 @@ FindSequence( if (eventMask & VirtualEventMask) { if (allowVirtual == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "virtual event not allowed in definition of another virtual event", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", + NULL); return NULL; } virtualFound = 1; @@ -3679,12 +3688,16 @@ FindSequence( */ if (numPats == 0) { - Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no events specified in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL); return NULL; } if ((numPats > 1) && (virtualFound != 0)) { - Tcl_SetResult(interp, "virtual events may not be composed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual events may not be composed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", + NULL); return NULL; } @@ -3804,6 +3817,7 @@ ParseEventDescription( } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad ASCII character 0x%x", UCHAR(*p))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL); count = 0; goto done; } @@ -3844,14 +3858,18 @@ ParseEventDescription( p = strchr(field, '>'); if (p == field) { - Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual event \"<<>>\" is badly formed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } if ((p == NULL) || (p[1] != '>')) { - Tcl_SetResult(interp, "missing \">\" in virtual binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in virtual binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } @@ -3917,9 +3935,11 @@ ParseEventDescription( eventMask = ButtonPressMask; } else if (eventFlags & KEY) { goto getKeysym; - } else if ((eventFlags & BUTTON) == 0) { - Tcl_AppendResult(interp, "specified button \"", field, - "\" for non-button event", NULL); + } else if (!(eventFlags & BUTTON)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified button \"%s\" for non-button event", + field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL); count = 0; goto done; } @@ -3929,24 +3949,28 @@ ParseEventDescription( getKeysym: patPtr->detail.keySym = TkStringToKeysym(field); if (patPtr->detail.keySym == NoSymbol) { - Tcl_AppendResult(interp, "bad event type or keysym \"", - field, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad event type or keysym \"%s\"", field)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field, + NULL); count = 0; goto done; } if (eventFlags == 0) { patPtr->eventType = KeyPress; eventMask = KeyPressMask; - } else if ((eventFlags & KEY) == 0) { - Tcl_AppendResult(interp, "specified keysym \"", field, - "\" for non-key event", NULL); + } else if (!(eventFlags & KEY)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified keysym \"%s\" for non-key event", field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL); count = 0; goto done; } } } else if (eventFlags == 0) { - Tcl_SetResult(interp, "no event type or button # or keysym", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no event type or button # or keysym", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); count = 0; goto done; } @@ -3958,14 +3982,16 @@ ParseEventDescription( while (*p != '\0') { p++; if (*p == '>') { - Tcl_SetResult(interp, - "extra characters after detail in binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after detail in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); count = 0; goto done; } } - Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); count = 0; goto done; } @@ -4020,31 +4046,30 @@ GetField( /* *--------------------------------------------------------------------------- * - * GetPatternString -- + * GetPatternObj -- * * Produce a string version of the given event, for displaying to the * user. * * Results: - * The string is left in dsPtr. + * The string is returned as a Tcl_Obj. * * Side effects: - * It is the caller's responsibility to initialize the DString before and - * to free it after calling this function. + * It is the caller's responsibility to arrange for the object to be + * released; it starts with a refCount of zero. * *--------------------------------------------------------------------------- */ -static void -GetPatternString( - PatSeq *psPtr, - Tcl_DString *dsPtr) +static Tcl_Obj * +GetPatternObj( + PatSeq *psPtr) { Pattern *patPtr; - char c, buffer[TCL_INTEGER_SPACE]; int patsLeft, needMods; const ModInfo *modPtr; const EventInfo *eiPtr; + Tcl_Obj *patternObj = Tcl_NewObj(); /* * The order of the patterns in the sequence is backwards from the order @@ -4058,14 +4083,15 @@ GetPatternString( */ if ((patPtr->eventType == KeyPress) - && ((psPtr->flags & PAT_NEARBY) == 0) + && !(psPtr->flags & PAT_NEARBY) && (patPtr->needMods == 0) && (patPtr->detail.keySym < 128) && isprint(UCHAR(patPtr->detail.keySym)) && (patPtr->detail.keySym != '<') && (patPtr->detail.keySym != ' ')) { - c = (char) patPtr->detail.keySym; - Tcl_DStringAppend(dsPtr, &c, 1); + char c = (char) patPtr->detail.keySym; + + Tcl_AppendToObj(patternObj, &c, 1); continue; } @@ -4074,9 +4100,7 @@ GetPatternString( */ if (patPtr->eventType == VirtualEvent) { - Tcl_DStringAppend(dsPtr, "<<", 2); - Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1); - Tcl_DStringAppend(dsPtr, ">>", 2); + Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name); continue; } @@ -4086,7 +4110,7 @@ GetPatternString( * or button detail. */ - Tcl_DStringAppend(dsPtr, "<", 1); + Tcl_AppendToObj(patternObj, "<", 1); if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) && (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { @@ -4100,12 +4124,12 @@ GetPatternString( (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { patsLeft--; patPtr--; - Tcl_DStringAppend(dsPtr, "Quadruple-", 10); + Tcl_AppendToObj(patternObj, "Quadruple-", 10); } else { - Tcl_DStringAppend(dsPtr, "Triple-", 7); + Tcl_AppendToObj(patternObj, "Triple-", 7); } } else { - Tcl_DStringAppend(dsPtr, "Double-", 7); + Tcl_AppendToObj(patternObj, "Double-", 7); } } @@ -4113,16 +4137,15 @@ GetPatternString( needMods != 0; modPtr++) { if (modPtr->mask & needMods) { needMods &= ~modPtr->mask; - Tcl_DStringAppend(dsPtr, modPtr->name, -1); - Tcl_DStringAppend(dsPtr, "-", 1); + Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name); } } for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { if (eiPtr->type == patPtr->eventType) { - Tcl_DStringAppend(dsPtr, eiPtr->name, -1); + Tcl_AppendToObj(patternObj, eiPtr->name, -1); if (patPtr->detail.clientData != 0) { - Tcl_DStringAppend(dsPtr, "-", 1); + Tcl_AppendToObj(patternObj, "-", 1); } break; } @@ -4134,16 +4157,17 @@ GetPatternString( const char *string = TkKeysymToString(patPtr->detail.keySym); if (string != NULL) { - Tcl_DStringAppend(dsPtr, string, -1); + Tcl_AppendToObj(patternObj, string, -1); } } else { - sprintf(buffer, "%d", patPtr->detail.button); - Tcl_DStringAppend(dsPtr, buffer, -1); + Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button); } } - Tcl_DStringAppend(dsPtr, ">", 1); + Tcl_AppendToObj(patternObj, ">", 1); } + + return patternObj; } /* diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index b0d1ecc..729fff4 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -342,8 +342,10 @@ GetBitmap( int result; if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify bitmap with '@' in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify bitmap with '@' in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); goto error; } @@ -363,8 +365,9 @@ GetBitmap( &bitmap, &dummy2, &dummy2); if (result != BitmapSuccess) { if (interp != NULL) { - Tcl_AppendResult(interp, "error reading bitmap file \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap file \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL); } Tcl_DStringFree(&buffer); goto error; @@ -384,8 +387,10 @@ GetBitmap( if (bitmap == None) { if (interp != NULL) { - Tcl_AppendResult(interp, "bitmap \"", string, - "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bitmap \"%s\" not defined", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", string, + NULL); } goto error; } @@ -487,8 +492,9 @@ Tk_DefineBitmap( predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable, name, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "bitmap \"", name, "\" is already defined", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bitmap \"%s\" is already defined", name)); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "EXISTS", NULL); return TCL_ERROR; } predefPtr = ckalloc(sizeof(TkPredefBitmap)); diff --git a/generic/tkBusy.c b/generic/tkBusy.c index fc7f6ab..8f73d80 100644 --- a/generic/tkBusy.c +++ b/generic/tkBusy.c @@ -687,8 +687,10 @@ GetBusy( } hPtr = Tcl_FindHashEntry(busyTablePtr, (char *) tkwin); if (hPtr == NULL) { - Tcl_AppendResult(interp, "can't find busy window \"", - Tcl_GetString(windowObj), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find busy window \"%s\"", Tcl_GetString(windowObj))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BUSY", + Tcl_GetString(windowObj), NULL); return NULL; } return Tcl_GetHashValue(hPtr); diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index 6cbc89b..4e4c582 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.c @@ -344,27 +344,23 @@ ArcCoords( ArcItem *arcPtr = (ArcItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(arcPtr->bbox[0]); - - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[1]); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[2]); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[3]); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *objs[4]; + + objs[0] = Tcl_NewDoubleObj(arcPtr->bbox[0]); + objs[1] = Tcl_NewDoubleObj(arcPtr->bbox[1]); + objs[2] = Tcl_NewDoubleObj(arcPtr->bbox[2]); + objs[3] = Tcl_NewDoubleObj(arcPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); } else if ((objc == 1)||(objc == 4)) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", + NULL); return TCL_ERROR; } } @@ -380,10 +376,9 @@ ArcCoords( } ComputeArcBbox(canvas, arcPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", NULL); return TCL_ERROR; } return TCL_OK; @@ -1823,13 +1818,14 @@ ArcToPostscript( * being created. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; - char buffer[400]; double y1, y2, ang1, ang2; XColor *color; Pixmap stipple; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]); @@ -1876,37 +1872,51 @@ ArcToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * If the arc is filled, output Postscript for the interior region of the * arc. */ if (arcPtr->fillGC != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - if (arcPtr->style == CHORD_STYLE) { - sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); - } else { - sprintf(buffer, - "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); + + if (arcPtr->style != CHORD_STYLE) { + Tcl_AppendToObj(psObj, "0 0 moveto ", -1); } - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", + ang1, ang2); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->outline.gc != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1915,57 +1925,86 @@ ArcToPostscript( */ if (arcPtr->outline.gc != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 0 1 %.15g %.15g", ang1, ang2); - Tcl_AppendResult(interp, buffer, - " arc\nsetmatrix\n0 setlinecap\n", NULL); - if (Tk_CanvasPsOutline(canvas, itemPtr, &(arcPtr->outline)) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc\nsetmatrix\n0 setlinecap\n", + ang1, ang2); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsOutline(canvas, itemPtr, &arcPtr->outline) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->style != ARC_STYLE) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); if (arcPtr->style == CHORD_STYLE) { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS); } else { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS); - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); - if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsStipple(interp, canvas, stipple) !=TCL_OK){ + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, PIE_OUTLINE2_PTS); } - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } } + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2021,8 +2060,10 @@ StyleParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad -style option \"", value, - "\": must be arc, chord, or pieslice", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad -style option \"%s\": must be arc, chord, or pieslice", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARC_STYLE", NULL); *stylePtr = PIESLICE_STYLE; return TCL_ERROR; } diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index ea16a29..d7d54f4 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.c @@ -249,10 +249,8 @@ BitmapCoords( if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(bmapPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); + Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->x)); + Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->y)); Tcl_SetObjResult(interp, obj); } else if (objc < 3) { if (objc == 1) { @@ -260,10 +258,10 @@ BitmapCoords( (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", + NULL); return TCL_ERROR; } } @@ -275,10 +273,9 @@ BitmapCoords( } ComputeBitmapBbox(canvas, bmapPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", NULL); return TCL_ERROR; } return TCL_OK; @@ -853,11 +850,12 @@ BitmapToPostscript( double x, y; int width, height, rowsAtOnce, rowsThisTime; int curRow; - char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4]; XColor *fgColor; XColor *bgColor; Pixmap bitmap; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -913,18 +911,29 @@ BitmapToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Color the background, if there is one. */ if (bgColor != NULL) { - sprintf(buffer, - "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n", - x, y, width, height, -width, "0 rlineto closepath"); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto " + "%d 0 rlineto closepath\n", + x, y, width, height, -width); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, bgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "fill\n", -1); } /* @@ -935,37 +944,61 @@ BitmapToPostscript( */ if (fgColor != NULL) { + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (width > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't generate Postscript", - " for bitmaps more than 60000 pixels wide", NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't generate Postscript for bitmaps more than 60000" + " pixels wide", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + goto error; } + rowsAtOnce = 60000/width; if (rowsAtOnce < 1) { rowsAtOnce = 1; } - sprintf(buffer, "%.15g %.15g translate\n", x, y+height); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y+height); + for (curRow = 0; curRow < height; curRow += rowsAtOnce) { rowsThisTime = rowsAtOnce; if (rowsThisTime > (height - curRow)) { rowsThisTime = height - curRow; } - sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n", + + Tcl_AppendPrintfToObj(psObj, + "0 -%.15g translate\n%d %d true matrix {\n", (double) rowsThisTime, width, rowsThisTime); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_ResetResult(interp); if (Tk_CanvasPsBitmap(interp, canvas, bitmap, 0, curRow, width, rowsThisTime) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "\n} imagemask\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "\n} imagemask\n", -1); } } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c index 880070b..899741a 100644 --- a/generic/tkCanvImg.c +++ b/generic/tkCanvImg.c @@ -232,37 +232,35 @@ ImageCoords( ImageItem *imgPtr = (ImageItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); + Tcl_Obj *objs[2]; - Tcl_Obj *subobj = Tcl_NewDoubleObj(imgPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(imgPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + objs[0] = Tcl_NewDoubleObj(imgPtr->x); + objs[1] = Tcl_NewDoubleObj(imgPtr->y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", + NULL); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &imgPtr->x) != TCL_OK) + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], + &imgPtr->x) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &imgPtr->y) != TCL_OK)) { return TCL_ERROR; } ComputeImageBbox(canvas, imgPtr); } else { - char buf[64]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", NULL); return TCL_ERROR; } return TCL_OK; @@ -697,14 +695,12 @@ ImageToPostscript( { ImageItem *imgPtr = (ImageItem *) itemPtr; Tk_Window canvasWin = Tk_CanvasTkwin(canvas); - - char buffer[256]; double x, y; int width, height; Tk_Image image; Tk_State state = itemPtr->state; - if(state == TK_STATE_NULL) { + if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; } @@ -748,8 +744,14 @@ ImageToPostscript( } if (!prepass) { - sprintf(buffer, "%.15g %.15g", x, y); - Tcl_AppendResult(interp, buffer, " translate\n", NULL); + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y); } return Tk_PostscriptImage(image, interp, canvasWin, diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index 20a391e..9d68c37 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.c @@ -75,7 +75,7 @@ typedef struct LineItem { static int ArrowheadPostscript(Tcl_Interp *interp, Tk_Canvas canvas, LineItem *linePtr, - double *arrowPtr); + double *arrowPtr, Tcl_Obj *psObj); static void ComputeLineBbox(Tk_Canvas canvas, LineItem *linePtr); static int ConfigureLine(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, @@ -391,54 +391,52 @@ LineCoords( } } if (objc & 1) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected an even number, got %d", - objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected an even number, got %d", + objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL); return TCL_ERROR; } else if (objc < 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected at least 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected at least 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL); return TCL_ERROR; - } else { - numPoints = objc/2; - if (linePtr->numPoints != numPoints) { - coordPtr = ckalloc(sizeof(double) * objc); - if (linePtr->coordPtr != NULL) { - ckfree(linePtr->coordPtr); - } - linePtr->coordPtr = coordPtr; - linePtr->numPoints = numPoints; + } + + numPoints = objc/2; + if (linePtr->numPoints != numPoints) { + coordPtr = ckalloc(sizeof(double) * objc); + if (linePtr->coordPtr != NULL) { + ckfree(linePtr->coordPtr); } - coordPtr = linePtr->coordPtr; - for (i = 0; i < objc ; i++) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], - coordPtr++) != TCL_OK) { - return TCL_ERROR; - } + linePtr->coordPtr = coordPtr; + linePtr->numPoints = numPoints; + } + coordPtr = linePtr->coordPtr; + for (i = 0; i < objc ; i++) { + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], + coordPtr++) != TCL_OK) { + return TCL_ERROR; } + } - /* - * Update arrowheads by throwing away any existing arrow-head - * information and calling ConfigureArrows to recompute it. - */ + /* + * Update arrowheads by throwing away any existing arrow-head information + * and calling ConfigureArrows to recompute it. + */ - if (linePtr->firstArrowPtr != NULL) { - ckfree(linePtr->firstArrowPtr); - linePtr->firstArrowPtr = NULL; - } - if (linePtr->lastArrowPtr != NULL) { - ckfree(linePtr->lastArrowPtr); - linePtr->lastArrowPtr = NULL; - } - if (linePtr->arrow != ARROWS_NONE) { - ConfigureArrows(canvas, linePtr); - } - ComputeLineBbox(canvas, linePtr); + if (linePtr->firstArrowPtr != NULL) { + ckfree(linePtr->firstArrowPtr); + linePtr->firstArrowPtr = NULL; + } + if (linePtr->lastArrowPtr != NULL) { + ckfree(linePtr->lastArrowPtr); + linePtr->lastArrowPtr = NULL; } + if (linePtr->arrow != ARROWS_NONE) { + ConfigureArrows(canvas, linePtr); + } + ComputeLineBbox(canvas, linePtr); return TCL_OK; } @@ -1752,15 +1750,7 @@ GetLineIndex( if (strncmp(string, "end", (unsigned) length) == 0) { *indexPtr = 2*linePtr->numPoints; } else { - /* - * Some of the paths here leave messages in interp->result, so we - * have to clear it out before storing our own message. - */ - - badIndex: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad index \"", string, "\"", NULL); - return TCL_ERROR; + goto badIndex; } } else if (string[0] == '@') { int i; @@ -1801,6 +1791,17 @@ GetLineIndex( } } return TCL_OK; + + /* + * Some of the paths here leave messages in interp->result, so we have to + * clear it out before storing our own message. + */ + + badIndex: + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "LINE", NULL); + return TCL_ERROR; } /* @@ -1894,16 +1895,8 @@ ParseArrowShape( } if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) { - syntaxError: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad arrow shape \"", value, - "\": must be list with three numbers", NULL); - if (argv != NULL) { - ckfree(argv); - } - return TCL_ERROR; - } - if (argc != 3) { + goto syntaxError; + } else if (argc != 3) { goto syntaxError; } if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK) @@ -1913,11 +1906,23 @@ ParseArrowShape( != TCL_OK)) { goto syntaxError; } + linePtr->arrowShapeA = (float) a; linePtr->arrowShapeB = (float) b; linePtr->arrowShapeC = (float) c; ckfree(argv); return TCL_OK; + + syntaxError: + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad arrow shape \"%s\": must be list with three numbers", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW_SHAPE", NULL); + if (argv != NULL) { + ckfree(argv); + } + return TCL_ERROR; } /* @@ -2014,8 +2019,10 @@ ArrowParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad arrow spec \"", value, - "\": must be none, first, last, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad arrow spec \"%s\": must be none, first, last, or both", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW", NULL); *arrowPtr = ARROWS_NONE; return TCL_ERROR; } @@ -2252,13 +2259,13 @@ LineToPostscript( * being created. */ { LineItem *linePtr = (LineItem *) itemPtr; - char buffer[64 + TCL_INTEGER_SPACE]; - const char *style; - + int style; double width; XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -2293,30 +2300,50 @@ LineToPostscript( return TCL_OK; } + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Check if we're just doing a "pixel". + */ + if (linePtr->numPoints == 1) { - sprintf(buffer, "%.15g %.15g translate %.15g %.15g", + Tcl_AppendToObj(psObj, "matrix currentmatrix\n", -1); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate %.15g %.15g", linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]), width/2.0, width/2.0); - Tcl_AppendResult(interp, "matrix currentmatrix\n", buffer, - " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", NULL); + Tcl_AppendToObj(psObj, + " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } + /* * Generate a path for the line's center-line (do this differently for * straight lines and smoothed lines). */ + Tcl_ResetResult(interp); if ((!linePtr->smooth) || (linePtr->numPoints < 3)) { Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints); } else if ((stipple == None) && linePtr->smooth->postscriptProc) { @@ -2348,29 +2375,34 @@ LineToPostscript( ckfree(pointPtr); } } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Set other line-drawing parameters and stroke out the line. */ - style = "0 setlinecap\n"; if (linePtr->capStyle == CapRound) { - style = "1 setlinecap\n"; + style = 1; } else if (linePtr->capStyle == CapProjecting) { - style = "2 setlinecap\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); - style = "0 setlinejoin\n"; + Tcl_AppendPrintfToObj(psObj, "%d setlinecap\n", style); if (linePtr->joinStyle == JoinRound) { - style = "1 setlinejoin\n"; + style = 1; } else if (linePtr->joinStyle == JoinBevel) { - style = "2 setlinejoin\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin\n", style); + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &linePtr->outline) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Output polygons for the arrowheads, if there are any. @@ -2378,23 +2410,37 @@ LineToPostscript( if (linePtr->firstArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->firstArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->firstArrowPtr, psObj) != TCL_OK) { + goto error; } } if (linePtr->lastArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->lastArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->lastArrowPtr, psObj) != TCL_OK) { + goto error; } } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2409,7 +2455,7 @@ LineToPostscript( * The return value is a standard Tcl result. If an error occurs in * generating Postscript then an error message is left in the interp's * result, replacing whatever used to be there. If no error occurs, then - * Postscript for the arrowhead is appended to the result. + * Postscript for the arrowhead is appended to the given object. * * Side effects: * None. @@ -2419,12 +2465,14 @@ LineToPostscript( static int ArrowheadPostscript( - Tcl_Interp *interp, /* Leave Postscript or error message here. */ + Tcl_Interp *interp, /* Leave error message here; non-error results + * will be discarded by caller. */ Tk_Canvas canvas, /* Information about overall canvas. */ LineItem *linePtr, /* Line item for which Postscript is being * generated. */ - double *arrowPtr) /* Pointer to first of five points describing + double *arrowPtr, /* Pointer to first of five points describing * arrowhead polygon. */ + Tcl_Obj *psObj) /* Append postscript to this object. */ { Pixmap stipple; Tk_State state = linePtr->header.state; @@ -2444,14 +2492,20 @@ ArrowheadPostscript( } } + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } return TCL_OK; } diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c index 943ef0b..f8ea42b 100644 --- a/generic/tkCanvPoly.c +++ b/generic/tkCanvPoly.c @@ -359,6 +359,7 @@ PolygonCoords( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected an even number, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "POLYGON", NULL); return TCL_ERROR; } @@ -1731,6 +1732,7 @@ GetPolygonIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "POLY", NULL); return TCL_ERROR; } @@ -1799,13 +1801,15 @@ PolygonToPostscript( * being created. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - const char *style; + int style; XColor *color; XColor *fillColor; Pixmap stipple; Pixmap fillStipple; Tk_State state = itemPtr->state; double width; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (polyPtr->numPoints < 2 || polyPtr->coordPtr == NULL) { return TCL_OK; @@ -1852,9 +1856,17 @@ PolygonToPostscript( fillStipple = polyPtr->disabledFillStipple; } } + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + if (polyPtr->numPoints == 2) { if (color == NULL) { - return TCL_OK; + goto done; } /* @@ -1862,7 +1874,7 @@ PolygonToPostscript( * tiny to be used directly...) */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + Tcl_AppendPrintfToObj(psObj, "matrix currentmatrix\n" /* save state */ "%.15g %.15g translate " /* go to drawing location */ "%.15g %.15g scale " /* scale the drawing */ @@ -1871,24 +1883,30 @@ PolygonToPostscript( "setmatrix\n", /* restore state */ polyPtr->coordPtr[0], Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]), - width/2.0, width/2.0)); + width/2.0, width/2.0); /* * Color it in. */ + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } /* @@ -1896,6 +1914,7 @@ PolygonToPostscript( */ if (fillColor != NULL && polyPtr->numPoints > 3) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1904,18 +1923,24 @@ PolygonToPostscript( polyPtr->numPoints, polyPtr->splineSteps); } if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "eoclip ", NULL); + Tcl_AppendToObj(psObj, "eoclip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "eofill\n", NULL); + Tcl_AppendToObj(psObj, "eofill\n", -1); } } @@ -1924,6 +1949,7 @@ PolygonToPostscript( */ if (color != NULL) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1931,20 +1957,38 @@ PolygonToPostscript( polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints, polyPtr->splineSteps); } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (polyPtr->joinStyle == JoinRound) { - style = "1"; + style = 1; } else if (polyPtr->joinStyle == JoinBevel) { - style = "2"; + style = 2; } else { - style = "0"; + style = 0; } - Tcl_AppendResult(interp, style, " setlinejoin 1 setlinecap\n", NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin 1 setlinecap\n", style); + + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &polyPtr->outline) != TCL_OK){ - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index eafc07f..6542864 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -134,6 +134,10 @@ static const Tk_ConfigSpec configSpecs[] = { static int GetPostscriptPoints(Tcl_Interp *interp, char *string, double *doublePtr); +static void PostscriptBitmap(Tk_Window tkwin, Pixmap bitmap, + int startX, int startY, int width, int height, + Tcl_Obj *psObj); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); /* *-------------------------------------------------------------- @@ -166,9 +170,9 @@ TkCanvPostscriptCmd( TkPostscriptInfo psInfo, *psInfoPtr = &psInfo; Tk_PostscriptInfo oldInfoPtr; int result; + int written; Tk_Item *itemPtr; #define STRING_LENGTH 400 - char string[STRING_LENGTH+1]; const char *p; time_t now; size_t length; @@ -177,6 +181,7 @@ TkCanvPostscriptCmd( Tcl_HashEntry *hPtr; Tcl_DString buffer; Tcl_Obj *preambleObj; + Tcl_Obj *psObj; int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be * marked up, measured in canvas units from * the positioning point on the page (reflects @@ -200,6 +205,7 @@ TkCanvPostscriptCmd( } Tcl_IncrRefCount(preambleObj); Tcl_ResetResult(interp); + psObj = Tcl_NewObj(); /* * Initialize the data structure describing Postscript generation, then @@ -321,8 +327,11 @@ TkCanvPostscriptCmd( } else if (strncmp(psInfo.colorMode, "color", length) == 0) { psInfo.colorLevel = 2; } else { - Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode, - "\": must be monochrome, gray, or color", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad color mode \"%s\": must be monochrome, gray, or color", + psInfo.colorMode)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "COLORMODE", NULL); + result = TCL_ERROR; goto cleanup; } } @@ -333,8 +342,9 @@ TkCanvPostscriptCmd( */ if (psInfo.channelName != NULL) { - Tcl_AppendResult(interp, "can't specify both -file", - " and -channel", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify both -file and -channel", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", NULL); result = TCL_ERROR; goto cleanup; } @@ -345,8 +355,9 @@ TkCanvPostscriptCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify -file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify -file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PS_FILE", NULL); result = TCL_ERROR; goto cleanup; } @@ -375,9 +386,11 @@ TkCanvPostscriptCmd( result = TCL_ERROR; goto cleanup; } - if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", psInfo.channelName, - "\" wasn't opened for writing", NULL); + if (!(mode & TCL_WRITABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel \"%s\" wasn't opened for writing", + psInfo.channelName)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "UNWRITABLE",NULL); result = TCL_ERROR; goto cleanup; } @@ -422,24 +435,27 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", - "%%Creator: Tk Canvas Widget\n", NULL); + Tcl_AppendToObj(psObj, + "%!PS-Adobe-3.0 EPSF-3.0\n" + "%%Creator: Tk Canvas Widget\n", -1); + #ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ - Tcl_AppendResult(interp, "%%For: ", - (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%For: %s\n", (pwPtr ? pwPtr->pw_gecos : "Unknown")); endpwent(); } #endif /* HAVE_PW_GECOS */ - Tcl_AppendResult(interp, "%%Title: Window ", Tk_PathName(tkwin), "\n", - NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%Title: Window %s\n", Tk_PathName(tkwin)); time(&now); - Tcl_AppendResult(interp, "%%CreationDate: ", - ctime(&now), NULL); /* INTL: Native. */ + Tcl_AppendPrintfToObj(psObj, + "%%%%CreationDate: %s", ctime(&now)); /* INTL: Native. */ if (!psInfo.rotate) { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX + psInfo.scale*deltaX), (int) (psInfo.pageY + psInfo.scale*deltaY), (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) @@ -447,50 +463,61 @@ TkCanvPostscriptCmd( (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) + 1.0)); } else { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX - psInfo.scale*(deltaY+psInfo.height)), (int) (psInfo.pageY + psInfo.scale*deltaX), (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + 1.0)); } - Tcl_AppendResult(interp, "%%BoundingBox: ", string, "\n", NULL); - Tcl_AppendResult(interp, "%%Pages: 1\n", - "%%DocumentData: Clean7Bit\n", NULL); - Tcl_AppendResult(interp, "%%Orientation: ", - psInfo.rotate ? "Landscape\n" : "Portrait\n", NULL); - p = "%%DocumentNeededResources: font "; + Tcl_AppendPrintfToObj(psObj, + "%%%%Pages: 1\n" + "%%%%DocumentData: Clean7Bit\n" + "%%%%Orientation: %s\n", + psInfo.rotate ? "Landscape" : "Portrait"); + p = "%%%%DocumentNeededResources: font %s\n"; for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, p, - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); - p = "%%+ font "; + Tcl_AppendPrintfToObj(psObj, p, + Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + p = "%%%%+ font %s\n"; } - Tcl_AppendResult(interp, "%%EndComments\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndComments\n\n", -1); /* * Insert the prolog */ - Tcl_AppendResult(interp, Tcl_GetString(preambleObj), NULL); + Tcl_AppendObjToObj(psObj, preambleObj); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + channelWriteFailed: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "problem writing postscript data to channel: %s", + Tcl_PosixError(interp))); + result = TCL_ERROR; + goto cleanup; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } /* * Document setup: set the color level and include fonts. */ - sprintf(string, "/CL %d def\n", psInfo.colorLevel); - Tcl_AppendResult(interp, "%%BeginSetup\n", string, NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%BeginSetup\n/CL %d def\n", psInfo.colorLevel); for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, "%%IncludeResource: font ", - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%IncludeResource: font %s\n", + (char *) Tcl_GetHashKey(&psInfo.fontTable, hPtr)); } - Tcl_AppendResult(interp, "%%EndSetup\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndSetup\n\n", -1); /* * Page setup: move to page positioning point, rotate if needed, set @@ -498,18 +525,19 @@ TkCanvPostscriptCmd( * region. */ - Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", NULL); - sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendToObj(psObj, "%%Page: 1 1\nsave\n", -1); + Tcl_AppendPrintfToObj(psObj, + "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); if (psInfo.rotate) { - Tcl_AppendResult(interp, "90 rotate\n", NULL); + Tcl_AppendToObj(psObj, "90 rotate\n", -1); } - sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, - "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", + Tcl_AppendPrintfToObj(psObj, + "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); + Tcl_AppendPrintfToObj(psObj, + "%d %d translate\n", deltaX - psInfo.x, deltaY); + Tcl_AppendPrintfToObj(psObj, + "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g " + "lineto closepath clip newpath\n", psInfo.x, Tk_PostscriptY((double)psInfo.y, (Tk_PostscriptInfo)psInfoPtr), psInfo.x2, Tk_PostscriptY((double)psInfo.y, @@ -518,12 +546,14 @@ TkCanvPostscriptCmd( (Tk_PostscriptInfo)psInfoPtr), psInfo.x, Tk_PostscriptY((double)psInfo.y2, (Tk_PostscriptInfo)psInfoPtr)); - Tcl_AppendResult(interp, string, - " lineto closepath clip newpath\n", NULL); - } - if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + if (psInfo.chan != NULL) { + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); + } } /* @@ -544,21 +574,28 @@ TkCanvPostscriptCmd( if (itemPtr->state == TK_STATE_HIDDEN) { continue; } - Tcl_AppendResult(interp, "gsave\n", NULL); + + Tcl_ResetResult(interp); result = itemPtr->typePtr->postscriptProc(interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (generating Postscript for item %d)", - itemPtr->id); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (generating Postscript for item %d)", + itemPtr->id)); goto cleanup; } - Tcl_AppendResult(interp, "grestore\n", NULL); + + Tcl_AppendToObj(psObj, "gsave\n", -1); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "grestore\n", -1); + if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(interp); + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } } @@ -568,12 +605,23 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "restore showpage\n\n", - "%%Trailer\nend\n%%EOF\n", NULL); + Tcl_AppendToObj(psObj, + "restore showpage\n\n" + "%%Trailer\n" + "end\n" + "%%EOF\n", -1); + + if (psInfo.chan != NULL) { + Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + } } - if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + + if (psInfo.chan == NULL) { + Tcl_SetObjResult(interp, psObj); + psObj = Tcl_NewObj(); } /* @@ -614,9 +662,23 @@ TkCanvPostscriptCmd( Tcl_DeleteHashTable(&psInfo.fontTable); canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; Tcl_DecrRefCount(preambleObj); + Tcl_DecrRefCount(psObj); return result; } +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *-------------------------------------------------------------- * @@ -645,9 +707,7 @@ Tk_PostscriptColor( XColor *colorPtr) /* Information about color. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - int tmp; double red, green, blue; - char string[200]; if (psInfoPtr->prepass) { return TCL_OK; @@ -659,12 +719,12 @@ Tk_PostscriptColor( */ if (psInfoPtr->colorVar != NULL) { - const char *cmdString; - - cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + const char *cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, Tk_NameOfColor(colorPtr), 0); + if (cmdString != NULL) { - Tcl_AppendResult(interp, cmdString, "\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%s\n", cmdString); return TCL_OK; } } @@ -681,15 +741,12 @@ Tk_PostscriptColor( * per color, but most diplays use at least 8 bits. */ - tmp = colorPtr->red; - red = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->green; - green = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->blue; - blue = ((double) (tmp >> 8))/255.0; - sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", + red = ((double) (((int) colorPtr->red) >> 8))/255.0; + green = ((double) (((int) colorPtr->green) >> 8))/255.0; + blue = ((double) (((int) colorPtr->blue) >> 8))/255.0; + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%.3f %.3f %.3f setrgbcolor AdjustColor\n", red, green, blue); - Tcl_AppendResult(interp, string, NULL); return TCL_OK; } @@ -723,9 +780,9 @@ Tk_PostscriptFont( * be printed. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; + const char *fontname; /* * First, look up the font's name in the font map, if there is one. If @@ -741,28 +798,24 @@ Tk_PostscriptFont( Tcl_Obj *list = Tcl_GetVar2Ex(interp, psInfoPtr->fontVar, name, 0); if (list != NULL) { - const char *fontname; - if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK || objc != 2 - || Tcl_GetString(objv[0])[0] == '\0' + || (fontname = Tcl_GetString(objv[0]))[0] == '\0' + || strchr(fontname, ' ') != NULL || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK || size <= 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad font map entry for \"", name, - "\": \"", Tcl_GetString(list), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad font map entry for \"%s\": \"%s\"", + name, Tcl_GetString(list))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "FONTMAP", + NULL); return TCL_ERROR; } - fontname = Tcl_GetString(objv[0]); - sprintf(pointString, "%d", (int) size); - - Tcl_AppendResult(interp, "/", fontname, " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(fontname, "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, (int) size, + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontname, &i); return TCL_OK; } @@ -774,13 +827,11 @@ Tk_PostscriptFont( Tcl_DStringInit(&ds); points = Tk_PostscriptFontName(tkfont, &ds); - sprintf(pointString, "%d", TkFontGetPoints(psInfoPtr->tkwin, points)); - Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + fontname = Tcl_DStringValue(&ds); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, TkFontGetPoints(psInfoPtr->tkwin, points), + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); Tcl_DStringFree(&ds); @@ -818,18 +869,32 @@ Tk_PostscriptBitmap( int width, int height) /* Height of rectangular region. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + PostscriptBitmap(tkwin, bitmap, startX, startY, width, height, + GetPostscriptBuffer(interp)); + return TCL_OK; +} + +static void +PostscriptBitmap( + Tk_Window tkwin, + Pixmap bitmap, /* Bitmap for which to generate Postscript. */ + int startX, int startY, /* Coordinates of upper-left corner of + * rectangular region to output. */ + int width, int height, /* Height of rectangular region. */ + Tcl_Obj *psObj) /* Where to append the postscript. */ +{ XImage *imagePtr; int charsInLine, x, y, lastX, lastY, value, mask; unsigned int totalWidth, totalHeight; - char string[100]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; - if (psInfoPtr->prepass) { - return TCL_OK; - } - /* * The following call should probably be a call to Tk_SizeOfBitmap * instead, but it seems that we are occasionally invoked by custom item @@ -843,7 +908,8 @@ Tk_PostscriptBitmap( (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); - Tcl_AppendResult(interp, "<", NULL); + + Tcl_AppendToObj(psObj, "<", -1); mask = 0x80; value = 0; charsInLine = 0; @@ -856,28 +922,26 @@ Tk_PostscriptBitmap( } mask >>= 1; if (mask == 0) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; if (charsInLine >= 60) { - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); charsInLine = 0; } } } if (mask != 0x80) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; } } - Tcl_AppendResult(interp, ">", NULL); + Tcl_AppendToObj(psObj, ">", -1); + XDestroyImage(imagePtr); - return TCL_OK; } /* @@ -912,10 +976,10 @@ Tk_PostscriptStipple( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int width, height; - char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -932,13 +996,11 @@ Tk_PostscriptStipple( XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, (unsigned *) &height, &dummyBorderwidth, &dummyDepth); - sprintf(string, "%d %d ", width, height); - Tcl_AppendResult(interp, string, NULL); - if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, - width, height) != TCL_OK) { - return TCL_ERROR; - } - Tcl_AppendResult(interp, " StippleFill\n", NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%d %d ", width, height); + PostscriptBitmap(tkwin, bitmap, 0, 0, width, height, psObj); + Tcl_AppendToObj(psObj, " StippleFill\n", -1); return TCL_OK; } @@ -998,19 +1060,19 @@ Tk_PostscriptPath( int numPoints) /* Number of points at *coordPtr. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[200]; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return; } - sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g moveto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); for (numPoints--, coordPtr += 2; numPoints > 0; numPoints--, coordPtr += 2) { - sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); } } @@ -1081,7 +1143,8 @@ GetPostscriptPoints( return TCL_OK; error: - Tcl_AppendResult(interp, "bad distance \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "POINTS", NULL); return TCL_ERROR; } @@ -1195,15 +1258,15 @@ TkPostscriptImage( int width, int height) /* Width and height of area */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[256]; int xx, yy, band, maxRows; double red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; int level = psInfoPtr->colorLevel; Colormap cmap; int i, ncolors; Visual *visual; TkColormapData cdata; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1289,15 +1352,16 @@ TkPostscriptImage( if (bytesPerLine > 60000) { Tcl_ResetResult(interp); - sprintf(buffer, - "Can't generate Postscript for images more than %d pixels wide", - maxWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); ckfree(cdata.colors); return TCL_ERROR; } maxRows = 60000 / bytesPerLine; + psObj = GetPostscriptBuffer(interp); for (band = height-1; band >= 0; band -= maxRows) { int rows = (band >= maxRows) ? maxRows : band + 1; @@ -1305,16 +1369,13 @@ TkPostscriptImage( switch (level) { case 0: - sprintf(buffer, "%d %d 1 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 1 matrix {\n<", width, rows); break; case 1: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; default: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; } for (yy = band; yy > band - rows; yy--) { @@ -1336,22 +1397,20 @@ TkPostscriptImage( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - mask=0x80; - data=0x00; + mask = 0x80; + data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); - mask=0x80; - data=0x00; + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; } break; } @@ -1364,13 +1423,13 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx ++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 * + Tcl_AppendPrintfToObj(psObj, "%02X", + (int) floor(0.5 + 255.0 * (0.30 * red + 0.59 * green + 0.11 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1383,15 +1442,14 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", (int) floor(0.5 + 255.0 * red), (int) floor(0.5 + 255.0 * green), (int) floor(0.5 + 255.0 * blue)); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1399,13 +1457,11 @@ TkPostscriptImage( } switch (level) { case 0: case 1: - sprintf(buffer, ">\n} image\n"); break; + Tcl_AppendToObj(psObj, ">\n} image\n", -1); break; default: - sprintf(buffer, ">\n} false 3 colorimage\n"); break; + Tcl_AppendToObj(psObj, ">\n} false 3 colorimage\n", -1); break; } - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 %d translate\n", rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "0 %d translate\n", rows); } ckfree(cdata.colors); return TCL_OK; @@ -1441,15 +1497,15 @@ Tk_PostscriptPhoto( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int colorLevel = psInfoPtr->colorLevel; - const char *displayOperation; + const char *displayOperation, *decode; unsigned char *pixelPtr; - char buffer[256], cspace[40], decode[40]; int bpc, xx, yy, lineLen, alpha; float red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; unsigned char opaque = 255; unsigned char *alphaPtr; int alphaOffset, alphaPitch, alphaIncr; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1482,10 +1538,10 @@ Tk_PostscriptPhoto( } if (bytesPerLine > 60000) { Tcl_ResetResult(interp); - sprintf(buffer, - "Can't generate Postscript for images more than %d pixels wide", - maxWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); return TCL_ERROR; } @@ -1493,35 +1549,32 @@ Tk_PostscriptPhoto( * Set up the postscript code except for the image-data stream. */ + psObj = GetPostscriptBuffer(interp); switch (colorLevel) { case 0: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[1 0]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "1 0"; bpc = 1; break; case 1: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[0 1]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "0 1"; bpc = 8; break; default: - strcpy(cspace, "/DeviceRGB"); - strcpy(decode, "[0 1 0 1 0 1]"); + Tcl_AppendToObj(psObj, "/DeviceRGB setcolorspace\n\n", -1); + decode = "0 1 0 1 0 1"; bpc = 8; break; } - - Tcl_AppendResult(interp, cspace, " setcolorspace\n\n", NULL); - - sprintf(buffer, " /Width %d\n /Height %d\n /BitsPerComponent %d\n", - width, height, bpc); - Tcl_AppendResult(interp, "<<\n /ImageType 1\n", buffer, - " /DataSource currentfile /ASCIIHexDecode filter\n", NULL); - - sprintf(buffer, " /ImageMatrix [1 0 0 -1 0 %d]\n", height); - Tcl_AppendResult(interp, buffer, " /Decode ", decode, "\n>>\n1 ", - displayOperation, "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "<<\n /ImageType 1\n" + " /Width %d\n /Height %d\n /BitsPerComponent %d\n" + " /DataSource currentfile\n /ASCIIHexDecode filter\n" + " /ImageMatrix [1 0 0 -1 0 %d]\n /Decode [%s]\n>>\n" + "1 %s\n", + width, height, bpc, height, decode, displayOperation); /* * Check the PhotoImageBlock information. We assume that: @@ -1581,20 +1634,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1622,20 +1673,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1650,12 +1699,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1672,13 +1720,12 @@ Tk_PostscriptPhoto( green = pixelPtr[blockPtr->offset[1]]; blue = pixelPtr[blockPtr->offset[2]]; - sprintf(buffer, "%02X", (int) floor(0.5 + + Tcl_AppendPrintfToObj(psObj, "%02X", (int) floor(0.5 + ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1692,12 +1739,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1710,22 +1756,25 @@ Tk_PostscriptPhoto( pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + (xx * blockPtr->pixelSize); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", pixelPtr[blockPtr->offset[0]], pixelPtr[blockPtr->offset[1]], pixelPtr[blockPtr->offset[2]]); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; } } - Tcl_AppendResult(interp, ">\n", NULL); + /* + * The end-of-data marker. + */ + + Tcl_AppendToObj(psObj, ">\n", -1); return TCL_OK; } diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 0861a21..eb8dfe3 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -338,29 +338,32 @@ TextCoords( subobj = Tcl_NewDoubleObj(textPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if (objc < 3) { - if (objc == 1) { - if (Tcl_ListObjGetElements(interp, objv[0], &objc, - (Tcl_Obj ***) &objv) != TCL_OK) { - return TCL_ERROR; - } else if (objc != 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # coordinates: expected 2, got %d", objc)); - return TCL_ERROR; - } - } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], - &textPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], - &textPtr->y) != TCL_OK)) { - return TCL_ERROR; - } - ComputeTextBbox(canvas, textPtr); - } else { + return TCL_OK; + } else if (objc > 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); + return TCL_ERROR; + } + + if (objc == 1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { + return TCL_ERROR; + } else if (objc != 2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); + return TCL_ERROR; + } + } + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], + &textPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], + &textPtr->y) != TCL_OK)) { return TCL_ERROR; } + ComputeTextBbox(canvas, textPtr); return TCL_OK; } @@ -1356,14 +1359,18 @@ GetTextIndex( } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.first", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } *indexPtr = textInfoPtr->selectFirst; } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.last", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } *indexPtr = textInfoPtr->selectLast; @@ -1403,6 +1410,7 @@ GetTextIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "TEXT", NULL); return TCL_ERROR; } return TCL_OK; @@ -1536,6 +1544,8 @@ TextToPostscript( XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -1561,26 +1571,40 @@ TextToPostscript( } } + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Generate postscript. + */ + + Tcl_ResetResult(interp); if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (prepass != 0) { - return TCL_OK; + goto done; } + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "/StippleText {\n ", NULL); + Tcl_ResetResult(interp); Tk_CanvasPsStipple(interp, canvas, stipple); - Tcl_AppendResult(interp, "} bind def\n", NULL); + Tcl_AppendPrintfToObj(psObj, "/StippleText {\n %s} bind def\n", + Tcl_GetString(Tcl_GetObjResult(interp))); } - Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%.15g %.15g %.15g [\n", - textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); - - Tk_TextLayoutToPostscript(interp, textPtr->textLayout); - x = 0; y = 0; justify = NULL; /* lint. */ switch (textPtr->anchor) { case TK_ANCHOR_NW: x = 0; y = 0; break; @@ -1600,12 +1624,31 @@ TextToPostscript( } Tk_GetFontMetrics(textPtr->tkfont, &fm); - Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g %.15g [\n", + textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); + Tcl_ResetResult(interp); + Tk_TextLayoutToPostscript(interp, textPtr->textLayout); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendPrintfToObj(psObj, "] %d %g %g %s %s DrawText\n", fm.linespace, x / -2.0, y / 2.0, justify, ((stipple == None) ? "false" : "true")); + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index 1a6a8c4..23c73e5 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -49,9 +49,23 @@ static int DashConvert(char *l, const char *p, int n, double width); static void TranslateAndAppendCoords(TkCanvas *canvPtr, double x, double y, XPoint *outArr, int numOut); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); #define ABS(a) ((a>=0)?(a):(-(a))) +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *---------------------------------------------------------------------- * @@ -756,8 +770,10 @@ TkSmoothParseProc( while (methods != NULL) { if (strncmp(value, methods->smooth.name, length) == 0) { if (smooth != NULL) { - Tcl_AppendResult(interp, "ambiguous smooth method \"", value, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous smooth method \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "SMOOTH", value, + NULL); return TCL_ERROR; } smooth = &methods->smooth; @@ -878,7 +894,7 @@ Tk_GetDash( if ((unsigned) ABS(dash->number) > sizeof(char *)) { ckfree(dash->pattern.pt); } - if (argc > (int)sizeof(char *)) { + if (argc > (int) sizeof(char *)) { dash->pattern.pt = pt = ckalloc(argc); } else { pt = dash->pattern.array; @@ -886,12 +902,12 @@ Tk_GetDash( dash->number = argc; largv = argv; - while (argc>0) { + while (argc > 0) { if (Tcl_GetInt(interp, *largv, &i) != TCL_OK || i < 1 || i>255) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "expected integer in the range 1..255 but got \"", - *largv, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer in the range 1..255 but got \"%s\"", + *largv)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL); goto syntaxError; } *pt++ = i; @@ -909,8 +925,10 @@ Tk_GetDash( */ badDashList: - Tcl_AppendResult(interp, "bad dash list \"", value, - "\": must be a list of integers or a format like \"-..\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad dash list \"%s\": must be a list of integers or a format like \"-..\"", + value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL); syntaxError: if (argv != NULL) { ckfree(argv); @@ -1252,9 +1270,9 @@ Tk_ChangeOutlineGC( * * Tk_ResetOutlineGC * - * Restores the GC to the situation before Tk_ChangeOutlineGC() was called. - * This function should be called just after the dashed item is drawn, - * because the GC is supposed to be read-only. + * Restores the GC to the situation before Tk_ChangeOutlineGC() was + * called. This function should be called just after the dashed item is + * drawn, because the GC is supposed to be read-only. * * Results: * 1 if there is a stipple pattern, and 0 otherwise. @@ -1361,15 +1379,16 @@ Tk_CanvasPsOutline( Tk_Item *item, Tk_Outline *outline) { - char string[41], pattern[11]; + char pattern[11]; int i; - char *ptr, *str = string, *lptr = pattern; + char *ptr, *lptr = pattern; Tcl_Interp *interp = Canvas(canvas)->interp; double width = outline->width; Tk_Dash *dash = &outline->dash; XColor *color = outline->color; Pixmap stipple = outline->stipple; Tk_State state = item->state; + Tcl_Obj *psObj = GetPostscriptBuffer(interp); if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -1380,7 +1399,7 @@ Tk_CanvasPsOutline( width = outline->activeWidth; } if (outline->activeDash.number > 0) { - dash = &(outline->activeDash); + dash = &outline->activeDash; } if (outline->activeColor != NULL) { color = outline->activeColor; @@ -1393,7 +1412,7 @@ Tk_CanvasPsOutline( width = outline->disabledWidth; } if (outline->disabledDash.number > 0) { - dash = &(outline->disabledDash); + dash = &outline->disabledDash; } if (outline->disabledColor != NULL) { color = outline->disabledColor; @@ -1402,66 +1421,65 @@ Tk_CanvasPsOutline( stipple = outline->disabledStipple; } } - sprintf(string, "%.15g setlinewidth\n", width); - Tcl_AppendResult(interp, string, NULL); - if (dash->number > 10) { - str = ckalloc(1 + 4*dash->number); - } else if (dash->number < -5) { - str = ckalloc(1 - 8*dash->number); - lptr = ckalloc(1 - 2*dash->number); - } + Tcl_AppendPrintfToObj(psObj, "%.15g setlinewidth\n", width); + ptr = ((unsigned) ABS(dash->number) > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; + Tcl_AppendToObj(psObj, "[", -1); if (dash->number > 0) { - char *ptr0 = ptr; + Tcl_Obj *converted; + char *p = ptr; - sprintf(str, "[%d", *ptr++ & 0xff); - i = dash->number-1; - while (i--) { - sprintf(str+strlen(str), " %d", *ptr++ & 0xff); + converted = Tcl_ObjPrintf("%d", *p++ & 0xff); + for (i = dash->number-1 ; i>=0 ; i--) { + Tcl_AppendPrintfToObj(converted, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - if (dash->number&1) { - Tcl_AppendResult(interp, " ", str+1, NULL); + Tcl_AppendObjToObj(psObj, converted); + if (dash->number & 1) { + Tcl_AppendToObj(psObj, " ", -1); + Tcl_AppendObjToObj(psObj, converted); } - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - ptr = ptr0; + Tcl_DecrRefCount(converted); + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else if (dash->number < 0) { - if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) { - char *lptr0 = lptr; + if (dash->number < -5) { + lptr = ckalloc(1 - 2*dash->number); + } + i = DashConvert(lptr, ptr, -dash->number, width); + if (i > 0) { + char *p = lptr; - sprintf(str, "[%d", *lptr++ & 0xff); - while (--i) { - sprintf(str+strlen(str), " %d", *lptr++ & 0xff); + Tcl_AppendPrintfToObj(psObj, "%d", *p++ & 0xff); + for (; --i>0 ;) { + Tcl_AppendPrintfToObj(psObj, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - lptr = lptr0; + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); + } + if (lptr != pattern) { + ckfree(lptr); } } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); - } - if (str != string) { - ckfree(str); - } - if (lptr != pattern) { - ckfree(lptr); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); } + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { return TCL_ERROR; } + + /* + * Note that psObj might hold an invalid reference now. + */ + if (stipple != None) { - Tcl_AppendResult(interp, "StrokeClip ", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "StrokeClip ", -1); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "stroke\n", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "stroke\n", -1); } return TCL_OK; @@ -1731,7 +1749,7 @@ TkCanvTranslatePath( * This is the loop that makes the four passes through the data. */ - for (j=0; j<4; j++){ + for (j=0; j<4; j++) { double xClip = limit[j]; int inside = a[0] < xClip; double priorY = a[1]; @@ -1742,7 +1760,7 @@ TkCanvTranslatePath( * rotated by 90 degrees clockwise. */ - for (i=0; i<numVertex; i++){ + for (i=0; i<numVertex; i++) { double x = a[i*2]; double y = a[i*2 + 1]; @@ -1833,7 +1851,7 @@ TkCanvTranslatePath( * XPoints and translate the origin for the drawable. */ - for (i=0; i<numVertex; i++){ + for (i=0; i<numVertex; i++) { TranslateAndAppendCoords(canvPtr, a[i*2], a[i*2+1], outArr, i); } if (tempArr != staticSpace) { diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index f2cce7d..f183b35 100644 --- a/generic/tkCanvWind.c +++ b/generic/tkCanvWind.c @@ -246,22 +246,21 @@ WinItemCoords( WindowItem *winItemPtr = (WindowItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(winItemPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(winItemPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *objs[2]; + + objs[0] = Tcl_NewDoubleObj(winItemPtr->x); + objs[1] = Tcl_NewDoubleObj(winItemPtr->y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", + NULL); return TCL_ERROR; } } @@ -272,10 +271,9 @@ WinItemCoords( } ComputeWindowBbox(canvas, winItemPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", NULL); return TCL_ERROR; } return TCL_OK; @@ -342,8 +340,7 @@ ConfigureWinItem( */ parent = Tk_Parent(winItemPtr->tkwin); - for (ancestor = canvasTkwin; ; - ancestor = Tk_Parent(ancestor)) { + for (ancestor = canvasTkwin ;; ancestor = Tk_Parent(ancestor)) { if (ancestor == parent) { break; } @@ -375,8 +372,10 @@ ConfigureWinItem( return TCL_OK; badWindow: - Tcl_AppendResult(interp, "can't use ", Tk_PathName(winItemPtr->tkwin), - " in a window item of this canvas", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s in a window item of this canvas", + Tk_PathName(winItemPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); winItemPtr->tkwin = NULL; return TCL_ERROR; } @@ -827,45 +826,44 @@ CanvasPsWindow( double x, double y, /* origin of window. */ int width, int height) /* width/height of window. */ { - char buffer[256]; XImage *ximage; int result; - Tcl_DString buffer1, buffer2; #ifdef X_GetImage Tk_ErrorHandler handle; #endif + Tcl_Obj *cmdObj, *psObj; + Tcl_InterpState interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Locate the subwindow within the wider window. + */ - sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n", + psObj = Tcl_ObjPrintf( + "\n%%%% %s item (%s, %d x %d)\n" // Comment + "%.15g %.15g translate\n", // Position Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y); - Tcl_AppendResult(interp, buffer, NULL); /* * First try if the widget has its own "postscript" command. If it exists, * this will produce much better postscript than when a pixmap is used. */ - Tcl_DStringInit(&buffer1); - Tcl_DStringInit(&buffer2); - Tcl_DStringGetResult(interp, &buffer2); - sprintf(buffer, "%s postscript -prolog 0\n", Tk_PathName(tkwin)); - result = Tcl_Eval(interp, buffer); - Tcl_DStringGetResult(interp, &buffer1); - Tcl_DStringResult(interp, &buffer2); - Tcl_DStringFree(&buffer2); + Tcl_ResetResult(interp); + cmdObj = Tcl_ObjPrintf("%s postscript -prolog 0", Tk_PathName(tkwin)); + Tcl_IncrRefCount(cmdObj); + result = Tcl_EvalObjEx(interp, cmdObj, 0); + Tcl_DecrRefCount(cmdObj); if (result == TCL_OK) { - Tcl_AppendResult(interp, "50 dict begin\nsave\ngsave\n", NULL); - sprintf(buffer, "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d", - height, width, height, width); - Tcl_AppendResult(interp, buffer, NULL); - Tcl_AppendResult(interp, " 0 rlineto closepath\n", + Tcl_AppendPrintfToObj(psObj, + "50 dict begin\nsave\ngsave\n" + "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d 0 rlineto closepath\n" "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n", - Tcl_DStringValue(&buffer1), "\nrestore\nend\n\n\n", NULL); - Tcl_DStringFree(&buffer1); - - return result; + height, width, height, width); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "\nrestore\nend\n\n\n", -1); + goto done; } - Tcl_DStringFree(&buffer1); /* * If the window is off the screen it will generate a BadMatch/XError. We @@ -890,13 +888,27 @@ CanvasPsWindow( #endif if (ximage == NULL) { - return TCL_OK; + result = TCL_OK; + } else { + Tcl_ResetResult(interp); + result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, + ximage, 0, 0, width, height); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + XDestroyImage(ximage); } - result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, ximage, - 0, 0, width, height); + /* + * Plug the accumulated postscript back into the result. + */ - XDestroyImage(ximage); + done: + if (result == TCL_OK) { + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + } else { + Tcl_DiscardInterpState(interpState); + } + Tcl_DecrRefCount(psObj); return result; } diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 14d8261..07f1cfe 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -269,7 +269,7 @@ static int ConfigureCanvas(Tcl_Interp *interp, Tcl_Obj *const *argv, int flags); static void DestroyCanvas(char *memPtr); static void DisplayCanvas(ClientData clientData); -static void DoItem(Tcl_Interp *interp, +static void DoItem(Tcl_Obj *accumObj, Tk_Item *itemPtr, Tk_Uid tag); static void EventuallyRedrawItem(TkCanvas *canvasPtr, Tk_Item *itemPtr); @@ -333,10 +333,10 @@ static const Tk_ClassProcs canvasClass = { #ifdef USE_OLD_TAG_SEARCH #define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ - (itemPtr) = StartTagSearch(canvasPtr,(objPtr),&search) + itemPtr = StartTagSearch(canvasPtr,(objPtr),&search) #define FOR_EVERY_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ - for ((itemPtr) = StartTagSearch(canvasPtr, (objPtr), &search); \ - (itemPtr) != NULL; (itemPtr) = NextItem(&search)) + for (itemPtr = StartTagSearch(canvasPtr, (objPtr), &search); \ + itemPtr != NULL; itemPtr = NextItem(&search)) #define FIND_ITEMS(objPtr, n) \ FindItems(interp, canvasPtr, objc, objv, (objPtr), (n)) #define RELINK_ITEMS(objPtr, itemPtr) \ @@ -928,8 +928,10 @@ CanvasWidgetCmd( } if (object == NULL) { - Tcl_AppendResult(interp, "item \"", Tcl_GetString(objv[2]), - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item \"%s\" doesn't exist", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM", + Tcl_GetString(objv[2]), NULL); result = TCL_ERROR; goto done; } @@ -953,8 +955,10 @@ CanvasWidgetCmd( } if (object == 0) { - Tcl_AppendResult(interp, "item \"", Tcl_GetString(objv[2]), - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item \"%s\" doesn't exist", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM", + Tcl_GetString(objv[2]), NULL); result = TCL_ERROR; goto done; } @@ -1030,10 +1034,10 @@ CanvasWidgetCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, canvasPtr->bindingTable, object, Tcl_GetString(objv[3])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual", - " events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_EVENTS", NULL); result = TCL_ERROR; goto done; } @@ -1274,8 +1278,10 @@ CanvasWidgetCmd( Tcl_MutexUnlock(&typeListMutex); if (matchPtr == NULL) { badType: - Tcl_AppendResult(interp, - "unknown or ambiguous item type \"", arg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown or ambiguous item type \"%s\"", arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM_TYPE", arg, + NULL); result = TCL_ERROR; goto done; } @@ -1501,9 +1507,13 @@ CanvasWidgetCmd( FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); if (itemPtr != NULL) { int i; + Tcl_Obj *resultObj = Tcl_NewObj(); + for (i = 0; i < itemPtr->numTags; i++) { - Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(itemPtr->tagPtr[i], -1)); } + Tcl_SetObjResult(interp, resultObj); } break; case CANV_ICURSOR: { @@ -1545,8 +1555,10 @@ CanvasWidgetCmd( } } if (itemPtr == NULL) { - Tcl_AppendResult(interp, "can't find an indexable item \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find an indexable item \"%s\"", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "INDEXABLE_ITEM", NULL); result = TCL_ERROR; goto done; } @@ -1647,8 +1659,10 @@ CanvasWidgetCmd( } else { FIRST_CANVAS_ITEM_MATCHING(objv[3], &searchPtr, goto done); if (itemPtr == NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(objv[3]), - "\" doesn't match any items", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tagOrId \"%s\" doesn't match any items", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL); result = TCL_ERROR; goto done; } @@ -1772,8 +1786,10 @@ CanvasWidgetCmd( prevPtr = itemPtr; } if (prevPtr == NULL) { - Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetString(objv[3]), - "\" doesn't match any items", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tagOrId \"%s\" doesn't match any items", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL); result = TCL_ERROR; goto done; } @@ -1847,7 +1863,9 @@ CanvasWidgetCmd( goto done; } if ((xScale == 0.0) || (yScale == 0.0)) { - Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scale factor cannot be zero", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_SCALE", NULL); result = TCL_ERROR; goto done; } @@ -1925,9 +1943,11 @@ CanvasWidgetCmd( } } if (itemPtr == NULL) { - Tcl_AppendResult(interp, - "can't find an indexable and selectable item \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find an indexable and selectable item \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SELECTABLE_ITEM", + NULL); result = TCL_ERROR; goto done; } @@ -2019,6 +2039,7 @@ CanvasWidgetCmd( int newX = 0; /* Initialization needed only to prevent gcc * warnings. */ double fraction; + const char **args; if (objc == 2) { Tcl_SetObjResult(interp, ScrollFractions( @@ -2026,39 +2047,37 @@ CanvasWidgetCmd( canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollX1, canvasPtr->scrollX2)); - } else { - const char **args = TkGetStringsFromObjs(objc, objv); + break; + } - type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); - if (args != NULL) { - ckfree(args); - } - switch (type) { - case TK_SCROLL_ERROR: - result = TCL_ERROR; - goto done; - case TK_SCROLL_MOVETO: - newX = canvasPtr->scrollX1 - canvasPtr->inset - + (int) (fraction * (canvasPtr->scrollX2 - - canvasPtr->scrollX1) + 0.5); - break; - case TK_SCROLL_PAGES: - newX = (int) (canvasPtr->xOrigin + count * .9 + args = TkGetStringsFromObjs(objc, objv); + type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); + if (args != NULL) { + ckfree(args); + } + switch (type) { + case TK_SCROLL_ERROR: + result = TCL_ERROR; + goto done; + case TK_SCROLL_MOVETO: + newX = canvasPtr->scrollX1 - canvasPtr->inset + + (int) (fraction * (canvasPtr->scrollX2 + - canvasPtr->scrollX1) + 0.5); + break; + case TK_SCROLL_PAGES: + newX = (int) (canvasPtr->xOrigin + count * .9 + * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->xScrollIncrement > 0) { + newX = canvasPtr->xOrigin + count*canvasPtr->xScrollIncrement; + } else { + newX = (int) (canvasPtr->xOrigin + count * .1 * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); - break; - case TK_SCROLL_UNITS: - if (canvasPtr->xScrollIncrement > 0) { - newX = canvasPtr->xOrigin - + count*canvasPtr->xScrollIncrement; - } else { - newX = (int) (canvasPtr->xOrigin + count * .1 - * (Tk_Width(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - } - break; } - CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); + break; } + CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); break; } case CANV_YVIEW: { @@ -2066,6 +2085,7 @@ CanvasWidgetCmd( int newY = 0; /* Initialization needed only to prevent gcc * warnings. */ double fraction; + const char **args; if (objc == 2) { Tcl_SetObjResult(interp, ScrollFractions( @@ -2073,40 +2093,36 @@ CanvasWidgetCmd( canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollY1, canvasPtr->scrollY2)); - } else { - const char **args = TkGetStringsFromObjs(objc, objv); + break; + } - type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); - if (args != NULL) { - ckfree(args); - } - switch (type) { - case TK_SCROLL_ERROR: - result = TCL_ERROR; - goto done; - case TK_SCROLL_MOVETO: - newY = canvasPtr->scrollY1 - canvasPtr->inset - + (int) (fraction*(canvasPtr->scrollY2 - - canvasPtr->scrollY1) + 0.5); - break; - case TK_SCROLL_PAGES: - newY = (int) (canvasPtr->yOrigin + count * .9 - * (Tk_Height(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - break; - case TK_SCROLL_UNITS: - if (canvasPtr->yScrollIncrement > 0) { - newY = canvasPtr->yOrigin - + count*canvasPtr->yScrollIncrement; - } else { - newY = (int) (canvasPtr->yOrigin + count * .1 - * (Tk_Height(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - } - break; + args = TkGetStringsFromObjs(objc, objv); + type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); + if (args != NULL) { + ckfree(args); + } + switch (type) { + case TK_SCROLL_ERROR: + result = TCL_ERROR; + goto done; + case TK_SCROLL_MOVETO: + newY = canvasPtr->scrollY1 - canvasPtr->inset + (int) ( + fraction*(canvasPtr->scrollY2-canvasPtr->scrollY1) + 0.5); + break; + case TK_SCROLL_PAGES: + newY = (int) (canvasPtr->yOrigin + count * .9 + * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->yScrollIncrement > 0) { + newY = canvasPtr->yOrigin + count*canvasPtr->yScrollIncrement; + } else { + newY = (int) (canvasPtr->yOrigin + count * .1 + * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset)); } - CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); + break; } + CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); break; } } @@ -2302,8 +2318,9 @@ ConfigureCanvas( return TCL_ERROR; } if (argc2 != 4) { - Tcl_AppendResult(interp, "bad scrollRegion \"", - canvasPtr->regionString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scrollRegion \"%s\"", canvasPtr->regionString)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SCROLL_REGION", NULL); badRegion: ckfree(canvasPtr->regionString); ckfree(argv2); @@ -3583,8 +3600,10 @@ TagSearchScanExpr( case '!': /* Negate next tag or subexpr */ if (looking_for_tag > 1) { - Tcl_AppendResult(interp, - "Too many '!' in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many '!' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "COMPLEXITY", NULL); return TCL_ERROR; } looking_for_tag++; @@ -3631,15 +3650,18 @@ TagSearchScanExpr( *tag++ = c; } if (!found_endquote) { - Tcl_AppendResult(interp, - "Missing endquote in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing endquote in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "ENDQUOTE", NULL); return TCL_ERROR; } if (!(tag - searchPtr->rewritebuffer)) { - Tcl_AppendResult(interp, - "Null quoted tag string in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "null quoted tag string in tag search expression", + -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "EMPTY", NULL); return TCL_ERROR; } *tag++ = '\0'; @@ -3653,9 +3675,10 @@ TagSearchScanExpr( case '|': case '^': case ')': - Tcl_AppendResult(interp, - "Unexpected operator in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected operator in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "UNEXPECTED", NULL); return TCL_ERROR; default: /* Unquoted tag string */ @@ -3716,8 +3739,10 @@ TagSearchScanExpr( case '&': /* AND operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '&') { - Tcl_AppendResult(interp, - "Singleton '&' in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '&' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "INCOMPLETE_OP", NULL); return TCL_ERROR; } expr->uids[expr->index++] = searchUids->andUid; @@ -3727,8 +3752,10 @@ TagSearchScanExpr( case '|': /* OR operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '|') { - Tcl_AppendResult(interp, - "Singleton '|' in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '|' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "INCOMPLETE_OP", NULL); return TCL_ERROR; } expr->uids[expr->index++] = searchUids->orUid; @@ -3745,8 +3772,10 @@ TagSearchScanExpr( goto breakwhile; default: /* syntax error */ - Tcl_AppendResult(interp, - "Invalid boolean operator in tag search expression", + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid boolean operator in tag search expression", + -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "BAD_OP", NULL); return TCL_ERROR; } @@ -3757,7 +3786,9 @@ TagSearchScanExpr( if (found_tag && !looking_for_tag) { return TCL_OK; } - Tcl_AppendResult(interp, "Missing tag in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing tag in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "NO_TAG", NULL); return TCL_ERROR; } @@ -4138,23 +4169,23 @@ TagSearchNext( * DoItem -- * * This is a utility function called by FindItems. It either adds - * itemPtr's id to the result forming in interp, or it adds a new tag to + * itemPtr's id to the list being constructed, or it adds a new tag to * itemPtr, depending on the value of tag. * * Results: * None. * * Side effects: - * If tag is NULL then itemPtr's id is added as a list element to the - * interp's result; otherwise tag is added to itemPtr's list of tags. + * If tag is NULL then itemPtr's id is added as an element to the + * supplied object; otherwise tag is added to itemPtr's list of tags. * *-------------------------------------------------------------- */ static void DoItem( - Tcl_Interp *interp, /* Interpreter in which to (possibly) record - * item id. */ + Tcl_Obj *accumObj, /* Object in which to (possibly) record item + * id. */ Tk_Item *itemPtr, /* Item to (possibly) modify. */ Tk_Uid tag) /* Tag to add to those already present for * item, or NULL. */ @@ -4167,10 +4198,7 @@ DoItem( */ if (tag == NULL) { - char msg[TCL_INTEGER_SPACE]; - - sprintf(msg, "%d", itemPtr->id); - Tcl_AppendElement(interp, msg); + Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewIntObj(itemPtr->id)); return; } @@ -4257,6 +4285,7 @@ FindItems( Tk_Item *itemPtr; Tk_Uid uid; int index, result; + Tcl_Obj *resultObj; static const char *const optionStrings[] = { "above", "all", "below", "closest", "enclosed", "overlapping", "withtag", NULL @@ -4288,7 +4317,9 @@ FindItems( lastPtr = itemPtr; } if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) { - DoItem(interp, lastPtr->nextPtr, uid); + resultObj = Tcl_NewObj(); + DoItem(resultObj, lastPtr->nextPtr, uid); + Tcl_SetObjResult(interp, resultObj); } break; } @@ -4298,10 +4329,12 @@ FindItems( return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - DoItem(interp, itemPtr, uid); + DoItem(resultObj, itemPtr, uid); } + Tcl_SetObjResult(interp, resultObj); break; case CANV_BELOW: @@ -4311,10 +4344,10 @@ FindItems( } FIRST_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr, return TCL_ERROR); - if (itemPtr != NULL) { - if (itemPtr->prevPtr != NULL) { - DoItem(interp, itemPtr->prevPtr, uid); - } + if ((itemPtr != NULL) && (itemPtr->prevPtr != NULL)) { + resultObj = Tcl_NewObj(); + DoItem(resultObj, itemPtr->prevPtr, uid); + Tcl_SetObjResult(interp, resultObj); } break; case CANV_CLOSEST: { @@ -4339,8 +4372,8 @@ FindItems( return TCL_ERROR; } if (halo < 0.0) { - Tcl_AppendResult(interp, "can't have negative halo value \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't have negative halo value \"%f\"", halo)); return TCL_ERROR; } } else { @@ -4404,7 +4437,9 @@ FindItems( itemPtr = canvasPtr->firstItemPtr; } if (itemPtr == startPtr) { - DoItem(interp, closestPtr, uid); + resultObj = Tcl_NewObj(); + DoItem(resultObj, closestPtr, uid); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (itemPtr->state == TK_STATE_HIDDEN || @@ -4442,10 +4477,16 @@ FindItems( Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId"); return TCL_ERROR; } + resultObj = Tcl_NewObj(); FOR_EVERY_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr, - return TCL_ERROR) { - DoItem(interp, itemPtr, uid); + goto badWithTagSearch) { + DoItem(resultObj, itemPtr, uid); } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + badWithTagSearch: + Tcl_DecrRefCount(resultObj); + return TCL_ERROR; } return TCL_OK; } @@ -4490,6 +4531,7 @@ FindArea( double rect[4], tmp; int x1, y1, x2, y2; Tk_Item *itemPtr; + Tcl_Obj *resultObj; if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[0], &rect[0]) != TCL_OK) @@ -4517,6 +4559,7 @@ FindArea( y1 = (int) (rect[1] - 1.0); x2 = (int) (rect[2] + 1.0); y2 = (int) (rect[3] + 1.0); + resultObj = Tcl_NewObj(); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { if (itemPtr->state == TK_STATE_HIDDEN || @@ -4529,9 +4572,10 @@ FindArea( continue; } if (ItemOverlap(canvasPtr, itemPtr, rect) >= enclosed) { - DoItem(interp, itemPtr, uid); + DoItem(resultObj, itemPtr, uid); } } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index 043c167..604fa98 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -367,10 +367,12 @@ Tk_ClipboardAppend( Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, type, ClipboardHandler, targetPtr, format); } else if (targetPtr->format != format) { - Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format), - "\" does not match current format \"", - Tk_GetAtomName(tkwin, targetPtr->format),"\" for ", - Tk_GetAtomName(tkwin, type), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "format \"%s\" does not match current format \"%s\" for %s", + Tk_GetAtomName(tkwin, format), + Tk_GetAtomName(tkwin, targetPtr->format), + Tk_GetAtomName(tkwin, type))); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "FORMAT_MISMATCH", NULL); return TCL_ERROR; } @@ -474,8 +476,9 @@ Tk_ClipboardObjCmd( i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum appendOptions) subIndex) { @@ -563,8 +566,9 @@ Tk_ClipboardObjCmd( } i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum getOptions) subIndex) { @@ -699,12 +703,11 @@ ClipboardGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - const char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1); return TCL_OK; } - /* * Local Variables: diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 63f626e..4e9494b 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -233,7 +233,7 @@ Tk_BindObjCmd( Tcl_ResetResult(interp); return TCL_OK; } - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -361,30 +361,28 @@ Tk_BindtagsObjCmd( } if (objc == 2) { listPtr = Tcl_NewObj(); - Tcl_IncrRefCount(listPtr); if (winPtr->numTags == 0) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->classUid, -1)); winPtr2 = winPtr; while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) { winPtr2 = winPtr2->parentPtr; } if ((winPtr != winPtr2) && (winPtr2 != NULL)) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr2->pathName, -1)); } - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("all", -1)); } else { for (i = 0; i < winPtr->numTags; i++) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1)); + Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1)); } } Tcl_SetObjResult(interp, listPtr); - Tcl_DecrRefCount(listPtr); return TCL_OK; } if (winPtr->tagPtr != NULL) { @@ -555,9 +553,15 @@ Tk_LowerObjCmd( } } if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]), - "\" below \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + if (other) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't lower \"%s\" below \"%s\"", + Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't lower \"%s\" to bottom", Tcl_GetString(objv[1]))); + } + Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", NULL); return TCL_ERROR; } return TCL_OK; @@ -609,9 +613,15 @@ Tk_RaiseObjCmd( } } if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]), - "\" above \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + if (other) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't raise \"%s\" above \"%s\"", + Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't raise \"%s\" to top", Tcl_GetString(objv[1]))); + } + Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", NULL); return TCL_ERROR; } return TCL_OK; @@ -675,9 +685,9 @@ AppnameCmd( const char *string; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "appname not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "appname not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "APPLICATION", NULL); return TCL_ERROR; } @@ -691,7 +701,7 @@ AppnameCmd( string = Tcl_GetString(objv[1]); winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); } - Tcl_AppendResult(interp, winPtr->nameUid, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); return TCL_OK; } @@ -800,8 +810,9 @@ ScalingCmd( double d; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, "scaling not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scaling not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL); return TCL_ERROR; } @@ -849,9 +860,9 @@ UseinputmethodsCmd( int skip; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "useinputmethods not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "useinputmethods not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "INPUT_METHODS", NULL); return TCL_ERROR; } @@ -933,22 +944,22 @@ InactiveCmd( inactive = (Tcl_IsSafe(interp) ? -1 : Tk_GetUserInactiveTime(Tk_Display(tkwin))); Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); - } else if (objc - skip == 2) { const char *string; string = Tcl_GetString(objv[objc-1]); if (strcmp(string, "reset") != 0) { - Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1); - - Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL); - Tcl_SetObjResult(interp, msg); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be reset", string)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string, NULL); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "resetting the user inactivity timer " - "is not allowed in a safe interpreter", TCL_STATIC); + "is not allowed in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "INACTIVITY_TIMER", NULL); return TCL_ERROR; } Tk_ResetUserInactiveTime(Tk_Display(tkwin)); @@ -1050,8 +1061,10 @@ Tk_TkwaitObjCmd( */ Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]), - "\" was deleted before its visibility changed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" was deleted before its visibility changed", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL); return TCL_ERROR; } Tk_DeleteEventHandler(window, @@ -1129,8 +1142,7 @@ WaitVisibilityProc( if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } - if (eventPtr->type == DestroyNotify) { + } else if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1584,8 +1596,10 @@ Tk_WinfoObjCmd( } name = Tk_GetAtomName(tkwin, (Atom) id); if (strcmp(name, "?bad atom?") == 0) { - Tcl_AppendResult(interp, "no atom exists with id \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no atom exists with id \"%s\"", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); @@ -1643,8 +1657,10 @@ Tk_WinfoObjCmd( winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id); if ((winPtr == NULL) || (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", string, - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, NULL); return TCL_ERROR; } @@ -1764,8 +1780,9 @@ Tk_WinfoObjCmd( visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask, &template, &count); if (visInfoPtr == NULL) { - Tcl_SetResult(interp, "can't find any visuals for screen", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find any visuals for screen", -1)); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", NULL); return TCL_ERROR; } resultPtr = Tcl_NewObj(); @@ -1860,8 +1877,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1886,8 +1903,10 @@ Tk_WmObjCmd( return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -2058,8 +2077,9 @@ TkGetDisplayOf( if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) { if (objc < 2) { - Tcl_SetResult(interp, "value for \"-displayof\" missing", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-displayof\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL); return -1; } *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr); @@ -2097,8 +2117,9 @@ TkDeadAppCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - Tcl_AppendResult(interp, "can't invoke \"", argv[0], - "\" command: application has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't invoke \"%s\" command: application has been destroyed", + argv[0])); return TCL_ERROR; } diff --git a/generic/tkColor.c b/generic/tkColor.c index ea03e28..e4fa3f7 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -224,11 +224,13 @@ Tk_GetColor( if (tkColPtr == NULL) { if (interp != NULL) { if (*name == '#') { - Tcl_AppendResult(interp, "invalid color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); } else { - Tcl_AppendResult(interp, "unknown color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color name \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "COLOR", name, NULL); } } if (isNew) { @@ -372,10 +374,12 @@ Tk_NameOfColor( sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, colorPtr->green, colorPtr->blue); - /* If the string has the form #RSRSTUTUVWVW (where equal - * letters denote equal hexdigits) then this is - * equivalent to #RSTUVW. Then output the shorter form. + /* + * If the string has the form #RSRSTUTUVWVW (where equal letters + * denote equal hexdigits) then this is equivalent to #RSTUVW. Then + * output the shorter form. */ + if ((tsdPtr->rgbString[1] == tsdPtr->rgbString[3]) && (tsdPtr->rgbString[2] == tsdPtr->rgbString[4]) && (tsdPtr->rgbString[5] == tsdPtr->rgbString[7]) diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 5262f58..b3e76d2 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -205,7 +205,7 @@ Tk_CreateOptionTable( hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr, &newEntry); if (!newEntry) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + tablePtr = Tcl_GetHashValue(hashEntryPtr); tablePtr->refCount++; return (Tk_OptionTable) tablePtr; } @@ -391,12 +391,11 @@ DestroyOptionHashTable( Tcl_HashTable *hashTablePtr = clientData; Tcl_HashSearch search; Tcl_HashEntry *hashEntryPtr; - OptionTable *tablePtr; for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); hashEntryPtr != NULL; hashEntryPtr = Tcl_NextHashEntry(&search)) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + OptionTable *tablePtr = Tcl_GetHashValue(hashEntryPtr); /* * The following statements do two tricky things: @@ -946,16 +945,13 @@ DoObjConfig( break; } - { - char buf[40+TCL_INTEGER_SPACE]; - default: - sprintf(buf, "bad config table: unknown type %d", - optionPtr->specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", + optionPtr->specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } /* * Release resources associated with the old value, if we're not returning @@ -1161,7 +1157,9 @@ GetOptionFromObj( error: if (interp != NULL) { - Tcl_AppendResult(interp, "unknown option \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL); } return NULL; } @@ -1228,12 +1226,13 @@ SetOptionFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to option except via GetOptionFromObj API", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1346,8 +1345,10 @@ Tk_SetOptions( if (objc < 2) { if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetStringFromObj(*objv, NULL), "\" missing",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", + Tcl_GetStringFromObj(*objv, NULL))); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); goto error; } } @@ -1369,11 +1370,9 @@ Tk_SetOptions( if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin, (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems] : NULL) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - Tcl_GetStringFromObj(*objv, NULL)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)", + Tcl_GetStringFromObj(*objv, NULL))); goto error; } if (savePtr != NULL) { @@ -1771,7 +1770,6 @@ FreeResources( * single option or all the configuration options in a table. * * Results: - * This function normally returns a pointer to an object. If namePtr * isn't NULL, then the result object is a list with five elements: the * option's name, its database name, database class, default value, and @@ -2154,8 +2152,7 @@ TkDebugConfig( Tcl_Obj *objPtr; objPtr = Tcl_NewObj(); - hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, - NULL); + hashTablePtr = Tcl_GetAssocData(interp, OPTION_HASH_KEY, NULL); if (hashTablePtr == NULL) { return objPtr; } diff --git a/generic/tkConsole.c b/generic/tkConsole.c index 53f49c1..434350a 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -747,7 +747,9 @@ ConsoleObjCmd( Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); Tcl_Release(consoleInterp); } else { - Tcl_AppendResult(interp, "no active console interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active console interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NONE", NULL); result = TCL_ERROR; } Tcl_DecrRefCount(cmd); @@ -796,7 +798,9 @@ InterpreterObjCmd( } if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) { - Tcl_AppendResult(interp, "no active master interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active master interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL); return TCL_ERROR; } diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 2bbf861..6b2d5f4 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -352,11 +352,15 @@ Tk_GetCursorFromData( */ if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", bg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 044a35b..d78f396 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -449,8 +449,8 @@ static int ComputeFormat(Spinbox *sbPtr); static const Tk_ClassProcs entryClass = { sizeof(Tk_ClassProcs), /* size */ EntryWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -612,6 +612,7 @@ EntryWidgetObjCmd( switch ((enum entryCmd) cmdIndex) { case COMMAND_BBOX: { int index, x, y, width, height; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -625,8 +626,11 @@ EntryWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height)); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -755,9 +759,11 @@ EntryWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -851,7 +857,7 @@ EntryWidgetObjCmd( goto error; } Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_NewBooleanObj(entryPtr->selectFirst >= 0)); goto done; case SELECTION_RANGE: @@ -912,7 +918,7 @@ EntryWidgetObjCmd( if (entryPtr->validate != VALIDATE_NONE) { entryPtr->validate = selIndex; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK)); break; } @@ -921,13 +927,12 @@ EntryWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -1165,9 +1170,11 @@ ConfigureEntry( if (entryPtr->type == TK_SPINBOX) { if (sbPtr->fromValue > sbPtr->toValue) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "-to value must be greater than -from value", - TCL_VOLATILE); + -1)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "RANGE_SANITY", + NULL); continue; } @@ -1184,9 +1191,12 @@ ConfigureEntry( formatLen = strlen(fmt); if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) { - badFormatOpt: - Tcl_AppendResult(interp, "bad spinbox format specifier \"", - sbPtr->reqFormat, "\"", NULL); + badFormatOpt: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad spinbox format specifier \"%s\"", + sbPtr->reqFormat)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "FORMAT_SANITY", + NULL); continue; } if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3) @@ -2528,8 +2538,12 @@ GetEntryIndex( case 's': if (entryPtr->selectFirst < 0) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "NO_SELECTION", NULL); return TCL_ERROR; } if (length < 5) { @@ -2589,6 +2603,9 @@ GetEntryIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad %s index \"%s\"", (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", string)); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "BAD_INDEX", NULL); return TCL_ERROR; } @@ -2935,10 +2952,9 @@ EntryUpdateScrollbar( code = Tcl_VarEval(interp, entryPtr->scrollCmd, " ", firstStr, " ", lastStr, NULL); if (code != TCL_OK) { - Tcl_AddErrorInfo(interp, - "\n (horizontal scrolling command executed by "); - Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin)); - Tcl_AddErrorInfo(interp, ")"); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (horizontal scrolling command executed by %s)", + Tk_PathName(entryPtr->tkwin))); Tcl_BackgroundException(interp, code); } Tcl_ResetResult(interp); @@ -3141,7 +3157,7 @@ EntryValidate( if (code != TCL_OK && code != TCL_RETURN) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n\t(in validation command executed by %s)", + "\n (in validation command executed by %s)", Tk_PathName(entryPtr->tkwin))); Tcl_BackgroundException(interp, code); return TCL_ERROR; @@ -3154,7 +3170,7 @@ EntryValidate( if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), &bool) != TCL_OK) { Tcl_AddErrorInfo(interp, - "\nvalid boolean not returned by validation command"); + "\n (invalid boolean result from validation command)"); Tcl_BackgroundError(interp); Tcl_ResetResult(interp); return TCL_ERROR; @@ -3280,7 +3296,7 @@ EntryValidateChange( TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (result != TCL_OK) { Tcl_AddErrorInfo(entryPtr->interp, - "\n\t(in invalidcommand executed by entry)"); + "\n (in invalidcommand executed by entry)"); Tcl_BackgroundException(entryPtr->interp, result); code = TCL_ERROR; entryPtr->validate = VALIDATE_NONE; @@ -3592,7 +3608,7 @@ Tk_SpinboxObjCmd( goto error; } - Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin)); return TCL_OK; error: @@ -3650,6 +3666,7 @@ SpinboxWidgetObjCmd( switch ((enum sbCmd) cmdIndex) { case SB_CMD_BBOX: { int index, x, y, width, height; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -3663,8 +3680,11 @@ SpinboxWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height)); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -3830,9 +3850,11 @@ SpinboxWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -3925,8 +3947,8 @@ SpinboxWidgetObjCmd( Tcl_WrongNumArgs(interp, 3, objv, NULL); goto error; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + entryPtr->selectFirst >= 0)); goto done; case SB_SEL_RANGE: @@ -4030,13 +4052,12 @@ SpinboxWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -4284,7 +4305,8 @@ SpinboxInvoke( Tcl_DStringFree(&script); if (code != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)"); + Tcl_AddErrorInfo(interp, + "\n (in command executed by spinbox)"); Tcl_BackgroundException(interp, code); /* diff --git a/generic/tkEvent.c b/generic/tkEvent.c index 1fbf1dd..463379a 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -1336,7 +1336,7 @@ Tk_HandleEvent( } } else { for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) { - if ((handlerPtr->mask & mask) != 0) { + if (handlerPtr->mask & mask) { ip.nextHandler = handlerPtr->nextPtr; handlerPtr->proc(handlerPtr->clientData, eventPtr); handlerPtr = ip.nextHandler; diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c index fba570b..8588d70 100644 --- a/generic/tkFileFilter.c +++ b/generic/tkFileFilter.c @@ -120,10 +120,12 @@ TkGetFileFilters( } if (count != 2 && count != 3) { - Tcl_AppendResult(interp, "bad file type \"", - Tcl_GetString(listObjv[i]), "\", ", - "should be \"typeName {extension ?extensions ...?} ", - "?{macType ?macTypes ...?}?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad file type \"%s\", should be " + "\"typeName {extension ?extensions ...?} " + "?{macType ?macTypes ...?}?\"", + Tcl_GetString(listObjv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILE_TYPE", NULL); return TCL_ERROR; } @@ -289,8 +291,10 @@ AddClause( Tcl_DStringFree(&osTypeDS); } if (len != 4) { - Tcl_AppendResult(interp, "bad Macintosh file type \"", - Tcl_GetString(ostypeList[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad Macintosh file type \"%s\"", + Tcl_GetString(ostypeList[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MAC_TYPE", NULL); code = TCL_ERROR; goto done; } diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 2f50009..b5e2edf 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -115,7 +115,7 @@ Tk_FocusObjCmd( }; Tk_Window tkwin = clientData; TkWindow *winPtr = clientData; - TkWindow *newPtr, *focusWinPtr, *topLevelPtr; + TkWindow *newPtr, *topLevelPtr; ToplevelFocusInfo *tlFocusPtr; const char *windowName; int index; @@ -125,9 +125,10 @@ Tk_FocusObjCmd( */ if (objc == 1) { - focusWinPtr = TkGetFocusWin(winPtr); - if (focusWinPtr != NULL) { - Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC); + Tk_Window focusWin = (Tk_Window) TkGetFocusWin(winPtr); + + if (focusWin != NULL) { + Tcl_SetObjResult(interp, TkNewWindowObj(focusWin)); } return TCL_OK; } @@ -180,7 +181,7 @@ Tk_FocusObjCmd( } newPtr = TkGetFocusWin(newPtr); if (newPtr != NULL) { - Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) newPtr)); } break; case 1: /* -force */ @@ -213,12 +214,12 @@ Tk_FocusObjCmd( for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; tlFocusPtr = tlFocusPtr->nextPtr) { if (tlFocusPtr->topLevelPtr == topLevelPtr) { - Tcl_SetResult(interp, - tlFocusPtr->focusWinPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + tlFocusPtr->focusWinPtr)); return TCL_OK; } } - Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) topLevelPtr)); return TCL_OK; } break; diff --git a/generic/tkFont.c b/generic/tkFont.c index 32d0589..4485df8 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -439,7 +439,7 @@ TkFontPkgFree( hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&fiPtr->namedTable); - if (fiPtr->updatePending != 0) { + if (fiPtr->updatePending) { Tcl_CancelIdleCall(TheWorldHasChanged, fiPtr); } ckfree(fiPtr); @@ -569,6 +569,7 @@ Tk_FontObjCmd( -1, 40, "..."); Tcl_AppendToObj(resultPtr, "\"", -1); Tcl_SetObjResult(interp, resultPtr); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL); return TCL_ERROR; } uniChar = Tcl_GetUniChar(charPtr, 0); @@ -615,9 +616,10 @@ Tk_FontObjCmd( if (namedHashPtr != NULL) { nfPtr = Tcl_GetHashValue(namedHashPtr); } - if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) { - Tcl_AppendResult(interp, "named font \"", string, - "\" doesn't exist", NULL); + if ((namedHashPtr == NULL) || nfPtr->deletePending) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); return TCL_ERROR; } if (objc == 3) { @@ -670,7 +672,7 @@ Tk_FontObjCmd( if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } - Tcl_AppendResult(interp, name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); break; } case FONT_DELETE: { @@ -686,7 +688,7 @@ Tk_FontObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?"); return TCL_ERROR; } - for (i = 2; i < objc && result == TCL_OK; i++) { + for (i = 2; (i < objc) && (result == TCL_OK); i++) { string = Tcl_GetString(objv[i]); result = TkDeleteNamedFont(interp, tkwin, string); } @@ -726,8 +728,8 @@ Tk_FontObjCmd( return TCL_ERROR; } string = Tcl_GetStringFromObj(objv[3 + skip], &length); - Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tk_TextWidth(tkfont, string, length))); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tk_TextWidth(tkfont, string, length))); Tk_FreeFont(tkfont); break; } @@ -792,7 +794,7 @@ Tk_FontObjCmd( while (namedHashPtr != NULL) { NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr); - if (nfPtr->deletePending == 0) { + if (!nfPtr->deletePending) { char *string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr); @@ -853,7 +855,7 @@ UpdateDependentFonts( fontPtr != NULL; fontPtr = fontPtr->nextPtr) { if (fontPtr->namedHashPtr == namedHashPtr) { TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa); - if (fiPtr->updatePending == 0) { + if (!fiPtr->updatePending) { fiPtr->updatePending = 1; Tcl_DoWhenIdle(TheWorldHasChanged, fiPtr); } @@ -947,10 +949,11 @@ TkCreateNamedFont( namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &isNew); if (!isNew) { nfPtr = Tcl_GetHashValue(namedHashPtr); - if (nfPtr->deletePending == 0) { + if (!nfPtr->deletePending) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" already exists", name)); + Tcl_SetErrorCode(interp, "TK", "FONT", "EXISTS", NULL); } return TCL_ERROR; } @@ -1000,8 +1003,9 @@ TkDeleteNamedFont( namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name); if (namedHashPtr == NULL) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL); } return TCL_ERROR; } @@ -1183,8 +1187,10 @@ Tk_AllocFontFromObj( if (isNew) { Tcl_DeleteHashEntry(cacheHashPtr); } - Tcl_AppendResult(interp, "failed to allocate font due to ", - "internal system font engine problem", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "failed to allocate font due to internal system font engine" + " problem", -1)); + Tcl_SetErrorCode(interp, "TK", "FONT", "INTERNAL_PROBLEM", NULL); return NULL; } @@ -1421,7 +1427,7 @@ Tk_FreeFont( nfPtr = Tcl_GetHashValue(fontPtr->namedHashPtr); nfPtr->refCount--; - if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) { + if ((nfPtr->refCount == 0) && nfPtr->deletePending) { Tcl_DeleteHashEntry(fontPtr->namedHashPtr); ckfree(nfPtr); } @@ -1749,7 +1755,7 @@ Tk_PostscriptFontName( slantString = NULL; if (fontPtr->fa.slant == TK_FS_ROMAN) { - ; + /* Do nothing */ } else if ((strcmp(family, "Helvetica") == 0) || (strcmp(family, "Courier") == 0) || (strcmp(family, "AvantGarde") == 0)) { @@ -2137,7 +2143,7 @@ Tk_ComputeTextLayout( * on the next line. Otherwise "Hello" and "Hello\n" are the same height. */ - if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) { + if ((layoutPtr->numChunks > 0) && !(flags & TK_IGNORE_NEWLINES)) { if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') { chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX, curX, baseline); @@ -2899,7 +2905,7 @@ Tk_IntersectTextLayout( result = 0; for (i = 0; i < layoutPtr->numChunks; i++) { - if ((chunkPtr->start[0] == '\n') || (chunkPtr->numBytes==0)) { + if ((chunkPtr->start[0] == '\n') || (chunkPtr->numBytes == 0)) { /* * Newline characters and empty chunks are not counted when * computing area intersection (but tab characters would still be @@ -3235,121 +3241,92 @@ Tk_TextLayoutToPostscript( Tk_TextLayout layout) /* The layout to be rendered. */ { TextLayout *layoutPtr = (TextLayout *) layout; -#define MAXUSE 128 - char buf[MAXUSE+30]; - LayoutChunk *chunkPtr; - int i, j, used, baseline, charsize; - Tcl_UniChar ch; + LayoutChunk *chunkPtr = layoutPtr->chunks; + int baseline = chunkPtr->y; + Tcl_Obj *psObj = Tcl_NewObj(); + int i, j, len; const char *p, *glyphname; + char uindex[5], c, *ps; + Tcl_UniChar ch; - chunkPtr = layoutPtr->chunks; - baseline = chunkPtr->y; - used = 0; - buf[used++] = '['; - buf[used++] = '('; - for (i = 0; i < layoutPtr->numChunks; i++) { + Tcl_AppendToObj(psObj, "[(", -1); + for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) { if (baseline != chunkPtr->y) { - buf[used++] = ')'; - buf[used++] = ']'; - buf[used++] = '\n'; - buf[used++] = '['; - buf[used++] = '('; + Tcl_AppendToObj(psObj, ")]\n[(", -1); baseline = chunkPtr->y; } if (chunkPtr->numDisplayChars <= 0) { if (chunkPtr->start[0] == '\t') { - buf[used++] = '\\'; - buf[used++] = 't'; + Tcl_AppendToObj(psObj, "\\t", -1); } - } else { - p = chunkPtr->start; - for (j = 0; j < chunkPtr->numDisplayChars; j++) { + continue; + } + + for (p=chunkPtr->start, j=0; j<chunkPtr->numDisplayChars; j++) { + /* + * INTL: We only handle symbols that have an encoding as a glyph + * from the standard set defined by Adobe. The rest get punted. + * Eventually this should be revised to handle more sophsticiated + * international postscript fonts. + */ + + p += Tcl_UtfToUniChar(p, &ch); + if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) { /* - * INTL: We only handle symbols that have an encoding as a - * flyph from the standard set defined by Adobe. The rest get - * punted. Eventually this should be revised to handle more - * sophsticiated international postscript fonts. + * Tricky point: the "03" is necessary in the sprintf below, + * so that a full three digits of octal are always generated. + * Without the "03", a number following this sequence could be + * interpreted by Postscript as part of this sequence. */ - charsize = Tcl_UtfToUniChar(p, &ch); - p += charsize; - - if ((ch == '(') || (ch == ')') || (ch == '\\') - || (ch < 0x20)) { - /* - * Tricky point: the "03" is necessary in the sprintf - * below, so that a full three digits of octal are always - * generated. Without the "03", a number following this - * sequence could be interpreted by Postscript as part of - * this sequence. - */ + Tcl_AppendPrintfToObj(psObj, "\\%03o", ch); + continue; + } else if (ch <= 0x7f) { + /* + * Normal ASCII character. + */ - sprintf(buf + used, "\\%03o", ch); - used += 4; - } else if (ch <= 0x7f) { - /* - * Normal ASCII character. - */ + c = (char) ch; + Tcl_AppendToObj(psObj, &c, 1); + continue; + } - buf[used++] = (char) ch; - } else { - char uindex[5]; + /* + * This character doesn't belong to the ASCII character set, so we + * use the full glyph name. + */ + sprintf(uindex, "%04X", ch); /* endianness? */ + glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0); + if (glyphname) { + ps = Tcl_GetStringFromObj(psObj, &len); + if (ps[len-1] == '(') { /* - * This character doesn't belong to the ASCII character - * set, so we use the full glyph name. + * In-place edit. Ewww! */ - sprintf(uindex, "%04X", ch); /* endianness? */ - glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, - 0); - if (glyphname) { - if (used > 0 && buf[used-1] == '(') { - used--; - } else { - buf[used++] = ')'; - } - buf[used++] = '/'; - while ((*glyphname) && (used < MAXUSE+27)) { - buf[used++] = *glyphname++; - } - buf[used++] = '('; - } else { - /* - * No known mapping for the character into the space - * of PostScript glyphs. Ignore it. :-( - */ + ps[len-1] = '/'; + } else { + Tcl_AppendToObj(psObj, ")/", -1); + } + Tcl_AppendToObj(psObj, glyphname, -1); + Tcl_AppendToObj(psObj, "(", -1); + } else { + /* + * No known mapping for the character into the space of + * PostScript glyphs. Ignore it. :-( + */ #ifdef TK_DEBUG_POSTSCRIPT_OUTPUT - fprintf(stderr, "Warning: no mapping to PostScript " - "glyphs for \\u%04x\n", ch); + fprintf(stderr, "Warning: no mapping to PostScript " + "glyphs for \\u%04x\n", ch); #endif - } - } - if (used >= MAXUSE) { - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); - used = 0; - } } } - if (used >= MAXUSE) { - /* - * If there are a whole bunch of returns or tabs in a row, then - * buf[] could get filled up. - */ - - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); - used = 0; - } - chunkPtr++; } - buf[used++] = ')'; - buf[used++] = ']'; - buf[used++] = '\n'; - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); + Tcl_AppendToObj(psObj, ")]\n", -1); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* @@ -3403,8 +3380,10 @@ ConfigAttributesObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(optionPtr), "\" option missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" option missing", + Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "FONT", "NO_ATTRIBUTE", NULL); } return TCL_ERROR; } @@ -3598,7 +3577,7 @@ ParseFontNameObj( } dash = strchr(string + 1, '-'); if ((dash != NULL) - && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */ + && !isspace(UCHAR(dash[-1]))) { /* INTL: ISO space */ goto xlfd; } @@ -3646,8 +3625,9 @@ ParseFontNameObj( if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK) || (objc < 1)) { if (interp != NULL) { - Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); } return TCL_ERROR; } @@ -3694,8 +3674,10 @@ ParseFontNameObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "unknown font style \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown font style \"%s\"", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT_STYLE", + Tcl_GetString(objv[i]), NULL); } return TCL_ERROR; } @@ -3848,7 +3830,7 @@ TkFontParseXLFD( * parsed set of attributes)". */ - if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) { + if ((i > XLFD_ADD_STYLE) && FieldSpecified(field[XLFD_ADD_STYLE])) { if (atoi(field[XLFD_ADD_STYLE]) != 0) { for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) { field[j + 1] = field[j]; @@ -4077,7 +4059,6 @@ TkFontGetPoints( * platform expects when asking for the font. * * Results: - * As above. The return value is NULL if the font name has no aliases. * * Side effects: @@ -4247,12 +4228,11 @@ TkFontGetFirstTextLayout( Tk_Font *font, char *dst) { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr; int numBytesInChunk; - layoutPtr = (TextLayout *) layout; - if ((layoutPtr==NULL) || (layoutPtr->numChunks==0) + if ((layoutPtr == NULL) || (layoutPtr->numChunks == 0) || (layoutPtr->chunks->numDisplayChars <= 0)) { dst[0] = '\0'; return 0; diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 55f5d51..8bc44ce 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -334,8 +334,8 @@ static void MapFrame(ClientData clientData); static const Tk_ClassProcs frameClass = { sizeof(Tk_ClassProcs), /* size */ FrameWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -465,7 +465,7 @@ CreateFrame( Tk_Window newWin; const char *className, *screenName, *visualName, *colormapName; const char *arg, *useOption; - int i, c, length, depth; + int i, length, depth; unsigned int mask; Colormap colormap; Visual *visual; @@ -496,20 +496,19 @@ CreateFrame( if (length < 2) { continue; } - c = arg[1]; - if ((c == 'c') && (length >= 3) + if ((arg[1] == 'c') && (length >= 3) && (strncmp(arg, "-class", (unsigned) length) == 0)) { className = Tcl_GetString(objv[i+1]); - } else if ((c == 'c') + } else if ((arg[1] == 'c') && (length >= 3) && (strncmp(arg, "-colormap", (unsigned) length) == 0)) { colormapName = Tcl_GetString(objv[i+1]); - } else if ((c == 's') && (type == TYPE_TOPLEVEL) + } else if ((arg[1] == 's') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-screen", (unsigned) length) == 0)) { screenName = Tcl_GetString(objv[i+1]); - } else if ((c == 'u') && (type == TYPE_TOPLEVEL) + } else if ((arg[1] == 'u') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-use", (unsigned) length) == 0)) { useOption = Tcl_GetString(objv[i+1]); - } else if ((c == 'v') + } else if ((arg[1] == 'v') && (strncmp(arg, "-visual", (unsigned) length) == 0)) { visualName = Tcl_GetString(objv[i+1]); } @@ -548,9 +547,10 @@ CreateFrame( * are being destroyed. Let an error be thrown. */ - Tcl_AppendResult(interp, "unable to create widget \"", - Tcl_GetString(objv[1]), "\"", NULL); - newWin = NULL; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to create widget \"%s\"", Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "APPLICATION_GONE", NULL); + return TCL_ERROR; } else { /* * We were called from Tk_Init; create a new application. @@ -560,13 +560,14 @@ CreateFrame( } if (newWin == NULL) { goto error; - } else { - /* - * Mark Tk frames as suitable candidates for [wm manage] - */ - TkWindow *winPtr = (TkWindow *)newWin; - winPtr->flags |= TK_WM_MANAGEABLE; } + + /* + * Mark Tk frames as suitable candidates for [wm manage]. + */ + + ((TkWindow *) newWin)->flags |= TK_WM_MANAGEABLE; + if (className == NULL) { className = Tk_GetOption(newWin, "class", "Class"); if (className == NULL) { @@ -577,10 +578,9 @@ CreateFrame( if (useOption == NULL) { useOption = Tk_GetOption(newWin, "use", "Use"); } - if ((useOption != NULL) && (*useOption != 0)) { - if (TkpUseWindow(interp, newWin, useOption) != TCL_OK) { - goto error; - } + if ((useOption != NULL) && (*useOption != 0) + && (TkpUseWindow(interp, newWin, useOption) != TCL_OK)) { + goto error; } if (visualName == NULL) { visualName = Tk_GetOption(newWin, "visual", "Visual"); @@ -630,12 +630,11 @@ CreateFrame( framePtr = ckalloc(sizeof(Frame)); memset(framePtr, 0, sizeof(Frame)); } - framePtr->tkwin = newWin; - framePtr->display = Tk_Display(newWin); - framePtr->interp = interp; - framePtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(newWin), FrameWidgetObjCmd, framePtr, - FrameCmdDeletedProc); + framePtr->tkwin = newWin; + framePtr->display = Tk_Display(newWin); + framePtr->interp = interp; + framePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(newWin), + FrameWidgetObjCmd, framePtr, FrameCmdDeletedProc); framePtr->optionTable = optionTable; framePtr->type = type; framePtr->colormap = colormap; @@ -665,14 +664,15 @@ CreateFrame( (ConfigureFrame(interp, framePtr, objc-2, objv+2) != TCL_OK)) { goto error; } - if ((framePtr->isContainer)) { - if (framePtr->useThis == NULL) { - TkpMakeContainer(framePtr->tkwin); - } else { - Tcl_AppendResult(interp, "A window cannot have both the -use ", - "and the -container option set.", NULL); + if (framePtr->isContainer) { + if (framePtr->useThis != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "windows cannot have both the -use and the -container" + " option set", -1)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CONTAINMENT", NULL); goto error; } + TkpMakeContainer(framePtr->tkwin); } if (type == TYPE_TOPLEVEL) { Tcl_DoWhenIdle(MapFrame, framePtr); @@ -765,6 +765,7 @@ FrameWidgetObjCmd( for (i = 2; i < objc; i++) { const char *arg = Tcl_GetStringFromObj(objv[i], &length); + if (length < 2) { continue; } @@ -785,23 +786,22 @@ FrameWidgetObjCmd( #ifdef SUPPORT_CONFIG_EMBEDDED if (c == 'u') { const char *string = Tcl_GetString(objv[i+1]); + if (TkpUseWindow(interp, framePtr->tkwin, string) != TCL_OK) { result = TCL_ERROR; goto done; } - } else { - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; + continue; } -#else - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; #endif + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't modify %s option after widget is created", + arg)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CREATE_ONLY", + NULL); + result = TCL_ERROR; + goto done; } } result = ConfigureFrame(interp, framePtr, objc-2, objv+2); @@ -1011,19 +1011,14 @@ ConfigureFrame( } sibling = ancestor; if (Tk_IsTopLevel(ancestor)) { - badWindow: - Tcl_AppendResult(interp, "can't use ", - Tk_PathName(labelframePtr->labelWin), - " as label in this frame", NULL); - labelframePtr->labelWin = NULL; - return TCL_ERROR; + goto badLabelWindow; } } if (Tk_IsTopLevel(labelframePtr->labelWin)) { - goto badWindow; + goto badLabelWindow; } if (labelframePtr->labelWin == framePtr->tkwin) { - goto badWindow; + goto badLabelWindow; } Tk_CreateEventHandler(labelframePtr->labelWin, StructureNotifyMask, FrameStructureProc, framePtr); @@ -1044,6 +1039,14 @@ ConfigureFrame( FrameWorldChanged(framePtr); return TCL_OK; + + badLabelWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as label in this frame", + Tk_PathName(labelframePtr->labelWin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); + labelframePtr->labelWin = NULL; + return TCL_ERROR; } /* diff --git a/generic/tkGeometry.c b/generic/tkGeometry.c index 2c6c113..2e0009a 100644 --- a/generic/tkGeometry.c +++ b/generic/tkGeometry.c @@ -321,7 +321,8 @@ Tk_SetMinimumRequestSize( int TkSetGeometryMaster( Tcl_Interp *interp, /* Current interpreter, for error. */ - Tk_Window tkwin, /* Window that will have geometry master set. */ + Tk_Window tkwin, /* Window that will have geometry master + * set. */ const char *master) /* The master identity. */ { register TkWindow *winPtr = (TkWindow *) tkwin; @@ -332,10 +333,11 @@ TkSetGeometryMaster( } if (winPtr->geometryMaster != NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "cannot use geometry manager ", master, - " inside ", Tk_PathName(tkwin), - " which already has slaves managed by ", - winPtr->geometryMaster, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot use geometry manager %s inside %s which already" + " has slaves managed by %s", + master, Tk_PathName(tkwin), winPtr->geometryMaster)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "FIGHT", NULL); } return TCL_ERROR; } @@ -364,8 +366,9 @@ TkSetGeometryMaster( void TkFreeGeometryMaster( - Tk_Window tkwin, /* Window that will have geometry master cleared. */ - const char *master) /* The master identity. */ + Tk_Window tkwin, /* Window that will have geometry master + * cleared. */ + const char *master) /* The master identity. */ { register TkWindow *winPtr = (TkWindow *) tkwin; diff --git a/generic/tkGet.c b/generic/tkGet.c index bd63971..d58b4a5 100644 --- a/generic/tkGet.c +++ b/generic/tkGet.c @@ -152,8 +152,10 @@ Tk_GetAnchor( } error: - Tcl_AppendResult(interp, "bad anchor position \"", string, - "\": must be n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad anchor position \"%s\": must be" + " n, ne, e, se, s, sw, w, nw, or center", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ANCHOR", NULL); return TCL_ERROR; } @@ -237,8 +239,10 @@ Tk_GetJoinStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad join style \"", string, - "\": must be bevel, miter, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad join style \"%s\": must be bevel, miter, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JOIN", NULL); return TCL_ERROR; } @@ -316,8 +320,10 @@ Tk_GetCapStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad cap style \"", string, - "\": must be butt, projecting, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cap style \"%s\": must be butt, projecting, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CAP", NULL); return TCL_ERROR; } @@ -432,8 +438,10 @@ Tk_GetJustify( return TCL_OK; } - Tcl_AppendResult(interp, "bad justification \"", string, - "\": must be left, right, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad justification \"%s\": must be left, right, or center", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JUSTIFY", NULL); return TCL_ERROR; } @@ -568,9 +576,7 @@ Tk_GetScreenMM( d = strtod(string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -606,6 +612,12 @@ Tk_GetScreenMM( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCREEN_DISTANCE", NULL); + return TCL_ERROR; } /* @@ -684,9 +696,7 @@ TkGetDoublePixels( d = strtod((char *) string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -725,6 +735,12 @@ TkGetDoublePixels( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL); + return TCL_ERROR; } /* diff --git a/generic/tkGrab.c b/generic/tkGrab.c index 695690b..2df5552 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -211,10 +211,15 @@ Tk_GrabObjCmd( * is "grab", but if it has been aliased, the message will be * incorrect. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "wrong # args: should be \"", - Tcl_GetString(objv[0]), " ?-global? window\" or \"", - Tcl_GetString(objv[0]), " option ?arg ...?\"", NULL); + + Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), + " option ?arg ...?\"", NULL); + /* This API not exposed: + * + ((Interp *) interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS; + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); + */ return TCL_ERROR; } @@ -277,17 +282,20 @@ Tk_GrabObjCmd( } dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName, - TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + dispPtr->eventualGrabWinPtr)); } } else { + Tcl_Obj *resultObj = Tcl_NewObj(); + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_AppendElement(interp, - dispPtr->eventualGrabWinPtr->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, TkNewWindowObj( + (Tk_Window) dispPtr->eventualGrabWinPtr)); } } + Tcl_SetObjResult(interp, resultObj); } return TCL_OK; @@ -340,6 +348,7 @@ Tk_GrabObjCmd( case GRABCMD_STATUS: { /* [grab status window] */ TkWindow *winPtr; + const char *statusString; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "status window"); @@ -352,12 +361,13 @@ Tk_GrabObjCmd( } dispPtr = winPtr->dispPtr; if (dispPtr->eventualGrabWinPtr != winPtr) { - Tcl_SetResult(interp, "none", TCL_STATIC); + statusString = "none"; } else if (dispPtr->grabFlags & GRAB_GLOBAL) { - Tcl_SetResult(interp, "global", TCL_STATIC); + statusString = "global"; } else { - Tcl_SetResult(interp, "local", TCL_STATIC); + statusString = "local"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(statusString, -1)); break; } } @@ -410,10 +420,7 @@ Tk_Grab( return TCL_OK; } if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) { - alreadyGrabbed: - Tcl_SetResult(interp, "grab failed: another application has grab", - TCL_STATIC); - return TCL_ERROR; + goto alreadyGrabbed; } Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr); } @@ -423,7 +430,7 @@ Tk_Grab( if (!grabGlobal) #else if (0) -#endif +#endif /* MAC_OSX_TK */ { Window dummy1, dummy2; int dummy3, dummy4, dummy5, dummy6; @@ -440,7 +447,7 @@ Tk_Grab( dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL); XQueryPointer(dispPtr->display, winPtr->window, &dummy1, &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state); - if ((state & ALL_BUTTONS) != 0) { + if (state & ALL_BUTTONS) { dispPtr->grabFlags |= GRAB_TEMP_GLOBAL; goto setGlobalGrab; } @@ -479,26 +486,7 @@ Tk_Grab( Tcl_Sleep(100); } if (grabResult != 0) { - grabError: - if (grabResult == GrabNotViewable) { - Tcl_SetResult(interp, "grab failed: window not viewable", - TCL_STATIC); - } else if (grabResult == AlreadyGrabbed) { - goto alreadyGrabbed; - } else if (grabResult == GrabFrozen) { - Tcl_SetResult(interp, - "grab failed: keyboard or pointer frozen", TCL_STATIC); - } else if (grabResult == GrabInvalidTime) { - Tcl_SetResult(interp, "grab failed: invalid time", - TCL_STATIC); - } else { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "grab failed for unknown reason (code %d)", - grabResult); - Tcl_AppendResult(interp, msg, NULL); - } - return TCL_ERROR; + goto grabError; } grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin), False, GrabModeAsync, GrabModeAsync, CurrentTime); @@ -546,6 +534,31 @@ Tk_Grab( } QueueGrabWindowChange(dispPtr, winPtr); return TCL_OK; + + grabError: + if (grabResult == GrabNotViewable) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: window not viewable", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL); + } else if (grabResult == AlreadyGrabbed) { + alreadyGrabbed: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: another application has grab", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL); + } else if (grabResult == GrabFrozen) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: keyboard or pointer frozen", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL); + } else if (grabResult == GrabInvalidTime) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: invalid time", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "BAD_TIME", NULL); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "grab failed for unknown reason (code %d)", grabResult)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNKNOWN", NULL); + } + return TCL_ERROR; } /* @@ -846,7 +859,7 @@ TkPointerEvent( } } if (eventPtr->type == ButtonPress) { - if ((eventPtr->xbutton.state & ALL_BUTTONS) == 0) { + if (!(eventPtr->xbutton.state & ALL_BUTTONS)) { if (outsideGrabTree) { TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr); Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD); diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 70d463e..19e4442 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -301,7 +301,7 @@ static int SetSlaveColumn(Tcl_Interp *interp, Gridder *slavePtr, int column, int numCols); static int SetSlaveRow(Tcl_Interp *interp, Gridder *slavePtr, int row, int numRows); -static void StickyToString(int flags, char *result); +static Tcl_Obj * StickyToObj(int flags); static int StringToSticky(const char *string); static void Unlink(Gridder *gridPtr); @@ -402,7 +402,8 @@ Tk_GridObjCmd( } /* This should not happen */ - Tcl_SetResult(interp, "Internal error in grid.", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("internal error in grid", -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } @@ -447,8 +448,9 @@ GridAnchorCommand( if (objc == 3) { gridPtr = masterPtr->masterDataPtr; - Tcl_SetResult(interp, (char *) Tk_NameOfAnchor(gridPtr == NULL ? - GRID_DEFAULT_ANCHOR : gridPtr->anchor), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfAnchor(gridPtr?gridPtr->anchor:GRID_DEFAULT_ANCHOR), + -1)); return TCL_OK; } @@ -720,7 +722,7 @@ GridInfoCommand( { register Gridder *slavePtr; Tk_Window slave; - char buffer[64 + TCL_INTEGER_SPACE * 4]; + Tcl_Obj *infoObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -735,18 +737,24 @@ GridInfoCommand( return TCL_OK; } - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); - sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d", - slavePtr->column, slavePtr->row, - slavePtr->numCols, slavePtr->numRows); - Tcl_AppendResult(interp, buffer, NULL); - TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX); - TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY); - TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX); - TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY); - StickyToString(slavePtr->sticky, buffer); - Tcl_AppendResult(interp, " -sticky ", buffer, NULL); + infoObj = Tcl_NewObj(); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1), + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-column", -1), + Tcl_NewIntObj(slavePtr->column)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-row", -1), + Tcl_NewIntObj(slavePtr->row)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-columnspan", -1), + Tcl_NewIntObj(slavePtr->numCols)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-rowspan", -1), + Tcl_NewIntObj(slavePtr->numRows)); + TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX); + TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY); + TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft, slavePtr->padX); + TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-sticky", -1), + StickyToObj(slavePtr->sticky)); + Tcl_SetObjResult(interp, infoObj); return TCL_OK; } @@ -994,9 +1002,9 @@ GridRowColumnConfigureCommand( string = Tcl_GetString(objv[1]); slotType = (*string == 'c') ? COLUMN : ROW; if (lObjc == 0) { - Tcl_AppendResult(interp, "no ", - (slotType == COLUMN) ? "column" : "row", - " indices specified", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("no %s indices specified", + (slotType == COLUMN) ? "column" : "row")); + Tcl_SetErrorCode(interp, "TK", "GRID", "NO_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1007,16 +1015,17 @@ GridRowColumnConfigureCommand( if ((objc == 4) || (objc == 5)) { if (lObjc != 1) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), - ": must specify a single element on retrieval", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify a single element on retrieval", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, lObjv[0], &slot) != TCL_OK) { Tcl_AppendResult(interp, - " (when retreiving options only integer indices are " + " (when retrieving options only integer indices are " "allowed)", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1073,19 +1082,19 @@ GridRowColumnConfigureCommand( return TCL_ERROR; } if (index == ROWCOL_MINSIZE) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].minSize : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].minSize : 0)); } else if (index == ROWCOL_WEIGHT) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].weight : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].weight : 0)); } else if (index == ROWCOL_UNIFORM) { Tk_Uid value = (ok == TCL_OK) ? slotPtr[slot].uniform : ""; - Tcl_SetObjResult(interp, - Tcl_NewStringObj(value == NULL ? "" : value, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (value == NULL) ? "" : value, -1)); } else if (index == ROWCOL_PAD) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].pad : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].pad : 0)); } Tcl_DecrRefCount(listCopy); return TCL_OK; @@ -1118,17 +1127,17 @@ GridRowColumnConfigureCommand( slavePtr = GetGrid(slave); if (slavePtr->masterPtr != masterPtr) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": the window \"", - Tcl_GetString(lObjv[j]), "\" is not managed by \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the window \"%s\" is not managed by \"%s\"", + Tcl_GetString(lObjv[j]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NOT_MASTER", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } } else { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": illegal index \"", - Tcl_GetString(lObjv[j]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "illegal index \"%s\"", Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1148,10 +1157,11 @@ GridRowColumnConfigureCommand( for (slot = first; slot <= last; slot++) { ok = CheckSlotData(masterPtr, slot, slotType, /*checkOnly*/ 0); if (ok != TCL_OK) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": \"", - Tcl_GetString(lObjv[j]), - "\" is out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is out of range", + Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", + NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1185,11 +1195,8 @@ GridRowColumnConfigureCommand( Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (wt < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + goto negativeIndex; } else { slotPtr[slot].weight = wt; } @@ -1206,11 +1213,8 @@ GridRowColumnConfigureCommand( Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (size < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + goto negativeIndex; } else { slotPtr[slot].pad = size; } @@ -1259,6 +1263,13 @@ GridRowColumnConfigureCommand( Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } return TCL_OK; + + negativeIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid arg \"%s\": should be non-negative", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); + return TCL_ERROR; } /* @@ -1361,8 +1372,9 @@ GridSlavesCommand( return TCL_ERROR; } if (value < 0) { - Tcl_AppendResult(interp, Tcl_GetString(objv[i]), - " is an invalid value: should NOT be < 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%d is an invalid value: should NOT be < 0", value)); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); return TCL_ERROR; } if (index == SLAVES_COLUMN) { @@ -1380,11 +1392,11 @@ GridSlavesCommand( res = Tcl_NewListObj(0, NULL); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - if (column>=0 && (slavePtr->column > column + if ((column >= 0) && (slavePtr->column > column || slavePtr->column+slavePtr->numCols-1 < column)) { continue; } - if (row>=0 && (slavePtr->row > row || + if ((row >= 0) && (slavePtr->row > row || slavePtr->row+slavePtr->numRows-1 < row)) { continue; } @@ -2528,7 +2540,8 @@ SetSlaveColumn( lastCol = ((newColumn >= 0) ? newColumn : 0) + newNumCols; if (lastCol >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Column out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("column out of bounds",-1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_COLUMN", NULL); return TCL_ERROR; } @@ -2568,7 +2581,8 @@ SetSlaveRow( lastRow = ((newRow >= 0) ? newRow : 0) + newNumRows; if (lastRow >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Row out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("row out of bounds", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_ROW", NULL); return TCL_ERROR; } @@ -2992,24 +3006,27 @@ ConfigureSlaves( continue; } if (length > 1 && i == 0) { - Tcl_AppendResult(interp, "bad argument \"", string, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (length > 1 && firstChar == '-') { break; } if (length > 1) { - Tcl_AppendResult(interp, "unexpected parameter, \"", - string, "\", in configure list. ", - "Should be window name or option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unexpected parameter \"%s\" in configure list:" + " should be window name or option", string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if ((firstChar == REL_HORIZ) && ((numWindows == 0) || (prevChar == REL_SKIP) || (prevChar == REL_VERT))) { - Tcl_AppendResult(interp, - "Must specify window before shortcut '-'.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify window before shortcut '-'", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3018,14 +3035,18 @@ ConfigureSlaves( continue; } - Tcl_AppendResult(interp, "invalid window shortcut, \"", - string, "\" should be '-', 'x', or '^'", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid window shortcut, \"%s\" should be '-', 'x', or '^'", + string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } numWindows = i; if ((objc - numWindows) & 1) { - Tcl_AppendResult(interp, "extra option or option with no value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra option or option with no value", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3051,10 +3072,10 @@ ConfigureSlaves( } else if (index == CONF_ROW) { if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "POSITIVE_INT", NULL); return TCL_ERROR; } defaultRow = tmp; @@ -3116,8 +3137,10 @@ ConfigureSlaves( } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't manage \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetGrid(slave); @@ -3144,9 +3167,10 @@ ConfigureSlaves( case CONF_COLUMN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad column value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad column value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3156,9 +3180,10 @@ ConfigureSlaves( case CONF_COLUMNSPAN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp <= 0) { - Tcl_AppendResult(interp, "bad columnspan value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad columnspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3171,8 +3196,9 @@ ConfigureSlaves( return TCL_ERROR; } if (other == slave) { - Tcl_SetResult(interp, "Window can't be managed in itself", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "window can't be managed in itself", -1)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } positionGiven = 1; @@ -3183,9 +3209,11 @@ ConfigureSlaves( int sticky = StringToSticky(Tcl_GetString(objv[i+1])); if (sticky == -1) { - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a string containing n, e, s, and/or w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be" + " a string containing n, e, s, and/or w", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } slavePtr->sticky = sticky; @@ -3194,9 +3222,10 @@ ConfigureSlaves( case CONF_IPADX: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; @@ -3204,9 +3233,10 @@ ConfigureSlaves( case CONF_IPADY: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -3226,9 +3256,10 @@ ConfigureSlaves( case CONF_ROW: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), - "\": must be a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3238,9 +3269,10 @@ ConfigureSlaves( case CONF_ROWSPAN: if ((Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK) || tmp <= 0) { - Tcl_AppendResult(interp, "bad rowspan value \"", - Tcl_GetString(objv[i+1]), - "\": must be a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad rowspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3305,8 +3337,10 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3317,9 +3351,10 @@ ConfigureSlaves( */ if (masterPtr->masterPtr == slavePtr) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), - ", would cause management loop.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s, would cause management loop", + Tcl_GetString(objv[j]), Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3379,8 +3414,8 @@ ConfigureSlaves( numSkip = 0; for (j = 0; j < numWindows; j++) { struct Gridder *otherPtr; - int match; /* Found a match for the ^ */ - int lastRow, lastColumn; /* Implied end of table. */ + int match; /* Found a match for the ^ */ + int lastRow, lastColumn; /* Implied end of table. */ string = Tcl_GetString(objv[j]); firstChar = string[0]; @@ -3397,7 +3432,9 @@ ConfigureSlaves( } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't use '^', cant find master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't use '^', cant find master", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3449,14 +3486,17 @@ ConfigureSlaves( } } if (!match) { - Tcl_AppendResult(interp, "can't find slave to extend with \"^\".", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find slave to extend with \"^\"", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't determine master window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't determine master window", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } SetGridSize(masterPtr); @@ -3477,13 +3517,13 @@ ConfigureSlaves( /* *---------------------------------------------------------------------- * - * StickyToString + * StickyToObj * * Converts the internal boolean combination of "sticky" bits onto a Tcl * list element containing zero or more of n, s, e, or w. * * Results: - * A string is placed into the "result" pointer. + * A new object is returned that holds the sticky representation. * * Side effects: * none. @@ -3491,29 +3531,26 @@ ConfigureSlaves( *---------------------------------------------------------------------- */ -static void -StickyToString( - int flags, /* The sticky flags. */ - char *result) /* Where to put the result. */ +static Tcl_Obj * +StickyToObj( + int flags) /* The sticky flags. */ { int count = 0; - if (flags&STICK_NORTH) { - result[count++] = 'n'; - } - if (flags&STICK_EAST) { - result[count++] = 'e'; + char buffer[4]; + + if (flags & STICK_NORTH) { + buffer[count++] = 'n'; } - if (flags&STICK_SOUTH) { - result[count++] = 's'; + if (flags & STICK_EAST) { + buffer[count++] = 'e'; } - if (flags&STICK_WEST) { - result[count++] = 'w'; + if (flags & STICK_SOUTH) { + buffer[count++] = 's'; } - if (count) { - result[count] = '\0'; - } else { - sprintf(result, "{}"); + if (flags & STICK_WEST) { + buffer[count++] = 'w'; } + return Tcl_NewStringObj(buffer, count); } /* diff --git a/generic/tkImage.c b/generic/tkImage.c index 5fa3671..ffa6f22 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -225,6 +225,7 @@ Tk_ImageObjCmd( char idString[16 + TCL_INTEGER_SPACE]; TkDisplay *dispPtr = winPtr->dispPtr; const char *arg, *name; + Tcl_Obj *resultObj; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -271,8 +272,9 @@ Tk_ImageObjCmd( } } if (typePtr == NULL) { - Tcl_AppendResult(interp, "image type \"", arg, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image type \"%s\" doesn't exist", arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", arg, NULL); return TCL_ERROR; } @@ -304,8 +306,10 @@ Tk_ImageObjCmd( topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name); if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { - Tcl_AppendResult(interp, "images may not be named the ", - "same as the main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "images may not be named the same as the main window", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL); return TCL_ERROR; } } @@ -387,9 +391,8 @@ Tk_ImageObjCmd( imagePtr->instanceData = typePtr->getProc(imagePtr->tkwin, masterPtr->masterData); } - Tcl_SetResult(interp, - Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); break; } case IMAGE_DELETE: @@ -412,28 +415,34 @@ Tk_ImageObjCmd( return TCL_ERROR; } hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); + resultObj = Tcl_NewObj(); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { continue; } - Tcl_AppendElement(interp, Tcl_GetHashKey( - &winPtr->mainPtr->imageTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_TYPES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_HEIGHT: @@ -490,7 +499,8 @@ Tk_ImageObjCmd( return TCL_OK; alreadyDeleted: - Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" doesn't exist",arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", arg, NULL); return TCL_ERROR; } @@ -630,7 +640,9 @@ Tk_GetImage( noSuchImage: if (interp) { - Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", name, NULL); } return NULL; } diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 82374cb..cdd57dd 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -152,7 +152,7 @@ static void ImgBmapConfigureInstance(BitmapInstance *instancePtr); static int ImgBmapConfigureMaster(BitmapMaster *masterPtr, int argc, Tcl_Obj *const objv[], int flags); static int NextBitmapWord(ParseInfo *parseInfoPtr); - + /* *---------------------------------------------------------------------- * @@ -207,7 +207,7 @@ ImgBmapCreate( *clientDataPtr = masterPtr; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -242,7 +242,7 @@ ImgBmapConfigureMaster( const char **argv = ckalloc((objc+1) * sizeof(char *)); for (dummy1 = 0; dummy1 < objc; dummy1++) { - argv[dummy1]=Tcl_GetString(objv[dummy1]); + argv[dummy1] = Tcl_GetString(objv[dummy1]); } argv[objc] = NULL; @@ -277,8 +277,10 @@ ImgBmapConfigureMaster( if ((masterPtr->maskFileString != NULL) || (masterPtr->maskDataString != NULL)) { if (masterPtr->data == NULL) { - Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap", - TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "can't have mask without bitmap", -1)); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "NO_BITMAP", NULL); return TCL_ERROR; } masterPtr->maskData = TkGetBitmapData(masterPtr->interp, @@ -291,8 +293,10 @@ ImgBmapConfigureMaster( || (maskHeight != masterPtr->height)) { ckfree(masterPtr->maskData); masterPtr->maskData = NULL; - Tcl_SetResult(masterPtr->interp, - "bitmap and mask have different sizes", TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "bitmap and mask have different sizes", -1)); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "MASK_SIZE", NULL); return TCL_ERROR; } } @@ -311,7 +315,7 @@ ImgBmapConfigureMaster( masterPtr->height, masterPtr->width, masterPtr->height); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -446,7 +450,7 @@ ImgBmapConfigureInstance( masterPtr->tkMaster))); Tcl_BackgroundError(masterPtr->interp); } - + /* *---------------------------------------------------------------------- * @@ -473,7 +477,7 @@ char * TkGetBitmapData( Tcl_Interp *interp, /* For reporting errors, or NULL. */ const char *string, /* String describing bitmap. May be NULL. */ - const char *fileName, /* Name of file containing bitmap description. + const char *fileName, /* Name of file containing bitmap description. * Used only if string is NULL. Must not be * NULL if string is NULL. */ int *widthPtr, int *heightPtr, @@ -490,8 +494,10 @@ TkGetBitmapData( pi.string = string; if (string == NULL) { if ((interp != NULL) && Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get bitmap data from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get bitmap data from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); return NULL; } expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer); @@ -503,8 +509,9 @@ TkGetBitmapData( if (pi.chan == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read bitmap file \"", - fileName, "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read bitmap file \"%s\": %s", + fileName, Tcl_PosixError(interp))); } return NULL; } @@ -593,8 +600,11 @@ TkGetBitmapData( } } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) { if (interp != NULL) { - Tcl_AppendResult(interp, "format error in bitmap data; ", - "looks like it's an obsolete X10 bitmap file", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data; looks like it's an" + " obsolete X10 bitmap file", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OBSOLETE", + NULL); } goto errorCleanup; } @@ -636,7 +646,9 @@ TkGetBitmapData( error: if (interp != NULL) { - Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "FORMAT", NULL); } errorCleanup: @@ -648,7 +660,7 @@ TkGetBitmapData( } return NULL; } - + /* *---------------------------------------------------------------------- * @@ -718,7 +730,7 @@ NextBitmapWord( parseInfoPtr->word[parseInfoPtr->wordLength] = 0; return TCL_OK; } - + /* *-------------------------------------------------------------- * @@ -781,7 +793,7 @@ ImgBmapCmd( return TCL_OK; } } - + /* *---------------------------------------------------------------------- * @@ -852,7 +864,7 @@ ImgBmapGet( return instancePtr; } - + /* *---------------------------------------------------------------------- * @@ -912,7 +924,7 @@ ImgBmapDisplay( XSetClipOrigin(display, instancePtr->gc, 0, 0); } } - + /* *---------------------------------------------------------------------- * @@ -975,7 +987,7 @@ ImgBmapFree( } ckfree(instancePtr); } - + /* *---------------------------------------------------------------------- * @@ -1016,7 +1028,7 @@ ImgBmapDelete( Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0); ckfree(masterPtr); } - + /* *---------------------------------------------------------------------- * @@ -1046,7 +1058,7 @@ ImgBmapCmdDeletedProc( Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster)); } } - + /* *---------------------------------------------------------------------- * @@ -1077,8 +1089,7 @@ GetByte( return buffer; } } - - + /* *---------------------------------------------------------------------- * @@ -1100,28 +1111,22 @@ GetByte( * 3. The postscript coordinate system has been scaled so that the * entire bitmap is one unit squared. * - * Some postscript implementations cannot handle bitmap strings longer - * than about 60k characters. If the bitmap data is that big or bigger, - * then we render it by splitting it into several smaller bitmaps. - * * Results: - * Returns TCL_OK on success. Returns TCL_ERROR and leaves and error - * message in interp->result if there is a problem. + * None. * * Side effects: - * Postscript code is appended to interp->result. + * Postscript code is appended to psObj. * *---------------------------------------------------------------------- */ -static int +static void ImgBmapPsImagemask( - Tcl_Interp *interp, /* Append postscript to this interpreter */ + Tcl_Obj *psObj, /* Append postscript to this buffer. */ int width, int height, /* Width and height of the bitmap in pixels */ - char *data) /* Data for the bitmap */ + char *data) /* Data for the bitmap. */ { int i, j, nBytePerRow; - char buffer[200]; /* * The bit order of bitmaps in Tk is the opposite of the bit order that @@ -1150,31 +1155,22 @@ ImgBmapPsImagemask( 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255, }; - if (width*height > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unable to generate postscript for bitmaps " - "larger than 60000 pixels", NULL); - return TCL_ERROR; - } - - sprintf(buffer, "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n", + Tcl_AppendPrintfToObj(psObj, + "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n", width, height, width, -height, height); - Tcl_AppendResult(interp, buffer, NULL); - nBytePerRow = (width+7)/8; - for(i=0; i<height; i++){ - for(j=0; j<nBytePerRow; j++){ - sprintf(buffer, " %02x", + nBytePerRow = (width + 7) / 8; + for (i=0; i<height; i++) { + for (j=0; j<nBytePerRow; j++) { + Tcl_AppendPrintfToObj(psObj, " %02x", bit_reverse[0xff & data[i*nBytePerRow + j]]); - Tcl_AppendResult(interp, buffer, NULL); } - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - Tcl_AppendResult(interp, ">} imagemask \n", NULL); - return TCL_OK; + Tcl_AppendToObj(psObj, ">} imagemask \n", -1); } - + /* *---------------------------------------------------------------------- * @@ -1183,7 +1179,6 @@ ImgBmapPsImagemask( * This procedure generates postscript for rendering a bitmap image. * * Results: - * On success, this routine writes postscript code into interp->result * and returns TCL_OK TCL_ERROR is returned and an error message is left * in interp->result if anything goes wrong. @@ -1204,7 +1199,8 @@ ImgBmapPostscript( int prepass) { BitmapMaster *masterPtr = clientData; - char buffer[200]; + Tcl_InterpState interpState; + Tcl_Obj *psObj; if (prepass) { return TCL_OK; @@ -1214,11 +1210,32 @@ ImgBmapPostscript( * There is nothing to do for bitmaps with zero width or height. */ - if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<= 0){ + if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0){ return TCL_OK; } /* + * Some postscript implementations cannot handle bitmap strings longer + * than about 60k characters. If the bitmap data is that big or bigger, + * we bail out. + */ + + if (masterPtr->width*masterPtr->height > 60000) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to generate postscript for bitmaps larger than 60000" + " pixels", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + return TCL_ERROR; + } + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Translate the origin of the coordinate system to be the lower-left * corner of the bitmap and adjust the scale of the coordinate system so * that entire bitmap covers one square unit of the page. The calling @@ -1227,13 +1244,11 @@ ImgBmapPostscript( * necessary here. */ - if (x!=0 || y!=0) { - sprintf(buffer, "%d %d moveto\n", x, y); - Tcl_AppendResult(interp, buffer, NULL); + if (x != 0 || y != 0) { + Tcl_AppendPrintfToObj(psObj, "%d %d moveto\n", x, y); } - if (width!=1 || height!=1) { - sprintf(buffer, "%d %d scale\n", width, height); - Tcl_AppendResult(interp, buffer, NULL); + if (width != 1 || height != 1) { + Tcl_AppendPrintfToObj(psObj, "%d %d scale\n", width, height); } /* @@ -1249,16 +1264,19 @@ ImgBmapPostscript( TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid, &color); + Tcl_ResetResult(interp); if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (masterPtr->maskData == NULL) { - Tcl_AppendResult(interp, - "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto ", - "closepath fill\n", NULL); - } else if (ImgBmapPsImagemask(interp, masterPtr->width, - masterPtr->height, masterPtr->maskData) != TCL_OK) { - return TCL_ERROR; + Tcl_AppendToObj(psObj, + "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto " + "closepath fill\n", -1); + } else { + ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height, + masterPtr->maskData); } } @@ -1271,17 +1289,31 @@ ImgBmapPostscript( TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid, &color); + Tcl_ResetResult(interp); if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) { - return TCL_ERROR; - } - if (ImgBmapPsImagemask(interp, masterPtr->width, masterPtr->height, - masterPtr->data) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height, + masterPtr->data); } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; -} + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; +} + /* * Local Variables: * mode: c diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 4cbf94d..fed4da4 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -430,8 +430,10 @@ FileReadGIF( return TCL_ERROR; } if (i == (argc-1)) { - Tcl_AppendResult(interp, "no value given for \"", - Tcl_GetString(objv[i]), "\" option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no value given for \"%s\" option", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "OPT_VALUE", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) { @@ -444,13 +446,15 @@ FileReadGIF( */ if (!ReadGIFHeader(gifConfPtr, chan, &fileWidth, &fileHeight)) { - Tcl_AppendResult(interp, "couldn't read GIF header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read GIF header from file \"%s\"", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "GIF image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "GIF image file \"%s\" has dimension(s) <= 0", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BOGUS_SIZE", NULL); return TCL_ERROR; } @@ -465,7 +469,9 @@ FileReadGIF( if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); return TCL_ERROR; } } @@ -501,14 +507,18 @@ FileReadGIF( * Premature end of image. */ - Tcl_AppendResult(interp, - "premature end of image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "premature end of image data for this index", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", + NULL); goto error; } switch (buf[0]) { case GIF_TERMINATOR: - Tcl_AppendResult(interp, "no image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no image data for this index", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL); goto error; case GIF_EXTENSION: @@ -517,23 +527,29 @@ FileReadGIF( */ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "error reading extension function code in GIF image", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } if (DoExtension(gifConfPtr, chan, buf[0], gifConfPtr->workingBuffer, &transparent) < 0) { - Tcl_SetResult(interp, "error reading extension in GIF image", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading extension in GIF image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } continue; case GIF_START: if (Fread(gifConfPtr, buf, 1, 9, chan) != 9) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't read left/top/width/height in GIF image", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "DIMENSIONS", + NULL); goto error; } break; @@ -561,7 +577,10 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", + "COLOR_MAP", NULL); goto error; } } @@ -608,7 +627,9 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); goto error; } } @@ -659,7 +680,7 @@ FileReadGIF( block.pixelPtr = ckalloc(nBytes); if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth, - imageHeight, colorMap, srcX, srcY, BitSet(buf[8],INTERLACE), + imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE), transparent) != TCL_OK) { ckfree(block.pixelPtr); goto error; @@ -677,7 +698,7 @@ FileReadGIF( * which suits as well). We're done. */ - Tcl_AppendResult(interp, tkImgFmtGIF.name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1)); result = TCL_OK; error: @@ -903,19 +924,19 @@ DoExtension( int count; switch (label) { - case 0x01: /* Plain Text Extension */ + case 0x01: /* Plain Text Extension */ break; - case 0xff: /* Application Extension */ + case 0xff: /* Application Extension */ break; - case 0xfe: /* Comment Extension */ + case 0xfe: /* Comment Extension */ do { count = GetDataBlock(gifConfPtr, chan, buf); } while (count > 0); return count; - case 0xf9: /* Graphic Control Extension */ + case 0xf9: /* Graphic Control Extension */ count = GetDataBlock(gifConfPtr, chan, buf); if (count < 0) { return 1; @@ -1011,13 +1032,14 @@ ReadImage( */ if (Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) <= 0) { - Tcl_AppendResult(interp, "error reading GIF image: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading GIF image: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (initialCodeSize > MAX_LWZ_BITS) { - Tcl_SetResult(interp, "malformed image", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("malformed image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "MALFORMED", NULL); return TCL_ERROR; } @@ -1416,7 +1438,7 @@ Mgetc( handle->data++; } while (c == GIF_SPACE); - if (c>GIF_SPECIAL) { + if (c > GIF_SPECIAL) { handle->state = GIF_DONE; return handle->c; } @@ -1689,7 +1711,8 @@ CommonWriteGIF( state.pixelPitch = blockPtr->pitch; SaveMap(&state, blockPtr); if (state.num >= MAXCOLORMAPSIZE) { - Tcl_AppendResult(interp, "too many colors", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("too many colors", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLORFUL", NULL); return TCL_ERROR; } if (state.num<2) { diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 8d6721e..b159c45 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -334,7 +334,9 @@ InitPNGImage( if (Tcl_ZlibStreamInit(NULL, dir, TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_COMPRESS_DEFAULT, NULL, &pngPtr->stream) != TCL_OK) { - Tcl_SetResult(interp, "zlib initialization failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "zlib initialization failed", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL); if (objPtr) { Tcl_DecrRefCount(objPtr); } @@ -515,7 +517,9 @@ ReadBase64( } if (destSz) { - Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -557,7 +561,9 @@ ReadByteArray( */ if (pngPtr->strDataLen < destSz) { - Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -618,14 +624,10 @@ ReadData( int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ); blockSz = Tcl_Read(pngPtr->channel, (char *)destPtr, blockSz); - - /* - * Check for read failure. - */ - if (blockSz < 0) { /* TODO: failure info... */ - Tcl_SetResult(interp, "Channel read failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel read failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -647,7 +649,9 @@ ReadData( */ if (destSz && Tcl_Eof(pngPtr->channel)) { - Tcl_SetResult(interp, "Unexpected end of file ", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of file", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EOF", NULL); return TCL_ERROR; } } @@ -732,7 +736,8 @@ CheckCRC( */ if (calculated != chunked) { - Tcl_SetResult(interp, "CRC check failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("CRC check failed", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "CRC", NULL); return TCL_ERROR; } @@ -882,8 +887,10 @@ ReadChunkHeader( temp = PNG_INT32(pc[0], pc[1], pc[2], pc[3]); if (temp > INT_MAX) { - Tcl_SetResult(interp, "Chunk size is out of supported range " - "on this architecture", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "chunk size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "OUTSIZE", NULL); return TCL_ERROR; } @@ -967,9 +974,29 @@ ReadChunkHeader( */ if (!(chunkType & PNG_CF_ANCILLARY)) { - Tcl_SetResult(interp, - "Encountered an unsupported criticial chunk type", - TCL_STATIC); + if (chunkType & PNG_INT32(128,128,128,128)) { + /* + * No nice ASCII conversion; shouldn't happen either, but + * we'll be doubly careful. + */ + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "encountered an unsupported criticial chunk type", + -1)); + } else { + char typeString[5]; + + typeString[0] = (char) ((chunkType >> 24) & 255); + typeString[1] = (char) ((chunkType >> 16) & 255); + typeString[2] = (char) ((chunkType >> 8) & 255); + typeString[3] = (char) (chunkType & 255); + typeString[4] = '\0'; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "encountered an unsupported criticial chunk type" + " \"%s\"", typeString)); + } + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "UNSUPPORTED_CRITICAL", NULL); return TCL_ERROR; } @@ -980,7 +1007,10 @@ ReadChunkHeader( for (i=0 ; i<4 ; i++) { if ((pc[i] < 65) || (pc[i] > 122) || ((pc[i] > 90) && (pc[i] < 97))) { - Tcl_SetResult(interp, "Invalid chunk type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid chunk type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "INVALID_CHUNK", NULL); return TCL_ERROR; } } @@ -1036,7 +1066,6 @@ CheckColor( Tcl_Interp *interp, PNGImage *pngPtr) { - int result = TCL_OK; int offset; /* @@ -1049,14 +1078,14 @@ CheckColor( if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_RGB: pngPtr->numChannels = 3; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; @@ -1064,32 +1093,32 @@ CheckColor( pngPtr->numChannels = 1; if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_GRAYALPHA: pngPtr->numChannels = 2; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_RGBA: pngPtr->numChannels = 4; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + unsupportedDepth: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bit depth is not allowed for given color type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_DEPTH", NULL); + return TCL_ERROR; } break; default: - Tcl_SetResult(interp, "Unknown Color Type field", TCL_STATIC); - return TCL_ERROR; - } - - if (TCL_ERROR == result) { - Tcl_SetResult(interp, "Bit depth is not allowed for given color type", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type field %d", pngPtr->colorType)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } @@ -1117,9 +1146,10 @@ CheckColor( */ if (pngPtr->block.width > INT_MAX / pngPtr->block.pixelSize) { - Tcl_SetResult(interp, - "Image pitch is out of supported range on this architecture", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image pitch is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PITCH", NULL); return TCL_ERROR; } @@ -1131,8 +1161,10 @@ CheckColor( */ if (pngPtr->block.height > INT_MAX / pngPtr->block.pitch) { - Tcl_SetResult(interp, "Image total size is out of supported range " - "on this architecture", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image total size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "SIZE", NULL); return TCL_ERROR; } @@ -1159,8 +1191,9 @@ CheckColor( pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 8 : 4; break; default: - Tcl_SetResult(interp, "internal error - unknown color type", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type %d", pngPtr->colorType)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } @@ -1240,8 +1273,9 @@ ReadIHDR( } if (mismatch) { - Tcl_SetResult(interp, "Data stream does not have a PNG signature", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "data stream does not have a PNG signature", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_SIG", NULL); return TCL_ERROR; } @@ -1257,12 +1291,16 @@ ReadIHDR( */ if (chunkType != CHUNK_IHDR) { - Tcl_SetResult(interp, "Expected IHDR chunk type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "expected IHDR chunk type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_IHDR", NULL); return TCL_ERROR; } if (chunkSz != 13) { - Tcl_SetResult(interp, "Invalid IHDR chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid IHDR chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IHDR", NULL); return TCL_ERROR; } @@ -1281,9 +1319,10 @@ ReadIHDR( } if (!width || !height || (width > INT_MAX) || (height > INT_MAX)) { - Tcl_SetResult(interp, - "Image dimensions are invalid or beyond architecture limits", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image dimensions are invalid or beyond architecture limits", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DIMENSIONS", NULL); return TCL_ERROR; } @@ -1325,8 +1364,10 @@ ReadIHDR( return TCL_ERROR; } - if (PNG_COMPRESS_DEFLATE != pngPtr->compression) { - Tcl_SetResult(interp, "Unknown compression method", TCL_STATIC); + if (pngPtr->compression != PNG_COMPRESS_DEFLATE) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown compression method %d", pngPtr->compression)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_COMPRESS", NULL); return TCL_ERROR; } @@ -1339,8 +1380,10 @@ ReadIHDR( return TCL_ERROR; } - if (PNG_FILTMETH_STANDARD != pngPtr->filter) { - Tcl_SetResult(interp, "Unknown filter method", TCL_STATIC); + if (pngPtr->filter != PNG_FILTMETH_STANDARD) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown filter method %d", pngPtr->filter)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -1354,7 +1397,9 @@ ReadIHDR( break; default: - Tcl_SetResult(interp, "Unknown interlace method", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown interlace method %d", pngPtr->interlace)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_INTERLACE", NULL); return TCL_ERROR; } @@ -1397,8 +1442,10 @@ ReadPLTE( switch (pngPtr->colorType) { case PNG_COLOR_GRAY: case PNG_COLOR_GRAYALPHA: - Tcl_SetResult(interp, "PLTE chunk type forbidden for grayscale", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk type forbidden for grayscale", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PLTE_UNEXPECTED", + NULL); return TCL_ERROR; default: @@ -1412,7 +1459,9 @@ ReadPLTE( */ if (!chunkSz || (chunkSz > PNG_PLTE_MAXSZ) || (chunkSz % 3)) { - Tcl_SetResult(interp, "Invalid palette chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid palette chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PLTE", NULL); return TCL_ERROR; } @@ -1474,9 +1523,10 @@ ReadTRNS( int i; if (pngPtr->colorType & PNG_COLOR_ALPHA) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "tRNS chunk not allowed color types with a full alpha channel", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_TRNS", NULL); return TCL_ERROR; } @@ -1486,7 +1536,9 @@ ReadTRNS( */ if (chunkSz > PNG_TRNS_MAXSZ) { - Tcl_SetResult(interp, "Invalid tRNS chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1515,9 +1567,9 @@ ReadTRNS( */ if (chunkSz > pngPtr->paletteLen) { - Tcl_SetResult(interp, - "Size of tRNS chunk is too large for the palette", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "size of tRNS chunk is too large for the palette", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TRNS_SIZE", NULL); return TCL_ERROR; } @@ -1533,9 +1585,10 @@ ReadTRNS( */ if (chunkSz != 2) { - Tcl_SetResult(interp, - "Invalid tRNS chunk size - must 2 bytes for grayscale", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 2 bytes for grayscale", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1559,9 +1612,9 @@ ReadTRNS( */ if (chunkSz != 6) { - Tcl_SetResult(interp, - "Invalid tRNS chunk size - must 6 bytes for RGB", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 6 bytes for RGB", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1742,7 +1795,9 @@ UnfilterLine( } break; default: - Tcl_SetResult(interp, "Invalid filter type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid filter type %d", *thisLine)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -1909,7 +1964,7 @@ DecodeLine( */ if ((PNG_COLOR_PLTE != pngPtr->colorType) && - ((pngPtr->colorType & PNG_COLOR_ALPHA) == 0)) { + !(pngPtr->colorType & PNG_COLOR_ALPHA)) { unsigned char alpha; if (pngPtr->useTRNS) { @@ -2049,8 +2104,10 @@ ReadIDAT( */ if (Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_SetResult(interp, "Extra data after end of zlib stream", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after end of zlib stream", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); return TCL_ERROR; } @@ -2089,9 +2146,11 @@ ReadIDAT( if (len2 == pngPtr->phaseSize) { if (pngPtr->phase > 7) { - Tcl_SetResult(interp, - "Extra data after final scan line of final phase", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after final scan line of final phase", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); return TCL_ERROR; } @@ -2134,8 +2193,9 @@ ReadIDAT( */ if (chunkSz != 0) { - Tcl_AppendResult(interp, - "compressed data after stream finalize in PNG data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "compressed data after stream finalize in PNG data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2271,9 +2331,10 @@ ParseFormat( } if ((pngPtr->alpha < 0.0) || (pngPtr->alpha > 1.0)) { - Tcl_SetResult(interp, - "-alpha value must be between 0.0 and 1.0", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-alpha value must be between 0.0 and 1.0", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_ALPHA", + NULL); return TCL_ERROR; } break; @@ -2363,8 +2424,9 @@ DecodePNG( return TCL_ERROR; } } else if (PNG_COLOR_PLTE == pngPtr->colorType) { - Tcl_SetResult(interp, "PLTE chunk required for indexed color", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk required for indexed color", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_PLTE", NULL); return TCL_ERROR; } @@ -2399,9 +2461,10 @@ DecodePNG( * interested in IDAT. The others should have been skipped. */ - if (CHUNK_IDAT != chunkType) { - Tcl_SetResult(interp, "At least one IDAT chunk is required", - TCL_STATIC); + if (chunkType != CHUNK_IDAT) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "at least one IDAT chunk is required", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_IDAT", NULL); return TCL_ERROR; } @@ -2422,9 +2485,10 @@ DecodePNG( */ if (pngPtr->block.width > ((INT_MAX - 1) / (pngPtr->numChannels * 2))) { - Tcl_SetResult(interp, - "Line size is out of supported range on this architecture", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "line size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "LINE_SIZE", NULL); return TCL_ERROR; } @@ -2449,7 +2513,9 @@ DecodePNG( pngPtr->block.pixelPtr = attemptckalloc(pngPtr->blockLen); if (!pngPtr->block.pixelPtr) { - Tcl_SetResult(interp, "Memory allocation failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } @@ -2499,7 +2565,9 @@ DecodePNG( */ if (!Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_AppendResult(interp, "unfinalized data stream in PNG data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unfinalized data stream in PNG data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2523,8 +2591,9 @@ DecodePNG( */ if (chunkSz) { - Tcl_SetResult(interp, "IEND chunk contents must be empty", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "IEND chunk contents must be empty", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } @@ -2543,7 +2612,9 @@ DecodePNG( #if 0 if (ReadData(interp, pngPtr, &c, 1, NULL) != TCL_ERROR) { - Tcl_SetResult(interp, "Extra data following IEND chunk", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data following IEND chunk", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } #endif @@ -2795,24 +2866,25 @@ WriteData( Tcl_GetByteArrayFromObj(pngPtr->objDataPtr, &objSz); if (objSz > INT_MAX - srcSz) { - Tcl_SetResult(interp, - "Image too large to store completely in byte array", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image too large to store completely in byte array", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } destPtr = Tcl_SetByteArrayLength(pngPtr->objDataPtr, objSz + srcSz); if (!destPtr) { - Tcl_SetResult(interp, "Memory allocation failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } memcpy(destPtr+objSz, srcPtr, srcSz); } else if (Tcl_Write(pngPtr->channel, (const char *) srcPtr, srcSz) < 0) { - /* TODO: reason */ - - Tcl_SetResult(interp, "Write to channel failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "write to channel failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -3127,7 +3199,9 @@ WriteIDAT( } if (Tcl_ZlibStreamPut(pngPtr->stream, pngPtr->thisLineObj, flush) != TCL_OK) { - Tcl_SetResult(interp, "deflate() returned error", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "deflate() returned error", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DEFLATE", NULL); return TCL_ERROR; } @@ -3301,8 +3375,9 @@ EncodePNG( if ((blockPtr->width > (INT_MAX - 1) / (pngPtr->bytesPerPixel)) || (blockPtr->height > INT_MAX / pngPtr->lineSize)) { - Tcl_SetResult(interp, "Image is too large to encode pixel data", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image is too large to encode pixel data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c index 527efa2..edd1b71 100644 --- a/generic/tkImgPPM.c +++ b/generic/tkImgPPM.c @@ -147,21 +147,22 @@ FileReadPPM( type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read raw PPM header from file \"%s\"", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has dimension(s) <= 0", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has bad maximum intensity value ", buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has bad maximum intensity value %d", + fileName, maxIntensity)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -218,10 +219,12 @@ FileReadPPM( } count = Tcl_Read(chan, (char *) pixelPtr, nBytes); if (count != nBytes) { - Tcl_AppendResult(interp, "error reading PPM image file \"", - fileName, "\": ", - Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading PPM image file \"%s\": %s", fileName, + Tcl_Eof(chan)?"not enough data":Tcl_PosixError(interp))); + if (Tcl_Eof(chan)) { + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "EOF", NULL); + } ckfree(pixelPtr); return TCL_ERROR; } @@ -325,8 +328,8 @@ FileWritePPM( chan = NULL; writeerror: - Tcl_AppendResult(interp, "error writing \"", fileName, "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", + fileName, Tcl_PosixError(interp))); if (chan != NULL) { Tcl_Close(NULL, chan); } @@ -482,22 +485,22 @@ StringReadPPM( type = ReadPPMStringHeader(dataObj, &fileWidth, &fileHeight, &maxIntensity, &dataBuffer, &dataSize); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from string", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't read raw PPM header from string", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image data has dimension(s) <= 0", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PPM image data has dimension(s) <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, - "PPM image data has bad maximum intensity value ", buffer, - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image data has bad maximum intensity value %d", + maxIntensity)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -538,7 +541,9 @@ StringReadPPM( */ if (block.pitch*height > dataSize) { - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } block.pixelPtr = dataBuffer + srcX * block.pixelSize; @@ -572,7 +577,9 @@ StringReadPPM( } if (dataSize < nBytes) { ckfree(pixelPtr); - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } for (p=pixelPtr,count=nBytes ; count>0 ; count--,p++,dataBuffer++) { diff --git a/generic/tkImgPhInstance.c b/generic/tkImgPhInstance.c index 5429ee3..3097489 100644 --- a/generic/tkImgPhInstance.c +++ b/generic/tkImgPhInstance.c @@ -1068,8 +1068,7 @@ GetColorTable( * Allocate colors for this color table if necessary. */ - if ((colorPtr->numColors == 0) - && ((colorPtr->flags & BLACK_AND_WHITE) == 0)) { + if ((colorPtr->numColors == 0) && !(colorPtr->flags & BLACK_AND_WHITE)) { AllocateColors(colorPtr); } } @@ -1104,12 +1103,12 @@ FreeColorTable( } if (force) { - if ((colorPtr->flags & DISPOSE_PENDING) != 0) { + if (colorPtr->flags & DISPOSE_PENDING) { Tcl_CancelIdleCall(DisposeColorTable, colorPtr); colorPtr->flags &= ~DISPOSE_PENDING; } DisposeColorTable(colorPtr); - } else if ((colorPtr->flags & DISPOSE_PENDING) == 0) { + } else if (!(colorPtr->flags & DISPOSE_PENDING)) { Tcl_DoWhenIdle(DisposeColorTable, colorPtr); colorPtr->flags |= DISPOSE_PENDING; } @@ -1813,11 +1812,11 @@ TkImgDitherInstance( } c = ((c + 2056) >> 4) - 128; - if ((masterPtr->flags & COLOR_IMAGE) == 0) { - c += srcPtr[0]; - } else { + if (masterPtr->flags & COLOR_IMAGE) { c += (unsigned) (srcPtr[0] * 11 + srcPtr[1] * 16 + srcPtr[2] * 5 + 16) >> 5; + } else { + c += srcPtr[0]; } srcPtr += 4; @@ -1886,11 +1885,11 @@ TkImgDitherInstance( } c = ((c + 2056) >> 4) - 128; - if ((masterPtr->flags & COLOR_IMAGE) == 0) { - c += srcPtr[0]; - } else { + if (masterPtr->flags & COLOR_IMAGE) { c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16 + srcPtr[2] * 5 + 16) >> 5; + } else { + c += srcPtr[0]; } srcPtr += 4; diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 5b172f1..ce160a4 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -504,7 +504,7 @@ ImgPhotoCmd( * TODO: Modifying result is bad! */ - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), masterPtr->dataString); } else { Tcl_AppendResult(interp, " {}", NULL); @@ -518,7 +518,7 @@ ImgPhotoCmd( * TODO: Modifying result is bad! */ - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), masterPtr->format); } else { Tcl_AppendResult(interp, " {}", NULL); @@ -562,17 +562,21 @@ ImgPhotoCmd( srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name)); if (srcHandle == NULL) { - Tcl_AppendResult(interp, "image \"", - Tcl_GetString(options.name), "\" doesn't", - " exist or is not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist or is not a photo image", + Tcl_GetString(options.name))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO", + Tcl_GetString(options.name), NULL); return TCL_ERROR; } Tk_PhotoGetImage(srcHandle, &block); if ((options.fromX2 > block.width) || (options.fromY2 > block.height) || (options.fromX2 > block.width) || (options.fromY2 > block.height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -624,8 +628,9 @@ ImgPhotoCmd( if (options.options & OPT_SHRINK) { if (ImgPhotoSetSize(masterPtr, options.toX2, options.toY2) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -672,8 +677,9 @@ ImgPhotoCmd( || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -681,7 +687,7 @@ ImgPhotoCmd( * Fill in default values for unspecified parameters. */ - if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { + if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { options.fromX2 = masterPtr->width; options.fromY2 = masterPtr->height; } @@ -719,9 +725,12 @@ ImgPhotoCmd( } } if (stringWriteProc == NULL) { - Tcl_AppendResult(interp, "image string format \"", - Tcl_GetString(options.format), "\" is ", - (matched ? "not supported" : "unknown"), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image string format \"%s\" is %s", + Tcl_GetString(options.format), + (matched ? "not supported" : "unknown"))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + Tcl_GetString(options.format), NULL); return TCL_ERROR; } } else { @@ -770,7 +779,7 @@ ImgPhotoCmd( * photo get command - first parse and check parameters. */ - char string[TCL_INTEGER_SPACE * 3]; + Tcl_Obj *channels[3]; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "x y"); @@ -782,8 +791,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ", - "coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s get: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -792,9 +804,10 @@ ImgPhotoCmd( */ pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; - sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1], - pixelPtr[2]); - Tcl_AppendResult(interp, string, NULL); + channels[0] = Tcl_NewIntObj(pixelPtr[0]); + channels[1] = Tcl_NewIntObj(pixelPtr[1]); + channels[2] = Tcl_NewIntObj(pixelPtr[2]); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels)); return TCL_OK; } @@ -820,7 +833,7 @@ ImgPhotoCmd( &imageHeight, &oldformat) == TCL_OK) { Tcl_Obj *format, *data; - if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) { + if (!(options.options & OPT_TO) || (options.toX2 < 0)) { options.toX2 = options.toX + imageWidth; options.toY2 = options.toY + imageHeight; } @@ -876,8 +889,11 @@ ImgPhotoCmd( pixelPtr = ckalloc(dataWidth * dataHeight * 3); block.pixelPtr = pixelPtr; } else if (listObjc != dataWidth) { - Tcl_AppendResult(interp, "all elements of color list must", - " have the same number of elements", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "all elements of color list must have the same" + " number of elements", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NON_RECTANGULAR", NULL); break; } @@ -920,8 +936,9 @@ ImgPhotoCmd( if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), colorString, &color)) { - Tcl_AppendResult(interp, "can't parse color \"", - colorString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't parse color \"%s\"", colorString)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); break; } *pixelPtr++ = color.red >> 8; @@ -992,8 +1009,9 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get image from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); return TCL_ERROR; } @@ -1031,12 +1049,14 @@ ImgPhotoCmd( if ((options.fromX > imageWidth) || (options.fromY > imageHeight) || (options.fromX2 > imageWidth) || (options.fromY2 > imageHeight)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } - if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { + if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { width = imageWidth - options.fromX; height = imageHeight - options.fromY; } else { @@ -1052,7 +1072,9 @@ ImgPhotoCmd( if (ImgPhotoSetSize(masterPtr, options.toX + width, options.toY + height) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -1143,8 +1165,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency get: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency get: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1180,8 +1205,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency set: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency set: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1244,8 +1272,9 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't write image to a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't write image to a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); return TCL_ERROR; } @@ -1270,8 +1299,9 @@ ImgPhotoCmd( || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -1338,19 +1368,19 @@ ImgPhotoCmd( } if (imageFormat == NULL) { if (fmtString == NULL) { - Tcl_AppendResult(interp, "no available image file format ", - "has file writing capability", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no available image file format has file writing" + " capability", -1)); } else if (!matched) { - Tcl_AppendResult(interp, "image file format \"", - fmtString, "\" is unknown", NULL); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - fmtString, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is unknown", fmtString)); } else { - Tcl_AppendResult(interp, "image file format \"", - fmtString, "\" has no file writing capability", NULL); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - fmtString, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" has no file writing capability", + fmtString)); } + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + fmtString, NULL); return TCL_ERROR; } @@ -1441,10 +1471,16 @@ ParseSubcommandOptions( int objc, /* Number of arguments in objv[]. */ Tcl_Obj *const objv[]) /* Arguments to be parsed. */ { + static const char *const compositingRules[] = { + "overlay", "set", /* Note that these must match the + * TK_PHOTO_COMPOSITE_* constants. */ + NULL + }; int index, c, bit, currentBit, length; int values[4], numValues, maxValues, argIndex; - const char *option; + const char *option, *expandedOption, *needed; const char *const *listPtr; + Tcl_Obj *msgObj; for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) { /* @@ -1452,7 +1488,7 @@ ParseSubcommandOptions( * optPtr->name. */ - option = Tcl_GetStringFromObj(objv[index], &length); + expandedOption = option = Tcl_GetStringFromObj(objv[index], &length); if (option[0] != '-') { if (optPtr->name == NULL) { optPtr->name = objv[index]; @@ -1471,9 +1507,9 @@ ParseSubcommandOptions( for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((c == *listPtr[0]) && (strncmp(option, *listPtr, (size_t) length) == 0)) { + expandedOption = *listPtr; if (bit != 0) { - bit = 0; /* An ambiguous option. */ - break; + goto unknownOrAmbiguousOption; } bit = currentBit; } @@ -1485,24 +1521,8 @@ ParseSubcommandOptions( * in the interpreter and return. */ - if ((allowedOptions & bit) == 0) { - Tcl_AppendResult(interp, "unrecognized option \"", - Tcl_GetString(objv[index]), - "\": must be ", NULL); - bit = 1; - for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { - if ((allowedOptions & bit) != 0) { - if ((allowedOptions & (bit - 1)) != 0) { - Tcl_AppendResult(interp, ", ", NULL); - if ((allowedOptions & ~((bit << 1) - 1)) == 0) { - Tcl_AppendResult(interp, "or ", NULL); - } - } - Tcl_AppendResult(interp, *listPtr, NULL); - } - bit <<= 1; - } - return TCL_ERROR; + if (!(allowedOptions & bit)) { + goto unknownOrAmbiguousOption; } /* @@ -1515,16 +1535,13 @@ ParseSubcommandOptions( * The -background option takes a single XColor value. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp), - Tk_GetUid(Tcl_GetString(objv[index]))); - if (!optPtr->background) { - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "the \"-background\" option ", - "requires a value", NULL); + if (index + 1 >= objc) { + goto oneValueRequired; + } + *optIndexPtr = ++index; + optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp), + Tk_GetUid(Tcl_GetString(objv[index]))); + if (!optPtr->background) { return TCL_ERROR; } } else if (bit == OPT_FORMAT) { @@ -1533,45 +1550,31 @@ ParseSubcommandOptions( * parsing this is outside the scope of this function. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->format = objv[index]; - } else { - Tcl_AppendResult(interp, "the \"-format\" option ", - "requires a value", NULL); - return TCL_ERROR; + if (index + 1 >= objc) { + goto oneValueRequired; } + *optIndexPtr = ++index; + optPtr->format = objv[index]; } else if (bit == OPT_COMPOSITE) { /* * The -compositingrule option takes a single value from a * well-known set. */ - if (index + 1 < objc) { - /* - * Note that these must match the TK_PHOTO_COMPOSITE_* - * constants. - */ - - static const char *const compositingRules[] = { - "overlay", "set", NULL - }; - - index++; - if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules, - "compositing rule", 0, &optPtr->compositingRule) - != TCL_OK) { - return TCL_ERROR; - } - *optIndexPtr = index; - } else { - Tcl_AppendResult(interp, "the \"-compositingrule\" option ", - "requires a value", NULL); + if (index + 1 >= objc) { + goto oneValueRequired; + } + index++; + if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules, + "compositing rule", 0, &optPtr->compositingRule) + != TCL_OK) { return TCL_ERROR; } + *optIndexPtr = index; } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { const char *val; - maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2; + + maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2; argIndex = index + 1; for (numValues = 0; numValues < maxValues; ++numValues) { if (argIndex >= objc) { @@ -1591,10 +1594,7 @@ ParseSubcommandOptions( } if (numValues == 0) { - Tcl_AppendResult(interp, "the \"", option, "\" option ", - "requires one ", maxValues == 2? "or two": "to four", - " integer values", NULL); - return TCL_ERROR; + goto manyValuesRequired; } *optIndexPtr = (index += numValues); @@ -1618,9 +1618,8 @@ ParseSubcommandOptions( case OPT_FROM: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -from", - " option must be non-negative", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->fromX = values[0]; @@ -1641,9 +1640,8 @@ ParseSubcommandOptions( case OPT_TO: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -to", - " option must be non-negative", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->toX = values[0]; @@ -1659,9 +1657,8 @@ ParseSubcommandOptions( break; case OPT_ZOOM: if ((values[0] <= 0) || (values[1] <= 0)) { - Tcl_AppendResult(interp, "value(s) for the -zoom", - " option must be positive", NULL); - return TCL_ERROR; + needed = "positive"; + goto numberOutOfRange; } optPtr->zoomX = values[0]; optPtr->zoomY = values[1]; @@ -1675,8 +1672,50 @@ ParseSubcommandOptions( optPtr->options |= bit; } - return TCL_OK; + + /* + * Exception generation. + */ + + oneValueRequired: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires a value", expandedOption)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL); + return TCL_ERROR; + + manyValuesRequired: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires one %s integer values", + expandedOption, (maxValues == 2) ? "or two": "to four")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL); + return TCL_ERROR; + + numberOutOfRange: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value(s) for the %s option must be %s", expandedOption, needed)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_VALUE", NULL); + return TCL_ERROR; + + unknownOrAmbiguousOption: + msgObj = Tcl_ObjPrintf("unrecognized option \"%s\": must be ", option); + bit = 1; + for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { + if (allowedOptions & bit) { + if (allowedOptions & (bit - 1)) { + if (allowedOptions & ~((bit << 1) - 1)) { + Tcl_AppendToObj(msgObj, ", ", -1); + } else { + Tcl_AppendToObj(msgObj, ", or ", -1); + } + } + Tcl_AppendToObj(msgObj, *listPtr, -1); + } + bit <<= 1; + } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; } /* @@ -1730,8 +1769,10 @@ ImgPhotoConfigureMaster( j--; } else { ckfree(args); - Tcl_AppendResult(interp, - "value for \"-data\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-data\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); return TCL_ERROR; } } else if ((args[j][1] == 'f') && @@ -1741,8 +1782,10 @@ ImgPhotoConfigureMaster( j--; } else { ckfree(args); - Tcl_AppendResult(interp, - "value for \"-format\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-format\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); return TCL_ERROR; } } @@ -1832,8 +1875,9 @@ ImgPhotoConfigureMaster( if (ImgPhotoSetSize(masterPtr, masterPtr->width, masterPtr->height) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -1851,8 +1895,10 @@ ImgPhotoConfigureMaster( if (Tcl_IsSafe(interp)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "can't get image from a file in a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); goto errorExit; } @@ -1876,8 +1922,9 @@ ImgPhotoConfigureMaster( result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight); if (result != TCL_OK) { Tcl_Close(NULL, chan); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -1906,8 +1953,9 @@ ImgPhotoConfigureMaster( goto errorExit; } if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -2351,8 +2399,11 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_FILE_FORMAT", NULL); return TCL_ERROR; } } @@ -2382,8 +2433,11 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_FILE_FORMAT", NULL); return TCL_ERROR; } } @@ -2405,12 +2459,17 @@ MatchFileFormat( if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image file format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is not supported", + formatString)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + formatString, NULL); } else { - Tcl_AppendResult(interp, - "couldn't recognize data in image file \"", fileName, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't recognize data in image file \"%s\"", + fileName)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE", + "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; } @@ -2480,8 +2539,11 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_DATA_FORMAT", NULL); return TCL_ERROR; } } @@ -2504,8 +2566,11 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_DATA_FORMAT", NULL); return TCL_ERROR; } } @@ -2521,10 +2586,15 @@ MatchStringFormat( } if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image format \"%s\" is not supported", formatString)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + formatString, NULL); } else { - Tcl_AppendResult(interp, "couldn't recognize image data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't recognize image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; } @@ -2641,8 +2711,9 @@ Tk_PhotoPutBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3037,8 +3108,9 @@ Tk_PhotoPutZoomedBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3435,8 +3507,9 @@ Tk_PhotoExpand( if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width), MAX(height, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3509,8 +3582,9 @@ Tk_PhotoSetSize( if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width), ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } diff --git a/generic/tkInt.h b/generic/tkInt.h index 01cc9cb..21b882c 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1170,7 +1170,7 @@ MODULE_SCOPE void TkpBuildRegionFromAlphaData(TkRegion region, unsigned x, unsigned y, unsigned width, unsigned height, unsigned char *dataPtr, unsigned pixelStride, unsigned lineStride); -MODULE_SCOPE void TkPrintPadAmount(Tcl_Interp *interp, +MODULE_SCOPE void TkAppendPadAmount(Tcl_Obj *bufferObj, const char *buffer, int pad1, int pad2); MODULE_SCOPE int TkParsePadAmount(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 7faa44b..620f82f 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -168,6 +168,13 @@ typedef struct { } Listbox; /* + * How to encode the keys for the hash tables used to store what items are + * selected and what the attributes are. + */ + +#define KEY(i) ((char *) INT2PTR(i)) + +/* * ItemAttr structures are used to store item configuration information for * the items in a listbox */ @@ -437,8 +444,8 @@ static void MigrateHashEntries(Tcl_HashTable *table, static const Tk_ClassProcs listboxClass = { sizeof(Tk_ClassProcs), /* size */ ListboxWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -480,8 +487,7 @@ Tk_ListboxObjCmd( return TCL_ERROR; } - optionTables = (ListboxOptionTables *) - Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); + optionTables = Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); if (optionTables == NULL) { /* * We haven't created the option tables for this widget class yet. Do @@ -515,7 +521,7 @@ Tk_ListboxObjCmd( */ listPtr = ckalloc(sizeof(Listbox)); - memset(listPtr, 0, (sizeof(Listbox))); + memset(listPtr, 0, sizeof(Listbox)); listPtr->tkwin = tkwin; listPtr->display = Tk_Display(tkwin); @@ -597,6 +603,7 @@ ListboxWidgetObjCmd( register Listbox *listPtr = clientData; int cmdIndex, index; int result = TCL_OK; + Tcl_Obj *objPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); @@ -661,9 +668,7 @@ ListboxWidgetObjCmd( result = ListboxBboxSubCmd(interp, listPtr, index); break; - case COMMAND_CGET: { - Tcl_Obj *objPtr; - + case COMMAND_CGET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); result = TCL_ERROR; @@ -679,11 +684,8 @@ ListboxWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); result = TCL_OK; break; - } - - case COMMAND_CONFIGURE: { - Tcl_Obj *objPtr; + case COMMAND_CONFIGURE: if (objc <= 3) { objPtr = Tk_GetOptionInfo(interp, (char *) listPtr, listPtr->optionTable, @@ -698,10 +700,8 @@ ListboxWidgetObjCmd( result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0); } break; - } case COMMAND_CURSELECTION: { - char indexStringRep[TCL_INTEGER_SPACE]; int i; if (objc != 2) { @@ -718,12 +718,13 @@ ListboxWidgetObjCmd( * selected. */ + objPtr = Tcl_NewObj(); for (i = 0; i < listPtr->nElements; i++) { - if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { - sprintf(indexStringRep, "%d", i); - Tcl_AppendElement(interp, indexStringRep); + if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) { + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(i)); } } + Tcl_SetObjResult(interp, objPtr); result = TCL_OK; break; } @@ -857,7 +858,6 @@ ListboxWidgetObjCmd( break; case COMMAND_ITEMCGET: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc != 4) { @@ -872,8 +872,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", - Tcl_GetString(objv[2]), "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL); result = TCL_ERROR; break; } @@ -892,7 +894,6 @@ ListboxWidgetObjCmd( } case COMMAND_ITEMCONFIGURE: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc < 3) { @@ -908,8 +909,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", Tcl_GetString(objv[2]), - "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL); result = TCL_ERROR; break; } @@ -922,10 +925,9 @@ ListboxWidgetObjCmd( if (objPtr == NULL) { result = TCL_ERROR; break; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } else { result = ConfigureListboxItem(interp, listPtr, attrPtr, objc-3, objv+3, index); @@ -1007,7 +1009,7 @@ ListboxWidgetObjCmd( } diff = listPtr->topIndex - index; if (diff > 0) { - if (diff <= (listPtr->fullLines/3)) { + if (diff <= listPtr->fullLines / 3) { ChangeListboxView(listPtr, index); } else { ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2); @@ -1015,7 +1017,7 @@ ListboxWidgetObjCmd( } else { diff = index - (listPtr->topIndex + listPtr->fullLines - 1); if (diff > 0) { - if (diff <= (listPtr->fullLines/3)) { + if (diff <= listPtr->fullLines / 3) { ChangeListboxView(listPtr, listPtr->topIndex + diff); } else { ChangeListboxView(listPtr, index-(listPtr->fullLines-1)/2); @@ -1090,7 +1092,7 @@ ListboxBboxSubCmd( */ if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) { - Tcl_Obj *el; + Tcl_Obj *el, *results[4]; const char *stringRep; int pixelWidth, stringLen, x, y, result; Tk_FontMetrics fm; @@ -1111,8 +1113,11 @@ ListboxBboxSubCmd( x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + listPtr->selBorderWidth; - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x, y, pixelWidth, fm.linespace)); + results[0] = Tcl_NewIntObj(x); + results[1] = Tcl_NewIntObj(y); + results[2] = Tcl_NewIntObj(pixelWidth); + results[3] = Tcl_NewIntObj(fm.linespace); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1197,9 +1202,8 @@ ListboxSelectionSubCmd( Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((Tcl_FindHashEntry(listPtr->selection, - (char *) INT2PTR(first)) != NULL))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + Tcl_FindHashEntry(listPtr->selection, KEY(first)) != NULL)); result = TCL_OK; break; case SELECTION_SET: @@ -1232,43 +1236,45 @@ ListboxXviewSubCmd( int objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { - - int index, count, type, windowWidth, windowUnits; + int index, count, windowWidth, windowUnits; int offset = 0; /* Initialized to stop gcc warnings. */ double fraction; windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset + listPtr->selBorderWidth); if (objc == 2) { + Tcl_Obj *results[2]; + if (listPtr->maxWidth == 0) { - Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); + results[0] = Tcl_NewDoubleObj(0.0); + results[1] = Tcl_NewDoubleObj(1.0); } else { double fraction2; - fraction = listPtr->xOffset/((double) listPtr->maxWidth); + fraction = listPtr->xOffset / (double) listPtr->maxWidth; fraction2 = (listPtr->xOffset + windowWidth) - / ((double) listPtr->maxWidth); + / (double) listPtr->maxWidth; if (fraction2 > 1.0) { fraction2 = 1.0; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%g %g", - fraction, fraction2)); + results[0] = Tcl_NewDoubleObj(fraction); + results[1] = Tcl_NewDoubleObj(fraction2); } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit); } else { - type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); - switch (type) { + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_ERROR: return TCL_ERROR; case TK_SCROLL_MOVETO: offset = (int) (fraction*listPtr->maxWidth + 0.5); break; case TK_SCROLL_PAGES: - windowUnits = windowWidth/listPtr->xScrollUnit; + windowUnits = windowWidth / listPtr->xScrollUnit; if (windowUnits > 2) { offset = listPtr->xOffset + count*listPtr->xScrollUnit*(windowUnits-2); @@ -1308,12 +1314,15 @@ ListboxYviewSubCmd( int objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { - int index, count, type; + int index, count; double fraction; if (objc == 2) { + Tcl_Obj *results[2]; + if (listPtr->nElements == 0) { - Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); + results[0] = Tcl_NewDoubleObj(0.0); + results[1] = Tcl_NewDoubleObj(1.0); } else { double fraction2, numEls = (double) listPtr->nElements; @@ -1322,17 +1331,17 @@ ListboxYviewSubCmd( if (fraction2 > 1.0) { fraction2 = 1.0; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%g %g", - fraction, fraction2)); + results[0] = Tcl_NewDoubleObj(fraction); + results[1] = Tcl_NewDoubleObj(fraction2); } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxView(listPtr, index); } else { - type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); - switch (type) { + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_MOVETO: index = (int) (listPtr->nElements*fraction + 0.5); break; @@ -1383,8 +1392,7 @@ ListboxGetItemAttributes( Tcl_HashEntry *entry; ItemAttr *attrs; - entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, - (char *) INT2PTR(index), &isNew); + entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, KEY(index), &isNew); if (isNew) { attrs = ckalloc(sizeof(ItemAttr)); attrs->border = NULL; @@ -1910,7 +1918,7 @@ DisplayListbox( * special foreground/background colors. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); /* * If the listbox is enabled, items may be drawn differently; they may @@ -1919,7 +1927,7 @@ DisplayListbox( */ if (listPtr->state & STATE_NORMAL) { - if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { + if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) { /* * Selected items are drawn differently. */ @@ -2001,8 +2009,7 @@ DisplayListbox( } /* Draw bottom bevel */ if (i + 1 == listPtr->nElements || - Tcl_FindHashEntry(listPtr->selection, - (char *) INT2PTR(i + 1)) == NULL ) { + !Tcl_FindHashEntry(listPtr->selection, KEY(i + 1))) { Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left, y + listPtr->lineHeight - listPtr->selBorderWidth, width+left+right, listPtr->selBorderWidth, 0, 0, 0, @@ -2238,7 +2245,7 @@ ListboxComputeGeometry( width = listPtr->width; if (width <= 0) { width = (listPtr->maxWidth + listPtr->xScrollUnit - 1) - /listPtr->xScrollUnit; + / listPtr->xScrollUnit; if (width < 1) { width = 1; } @@ -2439,13 +2446,13 @@ ListboxDeleteSubCmd( * Remove selection information. */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); @@ -2739,18 +2746,12 @@ GetListboxIndex( start = stringRep + 1; y = strtol(start, &end, 0); if ((start == end) || (*end != ',')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } start = end+1; y = strtol(start, &end, 0); if ((start == end) || (*end != '\0')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } *indexPtr = NearestListboxElement(listPtr, y); return TCL_OK; @@ -2768,10 +2769,11 @@ GetListboxIndex( * Everything failed, nothing matched. Throw up an error message. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad listbox index \"", - Tcl_GetString(indexObj), "\": must be active, anchor, ", - "end, @x,y, or a number", NULL); + badIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad listbox index \"%s\": must be active, anchor, end, @x,y," + " or a number", Tcl_GetString(indexObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", NULL); return TCL_ERROR; } @@ -2903,7 +2905,7 @@ ListboxScanTo( */ newTopIndex = listPtr->scanMarkYIndex - - (10*(y - listPtr->scanMarkY))/listPtr->lineHeight; + - (10*(y - listPtr->scanMarkY)) / listPtr->lineHeight; if (newTopIndex > maxIndex) { newTopIndex = listPtr->scanMarkYIndex = maxIndex; listPtr->scanMarkY = y; @@ -2955,7 +2957,7 @@ NearestListboxElement( { int index; - index = (y - listPtr->inset)/listPtr->lineHeight; + index = (y - listPtr->inset) / listPtr->lineHeight; if (index >= (listPtr->fullLines + listPtr->partialLine)) { index = listPtr->fullLines + listPtr->partialLine - 1; } @@ -3026,7 +3028,7 @@ ListboxSelect( */ for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (!select) { Tcl_DeleteHashEntry(entry); @@ -3037,8 +3039,8 @@ ListboxSelect( } } else { if (select) { - entry = Tcl_CreateHashEntry(listPtr->selection, - (char *) INT2PTR(i), &isNew); + entry = Tcl_CreateHashEntry(listPtr->selection, KEY(i), + &isNew); Tcl_SetHashValue(entry, NULL); listPtr->numSelected++; if (firstRedisplay < 0) { @@ -3052,7 +3054,7 @@ ListboxSelect( EventuallyRedrawRange(listPtr, first, last); } if ((oldCount == 0) && (listPtr->numSelected > 0) - && (listPtr->exportSelection)) { + && listPtr->exportSelection) { Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, listPtr); } @@ -3109,7 +3111,7 @@ ListboxFetchSelection( needNewline = 0; Tcl_DStringInit(&selection); for (i = 0; i < listPtr->nElements; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (needNewline) { Tcl_DStringAppend(&selection, "\n", 1); @@ -3250,9 +3252,9 @@ ListboxUpdateVScrollbar( first = 0.0; last = 1.0; } else { - first = listPtr->topIndex / ((double) listPtr->nElements); + first = listPtr->topIndex / (double) listPtr->nElements; last = (listPtr->topIndex + listPtr->fullLines) - / ((double) listPtr->nElements); + / (double) listPtr->nElements; if (last > 1.0) { last = 1.0; } @@ -3309,15 +3311,15 @@ ListboxUpdateHScrollbar( if (listPtr->xScrollCmd == NULL) { return; } - windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset - + listPtr->selBorderWidth); + + windowWidth = Tk_Width(listPtr->tkwin) + - 2*(listPtr->inset + listPtr->selBorderWidth); if (listPtr->maxWidth == 0) { first = 0; last = 1.0; } else { - first = listPtr->xOffset/((double) listPtr->maxWidth); - last = (listPtr->xOffset + windowWidth) - /((double) listPtr->maxWidth); + first = listPtr->xOffset / (double) listPtr->maxWidth; + last = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth; if (last > 1.0) { last = 1.0; } @@ -3429,7 +3431,7 @@ ListboxListVarProc( * Clean up selection. */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); @@ -3439,8 +3441,7 @@ ListboxListVarProc( * Clean up attributes. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, - (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); @@ -3514,23 +3515,21 @@ MigrateHashEntries( if (offset > 0) { for (i = last; i >= first; i--) { - entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, - (char *) INT2PTR(i + offset), &isNew); + entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } } else { for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, - (char *) INT2PTR(i + offset), &isNew); + entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 49f49ad..12d6ebd 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -374,8 +374,8 @@ static void TkMenuCleanup(ClientData unused); static const Tk_ClassProcs menuClass = { sizeof(Tk_ClassProcs), /* size */ MenuWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -889,7 +889,7 @@ MenuWidgetObjCmd( goto error; } if (index < 0) { - Tcl_SetResult(interp, "none", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); } @@ -966,6 +966,7 @@ MenuWidgetObjCmd( } case MENU_TYPE: { int index; + const char *typeStr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -978,11 +979,11 @@ MenuWidgetObjCmd( goto done; } if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { - Tcl_SetResult(interp, "tearoff", TCL_STATIC); + typeStr = "tearoff"; } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - menuEntryTypeStrings[menuPtr->entries[index]->type], -1)); + typeStr = menuEntryTypeStrings[menuPtr->entries[index]->type]; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); break; } case MENU_UNPOST: @@ -2206,7 +2207,9 @@ TkGetMenuIndex( } } - Tcl_AppendResult(interp, "bad menu entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad menu entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; success: @@ -2390,9 +2393,9 @@ MenuAddOrInsert( index = menuPtr->numEntries; } if (index < 0) { - const char *indexString = Tcl_GetString(indexPtr); - - Tcl_AppendResult(interp, "bad index \"", indexString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\"", Tcl_GetString(indexPtr))); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; } if (menuPtr->tearoff && (index == 0)) { @@ -3265,6 +3268,7 @@ TkSetWindowMenuBar( && (cloneMenuRefPtr->menuPtr != NULL)) { Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1); Tcl_Obj *nullPtr = Tcl_NewObj(); + cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin; menuBarPtr = cloneMenuRefPtr->menuPtr; newObjv[0] = cursorPtr; @@ -3468,6 +3472,7 @@ TkFindMenuReferencesObj( Tcl_Obj *objPtr) /* The path of the menu widget. */ { const char *pathName = Tcl_GetString(objPtr); + return TkFindMenuReferences(interp, pathName); } diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 31dbfbb..545401c 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -23,8 +23,8 @@ static const Tk_ClassProcs menubuttonClass = { sizeof(Tk_ClassProcs), /* size */ TkMenuButtonWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* diff --git a/generic/tkMessage.c b/generic/tkMessage.c index 0787efc..4779e00 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -191,8 +191,8 @@ static void DisplayMessage(ClientData clientData); static const Tk_ClassProcs messageClass = { sizeof(Tk_ClassProcs), /* size */ MessageWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -277,7 +277,7 @@ Tk_MessageObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(msgPtr->tkwin)); return TCL_OK; } diff --git a/generic/tkObj.c b/generic/tkObj.c index 8877d42..ed947d3 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -506,6 +506,7 @@ SetPixelFromAny( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad screen distance \"%.50s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); } return TCL_ERROR; } @@ -734,8 +735,9 @@ SetMMFromAny( */ error: - Tcl_AppendResult(interp, "bad screen distance \"", string, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DISTANCE", NULL); return TCL_ERROR; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { @@ -1032,10 +1034,10 @@ TkParsePadAmount( if (specObj->typePtr == &pixelObjType) { if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK){ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", - Tcl_GetString(specObj), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(specObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } secondInt = firstInt; @@ -1051,8 +1053,9 @@ TkParsePadAmount( return TCL_ERROR; } if (objc != 1 && objc != 2) { - Tcl_AppendResult(interp, - "wrong number of parts to pad specification", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong number of parts to pad specification", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "PARTS", NULL); return TCL_ERROR; } @@ -1062,9 +1065,10 @@ TkParsePadAmount( if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK || (firstInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1077,10 +1081,10 @@ TkParsePadAmount( secondInt = firstInt; } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1], &secondInt) != TCL_OK || (secondInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad 2nd pad value \"", - Tcl_GetString(objv[1]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad 2nd pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index 1ab6ab6..5496076 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -95,7 +95,8 @@ Tk_ConfigureWidget( * we're on our way out of the application */ - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return TCL_ERROR; } @@ -135,7 +136,9 @@ Tk_ConfigureWidget( */ if (argc < 2) { - Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", arg)); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); return TCL_ERROR; } if (flags & TK_CONFIG_OBJS) { @@ -144,11 +147,8 @@ Tk_ConfigureWidget( arg = argv[1]; } if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - specPtr->argvName); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)",specPtr->argvName)); return TCL_ERROR; } if (!(flags & TK_CONFIG_ARGV_ONLY)) { @@ -181,12 +181,10 @@ Tk_ConfigureWidget( if (value != NULL) { if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != TCL_OK) { - char msg[200]; - - sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", - "database entry for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (%s \"%.50s\" in widget \"%.50s\")", + "database entry for", specPtr->dbName, + Tk_PathName(tkwin))); return TCL_ERROR; } } else { @@ -199,13 +197,10 @@ Tk_ConfigureWidget( & TK_CONFIG_DONT_SET_DEFAULT)) { if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != TCL_OK) { - char msg[200]; - - sprintf(msg, + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.50s\" in widget \"%.50s\")", - "default value for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); + "default value for", specPtr->dbName, + Tk_PathName(tkwin))); return TCL_ERROR; } } @@ -272,15 +267,18 @@ FindConfigSpec( goto gotMatch; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", argvName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL); return NULL; } matchPtr = specPtr; } if (matchPtr == NULL) { - Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL); return NULL; } @@ -294,8 +292,11 @@ FindConfigSpec( if (specPtr->type == TK_CONFIG_SYNONYM) { for (specPtr = specs; ; specPtr++) { if (specPtr->type == TK_CONFIG_END) { - Tcl_AppendResult(interp, "couldn't find synonym for option \"", - argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't find synonym for option \"%s\"", + argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, + NULL); return NULL; } if ((specPtr->dbName == matchPtr->dbName) @@ -546,14 +547,12 @@ DoConfig( return TCL_ERROR; } break; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad config table: unknown type %d", specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } specPtr++; } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); return TCL_OK; @@ -626,12 +625,13 @@ Tk_ConfigureInfo( Tcl_ResetResult(interp); if (argvName != NULL) { - specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags,hateFlags); + specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags, + hateFlags); if (specPtr == NULL) { return TCL_ERROR; } list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - Tcl_SetResult(interp, list, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(list, -1)); ckfree(list); return TCL_OK; } @@ -936,7 +936,7 @@ Tk_ConfigureValue( } result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, &freeProc); - Tcl_SetResult(interp, (char *) result, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); if (freeProc != NULL) { if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { ckfree(result); diff --git a/generic/tkOption.c b/generic/tkOption.c index d5c423f..ec9e465 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -541,7 +541,7 @@ Tk_GetOption( winClassId = Tk_GetUid(masqClass); ckfree(masqClass); - winNameId = ((TkWindow *)tkwin)->nameUid; + winNameId = ((TkWindow *) tkwin)->nameUid; levelPtr = &tsdPtr->levels[tsdPtr->curLevel]; @@ -619,11 +619,9 @@ Tk_OptionObjCmd( int index, result; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - static const char *const optionCmds[] = { "add", "clear", "get", "readfile", NULL }; - enum optionVals { OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE }; @@ -663,13 +661,12 @@ Tk_OptionObjCmd( } case OPTION_CLEAR: { - TkMainInfo *mainPtr; + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } - mainPtr = ((TkWindow *) tkwin)->mainPtr; if (mainPtr->optionRootPtr != NULL) { ClearOptionTree(mainPtr->optionRootPtr); mainPtr->optionRootPtr = NULL; @@ -693,7 +690,7 @@ Tk_OptionObjCmd( value = Tk_GetOption(window, Tcl_GetString(objv[3]), Tcl_GetString(objv[4])); if (value != NULL) { - Tcl_SetResult(interp, (char *) value, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); } break; } @@ -880,9 +877,11 @@ ParsePriority( priority = strtoul(string, &end, 0); if ((end == string) || (*end != 0) || (priority < 0) || (priority > 100)) { - Tcl_AppendResult(interp, "bad priority level \"", string, - "\": must be widgetDefault, startupFile, userDefault, ", - "interactive, or a number between 0 and 100", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad priority level \"%s\": must be " + "widgetDefault, startupFile, userDefault, " + "interactive, or a number between 0 and 100", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PRIORITY", NULL); return -1; } } @@ -964,10 +963,9 @@ AddFromString( dst = name = src; while (*src != ':') { if ((*src == '\0') || (*src == '\n')) { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing colon on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing colon on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "COLON", NULL); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -999,10 +997,9 @@ AddFromString( src++; } if (*src == '\0') { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing value on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing value on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "VALUE", NULL); return TCL_ERROR; } @@ -1014,10 +1011,9 @@ AddFromString( dst = value = src; while (*src != '\n') { if (*src == '\0') { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing newline on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing newline on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "NEWLINE", NULL); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -1066,7 +1062,7 @@ ReadOptionFile( Tcl_Interp *interp, /* Interpreter to use for reporting results. */ Tk_Window tkwin, /* Token for window: options are entered for * this window's main window. */ - const char *fileName, /* Name of file containing options. */ + const char *fileName, /* Name of file containing options. */ int priority) /* Priority level to use for options in this * file, such as TK_USER_DEFAULT_PRIO or * TK_INTERACTIVE_PRIO. Must be between 0 and @@ -1083,8 +1079,9 @@ ReadOptionFile( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't read options from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't read options from a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "OPTION_FILE", NULL); return TCL_ERROR; } @@ -1095,9 +1092,8 @@ ReadOptionFile( chan = Tcl_OpenFileChannel(interp, realName, "r", 0); Tcl_DStringFree(&newName); if (chan == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't open \"", fileName, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't open \"%s\": %s", + fileName, Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1110,8 +1106,9 @@ ReadOptionFile( Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error seeking to end of file \"", - fileName, "\":", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error seeking to end of file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1119,8 +1116,9 @@ ReadOptionFile( buffer = ckalloc(bufferSize + 1); bufferSize = Tcl_Read(chan, buffer, bufferSize); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error reading file \"", fileName, "\":", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1309,6 +1307,7 @@ SetupStacks( if (tsdPtr->curLevel >= tsdPtr->numLevels) { StackLevel *newLevels = ckalloc(tsdPtr->numLevels * 2 * sizeof(StackLevel)); + memcpy(newLevels, tsdPtr->levels, tsdPtr->numLevels * sizeof(StackLevel)); ckfree(tsdPtr->levels); diff --git a/generic/tkPack.c b/generic/tkPack.c index b32cc23..134b61f 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -133,11 +133,11 @@ static int YExpansion(Packer *slavePtr, int cavityHeight); /* *------------------------------------------------------------------------ * - * TkPrintPadAmount -- + * TkAppendPadAmount -- * * This function generates a text value that describes one of the -padx, * -pady, -ipadx, or -ipady configuration options. The text value - * generated is appended to the interpreter result. + * generated is appended to the given Tcl_Obj. * * Results: * None. @@ -149,21 +149,25 @@ static int YExpansion(Packer *slavePtr, int cavityHeight); */ void -TkPrintPadAmount( - Tcl_Interp *interp, /* The interpreter into which the result is +TkAppendPadAmount( + Tcl_Obj *bufferObj, /* The interpreter into which the result is * written. */ - const char *switchName, /* One of "padx", "pady", "ipadx" or "ipady" */ + const char *switchName, /* One of "padx", "pady", "ipadx" or + * "ipady" */ int halfSpace, /* The left or top padding amount */ int allSpace) /* The total amount of padding */ { - char buffer[60 + 2*TCL_INTEGER_SPACE]; + Tcl_Obj *padding[2]; + if (halfSpace*2 == allSpace) { - sprintf(buffer, " -%.10s %d", switchName, halfSpace); + Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1), + Tcl_NewIntObj(halfSpace)); } else { - sprintf(buffer, " -%.10s {%d %d}", switchName, halfSpace, - allSpace - halfSpace); + padding[0] = Tcl_NewIntObj(halfSpace); + padding[1] = Tcl_NewIntObj(allSpace - halfSpace); + Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1), + Tcl_NewListObj(2, padding)); } - Tcl_AppendResult(interp, buffer, NULL); } /* @@ -238,8 +242,9 @@ Tk_PackObjCmd( } prevPtr = GetPacker(tkwin2); if (prevPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } return PackAfter(interp, prevPtr, prevPtr->masterPtr, objc-3, objv+3); @@ -271,8 +276,9 @@ Tk_PackObjCmd( } packPtr = GetPacker(tkwin2); if (packPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } masterPtr = packPtr->masterPtr; @@ -293,8 +299,9 @@ Tk_PackObjCmd( } case PACK_CONFIGURE: if (argv2[0] != '.') { - Tcl_AppendResult(interp, "bad argument \"", argv2, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", argv2)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); return TCL_ERROR; } return ConfigureSlaves(interp, tkwin, objc-2, objv+2); @@ -323,6 +330,7 @@ Tk_PackObjCmd( case PACK_INFO: { register Packer *slavePtr; Tk_Window slave; + Tcl_Obj *infoObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -333,35 +341,44 @@ Tk_PackObjCmd( } slavePtr = GetPacker(slave); if (slavePtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); - Tcl_AppendElement(interp, "-anchor"); - Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); - Tcl_AppendResult(interp, " -expand ", - (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ", NULL); + + infoObj = Tcl_NewObj(); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1), + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-anchor", -1), + Tcl_NewStringObj(Tk_NameOfAnchor(slavePtr->anchor), -1)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-expand", -1), + Tcl_NewBooleanObj(slavePtr->flags & EXPAND)); switch (slavePtr->flags & (FILLX|FILLY)) { case 0: - Tcl_AppendResult(interp, "none", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("none", -1)); break; case FILLX: - Tcl_AppendResult(interp, "x", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("x", -1)); break; case FILLY: - Tcl_AppendResult(interp, "y", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("y", -1)); break; case FILLX|FILLY: - Tcl_AppendResult(interp, "both", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("both", -1)); break; } - TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX); - TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY); - TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX); - TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY); - Tcl_AppendResult(interp, " -side ", sideNames[slavePtr->side], NULL); + TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX); + TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY); + TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft,slavePtr->padX); + TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-side", -1), + Tcl_NewStringObj(sideNames[slavePtr->side], -1)); + Tcl_SetObjResult(interp, infoObj); break; } case PACK_PROPAGATE: { @@ -1096,9 +1113,10 @@ PackAfter( for ( ; objc > 0; objc -= 2, objv += 2, prevPtr = packPtr) { if (objc < 2) { - Tcl_AppendResult(interp, "wrong # args: window \"", - Tcl_GetString(objv[0]), "\" should be followed by options", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: window \"%s\" should be followed by options", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -1120,8 +1138,10 @@ PackAfter( } if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) { badWindow: - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[0]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[0]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } @@ -1179,8 +1199,10 @@ PackAfter( } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) { if (optionCount < (index+2)) { missingPad: - Tcl_AppendResult(interp, "wrong # args: \"", curOpt, - "\" option must be followed by screen distance", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: \"%s\" option must be" + " followed by screen distance", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -1207,8 +1229,11 @@ PackAfter( } else if ((c == 'f') && (length > 1) && (strncmp(curOpt, "frame", (size_t) length) == 0)) { if (optionCount < (index+2)) { - Tcl_AppendResult(interp, "wrong # args: \"frame\" ", - "option must be followed by anchor point", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args: \"frame\"" + " option must be followed by anchor point", -1)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } if (Tk_GetAnchorFromObj(interp, options[index+1], @@ -1217,15 +1242,17 @@ PackAfter( } index++; } else { - Tcl_AppendResult(interp, "bad option \"", curOpt, - "\": should be top, bottom, left, right, expand, ", - "fill, fillx, filly, padx, pady, or frame", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": should be top, bottom, left," + " right, expand, fill, fillx, filly, padx, pady, or" + " frame", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } } if (packPtr != prevPtr) { - /* * Unpack this window if it's currently packed. */ @@ -1534,8 +1561,10 @@ ConfigureSlaves( return TCL_ERROR; } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't pack \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetPacker(slave); @@ -1558,9 +1587,10 @@ ConfigureSlaves( for (i = numWindows; i < objc; i+=2) { if ((i+2) > objc) { - Tcl_AppendResult(interp, "extra option \"", - Tcl_GetString(objv[i]), - "\" (option with no value?)", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "extra option \"%s\" (option with no value?)", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "PACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", @@ -1578,8 +1608,10 @@ ConfigureSlaves( prevPtr = GetPacker(other); if (prevPtr->masterPtr == NULL) { notPacked: - Tcl_AppendResult(interp, "window \"", - Tcl_GetString(objv[i+1]), "\" isn't packed", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } @@ -1635,8 +1667,10 @@ ConfigureSlaves( } else if (strcmp(string, "both") == 0) { slavePtr->flags |= FILLX|FILLY; } else { - Tcl_AppendResult(interp, "bad fill style \"", string, - "\": must be none, x, y, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad fill style \"%s\": must be " + "none, x, y, or both", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILL", NULL); return TCL_ERROR; } break; @@ -1658,24 +1692,22 @@ ConfigureSlaves( break; case CONF_IPADX: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; break; case CONF_IPADY: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -1752,14 +1784,17 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } if (slave == masterPtr->tkwin) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside itself", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside itself", Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 23ecf5d..4a4af53 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -658,10 +658,13 @@ PanedWindowWidgetObjCmd( objv[3], tkwin); } } - if (i == pwPtr->numSlaves) { - Tcl_SetResult(interp, "not managed by this window", TCL_STATIC); - } if (resultObj == NULL) { + if (i == pwPtr->numSlaves) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not managed by this window", -1)); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", + NULL); + } result = TCL_ERROR; } else { Tcl_SetObjResult(interp, resultObj); @@ -700,15 +703,11 @@ PanedWindowWidgetObjCmd( case PW_PANES: resultObj = Tcl_NewObj(); - - Tcl_IncrRefCount(resultObj); - for (i = 0; i < pwPtr->numSlaves; i++) { - Tcl_ListObjAppendElement(interp, resultObj, - Tcl_NewStringObj(Tk_PathName(pwPtr->slaves[i]->tkwin),-1)); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj(pwPtr->slaves[i]->tkwin)); } Tcl_SetObjResult(interp, resultObj); - Tcl_DecrRefCount(resultObj); break; case PW_PROXY: @@ -778,18 +777,19 @@ ConfigureSlaves( * A panedwindow cannot manage itself. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to itself", arg)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } else if (Tk_IsTopLevel(tkwin)) { /* * A panedwindow cannot manage a toplevel. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add toplevel ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add toplevel %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } else { /* @@ -803,9 +803,11 @@ ConfigureSlaves( break; } if (Tk_IsTopLevel(ancestor)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); return TCL_ERROR; } } @@ -862,9 +864,10 @@ ConfigureSlaves( */ if (haveLoc && index == -1) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkwin), - "\" is not managed by ", Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not managed by %s", + Tk_PathName(tkwin), Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", NULL); Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin); return TCL_ERROR; @@ -1086,7 +1089,6 @@ PanedWindowSashCommand( return TCL_ERROR; } - Tcl_ResetResult(interp); switch ((enum sashOptions) index) { case SASH_COORD: if (objc != 4) { @@ -1099,8 +1101,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } slavePtr = pwPtr->slaves[sash]; @@ -1121,8 +1124,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } @@ -1156,8 +1160,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } @@ -2398,10 +2403,11 @@ SetSticky( case ' ': case ',': case '\t': case '\r': case '\n': break; default: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(*value), "\": must be a string ", - "containing zero or more of n, e, s, and w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be a string" + " containing zero or more of n, e, s, and w", + Tcl_GetString(*value))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } } @@ -2654,7 +2660,7 @@ MoveSash( * None. * * Side effects: - * When the window gets deleted, internal structures get cleaned up. Whena + * When the window gets deleted, internal structures get cleaned up. When * it gets exposed, it is redisplayed. * *-------------------------------------------------------------- @@ -2958,10 +2964,8 @@ PanedWindowIdentifyCoords( Tcl_Interp *interp, /* Interpreter in which to store result. */ int x, int y) /* Coordinates of the point to identify. */ { - Tcl_Obj *list; int i, sashHeight, sashWidth, thisx, thisy; int found, isHandle, lpad, rpad, tpad, bpad; - list = Tcl_NewObj(); if (pwPtr->orient == ORIENT_HORIZONTAL) { if (Tk_IsMapped(pwPtr->tkwin)) { @@ -3036,16 +3040,17 @@ PanedWindowIdentifyCoords( } /* - * Set results. + * Set results. Note that the empty string is the default (this function + * is called inside the implementation of a command). */ if (found != -1) { - Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(found)); - Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj( - (isHandle ? "handle" : "sash"), -1)); - } + Tcl_Obj *list[2]; - Tcl_SetObjResult(interp, list); + list[0] = Tcl_NewIntObj(found); + list[1] = Tcl_NewStringObj((isHandle ? "handle" : "sash"), -1); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, list)); + } return TCL_OK; } diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 22072ce..afba488 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -343,7 +343,7 @@ Tk_PlaceObjCmd( for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, TkNewWindowObj(slavePtr->tkwin)); } Tcl_SetObjResult(interp, listPtr); @@ -619,8 +619,10 @@ ConfigureSlave( Tk_Window masterWin = (Tk_Window) NULL; if (Tk_TopWinHierarchy(tkwin)) { - Tcl_AppendResult(interp, "can't use placer on top-level window \"", - Tk_PathName(tkwin), "\"; use wm command instead", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use placer on top-level window \"%s\"; use " + "wm command instead", Tk_PathName(tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -652,7 +654,7 @@ ConfigureSlave( slavePtr->flags |= CHILD_WIDTH; } - if (((mask & IN_MASK) == 0) && (slavePtr->masterPtr != NULL)) { + if (!(mask & IN_MASK) && (slavePtr->masterPtr != NULL)) { /* * If no -in option was passed and the slave is already placed then * just recompute the placement. @@ -678,16 +680,18 @@ ConfigureSlave( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to ", - Tk_PathName(tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to %s", + Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } if (slavePtr->tkwin == tkwin) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to itself", + Tk_PathName(slavePtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } if ((slavePtr->masterPtr != NULL) @@ -771,54 +775,50 @@ PlaceInfoCommand( Tcl_Interp *interp, /* Interp into which to place result. */ Tk_Window tkwin) /* Token for the window to get info on. */ { - char buffer[32 + TCL_INTEGER_SPACE]; Slave *slavePtr; + Tcl_Obj *infoObj; slavePtr = FindSlave(tkwin); if (slavePtr == NULL) { return TCL_OK; } + infoObj = Tcl_NewObj(); if (slavePtr->masterPtr != NULL) { - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); + Tcl_AppendToObj(infoObj, "-in", -1); + Tcl_ListObjAppendElement(NULL, infoObj, + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_AppendToObj(infoObj, " ", -1); } - sprintf(buffer, " -x %d", slavePtr->x); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -relx %.4g", slavePtr->relX); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -y %d", slavePtr->y); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -rely %.4g", slavePtr->relY); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + "-x %d -relx %.4g -y %d -rely %.4g", + slavePtr->x, slavePtr->relX, slavePtr->y, slavePtr->relY); if (slavePtr->flags & CHILD_WIDTH) { - sprintf(buffer, " -width %d", slavePtr->width); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, " -width %d", slavePtr->width); } else { - Tcl_AppendResult(interp, " -width {}", NULL); + Tcl_AppendToObj(infoObj, " -width {}", -1); } if (slavePtr->flags & CHILD_REL_WIDTH) { - sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + " -relwidth %.4g", slavePtr->relWidth); } else { - Tcl_AppendResult(interp, " -relwidth {}", NULL); + Tcl_AppendToObj(infoObj, " -relwidth {}", -1); } if (slavePtr->flags & CHILD_HEIGHT) { - sprintf(buffer, " -height %d", slavePtr->height); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, " -height %d", slavePtr->height); } else { - Tcl_AppendResult(interp, " -height {}", NULL); + Tcl_AppendToObj(infoObj, " -height {}", -1); } if (slavePtr->flags & CHILD_REL_HEIGHT) { - sprintf(buffer, " -relheight %.4g", slavePtr->relHeight); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + " -relheight %.4g", slavePtr->relHeight); } else { - Tcl_AppendResult(interp, " -relheight {}", NULL); + Tcl_AppendToObj(infoObj, " -relheight {}", -1); } - Tcl_AppendElement(interp, "-anchor"); - Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); - Tcl_AppendElement(interp, "-bordermode"); - Tcl_AppendElement(interp, borderModeStrings[slavePtr->borderMode]); + Tcl_AppendPrintfToObj(infoObj, " -anchor %s -bordermode %s", + Tk_NameOfAnchor(slavePtr->anchor), + borderModeStrings[slavePtr->borderMode]); + Tcl_SetObjResult(interp, infoObj); return TCL_OK; } @@ -1183,8 +1183,8 @@ PlaceRequestProc( Slave *slavePtr = clientData; Master *masterPtr; - if (((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) != 0) - && ((slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) != 0)) { + if ((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) + && (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT))) { return; } masterPtr = slavePtr->masterPtr; diff --git a/generic/tkPointer.c b/generic/tkPointer.c index eab6e48..451373d 100644 --- a/generic/tkPointer.c +++ b/generic/tkPointer.c @@ -286,7 +286,7 @@ Tk_UpdatePointer( tsdPtr->restrictWinPtr = winPtr; TkpSetCapture(tsdPtr->restrictWinPtr); - } else if ((tsdPtr->lastState & ALL_BUTTONS) == 0) { + } else if (!(tsdPtr->lastState & ALL_BUTTONS)) { /* * Mouse is in a non-button grab, so ensure the button * grab is inside the grab tree. diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index 630737c..a51ca33 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -318,17 +318,13 @@ RectOvalCoords( */ if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[0])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[1])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[2])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[3])); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *bbox[4]; + + bbox[0] = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]); + bbox[1] = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]); + bbox[2] = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]); + bbox[3] = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); return TCL_OK; } @@ -348,10 +344,11 @@ RectOvalCoords( */ if (objc != 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", + (rectOvalPtr->header.typePtr == &tkRectangleType + ? "RECTANGLE" : "OVAL"), NULL); return TCL_ERROR; } @@ -515,9 +512,10 @@ ConfigureRectOval( } #ifdef MAC_OSX_TK /* - * Mac OS X CG drawing needs access to the outline linewidth - * even for fills (as linewidth controls antialiasing). + * Mac OS X CG drawing needs access to the outline linewidth even for + * fills (as linewidth controls antialiasing). */ + gcValues.line_width = rectOvalPtr->outline.gc != None ? rectOvalPtr->outline.gc->line_width : 0; mask |= GCLineWidth; @@ -677,7 +675,7 @@ ComputeRectOvalBbox( bloat = 1; #else bloat = 0; -#endif +#endif /* __WIN32__ */ } else { #ifdef MAC_OSX_TK /* @@ -689,7 +687,7 @@ ComputeRectOvalBbox( bloat = (int) (width+1.5)/2; #else bloat = (int) (width+1)/2; -#endif +#endif /* MAC_OSX_TK */ } /* @@ -757,9 +755,9 @@ DisplayRectOval( * will die if it isn't. */ - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0],rectOvalPtr->bbox[1], &x1, &y1); - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2],rectOvalPtr->bbox[3], &x2, &y2); if (x2 <= x1) { x2 = x1+1; @@ -1293,13 +1291,14 @@ RectOvalToPostscript( * information; 0 means final Postscript is * being created. */ { - char pathCmd[500]; + Tcl_Obj *pathObj, *psObj; RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; double y1, y2; XColor *color; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]); @@ -1310,12 +1309,23 @@ RectOvalToPostscript( */ if (rectOvalPtr->header.typePtr == &tkRectangleType) { - sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n", + pathObj = Tcl_ObjPrintf( + "%.15g %.15g moveto " + "%.15g 0 rlineto " + "0 %.15g rlineto " + "%.15g 0 rlineto " + "closepath\n", rectOvalPtr->bbox[0], y1, - rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1, + rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], + y2-y1, rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]); } else { - sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", + pathObj = Tcl_ObjPrintf( + "matrix currentmatrix\n" + "%.15g %.15g translate " + "%.15g %.15g scale " + "1 0 moveto 0 0 1 0 360 arc\n" + "setmatrix\n", (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2, (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2); } @@ -1349,24 +1359,38 @@ RectOvalToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * First draw the filled area of the rectangle. */ if (fillColor != NULL) { - Tcl_AppendResult(interp, pathCmd, NULL); + Tcl_AppendObjToObj(psObj, pathObj); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1375,14 +1399,32 @@ RectOvalToPostscript( */ if (color != NULL) { - Tcl_AppendResult(interp, pathCmd, "0 setlinejoin 2 setlinecap\n", - NULL); + Tcl_AppendObjToObj(psObj, pathObj); + Tcl_AppendToObj(psObj, "0 setlinejoin 2 setlinecap\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &rectOvalPtr->outline)!= TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); + Tcl_DecrRefCount(pathObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + Tcl_DecrRefCount(pathObj); + return TCL_ERROR; } /* diff --git a/generic/tkScale.c b/generic/tkScale.c index 5e577e9..3ca4a67 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -376,6 +376,7 @@ ScaleWidgetObjCmd( case COMMAND_COORDS: { int x, y; double value; + Tcl_Obj *coords[2]; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); @@ -397,7 +398,9 @@ ScaleWidgetObjCmd( y = scalePtr->horizTroughY + scalePtr->width/2 + scalePtr->borderWidth; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", x, y)); + coords[0] = Tcl_NewIntObj(x); + coords[1] = Tcl_NewIntObj(y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); break; } case COMMAND_GET: { @@ -421,7 +424,8 @@ ScaleWidgetObjCmd( break; } case COMMAND_IDENTIFY: { - int x, y, thing; + int x, y; + const char *zone = ""; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); @@ -431,18 +435,12 @@ ScaleWidgetObjCmd( || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScaleElement(scalePtr, x,y); - switch (thing) { - case TROUGH1: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case TROUGH2: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; + switch (TkpScaleElement(scalePtr, x, y)) { + case TROUGH1: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case TROUGH2: zone = "trough2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); break; } case COMMAND_SET: { diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 49ddca0..2d91db6 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -12,6 +12,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +/* + * TODO: Convert scrollbars to the Tcl_Obj API. + */ + #include "tkInt.h" #include "tkScrollbar.h" #include "default.h" @@ -132,8 +136,10 @@ Tk_ScrollbarCmd( Tk_Window newWin; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?-option value ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s pathName ?-option value ...?\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -230,8 +236,9 @@ ScrollbarWidgetCmd( int c; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s option ?arg ...?\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } Tcl_Preserve(scrollPtr); @@ -239,23 +246,23 @@ ScrollbarWidgetCmd( length = strlen(argv[1]); if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { int oldActiveField; + if (argc == 2) { + const char *zone = ""; + switch (scrollPtr->activeField) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + case TOP_ARROW: zone = "arrow1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); goto done; } if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " activate element\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s activate element\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } c = argv[2][0]; @@ -276,9 +283,9 @@ ScrollbarWidgetCmd( } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) && (length >= 2)) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " cget option\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s cget option\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } result = Tk_ConfigureValue(interp, scrollPtr->tkwin, @@ -300,8 +307,10 @@ ScrollbarWidgetCmd( double fraction; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delta xDelta yDelta\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s delta xDelta yDelta\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK) @@ -328,8 +337,9 @@ ScrollbarWidgetCmd( double fraction; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " fraction x y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s fraction x y\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) @@ -357,20 +367,19 @@ ScrollbarWidgetCmd( } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + Tcl_Obj *resObjs[4]; + if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s get\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if (scrollPtr->flags & NEW_STYLE_COMMANDS) { - Tcl_Obj *resObjs[2]; - resObjs[0] = Tcl_NewDoubleObj(scrollPtr->firstFraction); resObjs[1] = Tcl_NewDoubleObj(scrollPtr->lastFraction); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resObjs)); } else { - Tcl_Obj *resObjs[4]; - resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits); resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits); resObjs[2] = Tcl_NewIntObj(scrollPtr->firstUnit); @@ -378,35 +387,27 @@ ScrollbarWidgetCmd( Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs)); } } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { - int x, y, thing; + int x, y; + const char *zone = ""; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " identify x y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s identify x y\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScrollbarPosition(scrollPtr, x,y); - switch (thing) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case TOP_GAP: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_GAP: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + switch (TkpScrollbarPosition(scrollPtr, x, y)) { + case TOP_ARROW: zone = "arrow1"; break; + case TOP_GAP: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_GAP: zone = "trough2"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { int totalUnits, windowUnits, firstUnit, lastUnit; @@ -473,18 +474,22 @@ ScrollbarWidgetCmd( } scrollPtr->flags &= ~NEW_STYLE_COMMANDS; } else { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " set firstFraction lastFraction\" or \"", - argv[0], - " set totalUnits windowUnits firstUnit lastUnit\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be " + "\"%s set firstFraction lastFraction\" or " + "\"%s set totalUnits windowUnits firstUnit lastUnit\"", + argv[0], argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } TkpComputeScrollbarGeometry(scrollPtr); TkScrollbarEventuallyRedraw(scrollPtr); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be activate, cget, configure, delta, fraction, ", - "get, identify, or set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be activate, cget, configure," + " delta, fraction, get, identify, or set", argv[1])); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + argv[1], NULL); goto error; } @@ -538,7 +543,7 @@ ConfigureScrollbar( */ if (scrollPtr->command != NULL) { - scrollPtr->commandSize = (int)strlen(scrollPtr->command); + scrollPtr->commandSize = (int) strlen(scrollPtr->command); } else { scrollPtr->commandSize = 0; } @@ -602,8 +607,7 @@ TkScrollbarEventProc( * Tk_FreeOptions handle all the standard option-related stuff. */ - Tk_FreeOptions(configSpecs, (char *) scrollPtr, - scrollPtr->display, 0); + Tk_FreeOptions(configSpecs, (char*) scrollPtr, scrollPtr->display, 0); Tcl_EventuallyFree(scrollPtr, TCL_DYNAMIC); } else if (eventPtr->type == ConfigureNotify) { TkpComputeScrollbarGeometry(scrollPtr); @@ -683,10 +687,10 @@ void TkScrollbarEventuallyRedraw( TkScrollbar *scrollPtr) /* Information about widget. */ { - if ((scrollPtr->tkwin == NULL) || (!Tk_IsMapped(scrollPtr->tkwin))) { + if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(scrollPtr->tkwin)) { return; } - if ((scrollPtr->flags & REDRAW_PENDING) == 0) { + if (!(scrollPtr->flags & REDRAW_PENDING)) { Tcl_DoWhenIdle(TkpDisplayScrollbar, scrollPtr); scrollPtr->flags |= REDRAW_PENDING; } diff --git a/generic/tkSelect.c b/generic/tkSelect.c index ee52ba1..2414b3d 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -638,9 +638,10 @@ Tk_GetSelection( clientData); cantget: - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), + Tk_GetAtomName(tkwin, target))); return TCL_ERROR; } @@ -708,8 +709,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -767,8 +769,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -844,8 +847,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -868,7 +872,8 @@ Tk_SelectionObjCmd( } if ((count < 2) || (count > 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? window command"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? window command"); return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin); @@ -929,8 +934,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -972,7 +978,7 @@ Tk_SelectionObjCmd( if (tkwin == NULL) { return TCL_ERROR; } - winPtr = (TkWindow *)tkwin; + winPtr = (TkWindow *) tkwin; for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->selection == selection) { @@ -986,7 +992,7 @@ Tk_SelectionObjCmd( if ((infoPtr != NULL) && (infoPtr->owner != winPtr->dispPtr->clipWindow)) { - Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner)); } return TCL_OK; } @@ -1285,7 +1291,7 @@ SelGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - const char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend(clientData, portion, -1); return TCL_OK; @@ -1320,13 +1326,11 @@ HandleTclCommand( int maxBytes) /* Maximum # of bytes to store at buffer. */ { CommandInfo *cmdInfoPtr = clientData; - int spaceNeeded, length; -#define MAX_STATIC_SIZE 100 - char staticSpace[MAX_STATIC_SIZE]; - char *command; + int length; + Tcl_Obj *command; const char *string; Tcl_Interp *interp = cmdInfoPtr->interp; - Tcl_DString oldResult; + Tcl_InterpState savedState; int extraBytes, charOffset, count, numChars, code; const char *p; @@ -1363,23 +1367,23 @@ HandleTclCommand( * the offset and maximum # of bytes. */ - spaceNeeded = cmdInfoPtr->cmdLength + 30; - if (spaceNeeded < MAX_STATIC_SIZE) { - command = staticSpace; - } else { - command = ckalloc(spaceNeeded); - } - sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes); + command = Tcl_ObjPrintf("%s %d %d", + cmdInfoPtr->command, charOffset, maxBytes); + Tcl_IncrRefCount(command); /* * Execute the command. Be sure to restore the state of the interpreter * after executing the command. */ - Tcl_DStringInit(&oldResult); - Tcl_DStringGetResult(interp, &oldResult); - code = Tcl_EvalEx(interp, command, -1, TCL_EVAL_GLOBAL); + savedState = Tcl_SaveInterpState(interp, TCL_OK); + code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(command); if (code == TCL_OK) { + /* + * TODO: This assumes that bytes are characters; that's not true! + */ + string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); count = (length > maxBytes) ? maxBytes : length; memcpy(buffer, string, (size_t) count); @@ -1424,11 +1428,7 @@ HandleTclCommand( } count = -1; } - Tcl_DStringResult(interp, &oldResult); - - if (command != staticSpace) { - ckfree(command); - } + (void) Tcl_RestoreInterpState(interp, savedState); Tcl_Release(clientData); Tcl_Release(interp); @@ -1498,6 +1498,7 @@ TkSelDefaultSelection( && (selPtr->target != dispPtr->windowAtom)) { const char *atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target); + Tcl_DStringAppendElement(&ds, atomString); } } @@ -1564,11 +1565,10 @@ LostSelection( ClientData clientData) /* Pointer to LostCommand structure. */ { LostCommand *lostPtr = clientData; - Tcl_Obj *objPtr; - Tcl_Interp *interp; + Tcl_Interp *interp = lostPtr->interp; + Tcl_InterpState savedState; int code; - interp = lostPtr->interp; Tcl_Preserve(interp); /* @@ -1576,19 +1576,13 @@ LostSelection( * it after executing the command. */ - objPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(objPtr); + savedState = Tcl_SaveInterpState(interp, TCL_OK); Tcl_ResetResult(interp); - code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } - - Tcl_SetObjResult(interp, objPtr); - Tcl_DecrRefCount(objPtr); - - Tcl_Release(interp); + (void) Tcl_RestoreInterpState(interp, savedState); /* * Free the storage for the command, since we're done with it now. @@ -1596,6 +1590,7 @@ LostSelection( Tcl_DecrRefCount(lostPtr->cmdObj); ckfree(lostPtr); + Tcl_Release(interp); } /* diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 271243e..b1cdd53 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -55,7 +55,7 @@ TkpSync(Display *display) void TkCreateXEventSource(void) { - TkWinXInit(Tk_GetHINSTANCE()); + TkWinXInit(Tk_GetHINSTANCE()); } # define TkUnixContainerId 0 @@ -105,7 +105,7 @@ TkpPrintWindowId( * the hex representation of a pointer. */ Window window) /* Window to be printed into buffer. */ { - sprintf(buf, "%#08lx", (unsigned long) (window)); + sprintf(buf, "%#08lx", (unsigned long) (window)); } int diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index 53f177d..b4063b5 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -124,9 +124,8 @@ Tk_InitStubs( } if (!stubsPtr) { - Tcl_SetResult(interp, - "This implementation of Tk does not support stubs", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this implementation of Tk does not support stubs", -1)); return NULL; } diff --git a/generic/tkStyle.c b/generic/tkStyle.c index 76291fa..d5e1407 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -1356,8 +1356,9 @@ Tk_GetStyle( entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name!=NULL?name:"")); if (entryPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "style \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "STYLE", name, NULL); } return (Tk_Style) NULL; } diff --git a/generic/tkText.c b/generic/tkText.c index 56a98e7..e7b1c4d 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -760,13 +760,13 @@ TextWidgetObjCmd( } else { Tcl_Obj *objPtr = Tk_GetOptionValue(interp, (char *) textPtr, textPtr->optionTable, objv[2], textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } break; case TEXT_COMPARE: { @@ -792,12 +792,7 @@ TextWidgetObjCmd( if ((p[1] == '=') && (p[2] == 0)) { value = (relation <= 0); } else if (p[1] != 0) { - compareError: - Tcl_AppendResult(interp, "bad comparison operator \"", - Tcl_GetString(objv[3]), - "\": must be <, <=, ==, >=, >, or !=", NULL); - result = TCL_ERROR; - goto done; + goto compareError; } } else if (p[0] == '>') { value = (relation > 0); @@ -815,18 +810,26 @@ TextWidgetObjCmd( } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); break; + + compareError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad comparison operator \"%s\": must be" + " <, <=, ==, >=, >, or !=", Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COMPARISON", NULL); + result = TCL_ERROR; + goto done; } case TEXT_CONFIGURE: if (objc <= 3) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) textPtr, textPtr->optionTable, ((objc == 3) ? objv[2] : NULL), textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureText(interp, textPtr, objc-2, objv+2); } @@ -837,7 +840,8 @@ TextWidgetObjCmd( Tcl_Obj *objPtr = NULL; if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? index1 index2"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? index1 index2"); result = TCL_ERROR; goto done; } @@ -859,15 +863,7 @@ TextWidgetObjCmd( char c; if (length < 2 || option[0] != '-') { - badOption: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad option \"", - Tcl_GetString(objv[i]), - "\" must be -chars, -displaychars, -displayindices, ", - "-displaylines, -indices, -lines, -update, ", - "-xpixels, or -ypixels", NULL); - result = TCL_ERROR; - goto done; + goto badOption; } c = option[1]; if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) { @@ -1037,6 +1033,15 @@ TextWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); } break; + + badOption: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\" must be -chars, -displaychars, " + "-displayindices, -displaylines, -indices, -lines, -update, " + "-xpixels, or -ypixels", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_OPTION", NULL); + result = TCL_ERROR; + goto done; } case TEXT_DEBUG: if (objc > 3) { @@ -1257,7 +1262,7 @@ TextWidgetObjCmd( if (objc > 3) { name = Tcl_GetStringFromObj(objv[i], &length); if (length > 1 && name[0] == '-') { - if (strncmp("-displaychars", name, (unsigned)length)==0) { + if (strncmp("-displaychars", name, (unsigned) length) == 0) { i++; visible = 1; name = Tcl_GetStringFromObj(objv[i], &length); @@ -1395,9 +1400,10 @@ TextWidgetObjCmd( goto done; } if (TkTextIndexCmp(indexFromPtr, indexToPtr) > 0) { - Tcl_AppendResult(interp, "Index \"", Tcl_GetString(objv[3]), - "\" before \"", Tcl_GetString(objv[2]), - "\" in the text", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" before \"%s\" in the text", + Tcl_GetString(objv[3]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL); result = TCL_ERROR; goto done; } @@ -1663,7 +1669,7 @@ TextPeerCmd( return TCL_ERROR; } - switch ((enum peerOptions)index) { + switch ((enum peerOptions) index) { case PEER_CREATE: if (objc < 4) { Tcl_WrongNumArgs(interp, 3, objv, "pathName ?-option value ...?"); @@ -1673,17 +1679,21 @@ TextPeerCmd( objc-2, objv+2); case PEER_NAMES: { TkText *tPtr = textPtr->sharedTextPtr->peers; + Tcl_Obj *peersObj; if (objc > 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + peersObj = Tcl_NewObj(); while (tPtr != NULL) { if (tPtr != textPtr) { - Tcl_AppendElement(interp, Tk_PathName(tPtr->tkwin)); + Tcl_ListObjAppendElement(NULL, peersObj, + TkNewWindowObj(tPtr->tkwin)); } tPtr = tPtr->next; } + Tcl_SetObjResult(interp, peersObj); } } @@ -2054,9 +2064,9 @@ ConfigureText( end = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL); } if (start > end) { - Tcl_AppendResult(interp, - "-startline must be less than or equal to -endline", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-startline must be less than or equal to -endline", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -2089,6 +2099,7 @@ ConfigureText( /* Nothing tagged with "sel" */ } else { int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr); + if (line < start) { selChanged = 1; } else { @@ -3657,13 +3668,14 @@ TextSearchCmd( SearchSpec searchSpec; static const char *const switchStrings[] = { + "-hidden", "--", "-all", "-backwards", "-count", "-elide", "-exact", "-forwards", - "-hidden", "-nocase", "-nolinestop", "-overlap", "-regexp", - "-strictlimits", NULL + "-nocase", "-nolinestop", "-overlap", "-regexp", "-strictlimits", NULL }; enum SearchSwitches { + SEARCH_HIDDEN, SEARCH_END, SEARCH_ALL, SEARCH_BACK, SEARCH_COUNT, SEARCH_ELIDE, - SEARCH_EXACT, SEARCH_FWD, SEARCH_HIDDEN, SEARCH_NOCASE, + SEARCH_EXACT, SEARCH_FWD, SEARCH_NOCASE, SEARCH_NOLINESTOP, SEARCH_OVERLAP, SEARCH_REGEXP, SEARCH_STRICTLIMITS }; @@ -3696,21 +3708,20 @@ TextSearchCmd( for (i=2 ; i<objc ; i++) { int index; + if (Tcl_GetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], switchStrings, "switch", 0, + if (Tcl_GetIndexFromObj(NULL, objv[i], switchStrings, "switch", 0, &index) != TCL_OK) { /* - * Hide the -hidden option. + * Hide the -hidden option, generating the error description with + * the side effects of T_GIFO. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad switch \"", Tcl_GetString(objv[i]), - "\": must be --, -all, -backward, -count, -elide, ", - "-exact, -forward, -nocase, -nolinestop, -overlap, ", - "-regexp, or -strictlimits", NULL); + (void) Tcl_GetIndexFromObj(interp, objv[i], switchStrings+1, + "switch", 0, &index); return TCL_ERROR; } @@ -3726,8 +3737,9 @@ TextSearchCmd( break; case SEARCH_COUNT: if (i >= objc-1) { - Tcl_SetResult(interp, "no value given for \"-count\" option", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no value given for \"-count\" option", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "VALUE", NULL); return TCL_ERROR; } i++; @@ -3778,14 +3790,18 @@ TextSearchCmd( } if (searchSpec.noLineStop && searchSpec.exact) { - Tcl_SetResult(interp, "the \"-nolinestop\" option requires the " - "\"-regexp\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-nolinestop\" option requires the \"-regexp\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } if (searchSpec.overlap && !searchSpec.all) { - Tcl_SetResult(interp, "the \"-overlap\" option requires the " - "\"-all\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-overlap\" option requires the \"-all\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } @@ -4402,8 +4418,10 @@ TkTextGetTabs( } if (tabPtr->location <= 0) { - Tcl_AppendResult(interp, "tab stop \"", Tcl_GetString(objv[i]), - "\" is not at a positive distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab stop \"%s\" is not at a positive distance", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL); goto error; } @@ -4433,11 +4451,11 @@ TkTextGetTabs( } lastStop = tabPtr->location; #else - Tcl_AppendResult(interp, - "tabs must be monotonically increasing, but \"", - Tcl_GetString(objv[i]), - "\" is smaller than or equal to the previous tab", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tabs must be monotonically increasing, but \"%s\" is " + "smaller than or equal to the previous tab", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL); goto error; #endif /* _TK_ALLOW_DECREASING_TABS */ } @@ -4568,10 +4586,7 @@ TextDumpCmd( case DUMP_CMD: arg++; if (arg >= objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); - return TCL_ERROR; + goto wrongArgs; } command = objv[arg]; break; @@ -4580,9 +4595,11 @@ TextDumpCmd( } } if (arg >= objc || arg+2 < objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); + wrongArgs: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Usage: %s dump ?-all -image -text -mark -tag -window? " + "?-command script? index ?index2?", Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (what == 0) { @@ -4603,7 +4620,7 @@ TextDumpCmd( return TCL_ERROR; } str = Tcl_GetStringFromObj(objv[arg], &length); - if (strncmp(str, "end", (unsigned)length) == 0) { + if (strncmp(str, "end", (unsigned) length) == 0) { atEnd = 1; } } @@ -4748,8 +4765,7 @@ DumpLine( int length = last - first; char *range = ckalloc(length + 1); - memcpy(range, segPtr->body.chars + first, - length * sizeof(char)); + memcpy(range, segPtr->body.chars + first, length); range[length] = '\0'; TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, @@ -4826,6 +4842,7 @@ DumpLine( command, &index, what); } } + offset += currentSize; if (lineChanged) { TkTextSegment *newSegPtr; @@ -4843,9 +4860,7 @@ DumpLine( linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineno); newSegPtr = linePtr->segPtr; - if (segPtr == newSegPtr) { - segPtr = segPtr->nextPtr; - } else { + if (segPtr != newSegPtr) { while ((newOffset < endByte) && (newOffset < offset) && (newSegPtr != NULL)) { newOffset += currentSize; @@ -4867,11 +4882,9 @@ DumpLine( } } segPtr = newSegPtr; - if (segPtr != NULL) { - segPtr = segPtr->nextPtr; - } } - } else { + } + if (segPtr != NULL) { segPtr = segPtr->nextPtr; } } @@ -4910,31 +4923,25 @@ DumpSegment( int what) /* Look for TK_DUMP_INDEX bit. */ { char buffer[TK_POS_CHARS]; + Tcl_Obj *values[3], *tuple; TkTextPrintIndex(textPtr, index, buffer); + values[0] = Tcl_NewStringObj(key, -1); + values[1] = Tcl_NewStringObj(value, -1); + values[2] = Tcl_NewStringObj(buffer, -1); + tuple = Tcl_NewListObj(3, values); if (command == NULL) { - Tcl_AppendElement(interp, key); - Tcl_AppendElement(interp, value); - Tcl_AppendElement(interp, buffer); + Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple); + Tcl_DecrRefCount(tuple); return 0; } else { - const char *argv[4]; - char *list; int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree); - argv[0] = key; - argv[1] = value; - argv[2] = buffer; - argv[3] = NULL; - list = Tcl_Merge(3, argv); - Tcl_VarEval(interp, Tcl_GetString(command), " ", list, NULL); - ckfree(list); - if ((textPtr->flags & DESTROYED) || - TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch) { - return 1; - } else { - return 0; - } + Tcl_VarEval(interp, Tcl_GetString(command), " ", Tcl_GetString(tuple), + NULL); + Tcl_DecrRefCount(tuple); + return ((textPtr->flags & DESTROYED) || + TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch); } } @@ -5057,8 +5064,7 @@ TextEditCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; - + int index, setModified, oldModified; static const char *const editOptionStrings[] = { "modified", "redo", "reset", "separator", "undo", NULL }; @@ -5081,39 +5087,36 @@ TextEditCmd( if (objc == 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(textPtr->sharedTextPtr->isDirty)); + return TCL_OK; } else if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "?boolean?"); return TCL_ERROR; - } else { - int setModified, oldModified; - - if (Tcl_GetBooleanFromObj(interp, objv[3], - &setModified) != TCL_OK) { - return TCL_ERROR; - } + } else if (Tcl_GetBooleanFromObj(interp, objv[3], + &setModified) != TCL_OK) { + return TCL_ERROR; + } - /* - * Set or reset the dirty info, and trigger a Modified event. - */ + /* + * Set or reset the dirty info, and trigger a Modified event. + */ - setModified = setModified ? 1 : 0; + setModified = setModified ? 1 : 0; - oldModified = textPtr->sharedTextPtr->isDirty; - textPtr->sharedTextPtr->isDirty = setModified; - if (setModified) { - textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED; - } else { - textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; - } + oldModified = textPtr->sharedTextPtr->isDirty; + textPtr->sharedTextPtr->isDirty = setModified; + if (setModified) { + textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED; + } else { + textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; + } - /* - * Only issue the <<Modified>> event if the flag actually changed. - * However, degree of modified-ness doesn't matter. [Bug 1799782] - */ + /* + * Only issue the <<Modified>> event if the flag actually changed. + * However, degree of modified-ness doesn't matter. [Bug 1799782] + */ - if ((!oldModified) != (!setModified)) { - GenerateModifiedEvent(textPtr); - } + if ((!oldModified) != (!setModified)) { + GenerateModifiedEvent(textPtr); } break; case EDIT_REDO: @@ -5122,7 +5125,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditRedo(textPtr)) { - Tcl_AppendResult(interp, "nothing to redo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL); return TCL_ERROR; } break; @@ -5146,7 +5150,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditUndo(textPtr)) { - Tcl_AppendResult(interp, "nothing to undo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL); return TCL_ERROR; } break; @@ -5206,11 +5211,10 @@ TextGetText( if (TkTextIndexCmp(indexPtr1, indexPtr2) < 0) { while (1) { - int offset, last; - TkTextSegment *segPtr; + int offset; + TkTextSegment *segPtr = TkTextIndexToSeg(&tmpIndex, &offset); + int last = segPtr->size, last2; - segPtr = TkTextIndexToSeg(&tmpIndex, &offset); - last = segPtr->size; if (tmpIndex.linePtr == indexPtr2->linePtr) { /* * The last line that was requested must be handled carefully, @@ -5220,21 +5224,17 @@ TextGetText( if (indexPtr2->byteIndex == tmpIndex.byteIndex) { break; - } else { - int last2 = indexPtr2->byteIndex - tmpIndex.byteIndex - + offset; - - if (last2 < last) { - last = last2; - } } - } - if (segPtr->typePtr == &tkTextCharType) { - if (!visibleOnly || !TkTextIsElided(textPtr,&tmpIndex,NULL)) { - Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, - last - offset); + last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset; + if (last2 < last) { + last = last2; } } + if (segPtr->typePtr == &tkTextCharType && + !(visibleOnly && TkTextIsElided(textPtr,&tmpIndex,NULL))){ + Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, + last - offset); + } TkTextIndexForwBytes(textPtr, &tmpIndex, last-offset, &tmpIndex); } } @@ -5262,7 +5262,10 @@ static void GenerateModifiedEvent( TkText *textPtr) /* Information about text widget. */ { - union {XEvent general; XVirtualEvent virtual;} event; + union { + XEvent general; + XVirtualEvent virtual; + } event; Tk_MakeWindowExist(textPtr->tkwin); @@ -5398,14 +5401,9 @@ SearchPerform( * wrap when given a negative search range). */ - if (searchSpecPtr->backwards) { - if (TkTextIndexCmp(indexFromPtr, indexToPtr) == -1) { - return TCL_OK; - } - } else { - if (TkTextIndexCmp(indexFromPtr, indexToPtr) == 1) { - return TCL_OK; - } + if (TkTextIndexCmp(indexFromPtr, indexToPtr) == + (searchSpecPtr->backwards ? -1 : 1)) { + return TCL_OK; } if (searchSpecPtr->lineIndexProc(interp, toPtr, searchSpecPtr, @@ -5712,7 +5710,7 @@ SearchCore( } while (p >= startOfLine + firstOffset) { if (p[0] == c && !strncmp(p, pattern, - (unsigned)matchLength)) { + (unsigned) matchLength)) { goto backwardsMatch; } p--; @@ -5741,7 +5739,7 @@ SearchCore( */ p = startOfLine + lastOffset - firstNewLine - 1; - if (strncmp(p, pattern, (unsigned)(firstNewLine + 1))) { + if (strncmp(p, pattern, (unsigned) firstNewLine + 1)) { /* * No match. */ @@ -6701,9 +6699,7 @@ TkpTesttextCmd( TkTextSetMark(textPtr, "insert", &index); TkTextPrintIndex(textPtr, &index, buf); - sprintf(buf + strlen(buf), " %d", index.byteIndex); - Tcl_AppendResult(interp, buf, NULL); - + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s %d", buf, index.byteIndex)); return TCL_OK; } diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 1b41e31..d75f61c 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -5987,8 +5987,11 @@ TkTextScanCmd( dInfoPtr->scanTotalYScroll = 0; dInfoPtr->scanMarkY = y; } else { - Tcl_AppendResult(interp, "bad scan option \"", Tcl_GetString(objv[2]), - "\": must be mark or dragto", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } return TCL_OK; @@ -7299,7 +7302,7 @@ CharChunkMeasureChars( return MeasureChars(tkfont, chars, charsLen, start, end-start, startX, maxX, flags, nextXPtr); -#else +#else /* TK_LAYOUT_WITH_BASE_CHUNKS */ { int xDisplacement; int fit, bstart = start, bend = end; @@ -7339,7 +7342,7 @@ CharChunkMeasureChars( return fit - bstart; } } -#endif +#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ } /* diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index 47ee49a..1770cb6 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -155,8 +155,10 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } objPtr = Tk_GetOptionValue(interp, (char *) &eiPtr->body.ei, @@ -178,14 +180,17 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } if (objc <= 5) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, (objc == 5) ? objv[4] : NULL, textPtr->tkwin); + if (objPtr == NULL) { return TCL_ERROR; } else { @@ -272,16 +277,20 @@ TkTextImageCmd( case CMD_NAMES: { Tcl_HashSearch search; Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } default: @@ -323,11 +332,12 @@ EmbImageConfigure( Tcl_HashEntry *hPtr; Tcl_HashSearch search; char *name; + int dummy; int count = 0; /* The counter for picking a unique name */ int conflict = 0; /* True if we have a name conflict */ - size_t len; /* length of image name */ + size_t len; /* length of image name */ - if (Tk_SetOptions(textPtr->interp, (char*)&eiPtr->body.ei, + if (Tk_SetOptions(textPtr->interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, objc, objv, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; @@ -369,9 +379,11 @@ EmbImageConfigure( name = eiPtr->body.ei.imageString; } if (name == NULL) { - Tcl_AppendResult(textPtr->interp, "Either a \"-name\" ", - "or a \"-image\" argument must be provided ", - "to the \"image create\" subcommand.", NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj( + "Either a \"-name\" or a \"-image\" argument must be" + " provided to the \"image create\" subcommand", -1)); + Tcl_SetErrorCode(textPtr->interp, "TK", "TEXT", "IMAGE_CREATE_USAGE", + NULL); return TCL_ERROR; } len = strlen(name); @@ -403,14 +415,10 @@ EmbImageConfigure( Tcl_DStringAppend(&newName, buf, -1); } name = Tcl_DStringValue(&newName); - { - int dummy; - - hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, - &dummy); - } + hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, + &dummy); Tcl_SetHashValue(hPtr, eiPtr); - Tcl_AppendResult(textPtr->interp, name, NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj(name, -1)); eiPtr->body.ei.name = ckalloc(Tcl_DStringLength(&newName) + 1); strcpy(eiPtr->body.ei.name, name); Tcl_DStringFree(&newName); diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index c11ce0b..25888d8 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -84,6 +84,7 @@ FreeTextIndexInternalRep( * free. */ { TkTextIndex *indexPtr = GET_TEXTINDEX(indexObjPtr); + if (indexPtr->textPtr != NULL) { if (--indexPtr->textPtr->refCount == 0) { /* @@ -133,7 +134,6 @@ UpdateStringOfTextIndex( { char buffer[TK_POS_CHARS]; register int len; - const TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); len = TkTextPrintIndex(indexPtr->textPtr, indexPtr, buffer); @@ -148,8 +148,10 @@ SetTextIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_AppendResult(interp, "can't convert value to textindex except " - "via TkTextGetIndexFromObj API", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't convert value to textindex except via" + " TkTextGetIndexFromObj API", -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } @@ -830,15 +832,14 @@ GetIndex( if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) { if (tagPtr == textPtr->selTagPtr) { tagName = "sel"; - } else { - if (hPtr != NULL) { - tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr); - } + } else if (hPtr != NULL) { + tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr); } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "text doesn't contain any characters tagged with \"", - tagName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "text doesn't contain any characters tagged with \"%s\"", + tagName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_INDEX", tagName, + NULL); Tcl_DStringFree(©); return TCL_ERROR; } @@ -1001,8 +1002,8 @@ GetIndex( error: Tcl_DStringFree(©); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad text index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad text index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "BAD_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 76ab1a9..a306a05 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -26,6 +26,7 @@ * Forward references for functions defined in this file: */ +static Tcl_Obj * GetMarkName(TkText *textPtr, TkTextSegment *segPtr); static void InsertUndisplayProc(TkText *textPtr, TkTextDispChunk *chunkPtr); static int MarkDeleteProc(TkTextSegment *segPtr, @@ -132,7 +133,7 @@ TkTextMarkCmd( Tcl_WrongNumArgs(interp, 3, objv, "markName ?gravity?"); return TCL_ERROR; } - str = Tcl_GetStringFromObj(objv[3],&length); + str = Tcl_GetStringFromObj(objv[3], &length); if (length == 6 && !strcmp(str, "insert")) { markPtr = textPtr->insertMarkPtr; } else if (length == 7 && !strcmp(str, "current")) { @@ -140,18 +141,23 @@ TkTextMarkCmd( } else { hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, str); if (hPtr == NULL) { - Tcl_AppendResult(interp, "there is no mark named \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "there is no mark named \"%s\"", str)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_MARK", str, + NULL); return TCL_ERROR; } markPtr = Tcl_GetHashValue(hPtr); } if (objc == 4) { + const char *typeStr; + if (markPtr->typePtr == &tkTextRightMarkType) { - Tcl_SetResult(interp, "right", TCL_STATIC); + typeStr = "right"; } else { - Tcl_SetResult(interp, "left", TCL_STATIC); + typeStr = "left"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); return TCL_OK; } str = Tcl_GetStringFromObj(objv[4],&length); @@ -162,8 +168,9 @@ TkTextMarkCmd( (strncmp(str, "right", (unsigned) length) == 0)) { newTypePtr = &tkTextRightMarkType; } else { - Tcl_AppendResult(interp, "bad mark gravity \"", str, - "\": must be left or right", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mark gravity \"%s\": must be left or right", str)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MARK_GRAVITY", NULL); return TCL_ERROR; } TkTextMarkSegToIndex(textPtr, markPtr, &index); @@ -172,19 +179,27 @@ TkTextMarkCmd( TkBTreeLinkSegment(markPtr, &index); break; } - case MARK_NAMES: + case MARK_NAMES: { + Tcl_Obj *resultObj; + if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } - Tcl_AppendElement(interp, "insert"); - Tcl_AppendElement(interp, "current"); + resultObj = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + "insert", -1)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + "current", -1)); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->markTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); break; + } case MARK_NEXT: if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "index"); @@ -843,28 +858,12 @@ MarkFindNext( for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) { if (segPtr->typePtr == &tkTextRightMarkType || segPtr->typePtr == &tkTextLeftMarkType) { - if (segPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - } else if (segPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - } else if (segPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - continue; - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - segPtr->body.mark.hPtr), TCL_STATIC); + Tcl_Obj *markName = GetMarkName(textPtr, segPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } - return TCL_OK; } } index.linePtr = TkBTreeNextLine(textPtr, index.linePtr); @@ -962,28 +961,11 @@ MarkFindPrev( } } if (prevPtr != NULL) { - if (prevPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - return TCL_OK; - } else if (prevPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - return TCL_OK; - } else if (prevPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - prevPtr->body.mark.hPtr), TCL_STATIC); - return TCL_OK; + Tcl_Obj *markName = GetMarkName(textPtr, prevPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } } index.linePtr = TkBTreePreviousLine(textPtr, index.linePtr); @@ -995,6 +977,46 @@ MarkFindPrev( } /* + * ------------------------------------------------------------------------ + * + * GetMarkName -- + * Returns the name of the mark that is the given text segment, or NULL + * if it is unnamed (i.e., a widget-specific mark that isn't "current" or + * "insert"). + * + * ------------------------------------------------------------------------ + */ + +static Tcl_Obj * +GetMarkName( + TkText *textPtr, + TkTextSegment *segPtr) +{ + const char *markName; + + if (segPtr == textPtr->currentMarkPtr) { + markName = "current"; + } else if (segPtr == textPtr->insertMarkPtr) { + markName = "insert"; + } else if (segPtr->body.mark.hPtr == NULL) { + /* + * Ignore widget-specific marks for the other widgets. This is either + * an insert or a current mark (markPtr->body.mark.hPtr actually + * receives NULL for these marks in TkTextSetMark). The insert and + * current marks for textPtr having already been tested above, the + * current segment is an insert or current mark from a peer of + * textPtr, which we don't want to return. + */ + + return NULL; + } else { + markName = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, + segPtr->body.mark.hPtr); + } + return Tcl_NewStringObj(markName, -1); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 6cd018a..beb7eb5 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -100,7 +100,7 @@ static TkTextTag * FindTag(Tcl_Interp *interp, TkText *textPtr, Tcl_Obj *tagName); static void SortTags(int numTags, TkTextTag **tagArrayPtr); static int TagSortProc(const void *first, const void *second); -static void TagBindEvent(TkText *textPtr, XEvent *eventPtr, +static void TagBindEvent(TkText *textPtr, XEvent *eventPtr, int numTags, TkTextTag **tagArrayPtr); /* @@ -213,7 +213,7 @@ TkTextTagCmd( if (tagPtr == textPtr->selTagPtr) { /* - * Send an event that the selection changed. This is + * Send an event that the selection changed. This is * equivalent to: * event generate $textWidget <<Selection>> */ @@ -276,10 +276,10 @@ TkTextTagCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable, (ClientData) tagPtr->name, Tcl_GetString(objv[4])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual ", - "events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL); return TCL_ERROR; } } else if (objc == 5) { @@ -302,7 +302,7 @@ TkTextTagCmd( } Tcl_ResetResult(interp); } else { - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } } else { Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable, @@ -457,11 +457,14 @@ TkTextTagCmd( &tagPtr->elide) != TCL_OK) { return TCL_ERROR; } - /* Indices are potentially obsolete after changing -elide, - * especially those computed with "display" or "any" - * submodifier, therefore increase the epoch. - */ - textPtr->sharedTextPtr->stateEpoch++; + + /* + * Indices are potentially obsolete after changing -elide, + * especially those computed with "display" or "any" + * submodifier, therefore increase the epoch. + */ + + textPtr->sharedTextPtr->stateEpoch++; } /* @@ -646,6 +649,7 @@ TkTextTagCmd( TkTextIndex last; TkTextSearch tSearch; char position[TK_POS_CHARS]; + Tcl_Obj *resultObj; if ((objc != 5) && (objc != 6)) { Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); @@ -714,11 +718,15 @@ TkTextTagCmd( if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) { return TCL_OK; } + resultObj = Tcl_NewObj(); TkTextPrintIndex(textPtr, &tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position, -1)); TkBTreeNextTag(&tSearch); TkTextPrintIndex(textPtr, &tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position, -1)); + Tcl_SetObjResult(interp, resultObj); break; } case TAG_PREVRANGE: { @@ -726,6 +734,7 @@ TkTextTagCmd( TkTextSearch tSearch; char position1[TK_POS_CHARS]; char position2[TK_POS_CHARS]; + Tcl_Obj *resultObj; if ((objc != 5) && (objc != 6)) { Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); @@ -773,8 +782,7 @@ TkTextTagCmd( TkTextPrintIndex(textPtr, &index2, position1); TkTextPrintIndex(textPtr, &index1, position2); - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + goto gotPrevIndexPair; } return TCL_OK; } @@ -824,8 +832,14 @@ TkTextTagCmd( } } } - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + + gotPrevIndexPair: + resultObj = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position1, -1)); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position2, -1)); + Tcl_SetObjResult(interp, resultObj); break; } case TAG_RAISE: { @@ -884,12 +898,12 @@ TkTextTagCmd( 0, &last); TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); if (TkBTreeCharTagged(&first, tagPtr)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &first)); count++; } while (TkBTreeNextTag(&tSearch)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &tSearch.curIndex)); count++; } @@ -900,7 +914,7 @@ TkTextTagCmd( * closed. In this case we add the end of the range. */ - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &last)); } Tcl_SetObjResult(interp, listObj); @@ -941,15 +955,15 @@ TkTextCreateTag( const char *name; if (!strcmp(tagName, "sel")) { - if (textPtr->selTagPtr != NULL) { + if (textPtr->selTagPtr != NULL) { if (newTag != NULL) { - *newTag = 0; + *newTag = 0; } - return textPtr->selTagPtr; - } + return textPtr->selTagPtr; + } if (newTag != NULL) { *newTag = 1; - } + } name = "sel"; } else { hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->tagTable, @@ -1048,15 +1062,15 @@ FindTag( * NULL, then don't record an error * message. */ TkText *textPtr, /* Widget in which tag is being used. */ - Tcl_Obj *tagName) /* Name of desired tag. */ + Tcl_Obj *tagName) /* Name of desired tag. */ { Tcl_HashEntry *hPtr; int len; const char *str; str = Tcl_GetStringFromObj(tagName, &len); - if (len == 3 && !strcmp(str,"sel")) { - return textPtr->selTagPtr; + if (len == 3 && !strcmp(str, "sel")) { + return textPtr->selTagPtr; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable, Tcl_GetString(tagName)); @@ -1064,8 +1078,11 @@ FindTag( return Tcl_GetHashValue(hPtr); } if (interp != NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(tagName), - "\" isn't defined in text widget", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tag \"%s\" isn't defined in text widget", + Tcl_GetString(tagName))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_TAG", + Tcl_GetString(tagName), NULL); } return NULL; } @@ -1385,7 +1402,7 @@ TkTextBindProc( XEvent *eventPtr) /* Pointer to X event that just happened. */ { TkText *textPtr = clientData; - int repick = 0; + int repick = 0; # define AnyButtonMask \ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask) @@ -1429,7 +1446,7 @@ TkTextBindProc( } } else if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) { - if (eventPtr->xcrossing.state & AnyButtonMask) { + if (eventPtr->xcrossing.state & AnyButtonMask) { textPtr->flags |= BUTTON_DOWN; } else { textPtr->flags &= ~BUTTON_DOWN; @@ -1437,7 +1454,7 @@ TkTextBindProc( TkTextPickCurrent(textPtr, eventPtr); goto done; } else if (eventPtr->type == MotionNotify) { - if (eventPtr->xmotion.state & AnyButtonMask) { + if (eventPtr->xmotion.state & AnyButtonMask) { textPtr->flags |= BUTTON_DOWN; } else { textPtr->flags &= ~BUTTON_DOWN; @@ -1561,7 +1578,7 @@ TkTextPickCurrent( = eventPtr->xmotion.same_screen; textPtr->pickEvent.xcrossing.focus = False; textPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state; - } else { + } else { textPtr->pickEvent = *eventPtr; } } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index 58d3198..d2998da 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -173,8 +173,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } @@ -210,8 +212,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } if (objc <= 5) { @@ -331,16 +335,20 @@ TkTextWindowCmd( case WIND_NAMES: { Tcl_HashSearch search; Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->windowTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); break; } } @@ -436,9 +444,12 @@ EmbWinConfigure( } if (Tk_TopWinHierarchy(ancestor)) { badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " in ", - Tk_PathName(textPtr->tkwin), NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s in %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); ewPtr->body.ew.tkwin = NULL; if (client != NULL) { client->tkwin = NULL; @@ -846,7 +857,8 @@ EmbWinLayoutProc( Tk_Window ancestor; Tcl_HashEntry *hPtr; const char *before, *string; - Tcl_DString name, buf, *dsPtr = NULL; + Tcl_DString buf, *dsPtr = NULL; + Tcl_Obj *nameObj; before = ewPtr->body.ew.create; @@ -905,36 +917,40 @@ EmbWinLayoutProc( code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create); } if (code != TCL_OK) { - createError: Tcl_BackgroundException(textPtr->interp, code); goto gotWindow; } - Tcl_DStringInit(&name); - Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1); + nameObj = Tcl_GetObjResult(textPtr->interp); + Tcl_IncrRefCount(nameObj); Tcl_ResetResult(textPtr->interp); ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp, - Tcl_DStringValue(&name), textPtr->tkwin); - Tcl_DStringFree(&name); + Tcl_GetString(nameObj), textPtr->tkwin); + Tcl_DecrRefCount(nameObj); if (ewPtr->body.ew.tkwin == NULL) { - goto createError; + Tcl_BackgroundError(textPtr->interp); + goto gotWindow; } + for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { - badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " relative to ", - Tk_PathName(textPtr->tkwin), NULL); - Tcl_BackgroundError(textPtr->interp); - ewPtr->body.ew.tkwin = NULL; - goto gotWindow; + goto badMaster; } } if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin) || (textPtr->tkwin == ewPtr->body.ew.tkwin)) { - goto badMaster; + badMaster: + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s relative to %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", "HIERARCHY", + NULL); + Tcl_BackgroundError(textPtr->interp); + ewPtr->body.ew.tkwin = NULL; + goto gotWindow; } if (client == NULL) { diff --git a/generic/tkTrig.c b/generic/tkTrig.c index d999062..a2bf456 100644 --- a/generic/tkTrig.c +++ b/generic/tkTrig.c @@ -1375,7 +1375,7 @@ TkMakeBezierPostscript( int closed, i; int numCoords = numPoints*2; double control[8]; - char buffer[200]; + Tcl_Obj *psObj; /* * If the curve is a closed one then generate a special spline that spans @@ -1394,7 +1394,9 @@ TkMakeBezierPostscript( control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - sprintf(buffer, "%.15g %.15g moveto\n%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + psObj = Tcl_ObjPrintf( + "%.15g %.15g moveto\n" + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[0], Tk_CanvasPsY(canvas, control[1]), control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), @@ -1403,10 +1405,9 @@ TkMakeBezierPostscript( closed = 0; control[6] = pointPtr[0]; control[7] = pointPtr[1]; - sprintf(buffer, "%.15g %.15g moveto\n", + psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n", control[6], Tk_CanvasPsY(canvas, control[7])); } - Tcl_AppendResult(interp, buffer, NULL); /* * Cycle through all the remaining points in the curve, generating a curve @@ -1432,12 +1433,15 @@ TkMakeBezierPostscript( control[4] = 0.333*control[6] + 0.667*pointPtr[0]; control[5] = 0.333*control[7] + 0.667*pointPtr[1]; - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), control[6], Tk_CanvasPsY(canvas, control[7])); - Tcl_AppendResult(interp, buffer, NULL); } + + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* @@ -1472,15 +1476,14 @@ TkMakeRawCurvePostscript( { int i; double *segPtr; - char buffer[200]; + Tcl_Obj *psObj; /* * Put the first point into the path. */ - sprintf(buffer, "%.15g %.15g moveto\n", + psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n", pointPtr[0], Tk_CanvasPsY(canvas, pointPtr[1])); - Tcl_AppendResult(interp, buffer, NULL); /* * Loop through all the remaining points in the curve, generating a @@ -1495,19 +1498,19 @@ TkMakeRawCurvePostscript( * neighbouring knots, so this segment is just a straight line. */ - sprintf(buffer, "%.15g %.15g lineto\n", + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", segPtr[6], Tk_CanvasPsY(canvas, segPtr[7])); } else { /* * This is a generic Bezier curve segment. */ - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", segPtr[2], Tk_CanvasPsY(canvas, segPtr[3]), segPtr[4], Tk_CanvasPsY(canvas, segPtr[5]), segPtr[6], Tk_CanvasPsY(canvas, segPtr[7])); } - Tcl_AppendResult(interp, buffer, NULL); } /* @@ -1532,20 +1535,23 @@ TkMakeRawCurvePostscript( * Straight line. */ - sprintf(buffer, "%.15g %.15g lineto\n", + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", control[6], Tk_CanvasPsY(canvas, control[7])); } else { /* * Bezier curve segment. */ - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), control[6], Tk_CanvasPsY(canvas, control[7])); } - Tcl_AppendResult(interp, buffer, NULL); } + + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 5282708..385d1cb 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -56,6 +56,7 @@ TkStateParseProc( int c; int flags = PTR2INT(clientData); size_t length; + Tcl_Obj *msgObj; register Tk_State *statePtr = (Tk_State *) (widgRec + offset); @@ -84,18 +85,20 @@ TkStateParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", - " value \"", value, "\": must be normal", NULL); - if (flags&1) { - Tcl_AppendResult(interp, ", active", NULL); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal", + ((flags & 4) ? "-default" : "state"), value); + if (flags & 1) { + Tcl_AppendToObj(msgObj, ", active", -1); } - if (flags&2) { - Tcl_AppendResult(interp, ", hidden", NULL); + if (flags & 2) { + Tcl_AppendToObj(msgObj, ", hidden", -1); } - if (flags&3) { - Tcl_AppendResult(interp, ",", NULL); + if (flags & 3) { + Tcl_AppendToObj(msgObj, ",", -1); } - Tcl_AppendResult(interp, " or disabled", NULL); + Tcl_AppendToObj(msgObj, " or disabled", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL); *statePtr = TK_STATE_NORMAL; return TCL_ERROR; } @@ -195,8 +198,10 @@ TkOrientParseProc( *orientPtr = 1; return TCL_OK; } - Tcl_AppendResult(interp, "bad orientation \"", value, - "\": must be vertical or horizontal", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad orientation \"%s\": must be vertical or horizontal", + value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL); *orientPtr = 0; return TCL_ERROR; } @@ -265,6 +270,7 @@ TkOffsetParseProc( Tk_TSOffset tsoffset; const char *q, *p; int result; + Tcl_Obj *msgObj; if ((value == NULL) || (*value == 0)) { tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; @@ -376,15 +382,16 @@ TkOffsetParseProc( return TCL_OK; badTSOffset: - Tcl_AppendResult(interp, "bad offset \"", value, - "\": expected \"x,y\"", NULL); + msgObj = Tcl_ObjPrintf("bad offset \"%s\": expected \"x,y\"", value); if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { - Tcl_AppendResult(interp, ", \"#x,y\"", NULL); + Tcl_AppendToObj(msgObj, ", \"#x,y\"", -1); } if (PTR2INT(clientData) & TK_OFFSET_INDEX) { - Tcl_AppendResult(interp, ", <index>", NULL); + Tcl_AppendToObj(msgObj, ", <index>", -1); } - Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL); return TCL_ERROR; } @@ -481,7 +488,9 @@ TkPixelParseProc( result = TkGetDoublePixels(interp, tkwin, value, doublePtr); if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { - Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); return TCL_ERROR; } return result; @@ -644,8 +653,10 @@ Tk_GetScrollInfo( if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " moveto fraction\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "moveto fraction")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { @@ -655,8 +666,10 @@ Tk_GetScrollInfo( } else if ((c == 's') && (strncmp(argv[2], "scroll", length) == 0)) { if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " scroll number units|pages\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "scroll number units|pages")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { @@ -670,12 +683,15 @@ Tk_GetScrollInfo( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", argv[4], - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", argv[4])); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", argv[2], - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", argv[2])); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2], + NULL); return TK_SCROLL_ERROR; } @@ -744,12 +760,14 @@ Tk_GetScrollInfoObj( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", arg, - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", arg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", arg, - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL); return TK_SCROLL_ERROR; } @@ -913,14 +931,17 @@ TkFindStateNum( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, - "\": must be ", mPtr->strKey, NULL); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be %s", + option, strKey, mPtr->strKey); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, - ((mPtr[1].strKey != NULL) ? ", " : ", or "), - mPtr->strKey, NULL); + Tcl_AppendPrintfToObj(msgObj, ",%s %s", + ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey); } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", option, strKey, NULL); } return mPtr->numKey; } @@ -969,14 +990,19 @@ TkFindStateNumObj( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), - " value \"", key, "\": must be ", mPtr->strKey, NULL); + msgObj = Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + Tcl_GetString(optionPtr), key, mPtr->strKey); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, - ((mPtr[1].strKey != NULL) ? ", " : ", or "), - mPtr->strKey, NULL); + Tcl_AppendPrintfToObj(msgObj, ",%s %s", + ((mPtr[1].strKey != NULL) ? "" : " or"), mPtr->strKey); } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", Tcl_GetString(optionPtr), + key, NULL); } return mPtr->numKey; } @@ -1007,24 +1033,15 @@ TkBackgroundEvalObjv( Tcl_Obj *const *objv, int flags) { - Tcl_DString errorInfo, errorCode; - Tcl_SavedResult state; + Tcl_InterpState state; int n, r = TCL_OK; - Tcl_DStringInit(&errorInfo); - Tcl_DStringInit(&errorCode); - - Tcl_Preserve(interp); - /* - * Record the state of the interpreter + * Record the state of the interpreter. */ - Tcl_SaveResult(interp, &state); - Tcl_DStringAppend(&errorInfo, - Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); - Tcl_DStringAppend(&errorCode, - Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); + Tcl_Preserve(interp); + state = Tcl_SaveInterpState(interp, TCL_OK); /* * Evaluate the command and handle any error. @@ -1042,24 +1059,12 @@ TkBackgroundEvalObjv( Tcl_BackgroundException(interp, r); } - Tcl_Release(interp); - - /* - * Restore the state of the interpreter - */ - - Tcl_SetVar(interp, "errorInfo", - Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "errorCode", - Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); - Tcl_RestoreResult(interp, &state); - /* - * Clean up references. + * Restore the state of the interpreter. */ - Tcl_DStringFree(&errorInfo); - Tcl_DStringFree(&errorCode); + (void) Tcl_RestoreInterpState(interp, state); + Tcl_Release(interp); return r; } diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 3602088..8b0c155 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -20,7 +20,7 @@ */ typedef struct VisualDictionary { - const char *name; /* Textual name of class. */ + const char *name; /* Textual name of class. */ int minLength; /* Minimum # characters that must be specified * for an unambiguous match. */ int class; /* X symbol for class. */ @@ -173,9 +173,9 @@ Tk_GetVisual( */ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad X identifier for visual: \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad X identifier for visual: \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL); return NULL; } template.visualid = visualId; @@ -202,12 +202,16 @@ Tk_GetVisual( } } if (template.class == -1) { - Tcl_AppendResult(interp, "unknown or ambiguous visual name \"", - string, "\": class must be ", NULL); + Tcl_Obj *msgObj = Tcl_ObjPrintf( + "unknown or ambiguous visual name \"%s\": class must be ", + string); + for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { - Tcl_AppendResult(interp, dictPtr->name, ", ", NULL); + Tcl_AppendPrintfToObj(msgObj, "%s, ", dictPtr->name); } - Tcl_AppendResult(interp, "or default", NULL); + Tcl_AppendToObj(msgObj, "or default", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "VISUAL", string, NULL); return NULL; } while (isspace(UCHAR(*p))) { @@ -215,10 +219,8 @@ Tk_GetVisual( } if (*p == 0) { template.depth = 10000; - } else { - if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { - return NULL; - } + } else if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { + return NULL; } if (c == 'b') { mask = 0; @@ -237,8 +239,9 @@ Tk_GetVisual( visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template, &numVisuals); if (visInfoList == NULL) { - Tcl_SetResult(interp, "couldn't find an appropriate visual", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find an appropriate visual", -1)); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "INAPPROPRIATE", NULL); return NULL; } @@ -403,13 +406,15 @@ Tk_GetColormap( return None; } if (Tk_Screen(other) != Tk_Screen(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": not on same screen", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: not on same screen", string)); + Tcl_SetErrorCode(interp, "TK", "COLORMAP", "SCREEN", NULL); return None; } if (Tk_Visual(other) != Tk_Visual(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": incompatible visuals", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: incompatible visuals", string)); + Tcl_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", NULL); return None; } colormap = Tk_Colormap(other); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index b04b95f..f4138b2 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -103,8 +103,9 @@ static const XSetWindowAttributes defAtts= { typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); typedef struct { - const char *name; /* Name of command. */ - Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based function, or initProc. */ + const char *name; /* Name of command. */ + Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based + * function, or initProc. */ int flags; } TkCmd; @@ -153,7 +154,8 @@ static const TkCmd commands[] = { {"panedwindow", Tk_PanedWindowObjCmd, ISSAFE}, {"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE}, {"scale", Tk_ScaleObjCmd, ISSAFE}, - {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, + NOOBJPROC|PASSMAINWINDOW|ISSAFE}, {"spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"toplevel", Tk_ToplevelObjCmd, 0}, @@ -175,7 +177,8 @@ static const TkCmd commands[] = { {"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE}, {"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE}, {"::tk::scale", Tk_ScaleObjCmd, ISSAFE}, - {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, + NOOBJPROC|PASSMAINWINDOW|ISSAFE}, {"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"::tk::toplevel", Tk_ToplevelObjCmd, 0}, @@ -197,7 +200,7 @@ static const TkCmd commands[] = { * Misc. */ -#if defined(MAC_OSX_TK) +#ifdef MAC_OSX_TK {"::tk::unsupported::MacWindowStyle", TkUnsupported1ObjCmd, PASSMAINWINDOW|ISSAFE}, #endif @@ -290,6 +293,7 @@ TkCloseDisplay( if (dispPtr->errorPtr != NULL) { TkErrorHandler *errorPtr; + for (errorPtr = dispPtr->errorPtr; errorPtr != NULL; errorPtr = dispPtr->errorPtr) { @@ -383,7 +387,7 @@ CreateTopLevelWindow( } else { dispPtr = GetScreen(interp, screenName, &screenId); if (dispPtr == NULL) { - return (Tk_Window) NULL; + return NULL; } } @@ -416,7 +420,7 @@ CreateTopLevelWindow( if (parent != NULL) { if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) { Tk_DestroyWindow((Tk_Window) winPtr); - return (Tk_Window) NULL; + return NULL; } } TkWmNewWindow(winPtr); @@ -467,9 +471,9 @@ GetScreen( screenName = TkGetDefaultScreenName(interp, screenName); if (screenName == NULL) { - Tcl_SetResult(interp, - "no display name and no $DISPLAY environment variable", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no display name and no $DISPLAY environment variable", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL); return NULL; } length = strlen(screenName); @@ -497,9 +501,9 @@ GetScreen( dispPtr = TkpOpenDisplay(screenName); if (dispPtr == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't connect to display \"", - screenName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't connect to display \"%s\"", screenName)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL); return NULL; } dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */ @@ -531,10 +535,9 @@ GetScreen( } } if (screenId >= ScreenCount(dispPtr->display)) { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad screen number \"%d\"", screenId); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen number \"%d\"", screenId)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL); return NULL; } *screenPtr = screenId; @@ -774,24 +777,25 @@ NameWindow( } /* - * For non-anonymous windows, set up the window name. - */ - - winPtr->nameUid = Tk_GetUid(name); - - /* * Don't permit names that start with an upper-case letter: this will just * cause confusion with class names in the option database. */ if (isupper(UCHAR(name[0]))) { - Tcl_AppendResult(interp, - "window name starts with an upper-case letter: \"", - name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name starts with an upper-case letter: \"%s\"", + name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL); return TCL_ERROR; } /* + * For non-anonymous windows, set up the window name. + */ + + winPtr->nameUid = Tk_GetUid(name); + + /* * To permit names of arbitrary length, must be prepared to malloc a * buffer to hold the new path name. To run fast in the common case where * names are short, use a fixed-size buffer on the stack. @@ -799,7 +803,7 @@ NameWindow( length1 = strlen(parentPtr->pathName); length2 = strlen(name); - if ((length1+length2+2) <= FIXED_SIZE) { + if ((length1 + length2 + 2) <= FIXED_SIZE) { pathName = staticSpace; } else { pathName = ckalloc(length1 + length2 + 2); @@ -818,8 +822,9 @@ NameWindow( ckfree(pathName); } if (!isNew) { - Tcl_AppendResult(interp, "window name \"", name, - "\" already exists in parent", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name \"%s\" already exists in parent", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL); return TCL_ERROR; } Tcl_SetHashValue(hPtr, winPtr); @@ -856,7 +861,7 @@ TkCreateMainWindow( const char *screenName, /* Name of screen on which to create window. * Empty or NULL string means use DISPLAY * environment variable. */ - const char *baseName) /* Base name for application; usually of the + const char *baseName) /* Base name for application; usually of the * form "prog instance". */ { Tk_Window tkwin; @@ -949,22 +954,27 @@ TkCreateMainWindow( isSafe = Tcl_IsSafe(interp); for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { - if ((cmdPtr->objProc == NULL)) { + if (cmdPtr->objProc == NULL) { Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs"); } + #if defined(__WIN32__) && !defined(STATIC_BUILD) if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) { - /* We are running on Cygwin, so don't use the win32 dialogs */ + /* + * We are running on Cygwin, so don't use the win32 dialogs. + */ + continue; } -#endif +#endif /* __WIN32__ && !STATIC_BUILD */ + if (cmdPtr->flags & PASSMAINWINDOW) { clientData = tkwin; } else { clientData = NULL; } if (cmdPtr->flags & USEINITPROC) { - ((TkInitProc *)cmdPtr->objProc)(interp, clientData); + ((TkInitProc *) cmdPtr->objProc)(interp, clientData); } else if (cmdPtr->flags & NOOBJPROC) { Tcl_CreateCommand(interp, cmdPtr->name, (Tcl_CmdProc *) cmdPtr->objProc, clientData, NULL); @@ -972,10 +982,8 @@ TkCreateMainWindow( Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, clientData, NULL); } - if (isSafe) { - if (!(cmdPtr->flags & ISSAFE)) { - Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); - } + if (isSafe && !(cmdPtr->flags & ISSAFE)) { + Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); } } @@ -1032,13 +1040,15 @@ Tk_CreateWindow( if (parentPtr) { if (parentPtr->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't create window: its parent has -container = yes", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, @@ -1094,13 +1104,15 @@ Tk_CreateAnonymousWindow( if (parentPtr) { if (parentPtr->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't create window: its parent has -container = yes", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, @@ -1176,8 +1188,9 @@ Tk_CreateWindowFromPath( p = strrchr(pathName, '.'); if (p == NULL) { - Tcl_AppendResult(interp, "bad window path name \"", pathName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); return NULL; } numChars = (int) (p-pathName); @@ -1206,13 +1219,14 @@ Tk_CreateWindowFromPath( return NULL; } if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; - } - if (((TkWindow *) parent)->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, - "can't create window: its parent has -container = yes", NULL); + } else if (((TkWindow *) parent)->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } @@ -1354,8 +1368,8 @@ Tk_DestroyWindow( } while (winPtr->childList != NULL) { - TkWindow *childPtr; - childPtr = winPtr->childList; + TkWindow *childPtr = winPtr->childList; + childPtr->flags |= TK_DONT_DESTROY_WINDOW; Tk_DestroyWindow((Tk_Window) childPtr); if (winPtr->childList == childPtr) { @@ -1382,8 +1396,8 @@ Tk_DestroyWindow( * deleted, in which case TkpGetOtherWindow will return NULL. */ - TkWindow *childPtr; - childPtr = TkpGetOtherWindow(winPtr); + TkWindow *childPtr = TkpGetOtherWindow(winPtr); + if (childPtr != NULL) { childPtr->flags |= TK_DONT_DESTROY_WINDOW; Tk_DestroyWindow((Tk_Window) childPtr); @@ -1528,7 +1542,7 @@ Tk_DestroyWindow( */ if ((winPtr->mainPtr->interp != NULL) && - (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) { + !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name, TkDeadAppCmd, NULL, NULL); @@ -1613,7 +1627,7 @@ Tk_DestroyWindow( TkCloseDisplay(dispPtr); } -#endif +#endif /* !WIN32 && NOT_YET */ } } Tcl_EventuallyFree(winPtr, TCL_DYNAMIC); @@ -1751,6 +1765,7 @@ Tk_MakeWindowExist( if ((winPtr2->window != None) && !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) { XWindowChanges changes; + changes.sibling = winPtr2->window; changes.stack_mode = Below; XConfigureWindow(winPtr->display, winPtr->window, @@ -2328,7 +2343,8 @@ Tk_NameToWindow( */ if (interp != NULL) { - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); } return NULL; } @@ -2337,8 +2353,10 @@ Tk_NameToWindow( pathName); if (hPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad window path name \"", - pathName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName, + NULL); } return NULL; } @@ -2432,8 +2450,8 @@ Tcl_Interp * Tk_Interp( Tk_Window tkwin) { - if (tkwin != NULL && ((TkWindow *)tkwin)->mainPtr != NULL) { - return ((TkWindow *)tkwin)->mainPtr->interp; + if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) { + return ((TkWindow *) tkwin)->mainPtr->interp; } return NULL; } @@ -2591,9 +2609,8 @@ Tk_RestackWindow( if (winPtr->window != None) { XWindowChanges changes; - unsigned int mask; + unsigned int mask = CWStackMode; - mask = CWStackMode; changes.stack_mode = Above; for (otherPtr = winPtr->nextPtr; otherPtr != NULL; otherPtr = otherPtr->nextPtr) { @@ -2652,7 +2669,9 @@ Tk_MainWindow( return (Tk_Window) mainPtr->winPtr; } } - Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this isn't a Tk application", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return NULL; } @@ -2840,44 +2859,47 @@ static HMODULE tkcygwindll = NULL; /* * Run Tk_MainEx from libtk8.?.dll * - * This function is only ever called from wish8.4.exe, the cygwin - * port of Tcl. This means that the system encoding is utf-8, - * so we don't have to do any encoding conversions. + * This function is only ever called from wish8.4.exe, the cygwin port of Tcl. + * This means that the system encoding is utf-8, so we don't have to do any + * encoding conversions. */ + int -TkCygwinMainEx(argc, argv, appInitProc, interp) - int argc; /* Number of arguments. */ - char **argv; /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc; /* Application-specific initialization - * procedure to call after most - * initialization but before starting - * to execute commands. */ - Tcl_Interp *interp; +TkCygwinMainEx( + int argc, /* Number of arguments. */ + char **argv, /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc, + /* Application-specific initialization + * procedure to call after most initialization + * but before starting to execute commands. */ + Tcl_Interp *interp) { TCHAR name[MAX_PATH]; int len; - void (*sym)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */ - len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH); - name[len-2] = TEXT('.'); - name[len-1] = name[len-5]; - _tcscpy(name+len, TEXT(".dll")); - memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR)); - - tkcygwindll = LoadLibrary(name); - if (!tkcygwindll) { - /* dll is not present */ - return 0; - } - sym = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_MainEx"); - if (!sym) { - return 0; - } - sym(argc, argv, appInitProc, interp); + len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH); + name[len-2] = TEXT('.'); + name[len-1] = name[len-5]; + _tcscpy(name+len, TEXT(".dll")); + memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR)); + + tkcygwindll = LoadLibrary(name); + if (!tkcygwindll) { + /* dll is not present */ + return 0; + } + tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_MainEx"); + if (!tkmainex) { + return 0; + } + tkmainex(argc, argv, appInitProc, interp); return 1; } -#endif +#endif /* __WIN32__ && !__WIN64__ */ + /* *---------------------------------------------------------------------- * @@ -2907,14 +2929,14 @@ Tk_Init( { #if defined(__WIN32__) && !defined(__WIN64__) if (tkcygwindll) { - int (*sym)(Tcl_Interp *); + int (*tkinit)(Tcl_Interp *); - sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_Init"); - if (sym) { - return sym(interp); + tkinit = (int(*)(Tcl_Interp *)) GetProcAddress(tkcygwindll,"Tk_Init"); + if (tkinit) { + return tkinit(interp); } } -#endif +#endif /* __WIN32__ && !__WIN64__ */ return Initialize(interp); } @@ -2980,14 +3002,15 @@ Tk_SafeInit( #if defined(__WIN32__) && !defined(__WIN64__) if (tkcygwindll) { - int (*sym)(Tcl_Interp *); + int (*tksafeinit)(Tcl_Interp *); - sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_SafeInit"); - if (sym) { - return sym(interp); + tksafeinit = (int (*)(Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_SafeInit"); + if (tksafeinit) { + return tksafeinit(interp); } } -#endif +#endif /* __WIN32__ && !__WIN64__ */ return Initialize(interp); } @@ -2998,7 +3021,8 @@ MODULE_SCOPE const TkStubs tkStubs; * * Initialize -- * - * ???TODO??? + * The core of the initialization code for Tk, called from Tk_Init and + * Tk_SafeInit. * * Results: * A standard Tcl result. Also leaves an error message in the interp's @@ -3082,7 +3106,9 @@ Initialize( while (1) { master = Tcl_GetMaster(master); if (master == NULL) { - Tcl_AppendResult(interp, "NULL master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no controlling master interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL); code = TCL_ERROR; goto done; } @@ -3098,7 +3124,9 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { - Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error in Tcl_GetInterpPath", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } @@ -3123,8 +3151,9 @@ Initialize( */ Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "not allowed to start Tk by master's safe::TkInit", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not allowed to start Tk by master's safe::TkInit", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } Tcl_DStringFree(&ds); @@ -3389,6 +3418,7 @@ Tk_PkgInitStubsCheck( } return actualVersion; } + /* * Local Variables: * mode: c diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index a3d0179..136d4af 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -1177,13 +1177,13 @@ static void EntryDisplay(void *clientData, Drawable d) textarea = Ttk_ClientRegion(entryPtr->core.layout, "textarea"); showCursor = - (entryPtr->core.flags & CURSOR_ON) != 0 + (entryPtr->core.flags & CURSOR_ON) && EntryEditable(entryPtr) && entryPtr->entry.insertPos >= leftIndex && entryPtr->entry.insertPos <= rightIndex ; showSelection = - (entryPtr->core.state & TTK_STATE_DISABLED) == 0 + !(entryPtr->core.state & TTK_STATE_DISABLED) && selFirst > -1 && selLast > leftIndex && selFirst <= rightIndex @@ -1322,9 +1322,10 @@ EntryIndex( *indexPtr = entryPtr->entry.xscroll.last; } else if (strncmp(string, "sel.", 4) == 0) { if (entryPtr->entry.selectFirst < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->core.tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->core.tkwin))); + Tcl_SetErrorCode(interp, "TTK", "ENTRY", "NO_SELECTION", NULL); return TCL_ERROR; } if (strncmp(string, "sel.first", length) == 0) { @@ -1376,8 +1377,9 @@ EntryIndex( return TCL_OK; badIndex: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TTK", "ENTRY", "INDEX", NULL); return TCL_ERROR; } @@ -1452,7 +1454,7 @@ EntryGetCommand( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetResult(interp, entryPtr->entry.string, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->entry.string, -1)); return TCL_OK; } @@ -1782,9 +1784,9 @@ static int ComboboxCurrentCommand( return TCL_ERROR; } if (currentIndex < 0 || currentIndex >= nValues) { - Tcl_AppendResult(interp, - "Index ", Tcl_GetString(objv[2]), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Index %s out of range", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_RANGE", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c index 7860024..3e50a7f 100644 --- a/generic/ttk/ttkFrame.c +++ b/generic/ttk/ttkFrame.c @@ -206,10 +206,9 @@ int TtkGetLabelAnchorFromObj( error: if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Bad label anchor specification ", Tcl_GetString(objPtr), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Bad label anchor specification %s", Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "LABEL", "ANCHOR", NULL); } return TCL_ERROR; } diff --git a/generic/ttk/ttkImage.c b/generic/ttk/ttkImage.c index 0de5fc0..1d455d9 100644 --- a/generic/ttk/ttkImage.c +++ b/generic/ttk/ttkImage.c @@ -59,9 +59,10 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr) if ((objc % 2) != 1) { if (interp) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "image specification must contain an odd number of elements", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "SPEC", NULL); } goto error; } @@ -324,7 +325,9 @@ Ttk_CreateImageElement( int i; if (objc <= 0) { - Tcl_AppendResult(interp, "Must supply a base image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Must supply a base image", -1)); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "BASE", NULL); return TCL_ERROR; } @@ -347,9 +350,9 @@ Ttk_CreateImageElement( int option; if (i == objc - 1) { - Tcl_AppendResult(interp, - "Value for ", Tcl_GetString(objv[i]), " missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Value for %s missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "VALUE", NULL); goto error; } @@ -362,12 +365,16 @@ Ttk_CreateImageElement( #endif if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, - "option", 0, &option) != TCL_OK) { goto error; } + "option", 0, &option) != TCL_OK) { + goto error; + } switch (option) { case O_BORDER: if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->border) - != TCL_OK) { goto error; } + != TCL_OK) { + goto error; + } if (!padding_specified) { imageData->padding = imageData->border; } diff --git a/generic/ttk/ttkLayout.c b/generic/ttk/ttkLayout.c index d248dcb..de9d795 100644 --- a/generic/ttk/ttkLayout.c +++ b/generic/ttk/ttkLayout.c @@ -326,8 +326,9 @@ int Ttk_GetPaddingFromObj( if (padc > 4) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Wrong #elements in padding spec", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Wrong #elements in padding spec", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "PADDING", NULL); } goto error; } @@ -363,8 +364,9 @@ int Ttk_GetBorderFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad) if (padc > 4) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Wrong #elements in border spec", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Wrong #elements in padding spec", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "BORDER", NULL); } goto error; } @@ -476,11 +478,10 @@ int Ttk_GetStickyFromObj( case 's': case 'S': sticky |= TTK_STICK_S; break; default: if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Bad -sticky specification ", - Tcl_GetString(objPtr), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Bad -sticky specification %s", + Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STICKY", NULL); } return TCL_ERROR; } @@ -643,10 +644,10 @@ Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr) } if (++i >= objc) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Missing value for option ",Tcl_GetString(objv[i-1]), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Missing value for option %s", + Tcl_GetString(objv[i-1]))); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "LAYOUT", NULL); goto error; } @@ -790,7 +791,7 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node) int side = 0; unsigned sideFlags = flags & _TTK_MASK_PACK; - while ((sideFlags & TTK_PACK_LEFT) == 0) { + while (!(sideFlags & TTK_PACK_LEFT)) { ++side; sideFlags >>= 1; } @@ -799,9 +800,11 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node) } } - /* In Ttk_ParseLayoutTemplate, default -sticky is "nsew", - * so always include this even if no sticky bits are set. + /* + * In Ttk_ParseLayoutTemplate, default -sticky is "nsew", so always + * include this even if no sticky bits are set. */ + APPENDSTR("-sticky"); APPENDOBJ(Ttk_NewStickyObj(flags & _TTK_MASK_STICK)); @@ -875,8 +878,9 @@ Ttk_Layout Ttk_CreateLayout( Ttk_LayoutNode *bgnode; if (!layoutTemplate) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", styleName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL); return 0; } @@ -915,8 +919,9 @@ Ttk_CreateSublayout( layoutTemplate = Ttk_FindLayoutTemplate(themePtr, styleName); if (!layoutTemplate) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", styleName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL); return 0; } diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c index 256573f..cf98a6d 100644 --- a/generic/ttk/ttkManager.c +++ b/generic/ttk/ttkManager.c @@ -455,10 +455,9 @@ int Ttk_GetSlaveIndexFromObj( */ if (Tcl_GetIntFromObj(NULL, objPtr, &slaveIndex) == TCL_OK) { if (slaveIndex < 0 || slaveIndex >= mgr->nSlaves) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Slave index ", Tcl_GetString(objPtr), " out of bounds", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Slave index %d out of bounds", slaveIndex)); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "INDEX", NULL); return TCL_ERROR; } *indexPtr = slaveIndex; @@ -467,23 +466,23 @@ int Ttk_GetSlaveIndexFromObj( /* Try interpreting as a slave window name; */ - if ( (*string == '.') - && (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) - { + if ((*string == '.') && + (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) { slaveIndex = Ttk_SlaveIndex(mgr, tkwin); if (slaveIndex < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - string, " is not managed by ", Tk_PathName(mgr->masterWindow), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is not managed by %s", string, + Tk_PathName(mgr->masterWindow))); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "MANAGER", NULL); return TCL_ERROR; } *indexPtr = slaveIndex; return TCL_OK; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Invalid slave specification ", string, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid slave specification %s", string)); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "SPEC", NULL); return TCL_ERROR; } @@ -542,10 +541,9 @@ int Ttk_Maintainable(Tcl_Interp *interp, Tk_Window slave, Tk_Window master) return 1; badWindow: - Tcl_AppendResult(interp, - "can't add ", Tk_PathName(slave), - " as slave of ", Tk_PathName(master), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't add %s as slave of %s", + Tk_PathName(slave), Tk_PathName(master))); + Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL); return 0; } diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 551f4a6..6849135 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -727,9 +727,9 @@ static int AddTab( } #if 0 /* can't happen */ if (Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow) >= 0) { - Tcl_AppendResult(interp, - Tk_PathName(slaveWindow), " already added", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s already added", + Tk_PathName(slaveWindow))); + Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "PRESENT", NULL); return TCL_ERROR; } #endif @@ -859,10 +859,9 @@ static int GetTabIndex( int status = FindTabIndex(interp, nb, objPtr, index_rtn); if (status == TCL_OK && *index_rtn < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "tab '", Tcl_GetString(objPtr), "' not found", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab '%s' not found", Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "TAB", NULL); status = TCL_ERROR; } return status; @@ -1082,7 +1081,8 @@ static int NotebookIdentifyCommand( case IDENTIFY_ELEMENT: if (element) { const char *elementName = Ttk_ElementName(element); - Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1)); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1)); } break; case IDENTIFY_TAB: @@ -1173,10 +1173,10 @@ static int NotebookTabsCommand( result = Tcl_NewListObj(0, NULL); for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) { const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(pathName,-1)); + + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(pathName,-1)); } Tcl_SetObjResult(interp, result); - return TCL_OK; } diff --git a/generic/ttk/ttkPanedwindow.c b/generic/ttk/ttkPanedwindow.c index b301372..f4b14c9 100644 --- a/generic/ttk/ttkPanedwindow.c +++ b/generic/ttk/ttkPanedwindow.c @@ -157,7 +157,9 @@ static int ConfigurePane( /* Sanity-check: */ if (pane->weight < 0) { - Tcl_AppendResult(interp, "-weight must be nonnegative", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-weight must be nonnegative", -1)); + Tcl_SetErrorCode(interp, "TTK", "PANE", "WEIGHT", NULL); goto error; } @@ -419,9 +421,9 @@ static int AddPane( return TCL_ERROR; } if (Ttk_SlaveIndex(pw->paned.mgr, slaveWindow) >= 0) { - Tcl_AppendResult(interp, - Tk_PathName(slaveWindow), " already added", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s already added", Tk_PathName(slaveWindow))); + Tcl_SetErrorCode(interp, "TTK", "PANE", "PRESENT", NULL); return TCL_ERROR; } @@ -844,9 +846,9 @@ static int PanedSashposCommand( return TCL_ERROR; } if (sashIndex < 0 || sashIndex >= Ttk_NumberSlaves(pw->paned.mgr) - 1) { - Tcl_AppendResult(interp, - "sash index ", Tcl_GetString(objv[2]), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "sash index %d out of range", sashIndex)); + Tcl_SetErrorCode(interp, "TTK", "PANE", "SASH_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c index a71ae21..c34b900 100644 --- a/generic/ttk/ttkState.c +++ b/generic/ttk/ttkState.c @@ -98,8 +98,9 @@ static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) if (stateNames[j] == 0) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Invalid state name ", stateName,NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid state name %s", stateName)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATE", NULL); } return TCL_ERROR; } @@ -216,8 +217,8 @@ Tcl_Obj *Ttk_StateMapLookup( return specs[j+1]; } if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "No match in state map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("No match in state map", -1)); + Tcl_SetErrorCode(interp, "TTK", "STATE", "UNMATCHED", NULL); } return NULL; } @@ -240,10 +241,11 @@ Ttk_StateMap Ttk_GetStateMapFromObj( return NULL; if (nSpecs % 2 != 0) { - if (interp) - Tcl_SetResult(interp, - "State map must have an even number of elements", - TCL_STATIC); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "State map must have an even number of elements", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATEMAP", NULL); + } return 0; } diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c index b0e9171..5097abc 100644 --- a/generic/ttk/ttkTheme.c +++ b/generic/ttk/ttkTheme.c @@ -548,8 +548,9 @@ Ttk_CreateTheme( entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry); if (!newEntry) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Theme ", name, " already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Theme %s already exists", name)); + Tcl_SetErrorCode(interp, "TTK", "THEME", "EXISTS", NULL); return NULL; } @@ -591,8 +592,9 @@ static Ttk_Theme LookupTheme( entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name); if (!entryPtr) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "theme \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "theme \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "THEME", name, NULL); return NULL; } @@ -875,9 +877,10 @@ Ttk_ElementClass *Ttk_RegisterElement( if (specPtr->version != TK_STYLE_VERSION_2) { /* Version mismatch */ if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Internal error: Ttk_RegisterElement (", - name, "): invalid version", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Internal error: Ttk_RegisterElement (%s): invalid version", + name)); + Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "VERSION", NULL); } return 0; @@ -887,7 +890,9 @@ Ttk_ElementClass *Ttk_RegisterElement( if (!newEntry) { if (interp) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Duplicate element ", name, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Duplicate element %s", name)); + Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "DUPE", NULL); } return 0; } @@ -1355,8 +1360,9 @@ static int StyleThemeCurrentCmd( } if (name == NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("error: failed to get theme name", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error: failed to get theme name", -1)); + Tcl_SetErrorCode(interp, "TTK", "THEME", "NAMELESS", NULL); return TCL_ERROR; } @@ -1491,7 +1497,10 @@ static int StyleElementCreateCmd( entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName); if (!entryPtr) { - Tcl_AppendResult(interp, "No such element type ", factoryName, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "No such element type %s", factoryName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT_TYPE", factoryName, + NULL); return TCL_ERROR; } @@ -1550,7 +1559,9 @@ static int StyleElementOptionsCmd( return TCL_OK; } - Tcl_AppendResult(interp, "element ", elementName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "element %s not found", elementName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL); return TCL_ERROR; } @@ -1574,7 +1585,10 @@ static int StyleLayoutCmd( if (objc == 3) { layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName); if (!layoutTemplate) { - Tcl_AppendResult(interp, "Layout ", layoutName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", layoutName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", layoutName, + NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate)); diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c index 1ed2742..dc0206c 100644 --- a/generic/ttk/ttkTreeview.c +++ b/generic/ttk/ttkTreeview.c @@ -534,21 +534,18 @@ static TreeColumn *GetColumn( */ if (Tcl_GetIntFromObj(NULL, columnIDObj, &columnIndex) == TCL_OK) { if (columnIndex < 0 || columnIndex >= tv->tree.nColumns) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Column index ", - Tcl_GetString(columnIDObj), - " out of bounds", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Column index %s out of bounds", + Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLBOUND", NULL); return NULL; } return tv->tree.columns + columnIndex; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Invalid column index ", Tcl_GetString(columnIDObj), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid column index %s", Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL); return NULL; } @@ -566,10 +563,9 @@ static TreeColumn *FindColumn( return tv->tree.displayColumns[colno]; } /* else */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Column ", Tcl_GetString(columnIDObj), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Column %s out of range", Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL); return NULL; } @@ -587,8 +583,9 @@ static TreeItem *FindItem( Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tv->tree.items, itemName); if (!entryPtr) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Item ", itemName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Item %s not found", itemName)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM", NULL); return 0; } return Tcl_GetHashValue(entryPtr); @@ -1222,8 +1219,9 @@ static int ConfigureColumn( } if (mask & READONLY_OPTION) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Attempt to change read-only option", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Attempt to change read-only option", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "READONLY", NULL); goto error; } @@ -1912,11 +1910,10 @@ static int AncestryCheck( TreeItem *p = parent; while (p) { if (p == item) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Cannot insert ", ItemName(tv, item), - " as a descendant of ", ItemName(tv, parent), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Cannot insert %s as descendant of %s", + ItemName(tv, item), ItemName(tv, parent))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ANCESTRY", NULL); return 0; } p = p->parent; @@ -2318,9 +2315,7 @@ static int TreeviewIdentifyCommand( case I_COLUMN : if (colno >= 0) { - char dcolbuf[16]; - sprintf(dcolbuf, "#%d", colno); - Tcl_SetObjResult(interp, Tcl_NewStringObj(dcolbuf, -1)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%d", colno)); } break; @@ -2488,9 +2483,9 @@ static int TreeviewSetCommand( for (columnNumber=0; columnNumber<tv->tree.nColumns; ++columnNumber) { Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &value); if (value) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, tv->tree.columns[columnNumber].idObj); - Tcl_ListObjAppendElement(interp, result, value); + Tcl_ListObjAppendElement(NULL, result, value); } } Tcl_SetObjResult(interp, result); @@ -2504,7 +2499,9 @@ static int TreeviewSetCommand( if (column == &tv->tree.column0) { /* @@@ Maybe set -text here instead? */ - Tcl_AppendResult(interp, "Display column #0 cannot be set", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Display column #0 cannot be set", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_0", NULL); return TCL_ERROR; } @@ -2587,9 +2584,12 @@ static int TreeviewInsertCommand( objc -= 4; objv += 4; if (objc >= 2 && !strcmp("-id", Tcl_GetString(objv[0]))) { const char *itemName = Tcl_GetString(objv[1]); + entryPtr = Tcl_CreateHashEntry(&tv->tree.items, itemName, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "Item ",itemName," already exists",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Item %s already exists", itemName)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM_EXISTS", NULL); return TCL_ERROR; } objc -= 2; objv += 2; @@ -2646,7 +2646,9 @@ static int TreeviewDetachCommand( /* Sanity-check */ for (i = 0; items[i]; ++i) { if (items[i] == tv->tree.root) { - Tcl_AppendResult(interp, "Cannot detach root item", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot detach root item", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL); ckfree(items); return TCL_ERROR; } @@ -2694,7 +2696,9 @@ static int TreeviewDeleteCommand( for (i=0; items[i]; ++i) { if (items[i] == tv->tree.root) { ckfree(items); - Tcl_AppendResult(interp, "Cannot delete root item", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot delete root item", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL); return TCL_ERROR; } } @@ -2885,10 +2889,9 @@ static int TreeviewDragCommand( left = right; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "column ", Tcl_GetString(objv[2]), " is not displayed", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "column %s is not displayed", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_INVISIBLE", NULL); return TCL_ERROR; } @@ -2953,8 +2956,7 @@ static int TreeviewSelectionCommand( } if (Tcl_GetIndexFromObj(interp, objv[2], selopStrings, - "selection operation", 0, &selop) != TCL_OK) - { + "selection operation", 0, &selop) != TCL_OK) { return TCL_ERROR; } @@ -3040,10 +3042,10 @@ static int TreeviewTagBindCommand( */ if (mask & (~TreeviewBindEventMask)) { Tk_DeleteBinding(interp, bindingTable, tag, sequence); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unsupported event ", sequence, - "\nonly key, button, motion, and virtual events supported", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unsupported event %s\nonly key, button, motion, and" + " virtual events supported", sequence)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "BIND_EVENTS", NULL); return TCL_ERROR; } } diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c index d5e0484..016653d 100644 --- a/generic/ttk/ttkWidget.c +++ b/generic/ttk/ttkWidget.c @@ -440,7 +440,8 @@ int TtkWidgetConstructorObjCmd( error: if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); } else { Tk_DestroyWindow(tkwin); } @@ -634,8 +635,8 @@ int TtkWidgetConfigureCommand( return status; if (mask & READONLY_OPTION) { - Tcl_SetResult(interp, - "Attempt to change read-only option", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to change read-only option", -1)); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -649,7 +650,8 @@ int TtkWidgetConfigureCommand( status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask); if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); status = TCL_ERROR; } if (status != TCL_OK) { diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 62e3165..c0ab326 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -186,7 +186,8 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 092915c..3772a30 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -190,11 +190,13 @@ proc ::tk::dialog::color::Config {dataName argList} { set data(-title) " " } if {[catch {winfo rgb . $data(-initialcolor)} err]} { - error $err + return -code error -errorcode [list TK LOOKUP COLOR $data(-initialcolor)] \ + $err } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 39d27d3..f89754c 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -40,7 +40,8 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach spec $specs { if {[llength $spec] < 4} { - error "\"spec\" should contain 5 or 4 elements" + return -code error -errorcode {TK VALUE CONFIG_SPEC} \ + "\"spec\" should contain 5 or 4 elements" } set cmdsw [lindex $spec 0] set cmd($cmdsw) "" @@ -53,9 +54,11 @@ proc tclParseConfigSpec {w specs flags argList} { if {[llength $argList] & 1} { set cmdsw [lindex $argList end] if {![info exists cmd($cmdsw)]} { - error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" + return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \ + "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } - error "value for \"$cmdsw\" missing" + return -code error -errorcode {TK VALUE_MISSING} \ + "value for \"$cmdsw\" missing" } # 2: set the default values @@ -68,7 +71,8 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach {cmdsw value} $argList { if {![info exists cmd($cmdsw)]} { - error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" + return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \ + "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } set data($cmdsw) $value } @@ -120,7 +124,8 @@ proc tclListValidFlags {v} { proc ::tk::FocusGroup_Create {t} { variable ::tk::Priv if {[winfo toplevel $t] ne $t} { - error "$t is not a toplevel window" + return -code error -errorcode [list TK LOOKUP TOPLEVEL $t] \ + "$t is not a toplevel window" } if {![info exists Priv(fg,$t)]} { set Priv(fg,$t) 1 @@ -140,7 +145,8 @@ proc ::tk::FocusGroup_BindIn {t w cmd} { variable FocusIn variable ::tk::Priv if {![info exists Priv(fg,$t)]} { - error "focus group \"$t\" doesn't exist" + return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ + "focus group \"$t\" doesn't exist" } set FocusIn($t,$w) $cmd } @@ -156,7 +162,8 @@ proc ::tk::FocusGroup_BindOut {t w cmd} { variable FocusOut variable ::tk::Priv if {![info exists Priv(fg,$t)]} { - error "focus group \"$t\" doesn't exist" + return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ + "focus group \"$t\" doesn't exist" } set FocusOut($t,$w) $cmd } @@ -255,7 +262,8 @@ proc ::tk::FocusGroup_Out {t w detail} { proc ::tk::FDGetFileTypes {string} { foreach t $string { if {[llength $t] < 2 || [llength $t] > 3} { - error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" + return -code error -errorcode {TK VALUE FILE_TYPE} \ + "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" } lappend fileTypes([lindex $t 0]) {*}[lindex $t 1] } @@ -274,7 +282,8 @@ proc ::tk::FDGetFileTypes {string} { # empty. foreach macType [lindex $t 2] { if {[string length $macType] != 4} { - error "bad Macintosh file type \"$macType\"" + return -code error -errorcode {TK VALUE MAC_TYPE} \ + "bad Macintosh file type \"$macType\"" } } diff --git a/library/console.tcl b/library/console.tcl index 37832f2..ab074f5 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -976,8 +976,8 @@ proc ::tk::console::Expand {w {type ""}} { proc ::tk::console::ExpandPathname str { set pwd [EvalAttached pwd] - if {[catch {EvalAttached [list cd [file dirname $str]]} err]} { - return -code error $err + if {[catch {EvalAttached [list cd [file dirname $str]]} err opt]} { + return -options $opt $err } set dir [file tail $str] ## Check to see if it was known to be a directory and keep the trailing diff --git a/library/dialog.tcl b/library/dialog.tcl index adea259..6a9babb 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -34,8 +34,9 @@ proc ::tk_dialog {w title text bitmap default args} { # Check that $default was properly given if {[string is integer -strict $default]} { if {$default >= [llength $args]} { - return -code error "default button index greater than number of\ - buttons specified for tk_dialog" + return -code error -errorcode {TK DIALOG BAD_DEFAULT} \ + "default button index greater than number of buttons\ + specified for tk_dialog" } } elseif {"" eq $default} { set default -1 diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 13b5895..179476c 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -96,7 +96,8 @@ proc ::tk::fontchooser::Configure {args} { } elseif {[info exists S($option)]} { return $S($option) } - return -code error "bad option \"$option\": must be\ + return -code error -errorcode [list TK LOOKUP OPTION $option] \ + "bad option \"$option\": must be\ -command, -font, -parent, -title or -visible" } @@ -104,9 +105,10 @@ proc ::tk::fontchooser::Configure {args} { -font $S(-font) -command $S(-command)] set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args] if {![winfo exists $S(-parent)]} { + set code [list TK LOOKUP WINDOW $S(-parent)] set err "bad window path name \"$S(-parent)\"" array set S $cache - return -code error $err + return -code error -errorcode $code $err } if {[string trim $S(-title)] eq ""} { set S(-title) [::msgcat::mc "Font"] @@ -434,9 +436,9 @@ proc ::tk::fontchooser::ttk_slistbox {w args} { grid columnconfigure $f 0 -weight 1 interp hide {} $w interp alias {} $w {} $f.list - } err]} { + } err opt]} { destroy $f - return -code error $err + return -options $opt $err } return $w } diff --git a/library/iconlist.tcl b/library/iconlist.tcl index ce1aae2..62b0b2d 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -98,8 +98,9 @@ package require Tk 8.6 set first [set last [lindex $args 0]] } default { - return -code error "wrong # args: should be\ - \"[lrange [info level 0] 0 1] first ?last?\"" + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" } } @@ -149,8 +150,9 @@ package require Tk 8.6 set first [set last [lindex $args 0]] } default { - return -code error "wrong # args: should be\ - \"[lrange [info level 0] 0 1] first ?last?\"" + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" } } diff --git a/library/megawidget.tcl b/library/megawidget.tcl index 1cd2900..9b9be92 100644 --- a/library/megawidget.tcl +++ b/library/megawidget.tcl @@ -76,8 +76,14 @@ package require Tk 8.6 } } - method CreateHull {} {error "method must be overridden"} - method Create {} {error "method must be overridden"} + method CreateHull {} { + return -code error -errorcode {TCL OO ABSTRACT_METHOD} \ + "method must be overridden" + } + method Create {} { + return -code error -errorcode {TCL OO ABSTRACT_METHOD} \ + "method must be overridden" + } method WhenIdle {method args} { if {![info exists IdleCallbacks($method)]} { diff --git a/library/menu.tcl b/library/menu.tcl index a51c96f..cfe7536 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -253,7 +253,8 @@ proc ::tk::MbPost {w {x {}} {y {}}} { set tearoff [expr {[tk windowingsystem] eq "x11" \ || [$menu cget -type] eq "tearoff"}] if {[string first $w $menu] != 0} { - error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)" + return -code error -errorcode {TK MENUBUTTON POST_NONCHILD} \ + "can't post $menu: it isn't a descendant of $w" } set cur $Priv(postedMb) if {$cur ne ""} { @@ -320,7 +321,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { $menu activate $entry GenerateMenuSelect $menu } - } + } right { set x [expr {[winfo rootx $w] + [winfo width $w]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] @@ -353,14 +354,12 @@ proc ::tk::MbPost {w {x {}} {y {}}} { } } } - } msg]} { + } msg opt]} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. - set savedInfo $errorInfo MenuUnpost {} - error $msg $savedInfo - + return -options $opt $msg } set Priv(tearoff) $tearoff diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 60a2a19..10e91f1 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -111,7 +111,7 @@ static unsigned char w3_bits[] = { 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" - + # ::tk::MessageBox -- # # Pops up a messagebox with an application-supplied message with @@ -153,8 +153,9 @@ proc ::tk::MessageBox {args} { tclParseConfigSpec $w $specs "" $args - if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { - error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" + if {$data(-icon) ni {info warning error question}} { + return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \ + "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } set windowingsystem [tk windowingsystem] if {$windowingsystem eq "aqua"} { @@ -169,7 +170,8 @@ proc ::tk::MessageBox {args} { } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } switch -- $data(-type) { @@ -204,9 +206,10 @@ proc ::tk::MessageBox {args} { set cancel cancel } default { - error "bad -type value \"$data(-type)\": must be\ - abortretryignore, ok, okcancel, retrycancel,\ - yesno, or yesnocancel" + return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \ + "bad -type value \"$data(-type)\": must be\ + abortretryignore, ok, okcancel, retrycancel,\ + yesno, or yesnocancel" } } @@ -230,7 +233,8 @@ proc ::tk::MessageBox {args} { } } if {!$valid} { - error "invalid default button \"$data(-default)\"" + return -code error -errorcode {TK MSGBOX DEFAULT} \ + "invalid default button \"$data(-default)\"" } # 2. Set the dialog to be a child window of $parent diff --git a/library/palette.tcl b/library/palette.tcl index 21be8dc..924dd61 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -36,7 +36,8 @@ proc ::tk_setPalette {args} { array set new $args } if {![info exists new(background)]} { - error "must specify a background color" + return -code error -errorcode {TK SET_PALETTE BACKGROUND} \ + "must specify a background color" } set bg [winfo rgb . $new(background)] if {![info exists new(foreground)]} { diff --git a/library/safetk.tcl b/library/safetk.tcl index e664ace..9f8e25d 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -114,8 +114,8 @@ proc ::safe::loadTk {} {} } if {$nDisplay ne $display} { if {$displayGiven} { - error "conflicting -display $display and -use\ - $use -> $nDisplay" + return -code error -errorcode {TK DISPLAY SAFE} \ + "conflicting -display $display and -use $use -> $nDisplay" } else { set display $nDisplay } @@ -139,7 +139,7 @@ proc ::safe::TkInit {interpPath} { } else { Log $interpPath "TkInit called for interp with clearance:\ preventing Tk init" ERROR - error "not allowed" + return -code error -errorcode {TK SAFE PERMISSION} "not allowed" } } @@ -219,8 +219,8 @@ proc ::safe::tkTopLevel {slave display} { incr tkSafeId set w ".safe$tkSafeId" if {[catch {toplevel $w -screen $display -class SafeTk} msg]} { - return -code error "Unable to create toplevel for\ - safe slave \"$slave\" ($msg)" + return -code error -errorcode {TK TOPLEVEL SAFE} \ + "Unable to create toplevel for safe slave \"$slave\" ($msg)" } Log $slave "New toplevel $w" NOTICE diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 06c002c..641584d 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -376,7 +376,8 @@ proc ::tk::spinbox::ButtonDown {w x y} { $w selection clear } default { - return -code error "unknown spinbox element \"$Priv(element)\"" + return -code error -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \ + "unknown spinbox element \"$Priv(element)\"" } } } diff --git a/library/tk.tcl b/library/tk.tcl index cac9075..e0d9eda 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -213,7 +213,8 @@ if {[tk windowingsystem] ne "win32"} { } txt] && [catch { selection get -displayof $w -selection $sel } txt]} then { - return -code error "could not find default selection" + return -code error -errorcode {TK SELECTION NONE} \ + "could not find default selection" } else { return $txt } @@ -223,7 +224,8 @@ if {[tk windowingsystem] ne "win32"} { if {[catch { selection get -displayof $w -selection $sel } txt]} then { - return -code error "could not find default selection" + return -code error -errorcode {TK SELECTION NONE} \ + "could not find default selection" } else { return $txt } diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index ae16939..6604575 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -313,7 +313,8 @@ proc ::tk::dialog::file::Config {dataName type argList} { set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } # Set -multiple to a one or zero value (not other boolean types like diff --git a/library/unsupported.tcl b/library/unsupported.tcl index feb9cc5..2c68e78 100644 --- a/library/unsupported.tcl +++ b/library/unsupported.tcl @@ -231,7 +231,8 @@ proc ::tk::unsupported::ExposePrivateCommand {cmd} { variable PrivateCommands set cmds [array get PrivateCommands $cmd] if {[llength $cmds] == 0} { - return -code error "No compatibility support for \[$cmd]" + return -code error -errorcode {TK EXPOSE_PRIVATE_COMMAND} \ + "No compatibility support for \[$cmd]" } foreach {old new} $cmds { namespace eval :: [list interp alias {} $old {}] $new @@ -258,7 +259,8 @@ proc ::tk::unsupported::ExposePrivateVariable {var} { variable PrivateVariables set vars [array get PrivateVariables $var] if {[llength $vars] == 0} { - return -code error "No compatibility support for \$$var" + return -code error -errorcode {TK EXPOSE_PRIVATE_VARIABLE} \ + "No compatibility support for \$$var" } namespace eval ::tk::mac {} foreach {old new} $vars { diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index a1d6048..0578361 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -305,7 +305,8 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { set data(filter) * } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } diff --git a/macosx/tkMacOSXBitmap.c b/macosx/tkMacOSXBitmap.c index 0c94712..2610e3a 100644 --- a/macosx/tkMacOSXBitmap.c +++ b/macosx/tkMacOSXBitmap.c @@ -394,7 +394,8 @@ TkMacOSXIconBitmapObjCmd( } name = Tcl_GetStringFromObj(objv[i++], &len); if (!len) { - Tcl_AppendResult(interp, "empty bitmap name", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty bitmap name", -1)); + Tcl_SetErrorCode(interp, "TK", "MACBITMAP", "BAD", NULL); goto end; } if (Tcl_GetIntFromObj(interp, objv[i++], &ib.width) != TCL_OK) { @@ -409,19 +410,23 @@ TkMacOSXIconBitmapObjCmd( } value = Tcl_GetStringFromObj(objv[i++], &len); if (!len) { - Tcl_AppendResult(interp, "empty bitmap value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty bitmap value", -1)); + Tcl_SetErrorCode(interp, "TK", "MACBITMAP", "EMPTY", NULL); goto end; } #if 0 if ((kind == ICON_TYPE || kind == ICON_SYSTEM)) { Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + Tcl_UtfToExternalDString(encoding, value, -1, &ds); len = Tcl_DStringLength(&ds); Tcl_DStringFree(&ds); Tcl_FreeEncoding(encoding); if (len > 4) { - Tcl_AppendResult(interp, "invalid bitmap value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid bitmap value", -1)); + Tcl_SetErrorCode(interp, "TK", "MACBITMAP", "INVALID", NULL); goto end; } } @@ -441,7 +446,7 @@ TkMacOSXIconBitmapObjCmd( } *iconBitmap = ib; result = TCL_OK; -end: + end: return result; } diff --git a/macosx/tkMacOSXClipboard.c b/macosx/tkMacOSXClipboard.c index 92d6590..07a8419 100644 --- a/macosx/tkMacOSXClipboard.c +++ b/macosx/tkMacOSXClipboard.c @@ -137,9 +137,11 @@ TkSelGetSelection( } result = proc(clientData, interp, string ? [string UTF8String] : ""); } else { - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), + Tk_GetAtomName(tkwin, target))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL); } return result; } diff --git a/macosx/tkMacOSXCursor.c b/macosx/tkMacOSXCursor.c index a333adf..24793de 100644 --- a/macosx/tkMacOSXCursor.c +++ b/macosx/tkMacOSXCursor.c @@ -391,7 +391,9 @@ TkGetCursorByName( } if (!macCursorPtr || (!macCursorPtr->macCursor && macCursorPtr->type != NONE)) { - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); if (macCursorPtr) { ckfree(macCursorPtr); macCursorPtr = NULL; diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 23b3de5..334b9fd 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -257,16 +257,16 @@ Tk_ChooseColorObjCmd( for (i = 1; i < objc; i += 2) { int index; - const char *option, *value; + const char *value; if (Tcl_GetIndexFromObj(interp, objv[i], colorOptionStrings, "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - option = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", option, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL); goto end; } value = Tcl_GetString(objv[i + 1]); @@ -378,8 +378,9 @@ Tk_GetOpenFileObjCmd( goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -556,9 +557,9 @@ Tk_GetSaveFileObjCmd( goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -726,8 +727,9 @@ Tk_ChooseDirectoryObjCmd( goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -942,8 +944,9 @@ Tk_MessageBoxObjCmd( goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL); goto end; } switch (index) { @@ -1024,6 +1027,7 @@ Tk_MessageBoxObjCmd( if (!defaultNativeButtonIndex) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Illegal default option", -1)); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL); goto end; } } @@ -1366,99 +1370,99 @@ FontchooserConfigureCmd( return TCL_OK; } if (i + 1 == objc) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(objv[i]), "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL); return TCL_ERROR; } switch (optionIndex) { - case FontchooserVisible: { - const char *msg = "cannot change read-only option " - "\"-visible\": use the show or hide command"; + case FontchooserVisible: { + const char *msg = "cannot change read-only option " + "\"-visible\": use the show or hide command"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, sizeof(msg)-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL); + return TCL_ERROR; + } + case FontchooserParent: { + Tk_Window parent = Tk_NameToWindow(interp, + Tcl_GetString(objv[i+1]), tkwin); + + if (parent == None) { return TCL_ERROR; } - case FontchooserParent: { - Tk_Window parent = Tk_NameToWindow(interp, - Tcl_GetString(objv[i+1]), tkwin); - - if (parent == None) { - return TCL_ERROR; - } - if (fcdPtr->parent) { - Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, - FontchooserParentEventHandler, fcdPtr); - } - fcdPtr->parent = parent; - Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + if (fcdPtr->parent) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, FontchooserParentEventHandler, fcdPtr); - break; } - case FontchooserTitle: - if (fcdPtr->titleObj) { - Tcl_DecrRefCount(fcdPtr->titleObj); - } - Tcl_GetStringFromObj(objv[i+1], &len); - if (len) { - fcdPtr->titleObj = objv[i+1]; - if (Tcl_IsShared(fcdPtr->titleObj)) { - fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj); - } - Tcl_IncrRefCount(fcdPtr->titleObj); - } else { - fcdPtr->titleObj = NULL; + fcdPtr->parent = parent; + Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + break; + } + case FontchooserTitle: + if (fcdPtr->titleObj) { + Tcl_DecrRefCount(fcdPtr->titleObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->titleObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->titleObj)) { + fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj); } - break; - case FontchooserFont: - Tcl_GetStringFromObj(objv[i+1], &len); - if (len) { - Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]); - - if (!f) { - return TCL_ERROR; - } - [fontPanelFont autorelease]; - fontPanelFont = [TkMacOSXNSFontForFont(f) retain]; - [fontPanelFontAttributes setDictionary: - TkMacOSXNSFontAttributesForFont(f)]; - [fontPanelFontAttributes removeObjectsForKeys:[NSArray - arrayWithObjects:NSFontAttributeName, - NSLigatureAttributeName, NSKernAttributeName, - nil]]; - Tk_FreeFont(f); - } else { - [fontPanelFont release]; - fontPanelFont = nil; - [fontPanelFontAttributes removeAllObjects]; + Tcl_IncrRefCount(fcdPtr->titleObj); + } else { + fcdPtr->titleObj = NULL; + } + break; + case FontchooserFont: + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]); + + if (!f) { + return TCL_ERROR; } + [fontPanelFont autorelease]; + fontPanelFont = [TkMacOSXNSFontForFont(f) retain]; + [fontPanelFontAttributes setDictionary: + TkMacOSXNSFontAttributesForFont(f)]; + [fontPanelFontAttributes removeObjectsForKeys:[NSArray + arrayWithObjects:NSFontAttributeName, + NSLigatureAttributeName, NSKernAttributeName, nil]]; + Tk_FreeFont(f); + } else { + [fontPanelFont release]; + fontPanelFont = nil; + [fontPanelFontAttributes removeAllObjects]; + } - NSFontManager *fm = [NSFontManager sharedFontManager]; - NSFontPanel *fp = [fm fontPanel:NO]; + NSFontManager *fm = [NSFontManager sharedFontManager]; + NSFontPanel *fp = [fm fontPanel:NO]; - [fp setPanelFont:fontPanelFont isMultiple:NO]; - [fm setSelectedFont:fontPanelFont isMultiple:NO]; - [fm setSelectedAttributes:fontPanelFontAttributes - isMultiple:NO]; - if ([fp isVisible]) { - TkSendVirtualEvent(fcdPtr->parent, - "TkFontchooserFontChanged"); - } - break; - case FontchooserCmd: - if (fcdPtr->cmdObj) { - Tcl_DecrRefCount(fcdPtr->cmdObj); - } - Tcl_GetStringFromObj(objv[i+1], &len); - if (len) { - fcdPtr->cmdObj = objv[i+1]; - if (Tcl_IsShared(fcdPtr->cmdObj)) { - fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj); - } - Tcl_IncrRefCount(fcdPtr->cmdObj); - } else { - fcdPtr->cmdObj = NULL; + [fp setPanelFont:fontPanelFont isMultiple:NO]; + [fm setSelectedFont:fontPanelFont isMultiple:NO]; + [fm setSelectedAttributes:fontPanelFontAttributes + isMultiple:NO]; + if ([fp isVisible]) { + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged"); + } + break; + case FontchooserCmd: + if (fcdPtr->cmdObj) { + Tcl_DecrRefCount(fcdPtr->cmdObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->cmdObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->cmdObj)) { + fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj); } - break; + Tcl_IncrRefCount(fcdPtr->cmdObj); + } else { + fcdPtr->cmdObj = NULL; + } + break; } } return TCL_OK; diff --git a/macosx/tkMacOSXEmbed.c b/macosx/tkMacOSXEmbed.c index 354a231..824a995 100644 --- a/macosx/tkMacOSXEmbed.c +++ b/macosx/tkMacOSXEmbed.c @@ -208,8 +208,9 @@ TkpUseWindow( Container *containerPtr; if (winPtr->window != None) { - Tcl_AppendResult(interp, "can't modify container after widget is " - "created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } @@ -227,12 +228,12 @@ TkpUseWindow( } usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, (Window) parent); - if (usePtr != NULL) { - if (!(usePtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, "window \"", usePtr->pathName, - "\" doesn't have -container option set", NULL); - return TCL_ERROR; - } + if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); + return TCL_ERROR; } /* @@ -305,15 +306,17 @@ TkpUseWindow( if (containerPtr == NULL) { /* - * If someone has registered an in process embedding handler, then + * If someone has registered an in-process embedding handler, then * see if it can handle this window... */ if (tkMacOSXEmbedHandler == NULL || tkMacOSXEmbedHandler->registerWinProc((long) parent, (Tk_Window) winPtr) != TCL_OK) { - Tcl_AppendResult(interp, "The window ID ", string, - " does not correspond to a valid Tk Window.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "The window ID %s does not correspond to a valid Tk Window", + string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "HANDLE", NULL); return TCL_ERROR; } diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 50c6702..a05302f 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -703,10 +703,9 @@ TkWmProtocolEventProc( Tcl_Preserve(interp); result = Tcl_GlobalEval(interp, protPtr->command); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, - Tk_GetAtomName((Tk_Window) winPtr, protocol)); - Tcl_AddErrorInfo(interp, "\" window manager protocol)"); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + Tk_GetAtomName((Tk_Window) winPtr, protocol))); Tcl_BackgroundError(interp); } Tcl_Release(interp); diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 9ac0369..b651b3c 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -51,7 +51,6 @@ | tkCanJoinAllSpacesAttribute | tkMoveToActiveSpaceAttribute \ | tkNonactivatingPanelAttribute | tkHUDWindowAttribute) - /*Objects for use in setting background color and opacity of window.*/ NSColor *colorName = NULL; NSString *opaqueTag = NULL; @@ -407,6 +406,7 @@ SetWindowSizeLimits( wmPtr->maxAspect.x && wmPtr->minAspect.y == wmPtr->maxAspect.y) { NSSize aspect = NSMakeSize(wmPtr->minAspect.x, wmPtr->minAspect.y); CGFloat ratio = aspect.width/aspect.height; + [macWindow setContentAspectRatio:aspect]; if ((CGFloat)minWidth/(CGFloat)minHeight > ratio) { minHeight = lround(minWidth / ratio); @@ -458,7 +458,6 @@ static TkWindow* FrontWindowAtPoint( int x, int y) { - NSPoint p = NSMakePoint(x, tkMacOSXZeroScreenHeight - y); NSWindow *win = nil; NSInteger windowCount; @@ -470,6 +469,7 @@ FrontWindowAtPoint( NSWindowList(windowCount, windowNumbers); for (NSInteger index = 0; index < windowCount; index++) { NSWindow *w = [NSApp windowWithWindowNumber:windowNumbers[index]]; + if (w && NSMouseInRect(p, [w frame], NO)) { win = w; break; @@ -479,7 +479,6 @@ FrontWindowAtPoint( } return (win ? TkMacOSXGetTkWindow(win) : NULL); } - /* *---------------------------------------------------------------------- @@ -549,7 +548,7 @@ TkWmNewWindow( wmPtr->configHeight = -1; wmPtr->vRoot = None; wmPtr->protPtr = NULL; - wmPtr->cmdArgv = NULL; + wmPtr->commandObj = NULL; wmPtr->clientMachine = NULL; wmPtr->flags = WM_NEVER_MAPPED; wmPtr->macClass = kDocumentWindowClass; @@ -561,7 +560,6 @@ TkWmNewWindow( UpdateVRootGeometry(wmPtr); - /* * Tk must monitor structure events for top-level windows, in order to * detect size and position changes caused by window managers. @@ -753,14 +751,13 @@ TkWmDeadWindow( wmPtr2->hints.flags &= ~IconWindowHint; } while (wmPtr->protPtr != NULL) { - ProtocolHandler *protPtr; + ProtocolHandler *protPtr = wmPtr->protPtr; - protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); } - if (wmPtr->cmdArgv != NULL) { - ckfree(wmPtr->cmdArgv); + if (wmPtr->commandObj != NULL) { + Tcl_DecrRefCount(wmPtr->commandObj); } if (wmPtr->clientMachine != NULL) { ckfree(wmPtr->clientMachine); @@ -777,12 +774,13 @@ TkWmDeadWindow( */ NSWindow *window = wmPtr->window; + if (window && !Tk_IsEmbedded(winPtr) ) { [[window parentWindow] removeChildWindow:window]; [window close]; TkMacOSXUnregisterMacWindow(window); if (winPtr->window) { - ((MacDrawable *)winPtr->window)->view = nil; + ((MacDrawable *) winPtr->window)->view = nil; } TkMacOSXMakeCollectableAndRelease(wmPtr->window); } @@ -875,13 +873,13 @@ Tk_WmObjCmd( argv1 = Tcl_GetStringFromObj(objv[1], &length); if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0) - && (length >= 3)) { + && (length >= 3)) { if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(wmTracing)); return TCL_OK; } return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing); @@ -902,8 +900,10 @@ Tk_WmObjCmd( } if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -1013,12 +1013,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1033,7 +1034,9 @@ WmAspectCmd( } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -1273,18 +1276,18 @@ WmAttributesCmd( macWindow = TkMacOSXDrawableWindow(winPtr->window); if (objc == 3) { /* wm attributes $win */ - Tcl_Obj *result = Tcl_NewListObj(0,0); + Tcl_Obj *result = Tcl_NewObj(); for (attribute = 0; attribute < _WMATT_LAST_ATTRIBUTE; ++attribute) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(WmAttributeNames[attribute], -1)); - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, WmGetAttribute(winPtr, macWindow, attribute)); } Tcl_SetObjResult(interp, result); } else if (objc == 4) { /* wm attributes $win -attribute */ if (Tcl_GetIndexFromObj(interp, objv[3], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, WmGetAttribute(winPtr, macWindow, attribute)); @@ -1293,7 +1296,7 @@ WmAttributesCmd( for (i = 3; i < objc; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } if (WmSetAttribute(winPtr, macWindow, interp, attribute, objv[i+1]) @@ -1343,7 +1346,8 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } @@ -1389,10 +1393,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2; + TkWindow **cmapList, *winPtr2; int i, windowObjc, gotToplevel = 0; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1400,17 +1403,20 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) - && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { + && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } cmapList = ckalloc((windowObjc+1) * sizeof(TkWindow*)); @@ -1476,38 +1482,34 @@ WmCommandCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; - int cmdArgc; - const char **cmdArgv; + int len; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); return TCL_ERROR; } if (objc == 3) { - if (wmPtr->cmdArgv != NULL) { - argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - Tcl_SetResult(interp, argv3, TCL_VOLATILE); - ckfree(argv3); + if (wmPtr->commandObj != NULL) { + Tcl_SetObjResult(interp, wmPtr->commandObj); } return TCL_OK; } - argv3 = Tcl_GetString(objv[3]); - if (argv3[0] == 0) { - if (wmPtr->cmdArgv != NULL) { - ckfree(wmPtr->cmdArgv); - wmPtr->cmdArgv = NULL; + if (Tcl_GetString(objv[3])[0] == 0) { + if (wmPtr->commandObj != NULL) { + Tcl_DecrRefCount(wmPtr->commandObj); + wmPtr->commandObj = NULL; } return TCL_OK; } - if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) { + if (Tcl_ListObjLength(interp, objv[3], &len) != TCL_OK) { return TCL_ERROR; } - if (wmPtr->cmdArgv != NULL) { - ckfree(wmPtr->cmdArgv); + if (wmPtr->commandObj != NULL) { + Tcl_DecrRefCount(wmPtr->commandObj); } - wmPtr->cmdArgc = cmdArgc; - wmPtr->cmdArgv = cmdArgv; + wmPtr->commandObj = Tcl_DuplicateObj(objv[3]); + Tcl_IncrRefCount(wmPtr->commandObj); + Tcl_InvalidateStringRep(wmPtr->commandObj); return TCL_OK; } @@ -1542,16 +1544,21 @@ WmDeiconifyCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": it is an embedded window", NULL); + } else if (winPtr->flags & TK_EMBEDDED) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } + TkpWmSetState(winPtr, TkMacOSXIsWindowZoomed(winPtr) ? ZoomState : NormalState); return TCL_OK; @@ -1594,8 +1601,8 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } @@ -1636,18 +1643,17 @@ WmForgetCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - - register Tk_Window frameWin = (Tk_Window)winPtr; + register Tk_Window frameWin = (Tk_Window) winPtr; if (Tk_IsTopLevel(frameWin)) { - MacDrawable *macWin = (MacDrawable *) winPtr->parentPtr->window; + TkFocusJoin(winPtr); Tk_UnmapWindow(frameWin); - TkWmDeadWindow(macWin); + TkWmDeadWindow((TkWindow *) macWin); RemapWindows(winPtr, macWin); - winPtr->flags &=~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); /* * Flags (above) must be cleared before calling TkMapTopFrame (below). @@ -1655,7 +1661,9 @@ WmForgetCmd( TkMapTopFrame(frameWin); } else { - /* Already not managed by wm - ignore it */ + /* + * Already not managed by wm - ignore it. + */ } return TCL_OK; } @@ -1687,7 +1695,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1697,8 +1704,7 @@ WmFrameCmd( if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(buf, "0x%x", (unsigned) window); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) window)); return TCL_OK; } @@ -1737,8 +1743,6 @@ WmGeometryCmd( return TCL_ERROR; } if (objc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1750,9 +1754,8 @@ WmGeometryCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(buf, "%dx%d%c%d%c%d", - width, height, xSign, wmPtr->x, ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d", + width, height, xSign, wmPtr->x, ySign, wmPtr->y)); return TCL_OK; } argv3 = Tcl_GetString(objv[3]); @@ -1792,6 +1795,7 @@ WmGridCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; + char *errorMsg; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -1800,12 +1804,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1832,20 +1837,17 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); - return TCL_ERROR; - } - if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); - return TCL_ERROR; + errorMsg = "baseWidth can't be < 0"; + goto error; + } else if (reqHeight < 0) { + errorMsg = "baseHeight can't be < 0"; + goto error; + } else if (widthInc <= 0) { + errorMsg = "widthInc can't be <= 0"; + goto error; + } else if (heightInc <= 0) { + errorMsg = "heightInc can't be <= 0"; + goto error; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, heightInc); @@ -1853,6 +1855,11 @@ WmGridCmd( wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMsg, -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "GRID", NULL); + return TCL_ERROR; } /* @@ -1891,10 +1898,11 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } + argv3 = Tcl_GetStringFromObj(objv[3], &length); if (*argv3 == '\0') { wmPtr->hints.flags &= ~WindowGroupHint; @@ -1954,8 +1962,9 @@ WmIconbitmapCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char*)Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display,wmPtr->hints.icon_pixmap), + -1)); } return TCL_OK; } @@ -2016,26 +2025,33 @@ WmIconifyCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; - } - if (wmPtr->master != None) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + } else if (wmPtr->master != None) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; - } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + } else if (wmPtr->iconFor != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an embedded window", NULL); + } else if (winPtr->flags & TK_EMBEDDED) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } + TkpWmSetState(winPtr, IconicState); return TCL_OK; } @@ -2073,13 +2089,16 @@ WmIconmaskCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_mask), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + -1)); } return TCL_OK; } + argv3 = Tcl_GetString(objv[3]); if (*argv3 == '\0') { if (wmPtr->hints.icon_mask != None) { @@ -2200,8 +2219,10 @@ WmIconphotoCmd( for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -2247,16 +2268,18 @@ WmIconpositionCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } + if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->hints.flags &= ~IconPositionHint; } else { @@ -2304,12 +2327,14 @@ WmIconwindowCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon)); } return TCL_OK; } + if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->hints.flags &= ~IconWindowHint; if (wmPtr->icon != NULL) { @@ -2323,19 +2348,24 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tk_PathName(tkwin2))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "TOPLEVEL", + NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr3->iconFor = NULL; } Tk_MakeWindowExist(tkwin2); @@ -2379,18 +2409,18 @@ WmManageCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - - register Tk_Window frameWin = (Tk_Window)winPtr; + register Tk_Window frameWin = (Tk_Window) winPtr; register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *oldClass = (char*)Tk_Class(frameWin); if (!Tk_IsTopLevel(frameWin)) { MacDrawable *macWin = (MacDrawable *) winPtr->window; if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", - Tk_PathName(frameWin), "\" is not manageable: must be " - "a frame, labelframe or toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a" + " frame, labelframe or toplevel", + Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -2449,16 +2479,19 @@ WmMaxsizeCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } + if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } wmPtr->maxWidth = width; @@ -2500,14 +2533,17 @@ WmMinsizeCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } + if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMinSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; @@ -2551,11 +2587,13 @@ WmOverrideredirectCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); return TCL_ERROR; } + if (objc == 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj( Tk_Attributes((Tk_Window) winPtr)->override_redirect)); return TCL_OK; } + if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { return TCL_ERROR; } @@ -2601,14 +2639,16 @@ WmPositionfromCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("user", -1)); } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("program", -1)); } return TCL_OK; } + if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); } else { @@ -2659,23 +2699,28 @@ WmProtocolCmd( Atom protocol; char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); return TCL_ERROR; } + if (objc == 3) { /* * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } + protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); if (objc == 4) { /* @@ -2685,7 +2730,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -2755,17 +2801,18 @@ WmResizableCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } + if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } + if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) - || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { + || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } if (width) { @@ -2833,11 +2880,12 @@ WmSizefromCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("user", -1)); } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("program", -1)); } return TCL_OK; } @@ -2887,11 +2935,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { - "isabove", "isbelow", NULL }; + "isabove", "isbelow", NULL + }; enum options { - OPT_ISABOVE, OPT_ISBELOW }; + OPT_ISABOVE, OPT_ISBELOW + }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -2905,35 +2956,40 @@ WmStackorderCmd( Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } + Tcl_SetObjResult(interp, resultObj); ckfree(windows); return TCL_OK; } else { TkWindow *winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; - } - - if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + } else if (!Tk_IsMapped(winPtr2)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -2944,22 +3000,23 @@ WmStackorderCmd( windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "FAIL", NULL); return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = windowPtr - windows; } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = windowPtr - windows; } } if (index1 == -1) { Tcl_Panic("winPtr window not found"); - } - if (index2 == -1) { + } else if (index2 == -1) { Tcl_Panic("winPtr2 window not found"); } @@ -2977,7 +3034,6 @@ WmStackorderCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } - return TCL_OK; } /* @@ -3016,21 +3072,25 @@ WmStateCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); return TCL_ERROR; } + if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't change state of ", - winPtr->pathName, ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "EMBEDDED", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + &index) != TCL_OK) { return TCL_ERROR; } @@ -3043,13 +3103,19 @@ WmStateCmd( */ } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->master != None) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -3059,7 +3125,7 @@ WmStateCmd( TkpWmSetState(winPtr, ZoomState); } } else if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("icon", -1)); } else { if (wmPtr->hints.initial_state == NormalState || wmPtr->hints.initial_state == ZoomState) { @@ -3068,16 +3134,16 @@ WmStateCmd( } switch (wmPtr->hints.initial_state) { case NormalState: - Tcl_SetResult(interp, "normal", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("normal", -1)); break; case IconicState: - Tcl_SetResult(interp, "iconic", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("iconic", -1)); break; case WithdrawnState: - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("withdrawn", -1)); break; case ZoomState: - Tcl_SetResult(interp, "zoomed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("zoomed", -1)); break; } } @@ -3117,11 +3183,13 @@ WmTitleCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); return TCL_ERROR; } + if (objc == 3) { - Tcl_SetResult(interp, (char *)((wmPtr->titleUid != NULL) ? - wmPtr->titleUid : winPtr->nameUid), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->titleUid ? wmPtr->titleUid : winPtr->nameUid, -1)); return TCL_OK; } + argv3 = Tcl_GetStringFromObj(objv[3], &length); wmPtr->titleUid = Tk_GetUid(argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED) && !Tk_IsEmbedded(winPtr)) { @@ -3167,7 +3235,8 @@ WmTransientCmd( } if (objc == 3) { if (wmPtr->master != None) { - Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->masterWindowName, -1)); } return TCL_OK; } @@ -3184,9 +3253,10 @@ WmTransientCmd( Tk_MakeWindowExist(master); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } @@ -3194,15 +3264,17 @@ WmTransientCmd( /* Under some circumstances, wmPtr2 is NULL here */ if (wmPtr2 != NULL && wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if ((TkWindow *) master == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } @@ -3249,9 +3321,12 @@ WmWithdrawCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, WithdrawnState); @@ -3667,7 +3742,7 @@ UpdateGeometryInfo( if (((width != winPtr->changes.width) || (height != winPtr->changes.height)) && (wmPtr->gridWin == NULL) - && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) { + && !(wmPtr->sizeHintsFlags & (PMinSize|PMaxSize))) { wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) { @@ -3871,7 +3946,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; flags |= WM_UPDATE_SIZE_HINTS; } @@ -3906,7 +3981,9 @@ ParseGeometry( return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } @@ -4243,7 +4320,7 @@ UpdateVRootGeometry( wmPtr->flags &= ~WM_VROOT_OFFSET_STALE; if (wmPtr->vRoot == None) { - noVRoot: + noVRoot: wmPtr->vRootX = wmPtr->vRootY = 0; wmPtr->vRootWidth = DisplayWidth(winPtr->display, winPtr->screenNum); wmPtr->vRootHeight = DisplayHeight(winPtr->display, winPtr->screenNum); @@ -4366,7 +4443,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } @@ -4974,78 +5051,64 @@ TkUnsupported1ObjCmd( }; Tk_Window tkwin = clientData; TkWindow *winPtr; - int index; + int index, i; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?"); return TCL_ERROR; } + /* + * Iterate through objc/objv to set correct background color and toggle + * opacity of window. + */ - /* Iterate through objc/objv to set correct background color and toggle opacity of window. */ - int i; for (i= 0; i < objc; i++) { - - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*black*") == 1) { - colorName = [NSColor blackColor]; // use #000000 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*dark*") == 1) { + if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*black*")) { + colorName = [NSColor blackColor]; // use #000000 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*dark*")) { colorName = [NSColor darkGrayColor]; //use #545454 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*light*") == 1) { + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*light*")) { colorName = [NSColor lightGrayColor]; //use #ababab in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*white*")) { + colorName = [NSColor whiteColor]; //use #ffffff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "gray*")) { + colorName = [NSColor grayColor]; //use #7f7f7f in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*red*")) { + colorName = [NSColor redColor]; //use #ff0000 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*green*")) { + colorName = [NSColor greenColor]; //use #00ff00 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*blue*")) { + colorName = [NSColor blueColor]; //use #0000ff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*cyan*")) { + colorName = [NSColor cyanColor]; //use #00ffff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*yellow*")) { + colorName = [NSColor yellowColor]; //use #ffff00 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*magenta*")) { + colorName = [NSColor magentaColor]; //use #ff00ff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*orange*")) { + colorName = [NSColor orangeColor]; //use #ff8000 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*purple*")) { + colorName = [NSColor purpleColor]; //use #800080 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*brown*")){ + colorName = [NSColor brownColor]; //use #996633 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*clear*")) { + colorName = [NSColor clearColor]; //use systemTransparent in Tk scripts to match } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*white*") == 1) { - colorName = [NSColor whiteColor]; //use #ffffff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "gray*") == 1) { - colorName = [NSColor grayColor]; //use #7f7f7f in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*red*") == 1) { - colorName = [NSColor redColor]; //use #ff0000 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*green*") == 1) { - colorName = [NSColor greenColor]; //use #00ff00 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*blue*") == 1) { - colorName = [NSColor blueColor]; //use #0000ff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*cyan*") == 1) { - colorName = [NSColor cyanColor]; //use #00ffff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*yellow*") == 1) { - colorName = [NSColor yellowColor]; //use #ffff00 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*magenta*") == 1) { - colorName = [NSColor magentaColor]; //use #ff00ff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*orange*") == 1) { - colorName = [NSColor orangeColor]; //use #ff8000 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*purple*") == 1) { - colorName = [NSColor purpleColor]; //use #800080 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*brown*") == 1){ - colorName = [NSColor brownColor]; //use #996633 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*clear*") == 1) { - colorName = [NSColor clearColor]; //use systemTransparent in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*opacity*") == 1) { - opaqueTag=@"YES"; + if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*opacity*")) { + opaqueTag = @"YES"; } } - winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); if (winPtr == NULL) { return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WINDOWSTYLE", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -5120,7 +5183,10 @@ WmWinStyle( { NULL } }; - /* Map window attributes. Color and opacity are mapped to NULL; these are parsed from the objv in TkUnsupported1ObjCmd.*/ + /* + * Map window attributes. Color and opacity are mapped to NULL; these are + * parsed from the objv in TkUnsupported1ObjCmd. + */ static const struct StrIntMap attrMap[] = { { "closeBox", kWindowCloseBoxAttribute }, @@ -5151,21 +5217,21 @@ WmWinStyle( { "moveToActiveSpace", tkMoveToActiveSpaceAttribute }, { "nonActivating", tkNonactivatingPanelAttribute }, { "hud", tkHUDWindowAttribute }, - { "black", NULL }, - { "dark", NULL }, - { "light", NULL }, - { "gray", NULL }, - { "red", NULL }, - { "green", NULL }, - { "blue", NULL }, - { "cyan", NULL }, - { "yellow", NULL }, - { "magenta", NULL }, - { "orange", NULL }, - { "purple", NULL }, - { "brown", NULL }, - { "clear", NULL }, - { "opacity", NULL }, + { "black", 0 }, + { "dark", 0 }, + { "light", 0 }, + { "gray", 0 }, + { "red", 0 }, + { "green", 0 }, + { "blue", 0 }, + { "cyan", 0 }, + { "yellow", 0 }, + { "magenta", 0 }, + { "orange", 0 }, + { "purple", 0 }, + { "brown", 0 }, + { "clear", 0 }, + { "opacity", 0 }, { NULL } }; @@ -5186,7 +5252,6 @@ WmWinStyle( Tcl_Panic("invalid class"); } - attributeList = Tcl_NewListObj(0, NULL); attributes = wmPtr->attributes; @@ -5194,7 +5259,7 @@ WmWinStyle( UInt64 intValue = compositeAttrMap[i].intValue; if (intValue && (attributes & intValue) == intValue) { - Tcl_ListObjAppendElement(interp, attributeList, + Tcl_ListObjAppendElement(NULL, attributeList, Tcl_NewStringObj(compositeAttrMap[i].strValue, -1)); attributes &= ~intValue; @@ -5203,11 +5268,11 @@ WmWinStyle( } for (i = 0; attrMap[i].strValue != NULL; i++) { if (attributes & attrMap[i].intValue) { - Tcl_ListObjAppendElement(interp, attributeList, + Tcl_ListObjAppendElement(NULL, attributeList, Tcl_NewStringObj(attrMap[i].strValue, -1)); } } - Tcl_ListObjAppendElement(interp, newResult, attributeList); + Tcl_ListObjAppendElement(NULL, newResult, attributeList); Tcl_SetObjResult(interp, newResult); } else { int attrObjc; @@ -5259,7 +5324,6 @@ WmWinStyle( return TCL_ERROR; } - return TCL_OK; } @@ -5421,7 +5485,7 @@ TkMacOSXMakeRealWindowExist( /* Set background color and opacity of window if those flags are set. */ if (colorName != NULL) { [window setBackgroundColor: colorName]; - } + } if (opaqueTag != NULL) { [window setOpaque: opaqueTag]; @@ -5911,7 +5975,7 @@ TkWindow ** TkWmStackorderToplevel( TkWindow *parentPtr) /* Parent toplevel window. */ { - TkWindow *childWinPtr, **windows, **window_ptr; + TkWindow *childWinPtr, **windows, **windowPtr; Tcl_HashTable table; Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -5948,8 +6012,8 @@ TkWmStackorderToplevel( ckfree(windows); windows = NULL; } else { - window_ptr = windows + table.numEntries; - *window_ptr-- = NULL; + windowPtr = windows + table.numEntries; + *windowPtr-- = NULL; windowNumbers = ckalloc(windowCount * sizeof(NSInteger)); NSWindowList(windowCount, windowNumbers); for (NSInteger index = 0; index < windowCount; index++) { @@ -5959,11 +6023,11 @@ TkWmStackorderToplevel( hPtr = Tcl_FindHashEntry(&table, (char*) w); if (hPtr != NULL) { childWinPtr = Tcl_GetHashValue(hPtr); - *window_ptr-- = childWinPtr; + *windowPtr-- = childWinPtr; } } } - if (window_ptr != (windows-1)) { + if (windowPtr != windows-1) { Tcl_Panic("num matched toplevel windows does not equal num " "children"); } @@ -6281,10 +6345,11 @@ TkMacOSXMakeFullscreen( if ((wmPtr->maxWidth > 0 && wmPtr->maxWidth < screenWidth) || (wmPtr->maxHeight > 0 && wmPtr->maxHeight < screenHeight)) { if (interp) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, - "\": max width/height is too small", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\": max" + " width/height is too small", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "FULLSCREEN", + "CONSTRAINT_FAILURE", NULL); } result = TCL_ERROR; wmPtr->flags &= ~WM_FULLSCREEN; @@ -6535,8 +6600,6 @@ RemapWindows( RemapWindows(childPtr, (MacDrawable *) winPtr->window); } } - - /* * Local Variables: diff --git a/macosx/tkMacOSXWm.h b/macosx/tkMacOSXWm.h index bfc7fac..d98010f 100644 --- a/macosx/tkMacOSXWm.h +++ b/macosx/tkMacOSXWm.h @@ -6,8 +6,8 @@ * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TKMACWM @@ -17,25 +17,23 @@ #include "tkMenu.h" /* - * A data structure of the following type holds information for - * each window manager protocol (such as WM_DELETE_WINDOW) for - * which a handler (i.e. a Tcl command) has been defined for a - * particular top-level window. + * A data structure of the following type holds information for each window + * manager protocol (such as WM_DELETE_WINDOW) for which a handler (i.e. a Tcl + * command) has been defined for a particular top-level window. */ typedef struct ProtocolHandler { Atom protocol; /* Identifies the protocol. */ struct ProtocolHandler *nextPtr; - /* Next in list of protocol handlers for - * the same top-level window, or NULL for - * end of list. */ + /* Next in list of protocol handlers for the + * same top-level window, or NULL for end of + * list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ - char command[4]; /* Tcl command to invoke when a client - * message for this protocol arrives. - * The actual size of the structure varies - * to accommodate the needs of the actual - * command. THIS MUST BE THE LAST FIELD OF - * THE STRUCTURE. */ + char command[4]; /* Tcl command to invoke when a client message + * for this protocol arrives. The actual size + * of the structure varies to accommodate the + * needs of the actual command. THIS MUST BE + * THE LAST FIELD OF THE STRUCTURE. */ } ProtocolHandler; #define HANDLER_SIZE(cmdLength) \ @@ -47,84 +45,80 @@ typedef struct ProtocolHandler { */ typedef struct TkWmInfo { - TkWindow *winPtr; /* Pointer to main Tk information for - * this window. */ + TkWindow *winPtr; /* Pointer to main Tk information for this + * window. */ Window reparent; /* If the window has been reparented, this * gives the ID of the ancestor of the window - * that is a child of the root window (may - * not be window's immediate parent). If - * the window isn't reparented, this has the - * value None. */ - Tk_Uid titleUid; /* Title to display in window caption. If - * NULL, use name of widget. */ + * that is a child of the root window (may not + * be window's immediate parent). If the window + * isn't reparented, this has the value + * None. */ + Tk_Uid titleUid; /* Title to display in window caption. If NULL, + * use name of widget. */ char *iconName; /* Name to display in icon. */ - Window master; /* Master window for TRANSIENT_FOR property, - * or None. */ - XWMHints hints; /* Various pieces of information for - * window manager. */ + Window master; /* Master window for TRANSIENT_FOR property, or + * None. */ + XWMHints hints; /* Various pieces of information for window + * manager. */ char *leaderName; /* Path name of leader of window group * (corresponds to hints.window_group). - * Malloc-ed. Note: this field doesn't - * get updated if leader is destroyed. */ - char *masterWindowName; /* Path name of window specified as master - * in "wm transient" command, or NULL. - * Malloc-ed. Note: this field doesn't - * get updated if masterWindowName is - * destroyed. */ - Tk_Window icon; /* Window to use as icon for this window, - * or NULL. */ + * Malloc-ed. Note: this field doesn't get + * updated if leader is destroyed. */ + char *masterWindowName; /* Path name of window specified as master in + * "wm transient" command, or NULL. Malloc-ed. + * Note: this field doesn't get updated if + * masterWindowName is destroyed. */ + Tk_Window icon; /* Window to use as icon for this window, or + * NULL. */ Tk_Window iconFor; /* Window for which this window is icon, or * NULL if this isn't an icon for anyone. */ /* - * Information used to construct an XSizeHints structure for - * the window manager: + * Information used to construct an XSizeHints structure for the window + * manager: */ - int sizeHintsFlags; /* Flags word for XSizeHints structure. - * If the PBaseSize flag is set then the - * window is gridded; otherwise it isn't - * gridded. */ - int minWidth, minHeight; /* Minimum dimensions of window, in - * grid units, not pixels. */ - int maxWidth, maxHeight; /* Maximum dimensions of window, in - * grid units, not pixels. */ - Tk_Window gridWin; /* Identifies the window that controls - * gridding for this top-level, or NULL if - * the top-level isn't currently gridded. */ - int widthInc, heightInc; /* Increments for size changes (# pixels - * per step). */ + int sizeHintsFlags; /* Flags word for XSizeHints structure. If the + * PBaseSize flag is set then the window is + * gridded; otherwise it isn't gridded. */ + int minWidth, minHeight; /* Minimum dimensions of window, in grid units, + * not pixels. */ + int maxWidth, maxHeight; /* Maximum dimensions of window, in grid units, + * not pixels. */ + Tk_Window gridWin; /* Identifies the window that controls gridding + * for this top-level, or NULL if the top-level + * isn't currently gridded. */ + int widthInc, heightInc; /* Increments for size changes (# pixels per + * step). */ struct { int x; /* numerator */ int y; /* denominator */ } minAspect, maxAspect; /* Min/max aspect ratios for window. */ int reqGridWidth, reqGridHeight; - /* The dimensions of the window (in - * grid units) requested through - * the geometry manager. */ + /* The dimensions of the window (in grid units) + * requested through the geometry manager. */ int gravity; /* Desired window gravity. */ /* * Information used to manage the size and location of a window. */ - int width, height; /* Desired dimensions of window, specified - * in grid units. These values are - * set by the "wm geometry" command and by - * ConfigureNotify events (for when wm - * resizes window). -1 means user hasn't - * requested dimensions. */ + int width, height; /* Desired dimensions of window, specified in + * grid units. These values are set by the "wm + * geometry" command and by ConfigureNotify + * events (for when wm resizes window). -1 + * means user hasn't requested dimensions. */ int x, y; /* Desired X and Y coordinates for window. - * These values are set by "wm geometry", - * plus by ConfigureNotify events (when wm - * moves window). These numbers are - * different than the numbers stored in - * winPtr->changes because (a) they could be - * measured from the right or bottom edge - * of the screen (see WM_NEGATIVE_X and - * WM_NEGATIVE_Y flags) and (b) if the window - * has been reparented then they refer to the - * parent rather than the window itself. */ + * These values are set by "wm geometry", plus + * by ConfigureNotify events (when wm moves + * window). These numbers are different than + * the numbers stored in winPtr->changes + * because (a) they could be measured from the + * right or bottom edge of the screen (see + * WM_NEGATIVE_X and WM_NEGATIVE_Y flags) and + * (b) if the window has been reparented then + * they refer to the parent rather than the + * window itself. */ int parentWidth, parentHeight; /* Width and height of reparent, in pixels * *including border*. If window hasn't been @@ -140,29 +134,29 @@ typedef struct TkWmInfo { * switched into fullscreen state, */ int configWidth, configHeight; /* Dimensions passed to last request that we - * issued to change geometry of window. Used - * to eliminate redundant resize operations. */ + * issued to change geometry of window. Used to + * eliminate redundant resize operations. */ /* - * Information about the virtual root window for this top-level, - * if there is one. + * Information about the virtual root window for this top-level, if there + * is one. */ - Window vRoot; /* Virtual root window for this top-level, - * or None if there is no virtual root - * window (i.e. just use the screen's root). */ - int vRootX, vRootY; /* Position of the virtual root inside the - * root window. If the WM_VROOT_OFFSET_STALE - * flag is set then this information may be - * incorrect and needs to be refreshed from - * the X server. If vRoot is None then these - * values are both 0. */ + Window vRoot; /* Virtual root window for this top-level, or + * None if there is no virtual root window + * (i.e. just use the screen's root). */ + int vRootX, vRootY; /* Position of the virtual root inside the root + * window. If the WM_VROOT_OFFSET_STALE flag is + * set then this information may be incorrect + * and needs to be refreshed from the OS. If + * vRoot is None then these values are both + * 0. */ unsigned int vRootWidth, vRootHeight; - /* Dimensions of the virtual root window. - * If vRoot is None, gives the dimensions - * of the containing screen. This information - * is never stale, even though vRootX and - * vRootY can be. */ + /* Dimensions of the virtual root window. If + * vRoot is None, gives the dimensions of the + * containing screen. This information is never + * stale, even though vRootX and vRootY can + * be. */ /* * List of children of the toplevel which have private colormaps. @@ -175,11 +169,10 @@ typedef struct TkWmInfo { * Miscellaneous information. */ - ProtocolHandler *protPtr; /* First in list of protocol handlers for - * this window (NULL means none). */ - int cmdArgc; /* Number of elements in cmdArgv below. */ - const char **cmdArgv; /* Array of strings to store in the - * WM_COMMAND property. NULL means nothing + ProtocolHandler *protPtr; /* First in list of protocol handlers for this + * window (NULL means none). */ + Tcl_Obj *commandObj; /* The command (guaranteed to be a list) for + * the WM_COMMAND property. NULL means nothing * available. */ char *clientMachine; /* String to store in WM_CLIENT_MACHINE * property, or NULL. */ @@ -188,6 +181,7 @@ typedef struct TkWmInfo { /* * Macintosh information. */ + WindowClass macClass; UInt64 attributes, configAttributes; TkWindow *scrollWinPtr; /* Ptr to scrollbar handling grow widget. */ @@ -195,19 +189,18 @@ typedef struct TkWmInfo { NSWindow *window; } WmInfo; - /* * Flag values for WmInfo structures: * - * WM_NEVER_MAPPED - non-zero means window has never been - * mapped; need to update all info when - * window is first mapped. + * WM_NEVER_MAPPED - non-zero means window has never been mapped; + * need to update all info when window is first + * mapped. * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo - * has already been scheduled for this - * window; no need to schedule another one. + * has already been scheduled for this window; no + * need to schedule another one. * WM_NEGATIVE_X - non-zero means x-coordinate is measured in - * pixels from right edge of screen, rather - * than from left edge. + * pixels from right edge of screen, rather than + * from left edge. * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in * pixels up from bottom of screen, rather than * down from top. @@ -218,27 +211,24 @@ typedef struct TkWmInfo { * WM_VROOT_OFFSET_STALE - non-zero means that (x,y) offset information * about the virtual root window is stale and * needs to be fetched fresh from the X server. - * WM_ABOUT_TO_MAP - non-zero means that the window is about to - * be mapped by TkWmMapWindow. This is used - * by UpdateGeometryInfo to modify its behavior. - * WM_MOVE_PENDING - non-zero means the application has requested - * a new position for the window, but it hasn't - * been reflected through the window manager - * yet. - * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were - * set explicitly via "wm colormapwindows". + * WM_ABOUT_TO_MAP - non-zero means that the window is about to be + * mapped by TkWmMapWindow. This is used by + * UpdateGeometryInfo to modify its behavior. + * WM_MOVE_PENDING - non-zero means the application has requested a + * new position for the window, but it hasn't + * been reflected through the window manager yet. + * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were set + * explicitly via "wm colormapwindows". * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows" * was called the top-level itself wasn't - * specified, so we added it implicitly at - * the end of the list. + * specified, so we added it implicitly at the + * end of the list. * WM_WIDTH_NOT_RESIZABLE - non-zero means that we're not supposed to * allow the user to change the width of the - * window (controlled by "wm resizable" - * command). + * window (controlled by "wm resizable" command). * WM_HEIGHT_NOT_RESIZABLE - non-zero means that we're not supposed to * allow the user to change the height of the - * window (controlled by "wm resizable" - * command). + * window (controlled by "wm resizable" command). */ #define WM_NEVER_MAPPED 0x0001 @@ -258,5 +248,13 @@ typedef struct TkWmInfo { #define WM_FULLSCREEN 0x4000 #define WM_TRANSPARENT 0x8000 -#endif - +#endif /* _TKMACWM */ + +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/tests/canvas.test b/tests/canvas.test index f5b33cc..2b0da48 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -406,7 +406,7 @@ test canvas-10.2 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {&&c} -} -returnCodes error -result {Unexpected operator in tag search expression} +} -returnCodes error -result {unexpected operator in tag search expression} test canvas-10.3 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -414,7 +414,7 @@ test canvas-10.3 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {!!c} -} -returnCodes error -result {Too many '!' in tag search expression} +} -returnCodes error -result {too many '!' in tag search expression} test canvas-10.4 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -422,7 +422,7 @@ test canvas-10.4 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {b||} -} -returnCodes error -result {Missing tag in tag search expression} +} -returnCodes error -result {missing tag in tag search expression} test canvas-10.5 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -430,7 +430,7 @@ test canvas-10.5 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {b&&(c||)} -} -returnCodes error -result {Unexpected operator in tag search expression} +} -returnCodes error -result {unexpected operator in tag search expression} test canvas-10.6 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -438,7 +438,7 @@ test canvas-10.6 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {d&&""} -} -returnCodes error -result {Null quoted tag string in tag search expression} +} -returnCodes error -result {null quoted tag string in tag search expression} test canvas-10.7 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -446,7 +446,7 @@ test canvas-10.7 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag "d&&\"tag with spaces" -} -returnCodes error -result {Missing endquote in tag search expression} +} -returnCodes error -result {missing endquote in tag search expression} test canvas-10.8 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -454,7 +454,7 @@ test canvas-10.8 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -returnCodes error -body { .c find withtag {a&&"tag with spaces"z} -} -result {Invalid boolean operator in tag search expression} +} -result {invalid boolean operator in tag search expression} test canvas-10.9 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -462,7 +462,7 @@ test canvas-10.9 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {a&&b&c} -} -returnCodes error -result {Singleton '&' in tag search expression} +} -returnCodes error -result {singleton '&' in tag search expression} test canvas-10.10 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -470,7 +470,7 @@ test canvas-10.10 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {a||b|c} -} -returnCodes error -result {Singleton '|' in tag search expression} +} -returnCodes error -result {singleton '|' in tag search expression} test canvas-10.11 {backward compatility - strange tags that are not expressions} -setup { catch {destroy .c} canvas .c diff --git a/tests/embed.test b/tests/embed.test index 8a29862..1fe73ef 100644 --- a/tests/embed.test +++ b/tests/embed.test @@ -33,7 +33,7 @@ test embed-1.3 {CreateFrame procedure, both -use and -container is invalid} -set toplevel .t -use [winfo id .container] -container 1 } -cleanup { deleteWindows -} -returnCodes error -result {A window cannot have both the -use and the -container option set.} +} -returnCodes error -result {windows cannot have both the -use and the -container option set} # testing window embedding for win platforms test embed-1.4.win {TkpUseWindow procedure, -container must be set} -constraints { diff --git a/tests/font.test b/tests/font.test index 3a2568c..dff9fc9 100644 --- a/tests/font.test +++ b/tests/font.test @@ -76,7 +76,7 @@ test font-2.1 {TkFontPkgFree} -setup { lappend x [foo eval {catch {font families} msg; set msg}] } -cleanup { interp delete foo -} -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} +} -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} test font-3.1 {font command: general} -body { diff --git a/tests/frame.test b/tests/frame.test index 35b9605..c7b0ed8 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -468,7 +468,7 @@ test frame-2.18 {toplevel configuration options} -setup { toplevel .x -container 1 -use [winfo id .t] } -cleanup { deleteWindows -} -returnCodes error -result {A window cannot have both the -use and the -container option set.} +} -returnCodes error -result {windows cannot have both the -use and the -container option set} test frame-2.19 {toplevel configuration options} -setup { deleteWindows set opts {} diff --git a/tests/grid.test b/tests/grid.test index b27318e..c1d9d06 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -1,5 +1,5 @@ -# This file is a Tcl script to test out the *NEW* "grid" command -# of Tk. It is (almost) organized in the standard fashion for Tcl tests. +# This file is a Tcl script to test out the *NEW* "grid" command of Tk. It is +# (almost) organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. @@ -10,15 +10,14 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test - -# helper routine to return "." to a sane state after a test -# The variable GRID_VERBOSE can be used to "look" at the result -# of one or all of the tests +# helper routine to return "." to a sane state after a test. +# The variable GRID_VERBOSE can be used to "look" at the result of one or all +# of the tests proc grid_reset {{test ?} {top .}} { global GRID_VERBOSE if {[info exists GRID_VERBOSE]} { - if {$GRID_VERBOSE=="" || $GRID_VERBOSE==$test} { + if {$GRID_VERBOSE eq "" || $GRID_VERBOSE eq $test} { puts -nonewline "grid test $test: " flush stdout gets stdin @@ -28,10 +27,10 @@ proc grid_reset {{test ?} {top .}} { update foreach {cols rows} [grid size .] {} for {set i 0} {$i <= $cols} {incr i} { - grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" + grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } for {set i 0} {$i <= $rows} {incr i} { - grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" + grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } grid propagate . 1 grid anchor . nw @@ -40,77 +39,74 @@ proc grid_reset {{test ?} {top .}} { grid_reset 0.0 wm geometry . {} - + test grid-1.1 {basic argument checking} -body { - grid + grid } -returnCodes error -result {wrong # args: should be "grid option arg ?arg ...?"} test grid-1.2 {basic argument checking} -body { - grid foo bar + grid foo bar } -returnCodes error -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, forget, info, location, propagate, remove, rowconfigure, size, or slaves} test grid-1.3 {basic argument checking} -body { - button .b - grid .b -row 0 -column + button .b + grid .b -row 0 -column } -cleanup { grid_reset 1.3 } -returnCodes error -result {extra option or option with no value} - test grid-1.4 {basic argument checking} -body { - button .b - grid configure .b - foo + button .b + grid configure .b - foo } -cleanup { grid_reset 1.4 -} -returnCodes error -result {unexpected parameter, "foo", in configure list. Should be window name or option} +} -returnCodes error -result {unexpected parameter "foo" in configure list: should be window name or option} test grid-1.5 {basic argument checking} -body { - grid . + grid . } -returnCodes error -result {can't manage ".": it's a top-level window} test grid-1.6 {basic argument checking} -body { - grid x + grid x } -returnCodes error -result {can't determine master window} test grid-1.7 {basic argument checking} -body { - grid configure x + grid configure x } -returnCodes error -result {can't determine master window} test grid-1.8 {basic argument checking} -body { - button .b - grid x .b + button .b + grid x .b } -cleanup { grid_reset 1.8 } -returnCodes ok -result {} - test grid-1.9 {basic argument checking} -body { - button .b - grid configure x .b + button .b + grid configure x .b } -cleanup { grid_reset 1.9 } -returnCodes ok -result {} - test grid-2.1 {bbox} -body { - grid bbox . + grid bbox . } -result {0 0 0 0} test grid-2.2 {bbox} -body { - button .b - grid .b - destroy .b - update - grid bbox . + button .b + grid .b + destroy .b + update + grid bbox . } -result {0 0 0 0} test grid-2.3 {bbox: argument checking} -body { - grid bbox . 0 0 5 + grid bbox . 0 0 5 } -returnCodes error -result {wrong # args: should be "grid bbox master ?column row ?column row??"} test grid-2.4 {bbox} -body { - grid bbox .bad 0 0 + grid bbox .bad 0 0 } -returnCodes error -result {bad window path name ".bad"} test grid-2.5 {bbox} -body { - grid bbox . x 0 + grid bbox . x 0 } -returnCodes error -result {expected integer but got "x"} test grid-2.6 {bbox} -body { - grid bbox . 0 x + grid bbox . 0 x } -returnCodes error -result {expected integer but got "x"} test grid-2.7 {bbox} -body { - grid bbox . 0 0 x 0 + grid bbox . 0 0 x 0 } -returnCodes error -result {expected integer but got "x"} test grid-2.8 {bbox} -body { - grid bbox . 0 0 0 x + grid bbox . 0 0 0 x } -returnCodes error -result {expected integer but got "x"} test grid-2.9 {bbox} -body { frame .1 -width 75 -height 75 -bg red @@ -123,11 +119,10 @@ test grid-2.9 {bbox} -body { lappend a [grid bbox . 0 0] lappend a [grid bbox . 0 0 1 1] lappend a [grid bbox . 1 1] - set a + return $a } -cleanup { grid_reset 2.9 } -result {{0 0 165 165} {0 0 75 75} {0 0 165 165} {75 75 90 90}} - test grid-2.10 {bbox} -body { frame .1 -width 75 -height 75 -bg red frame .2 -width 90 -height 90 -bg red @@ -138,12 +133,11 @@ test grid-2.10 {bbox} -body { lappend a [grid bbox . 10 10 0 0] lappend a [grid bbox . -2 -2 -1 -1] lappend a [grid bbox . 10 10 12 12] - set a + return $a } -cleanup { grid_reset 2.10 } -result {{0 0 165 165} {0 0 0 0} {165 165 0 0}} - test grid-3.1 {configure: basic argument checking} -body { grid configure foo } -returnCodes error -result {bad argument "foo": must be name of window} @@ -154,35 +148,30 @@ test grid-3.2 {configure: basic argument checking} -body { } -cleanup { grid_reset 3.2 } -result {.b} - test grid-3.3 {configure: basic argument checking} -body { button .b grid .b -row -1 } -cleanup { grid_reset 3.3 } -returnCodes error -result {bad row value "-1": must be a non-negative integer} - test grid-3.4 {configure: basic argument checking} -body { button .b grid .b -column -1 } -cleanup { grid_reset 3.4 } -returnCodes error -result {bad column value "-1": must be a non-negative integer} - test grid-3.5 {configure: basic argument checking} -body { button .b grid .b -rowspan 0 } -cleanup { grid_reset 3.5 } -returnCodes error -result {bad rowspan value "0": must be a positive integer} - test grid-3.6 {configure: basic argument checking} -body { button .b grid .b -columnspan 0 } -cleanup { grid_reset 3.6 } -returnCodes error -result {bad columnspan value "0": must be a positive integer} - test grid-3.7 {configure: basic argument checking} -body { frame .f button .f.b @@ -190,7 +179,6 @@ test grid-3.7 {configure: basic argument checking} -body { } -cleanup { grid_reset 3.7 } -returnCodes error -result {can't put .f.b inside .} - test grid-3.8 {configure: basic argument checking} -body { button .b grid configure x .b @@ -198,7 +186,6 @@ test grid-3.8 {configure: basic argument checking} -body { } -cleanup { grid_reset 3.8 } -result {.b} - test grid-3.9 {configure: basic argument checking} -body { button .b grid configure y .b @@ -206,7 +193,6 @@ test grid-3.9 {configure: basic argument checking} -body { grid_reset 3.9 } -returnCodes error -result {invalid window shortcut, "y" should be '-', 'x', or '^'} - test grid-4.1 {forget: basic argument checking} -body { grid forget foo } -returnCodes error -result {bad window path name "foo"} @@ -216,11 +202,10 @@ test grid-4.2 {forget} -body { set a [grid slaves .] grid forget .b .c lappend a [grid slaves .] - set a + return $a } -cleanup { grid_reset 4.2 } -result {.b {}} - test grid-4.3 {forget} -body { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns @@ -230,7 +215,6 @@ test grid-4.3 {forget} -body { } -cleanup { grid_reset 4.3 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} - test grid-4.4 {forget} -body { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx {3 5} -pady {4 7} -sticky ns @@ -240,7 +224,6 @@ test grid-4.4 {forget} -body { } -cleanup { grid_reset 4.3.1 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} - test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body { frame .f -bd 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 @@ -256,9 +239,8 @@ test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body { grid_reset 4.4 } -result {1 0} - test grid-5.1 {info: basic argument checking} -body { - grid info a b + grid info a b } -returnCodes error -result {wrong # args: should be "grid info window"} test grid-5.2 {info} -body { frame .1 -width 75 -height 75 -bg red @@ -268,7 +250,6 @@ test grid-5.2 {info} -body { } -cleanup { grid_reset 5.2 } -returnCodes error -result {bad window path name ".x"} - test grid-5.3 {info} -body { frame .1 -width 75 -height 75 -bg red grid .1 -row 0 -column 0 @@ -277,7 +258,6 @@ test grid-5.3 {info} -body { } -cleanup { grid_reset 5.3 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} - test grid-5.4 {info} -body { frame .1 -width 75 -height 75 -bg red update @@ -286,26 +266,24 @@ test grid-5.4 {info} -body { grid_reset 5.4 } -returnCodes ok -result {} - test grid-6.1 {location: basic argument checking} -body { - grid location . + grid location . } -returnCodes error -result {wrong # args: should be "grid location master x y"} test grid-6.2 {location: basic argument checking} -body { - grid location .bad 0 0 + grid location .bad 0 0 } -returnCodes error -result {bad window path name ".bad"} test grid-6.3 {location: basic argument checking} -body { - grid location . x y + grid location . x y } -returnCodes error -result {bad screen distance "x"} test grid-6.4 {location: basic argument checking} -body { - grid location . 1c y + grid location . 1c y } -returnCodes error -result {bad screen distance "y"} test grid-6.5 {location: basic argument checking} -body { - frame .f - grid location .f 10 10 + frame .f + grid location .f 10 10 } -cleanup { grid_reset 6.5 } -result {-1 -1} - test grid-6.6 {location (x)} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -319,11 +297,10 @@ test grid-6.6 {location (x)} -body { set got $a } } - set result + return $result } -cleanup { grid_reset 6.6 } -result {{-10->-1 0} {0->0 0} {201->1 0}} - test grid-6.7 {location (y)} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -337,11 +314,10 @@ test grid-6.7 {location (y)} -body { set got $a } } - set result + return $result } -cleanup { grid_reset 6.7 } -result {{-10->0 -1} {0->0 0} {101->0 1}} - test grid-6.8 {location (weights)} -body { frame .f -width 300 -height 100 -highlightthickness 0 -bg red frame .a @@ -361,56 +337,49 @@ test grid-6.8 {location (weights)} -body { set got $a } } - set result + return $result } -cleanup { grid_reset 6.8 } -result {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}} - test grid-6.9 {location: check updates pending} -constraints { - nonPortable + nonPortable } -body { - set a "" - foreach i {0 1 2} { - frame .$i -width 120 -height 75 -bg red - lappend a [grid location . 150 90] - grid .$i -row $i -column $i - } - set a + set a "" + foreach i {0 1 2} { + frame .$i -width 120 -height 75 -bg red + lappend a [grid location . 150 90] + grid .$i -row $i -column $i + } + return $a } -cleanup { grid_reset 6.9 } -result {{0 0} {1 1} {1 1}} - test grid-7.1 {propagate} -body { grid propagate . 1 xxx } -cleanup { grid_reset 7.1 } -returnCodes error -result {wrong # args: should be "grid propagate window ?boolean?"} - test grid-7.2 {propagate} -body { grid propagate . } -cleanup { grid_reset 7.2 } -result {1} - test grid-7.3 {propagate} -body { grid propagate . 0;grid propagate . } -cleanup { grid_reset 7.3 } -result {0} - test grid-7.4 {propagate} -body { grid propagate .x } -cleanup { grid_reset 7.4 } -returnCodes error -result {bad window path name ".x"} - test grid-7.5 {propagate} -body { grid propagate . x } -cleanup { grid_reset 7.5 } -returnCodes error -result {expected boolean value but got "x"} - test grid-7.6 {propagate} -body { frame .f -width 100 -height 100 -bg red grid .f -row 0 -column 0 @@ -424,7 +393,7 @@ test grid-7.6 {propagate} -body { grid propagate .f 1 update lappend a [winfo width .f]x[winfo height .f] - set a + return $a } -cleanup { grid_reset 7.6 } -result {100x100 100x100 75x85} @@ -435,31 +404,27 @@ test grid-7.7 {propagate} -body { lappend res [grid propagate .] grid propagate . 0 lappend res [grid propagate .] - set res + return $res } -cleanup { grid_reset 7.7 } -result [list 1 0 0] - test grid-8.1 {size} -body { grid size . foo } -cleanup { grid_reset 8.1 } -returnCodes error -result {wrong # args: should be "grid size window"} - test grid-8.2 {size} -body { grid size .x } -cleanup { grid_reset 8.2 } -returnCodes error -result {bad window path name ".x"} - test grid-8.3 {size} -body { frame .f grid size .f } -cleanup { grid_reset 8.3 } -result {0 0} - test grid-8.4 {size} -body { catch {unset a} scale .f @@ -475,11 +440,10 @@ test grid-8.4 {size} -body { grid .f -row 0 -column 0 update lappend a [grid size .] - set a + return $a } -cleanup { grid_reset 8.4 } -result {{1 1} {6 5} {664 948} {1 1}} - test grid-8.5 {size} -body { catch {unset a} scale .f @@ -496,11 +460,10 @@ test grid-8.5 {size} -body { grid rowconfigure . 17 -weight 0 update lappend a [grid size .] - set a + return $a } -cleanup { grid_reset 8.5 } -result {{1 1} {1 18} {64 18} {1 1}} - test grid-8.6 {size} -body { catch {unset a} scale .f @@ -523,49 +486,47 @@ test grid-8.6 {size} -body { grid columnconfigure . 15 -weight 0 update lappend a [grid size .] - set a + return $a } -cleanup { grid_reset 8.6 } -result {{51 11} {51 11} {31 11} {21 11} {16 1} {1 1}} - test grid-9.1 {slaves} -body { - grid slaves . + grid slaves . } -returnCodes ok -result {} test grid-9.2 {slaves} -body { - grid slaves .foo + grid slaves .foo } -returnCodes error -result {bad window path name ".foo"} test grid-9.3 {slaves} -body { - grid slaves a b + grid slaves a b } -returnCodes error -result {wrong # args: should be "grid slaves window ?-option value ...?"} test grid-9.4 {slaves} -body { - grid slaves . a b + grid slaves . a b } -returnCodes error -result {bad option "a": must be -column or -row} test grid-9.5 {slaves} -body { - grid slaves . -column x + grid slaves . -column x } -returnCodes error -result {expected integer but got "x"} test grid-9.6 {slaves} -body { - grid slaves . -row -3 -} -returnCodes error -result {-row is an invalid value: should NOT be < 0} + grid slaves . -row -3 +} -returnCodes error -result {-3 is an invalid value: should NOT be < 0} test grid-9.7 {slaves} -body { - grid slaves . -foo 3 + grid slaves . -foo 3 } -returnCodes error -result {bad option "-foo": must be -column or -row} test grid-9.8 {slaves} -body { - grid slaves .x -row 3 + grid slaves .x -row 3 } -returnCodes error -result {bad window path name ".x"} test grid-9.9 {slaves} -body { - grid slaves . -row 3 + grid slaves . -row 3 } -returnCodes ok -result {} test grid-9.10 {slaves} -body { - foreach i {0 1 2} { - label .$i -text $i - grid .$i -row $i -column $i - } - grid slaves . + foreach i {0 1 2} { + label .$i -text $i + grid .$i -row $i -column $i + } + grid slaves . } -cleanup { grid_reset 9.10 } -result {.2 .1 .0} - test grid-9.11 {slaves} -body { catch {unset a} foreach i {0 1 2} { @@ -580,168 +541,145 @@ test grid-9.11 {slaves} -body { foreach col {0 1 2 3} { lappend a $col{[grid slaves . -column $col]} } - set a + return $a } -cleanup { grid_reset 9.11 } -result {{0{.0-x .0}} {1{.1-x .1}} {2{.2-x .2}} 3{} 0{.0} {1{.1 .0-x}} {2{.2 .1-x}} 3{.2-x}} - # column/row configure test grid-10.1 {column/row configure} -body { - grid columnconfigure . + grid columnconfigure . } -cleanup { grid_reset 10.1 } -returnCodes error -result {wrong # args: should be "grid columnconfigure master index ?-option value ...?"} - test grid-10.2 {column/row configure} -body { - grid columnconfigure . 0 -weight 0 -pad + grid columnconfigure . 0 -weight 0 -pad } -cleanup { grid_reset 10.2 } -returnCodes error -result {wrong # args: should be "grid columnconfigure master index ?-option value ...?"} - test grid-10.3 {column/row configure} -body { - grid columnconfigure .f 0 -weight + grid columnconfigure .f 0 -weight } -cleanup { grid_reset 10.3 } -returnCodes error -result {bad window path name ".f"} - test grid-10.4 {column/row configure} -body { - grid columnconfigure . nine -weight + grid columnconfigure . nine -weight } -cleanup { grid_reset 10.4 -} -returnCodes error -result {expected integer but got "nine" (when retreiving options only integer indices are allowed)} - +} -returnCodes error -result {expected integer but got "nine" (when retrieving options only integer indices are allowed)} test grid-10.5 {column/row configure} -body { - grid columnconfigure . 265 -weight + grid columnconfigure . 265 -weight } -cleanup { grid_reset 10.5 } -result {0} - test grid-10.6 {column/row configure} -body { - grid columnconfigure . 0 + grid columnconfigure . 0 } -cleanup { grid_reset 10.6 } -result {-minsize 0 -pad 0 -uniform {} -weight 0} - test grid-10.7 {column/row configure} -body { - grid columnconfigure . 0 -foo + grid columnconfigure . 0 -foo } -cleanup { grid_reset 10.7 } -returnCodes error -result {bad option "-foo": must be -minsize, -pad, -uniform, or -weight} - test grid-10.8 {column/row configure} -body { - grid columnconfigure . 0 -minsize foo + grid columnconfigure . 0 -minsize foo } -cleanup { grid_reset 10.8 } -returnCodes error -result {bad screen distance "foo"} - test grid-10.9 {column/row configure} -body { - grid columnconfigure . 0 -minsize foo + grid columnconfigure . 0 -minsize foo } -cleanup { grid_reset 10.9 } -returnCodes error -result {bad screen distance "foo"} - test grid-10.10 {column/row configure} -body { - grid columnconfigure . 0 -minsize 10 - grid columnconfigure . 0 -minsize + grid columnconfigure . 0 -minsize 10 + grid columnconfigure . 0 -minsize } -cleanup { grid_reset 10.10 } -result {10} - test grid-10.11 {column/row configure} -body { - grid columnconfigure . 0 -weight bad + grid columnconfigure . 0 -weight bad } -cleanup { grid_reset 10.11 } -returnCodes error -result {expected integer but got "bad"} - test grid-10.12 {column/row configure} -body { - grid columnconfigure . 0 -weight -3 + grid columnconfigure . 0 -weight -3 } -cleanup { grid_reset 10.12 } -returnCodes error -result {invalid arg "-weight": should be non-negative} - test grid-10.13 {column/row configure} -body { - grid columnconfigure . 0 -weight 3 - grid columnconfigure . 0 -weight + grid columnconfigure . 0 -weight 3 + grid columnconfigure . 0 -weight } -cleanup { grid_reset 10.13 } -result {3} - test grid-10.14 {column/row configure} -body { - grid columnconfigure . 0 -pad foo + grid columnconfigure . 0 -pad foo } -cleanup { grid_reset 10.14 } -returnCodes error -result {bad screen distance "foo"} - test grid-10.15 {column/row configure} -body { - grid columnconfigure . 0 -pad -3 + grid columnconfigure . 0 -pad -3 } -cleanup { grid_reset 10.15 } -returnCodes error -result {invalid arg "-pad": should be non-negative} - test grid-10.16 {column/row configure} -body { - grid columnconfigure . 0 -pad 3 - grid columnconfigure . 0 -pad + grid columnconfigure . 0 -pad 3 + grid columnconfigure . 0 -pad } -cleanup { grid_reset 10.16 } -result {3} - test grid-10.17 {column/row configure} -body { - frame .f - set a "" - grid columnconfigure .f 0 -weight 0 - lappend a [grid columnconfigure .f 0 -weight] - grid columnconfigure .f 0 -weight 1 - lappend a [grid columnconfigure .f 0 -weight] - grid rowconfigure .f 0 -weight 0 - lappend a [grid rowconfigure .f 0 -weight] - grid rowconfigure .f 0 -weight 1 - lappend a [grid columnconfigure .f 0 -weight] - grid columnconfigure .f 0 -weight 0 - set a + frame .f + set a "" + grid columnconfigure .f 0 -weight 0 + lappend a [grid columnconfigure .f 0 -weight] + grid columnconfigure .f 0 -weight 1 + lappend a [grid columnconfigure .f 0 -weight] + grid rowconfigure .f 0 -weight 0 + lappend a [grid rowconfigure .f 0 -weight] + grid rowconfigure .f 0 -weight 1 + lappend a [grid columnconfigure .f 0 -weight] + grid columnconfigure .f 0 -weight 0 + return $a } -cleanup { grid_reset 10.17 } -result {0 1 0 1} - test grid-10.18 {column/row configure} -body { - frame .f - grid columnconfigure .f {0 2} -minsize 10 -weight 1 - list [grid columnconfigure .f 0 -minsize] \ - [grid columnconfigure .f 1 -minsize] \ - [grid columnconfigure .f 2 -minsize] \ - [grid columnconfigure .f 0 -weight] \ - [grid columnconfigure .f 1 -weight] \ - [grid columnconfigure .f 2 -weight] + frame .f + grid columnconfigure .f {0 2} -minsize 10 -weight 1 + list [grid columnconfigure .f 0 -minsize] \ + [grid columnconfigure .f 1 -minsize] \ + [grid columnconfigure .f 2 -minsize] \ + [grid columnconfigure .f 0 -weight] \ + [grid columnconfigure .f 1 -weight] \ + [grid columnconfigure .f 2 -weight] } -cleanup { grid_reset 10.18 } -result {10 0 10 1 0 1} - test grid-10.19 {column/row configure} -body { - grid columnconfigure . {0 -1 2} -weight 1 + grid columnconfigure . {0 -1 2} -weight 1 } -cleanup { grid_reset 10.19 -} -returnCodes error -result {grid columnconfigure: "-1" is out of range} - +} -returnCodes error -result {"-1" is out of range} test grid-10.20 {column/row configure} -body { - grid columnconfigure . 0 -uniform foo - grid columnconfigure . 0 -uniform + grid columnconfigure . 0 -uniform foo + grid columnconfigure . 0 -uniform } -cleanup { grid_reset 10.20 } -result {foo} - test grid-10.21 {column/row configure} -body { grid columnconfigure . .b -weight 1 } -cleanup { grid_reset 10.21 -} -returnCodes error -result {grid columnconfigure: illegal index ".b"} - +} -returnCodes error -result {illegal index ".b"} test grid-10.22 {column/row configure} -body { button .b grid columnconfigure . .b -weight 1 } -cleanup { grid_reset 10.22 -} -returnCodes error -result {grid columnconfigure: the window ".b" is not managed by "."} - +} -returnCodes error -result {the window ".b" is not managed by "."} test grid-10.23 {column/row configure} -body { button .b grid .b -column 1 -columnspan 2 @@ -750,11 +688,10 @@ test grid-10.23 {column/row configure} -body { foreach i {0 1 2 3} { lappend res [grid columnconfigure . $i -weight] } - set res + return $res } -cleanup { grid_reset 10.23 } -result {0 1 1 0} - test grid-10.24 {column/row configure} -body { button .b button .c @@ -768,11 +705,10 @@ test grid-10.24 {column/row configure} -body { foreach i {0 1 2 3 4 5 6} { lappend res [grid columnconfigure . $i -weight] } - set res + return $res } -cleanup { grid_reset 10.24 } -result {0 1 2 2 2 1 0} - test grid-10.25 {column/row configure} -body { button .b button .c @@ -786,18 +722,16 @@ test grid-10.25 {column/row configure} -body { foreach i {0 1 2 3 4 5 6 7} { lappend res [grid rowconfigure . $i -weight] } - set res + return $res } -cleanup { grid_reset 10.25 } -result {0 2 1 1 2 2 0 1} - test grid-10.26 {column/row configure} -body { button .b grid columnconfigure .b 0 } -cleanup { grid_reset 10.26 } -result {-minsize 0 -pad 0 -uniform {} -weight 0} - test grid-10.27 {column/row configure - no indices} -body { # Bug 1422430 set t [toplevel .test] @@ -813,10 +747,10 @@ test grid-10.28 {column/row configure - no indices} -body { } -returnCodes error -result {no row indices specified} test grid-10.29 {column/row configure - invalid indices} -body { grid columnconfigure . {0 1 2} -weight -} -returnCodes error -result {grid columnconfigure: must specify a single element on retrieval} +} -returnCodes error -result {must specify a single element on retrieval} test grid-10.30 {column/row configure - invalid indices} -body { grid rowconfigure . {0 1 2} -weight -} -returnCodes error -result {grid rowconfigure: must specify a single element on retrieval} +} -returnCodes error -result {must specify a single element on retrieval} test grid-10.31 {column/row configure - empty 'all' configure} -body { # Bug 1422430 set t [toplevel .test] @@ -834,23 +768,20 @@ test grid-10.32 {column/row configure} -body { append res [grid columnconfigure .f {.f.f 1} -weight 1] append res [grid columnconfigure .f {2 .f.f} -weight 1] destroy .f - set res + return $res } -cleanup { grid_reset 10.35 } -result {} - test grid-10.33 {column/row configure} -body { grid columnconfigure . all } -cleanup { grid_reset 10.36 -} -returnCodes error -result {expected integer but got "all" (when retreiving options only integer indices are allowed)} - +} -returnCodes error -result {expected integer but got "all" (when retrieving options only integer indices are allowed)} test grid-10.34 {column/row configure} -body { grid columnconfigure . 100000 } -cleanup { grid_reset 10.37 } -result {-minsize 0 -pad 0 -uniform {} -weight 0} - test grid-10.35 {column/row configure} -body { # This is a test for bug 1423666 where a column >= 10000 caused # a crash in layout. The update is needed to reach the layout stage. @@ -863,17 +794,16 @@ test grid-10.35 {column/row configure} -body { lappend res [catch {grid .f -rowspan 2 -row 9998} msg] $msg ; update lappend res [catch {grid .f -column 9998 -columnspan 2} msg] $msg ; update lappend res [catch {grid .f -row 9998 -rowspan 2} msg] $msg ; update - set res + return $res } -cleanup {destroy .f} -result [lrange { - 1 {Column out of bounds} - 1 {Row out of bounds} - 1 {Column out of bounds} - 1 {Row out of bounds} - 1 {Column out of bounds} - 1 {Row out of bounds} + 1 {column out of bounds} + 1 {row out of bounds} + 1 {column out of bounds} + 1 {row out of bounds} + 1 {column out of bounds} + 1 {row out of bounds} } 0 end] grid_reset 10.38 - test grid-10.36 {column/row configure} -body { # Additional tests for row/column overflow frame .f @@ -887,51 +817,45 @@ test grid-10.36 {column/row configure} -body { grid forget .f .g lappend res [catch {eval grid [string repeat " x " 9999] .f} msg] $msg update - set res + return $res } -cleanup {destroy .f .g} -result [lrange { - 1 {Row out of bounds} - 1 {Row out of bounds} - 1 {Column out of bounds} - 1 {Column out of bounds} + 1 {row out of bounds} + 1 {row out of bounds} + 1 {column out of bounds} + 1 {column out of bounds} } 0 end] grid_reset 10.39 - # auto-placement tests test grid-11.1 {default widget placement} -body { - grid ^ + grid ^ } -cleanup { grid_reset 11.1 } -returnCodes error -result {can't use '^', cant find master} - test grid-11.2 {default widget placement} -body { - button .b - grid .b ^ + button .b + grid .b ^ } -cleanup { grid_reset 11.2 -} -returnCodes error -result {can't find slave to extend with "^".} - +} -returnCodes error -result {can't find slave to extend with "^"} test grid-11.3 {default widget placement} -body { - button .b - grid .b - - .c + button .b + grid .b - - .c } -cleanup { grid_reset 11.3 } -returnCodes error -result {bad window path name ".c"} - test grid-11.4 {default widget placement} -body { - button .b - grid .b - - = - + button .b + grid .b - - = - } -cleanup { grid_reset 11.4 } -returnCodes error -result {invalid window shortcut, "=" should be '-', 'x', or '^'} - test grid-11.5 {default widget placement} -body { - button .b - grid .b - x - + button .b + grid .b - x - } -cleanup { grid_reset 11.5 -} -returnCodes error -result {Must specify window before shortcut '-'.} - +} -returnCodes error -result {must specify window before shortcut '-'} test grid-11.6 {default widget placement} -body { foreach i {1 2 3 4 5 6} { frame .f$i -width 50 -height 50 -highlightthickness 0 -bg red @@ -944,38 +868,34 @@ test grid-11.6 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.6 } -result {{0,50 100,50} {150,50 50,50}} - test grid-11.7 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 grid .f x - } -cleanup { grid_reset 11.7 -} -returnCodes error -result {Must specify window before shortcut '-'.} - +} -returnCodes error -result {must specify window before shortcut '-'} test grid-11.8 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 grid .f ^ - } -cleanup { grid_reset 11.8 -} -returnCodes error -result {Must specify window before shortcut '-'.} - +} -returnCodes error -result {must specify window before shortcut '-'} test grid-11.9 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 grid .f x ^ } -cleanup { grid_reset 11.9 -} -returnCodes error -result {can't find slave to extend with "^".} - +} -returnCodes error -result {can't find slave to extend with "^"} test grid-11.10 {default widget placement} -body { foreach i {1 2 3} { - frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red + frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red } grid .f1 .f2 -sticky nsew grid .f3 ^ -sticky nsew @@ -985,57 +905,54 @@ test grid-11.10 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.10 } -result {{0,0 100,50} {100,0 100,100} {0,50 100,50}} - test grid-11.11 {default widget placement} -body { foreach i {1 2 3 4 5 6 7 8 9 10 11 12} { - frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black } - grid .f1 .f2 .f3 .f4 -sticky nsew + grid .f1 .f2 .f3 .f4 -sticky nsew grid .f5 .f6 - .f7 -sticky nsew grid .f8 ^ ^ .f9 -sticky nsew - grid .f10 ^ ^ .f11 -sticky nsew - grid .f12 - - - -sticky nsew + grid .f10 ^ ^ .f11 -sticky nsew + grid .f12 - - - -sticky nsew update set a "" foreach i {5 6 7 8 9 10 11 12 } { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.11 } -result {{0,50 50,50} {50,50 100,150} {150,50 50,50} {0,100 50,50} {150,100 50,50} {0,150 50,50} {150,150 50,50} {0,200 200,50}} - test grid-11.12 {default widget placement} -body { foreach i {1 2 3 4} { - frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black } grid .f1 .f2 .f3 -sticky nsew grid .f4 ^ -sticky nsew update set a "" foreach i {1 2 3 4} { - lappend a "[winfo x .f$i],[winfo y .f$i] \ - [winfo width .f$i],[winfo height .f$i]" + lappend a "[winfo x .f$i],[winfo y .f$i] \ + [winfo width .f$i],[winfo height .f$i]" } grid .f4 ^ -column 1 update foreach i {1 2 3 4} { - lappend a "[winfo x .f$i],[winfo y .f$i] \ - [winfo width .f$i],[winfo height .f$i]" - } - set a + lappend a "[winfo x .f$i],[winfo y .f$i] \ + [winfo width .f$i],[winfo height .f$i]" + } + return $a } -cleanup { grid_reset 11.12 } -result {{0,0 75,50} {75,0 75,100} {150,0 75,50} {0,50 75,50} {0,0 75,50} {75,0 75,100} {150,0 75,100} {75,50 75,50}} - test grid-11.13 {default widget placement} -body { foreach i {1 2 3 4 5 6 7} { - frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black } grid .f1 .f2 .f3 .f4 .f5 -sticky nsew grid .f6 - .f7 -sticky nsew -columnspan 2 @@ -1045,11 +962,10 @@ test grid-11.13 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.13 } -result {{0,50 120,50} {120,50 80,50}} - test grid-11.14 {default widget placement} -body { foreach i {1 2 3} { frame .f$i -width 60 -height 60 -highlightthickness 0 -bg red @@ -1062,11 +978,10 @@ test grid-11.14 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.14 } -result {{0,30 60,60} {60,0 60,60} {60,60 60,60}} - test grid-11.15 {^ ^ test with multiple windows} -body { foreach i {1 2 3 4} { frame .f$i -width 50 -height 50 -bd 1 -relief solid @@ -1079,11 +994,10 @@ test grid-11.15 {^ ^ test with multiple windows} -body { lappend a "[winfo x .f$i],[winfo y .f$i]\ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.15 } -result {{0,0 50,50} {50,0 50,100} {100,0 50,100} {0,50 50,50}} - test grid-11.16 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1098,7 +1012,6 @@ test grid-11.16 {default widget placement} -body { } -cleanup { grid_reset 11.16 } -result {50 100 50} - test grid-11.17 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1113,7 +1026,6 @@ test grid-11.17 {default widget placement} -body { } -cleanup { grid_reset 11.17 } -result {100 50 100} - test grid-11.18 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1130,7 +1042,6 @@ test grid-11.18 {default widget placement} -body { } -cleanup { grid_reset 11.18 } -result {100 100 100 50} - test grid-11.19 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1139,7 +1050,6 @@ test grid-11.19 {default widget placement} -body { grid .c .d -sticky news grid ^ -in . -row 2 grid x ^ -in . -row 1 - grid rowconfigure . {0 1 2} -uniform a update set res "" @@ -1151,7 +1061,6 @@ test grid-11.19 {default widget placement} -body { grid_reset 11.19 } -result {50 100 100 50} - test grid-12.1 {-sticky} -body { catch {unset data} frame .f -width 200 -height 100 -highlightthickness 0 -bg red @@ -1167,7 +1076,7 @@ test grid-12.1 {-sticky} -body { array set data [grid info .f] append a "($data(-sticky)) [winfo x .f] [winfo y .f] [winfo width .f] [winfo height .f]\n" } - set a + return $a } -cleanup { grid_reset 12.1 } -result {() 25 25 200 100 @@ -1187,14 +1096,12 @@ test grid-12.1 {-sticky} -body { (new) 0 0 250 100 (nesw) 0 0 250 150 } - test grid-12.2 {-sticky} -body { frame .f -bg red grid .f -sticky glue } -cleanup { grid_reset 12.2 } -returnCodes error -result {bad stickyness value "glue": must be a string containing n, e, s, and/or w} - test grid-12.3 {-sticky} -body { frame .f -bg red grid .f -sticky {n,s,e,w} @@ -1204,14 +1111,12 @@ test grid-12.3 {-sticky} -body { grid_reset 12.3 } -result {nesw} - test grid-13.1 {-in} -body { frame .f -bg red grid .f -in .f } -cleanup { grid_reset 13.1 -} -returnCodes error -result {Window can't be managed in itself} - +} -returnCodes error -result {window can't be managed in itself} test grid-13.2 {-in} -body { frame .f -bg red list [winfo manager .f] \ @@ -1219,15 +1124,13 @@ test grid-13.2 {-in} -body { [winfo manager .f] } -cleanup { grid_reset 13.1.1 -} -result {{} 1 {Window can't be managed in itself} {}} - +} -result {{} 1 {window can't be managed in itself} {}} test grid-13.3 {-in} -body { frame .f -bg red grid .f -in .bad } -cleanup { grid_reset 13.2 } -returnCodes error -result {bad window path name ".bad"} - test grid-13.4 {-in} -body { frame .f -bg red toplevel .top @@ -1236,21 +1139,18 @@ test grid-13.4 {-in} -body { grid_reset 13.3 } -returnCodes error -result {can't put .f inside .top} destroy .top - test grid-13.5 {-ipadx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipadx x } -cleanup { grid_reset 13.4 } -returnCodes error -result {bad ipadx value "x": must be positive screen distance} - test grid-13.6 {-ipadx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipadx {5 5} } -cleanup { grid_reset 13.4.1 } -returnCodes error -result {bad ipadx value "5 5": must be positive screen distance} - test grid-13.7 {-ipadx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1262,21 +1162,18 @@ test grid-13.7 {-ipadx} -body { } -cleanup { grid_reset 13.5 } -result {200 202} - test grid-13.8 {-ipady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipady x } -cleanup { grid_reset 13.6 } -returnCodes error -result {bad ipady value "x": must be positive screen distance} - test grid-13.9 {-ipady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipady {5 5} } -cleanup { grid_reset 13.6.1 } -returnCodes error -result {bad ipady value "5 5": must be positive screen distance} - test grid-13.10 {-ipady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1288,21 +1185,18 @@ test grid-13.10 {-ipady} -body { } -cleanup { grid_reset 13.7 } -result {100 102} - test grid-13.11 {-padx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -padx x } -cleanup { grid_reset 13.8 } -returnCodes error -result {bad pad value "x": must be positive screen distance} - test grid-13.12 {-padx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -padx {10 x} } -cleanup { grid_reset 13.8.1 } -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} - test grid-13.13 {-padx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1314,7 +1208,6 @@ test grid-13.13 {-padx} -body { } -cleanup { grid_reset 13.9 } -result {{200 200} {200 202 1}} - test grid-13.14 {-padx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1326,21 +1219,18 @@ test grid-13.14 {-padx} -body { } -cleanup { grid_reset 13.9.1 } -result {{200 200} {200 215 10}} - test grid-13.15 {-pady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -pady x } -cleanup { grid_reset 13.10 } -returnCodes error -result {bad pad value "x": must be positive screen distance} - test grid-13.16 {-pady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -pady {10 x} } -cleanup { grid_reset 13.10.1 } -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} - test grid-13.17 {-pady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1352,7 +1242,6 @@ test grid-13.17 {-pady} -body { } -cleanup { grid_reset 13.11 } -result {{100 100} {100 102 1}} - test grid-13.18 {-pady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1364,27 +1253,25 @@ test grid-13.18 {-pady} -body { } -cleanup { grid_reset 13.11.1 } -result {{100 100} {100 120 4}} - test grid-13.19 {-ipad x and y} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid columnconfigure . 0 -minsize 150 grid rowconfigure . 0 -minsize 100 set a "" foreach x {0 5} { - foreach y {0 5} { + foreach y {0 5} { grid .f -ipadx $x -ipady $y update append a " $x,$y:" foreach prop {x y width height} { - append a ,[winfo $prop .f] + append a ,[winfo $prop .f] } } } - set a + return $a } -cleanup { grid_reset 13.12 } -result { 0,0:,65,40,20,20 0,5:,65,35,20,30 5,0:,60,40,30,20 5,5:,60,35,30,30} - test grid-13.20 {reparenting} -body { frame .1 frame .2 @@ -1398,12 +1285,11 @@ test grid-13.20 {reparenting} -body { catch {unset info}; array set info [grid info .b] lappend a [grid slaves .1],[grid slaves .2],$info(-in) unset info - set a + return $a } -cleanup { grid_reset 13.13 } -result {.b,,.1 ,.b,.2} - test grid-14.1 {structure notify} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red frame .g -width 200 -height 100 -highlightthickness 0 -bg red @@ -1417,11 +1303,10 @@ test grid-14.1 {structure notify} -body { update lappend a "[winfo x .g],[winfo y .g] \ [winfo width .g],[winfo height .g]" - set a + return $a } -cleanup { grid_reset 14.1 } -result {{0,0 200,100} {5,5 200,100}} - test grid-14.2 {structure notify} -body { frame .f -width 200 -height 100 frame .f.g -width 200 -height 100 @@ -1436,10 +1321,7 @@ test grid-14.2 {structure notify} -body { } -cleanup { grid_reset 14.2 } -result {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}} - -test grid-14.3 {map notify: bug 1648} -constraints { - nonPortable -} -body { +test grid-14.3 {map notify: bug 1648} -constraints {nonPortable} -body { # This test is nonPortable because the number of times # A(.) will be incremented is unspecified--the behavior # is different accross window managers. @@ -1462,7 +1344,6 @@ test grid-14.3 {map notify: bug 1648} -constraints { grid_reset 14.3 } -result {.2 2 .0 1 . 2 .1 1} - test grid-15.1 {lost slave} -body { button .b grid .b @@ -1474,7 +1355,6 @@ test grid-15.1 {lost slave} -body { } -cleanup { grid_reset 15.1 } -result {.b {} .b} - test grid-15.2 {lost slave} -body { frame .f grid .f @@ -1489,11 +1369,10 @@ test grid-15.2 {lost slave} -body { grid_reset 15.2 } -result {.b {} .b} - test grid-16.1 {layout centering} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid anchor . center @@ -1503,13 +1382,12 @@ test grid-16.1 {layout centering} -body { } -cleanup { grid_reset 16.1 } -result {37 50 225 150} - test grid-16.2 {layout weights (expanding)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] - grid columnconfigure . $i -weight [expr $i + 1] + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] + grid columnconfigure . $i -weight [expr $i + 1] } grid propagate . 0 . configure -width 500 -height 300 @@ -1518,17 +1396,16 @@ test grid-16.2 {layout weights (expanding)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.2 } -result {120-75 167-100 213-125} - test grid-16.3 {layout weights (shrinking)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] - grid columnconfigure . $i -weight [expr $i + 1] + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] + grid columnconfigure . $i -weight [expr $i + 1] } grid propagate . 0 . configure -width 200 -height 150 @@ -1537,17 +1414,16 @@ test grid-16.3 {layout weights (shrinking)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.3 } -result {84-63 66-50 50-37} - test grid-16.4 {layout weights (shrinking with minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 - grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 + grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 } grid propagate . 0 . configure -width 200 -height 150 @@ -1556,17 +1432,16 @@ test grid-16.4 {layout weights (shrinking with minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.4 } -result {70-60 65-45 65-45} - test grid-16.5 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight 0 -minsize 70 - grid columnconfigure . $i -weight 0 -minsize 90 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight 0 -minsize 70 + grid columnconfigure . $i -weight 0 -minsize 90 } grid propagate . 0 . configure -width 100 -height 75 @@ -1575,18 +1450,16 @@ test grid-16.5 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.5 } -result {100-75 100-75 100-75} - - test grid-16.6 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 - grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 + grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 } grid propagate . 0 . configure -width 200 -height 150 @@ -1595,11 +1468,10 @@ test grid-16.6 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.6 } -result {69-52 69-52 69-52} - # test fails when run alone # reason (I think): -minsize 0 causes both: # [winfo ismapped .$i] => 0 and @@ -1608,8 +1480,8 @@ test grid-16.6 {layout weights (shrinking at minsize)} -body { # That doesn't happen if previous tests run test grid-16.7 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid columnconfigure . 1 -weight 1 -minsize 0 @@ -1620,15 +1492,14 @@ test grid-16.7 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i] } - set a + return $a } -cleanup { grid_reset 16.7 } -result {100-75-1 1-1-0 100-75-1} - test grid-16.8 {layout internal constraints} -body { foreach i {0 1 2 3 4} { - frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } frame .f -bg red -width 250 -height 200 frame .g -bg green -width 200 -height 180 @@ -1639,32 +1510,31 @@ test grid-16.8 {layout internal constraints} -body { update set a "" foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .g grid .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } - set a + return $a } -cleanup { grid_reset 16.8 } -result {0 30 130 230 280 , 0 30 130 230 260 , 0 30 113 196 280 , 0 30 60 90 120 } - test grid-16.9 {layout uniform} -body { frame .f1 -width 75 -height 50 frame .f2 -width 60 -height 25 @@ -1682,14 +1552,12 @@ test grid-16.9 {layout uniform} -body { } -cleanup { grid_reset 16.9 } -result {{0 0 135 75} {0 75 135 100} {0 175 135 75} {0 250 135 100} {0 350 135 40}} - test grid-16.10 {layout uniform} -body { grid [frame .f1 -width 75 -height 50] -row 0 -column 0 grid [frame .f2 -width 60 -height 30] -row 1 -column 2 grid [frame .f3 -width 95 -height 90] -row 2 -column 1 grid [frame .f4 -width 60 -height 100] -row 3 -column 4 grid [frame .f5 -width 60 -height 40] -row 4 -column 3 - grid rowconfigure . {0 1} -uniform a grid rowconfigure . {2 4} -uniform b grid rowconfigure . {0 2} -weight 2 @@ -1704,7 +1572,6 @@ test grid-16.10 {layout uniform} -body { } -cleanup { grid_reset 16.10 } -result {{0 0 75 60} {170 60 150 30} {75 90 95 90} {390 180 140 100} {320 280 70 45}} - test grid-16.11 {layout uniform (shrink)} -body { frame .f1 -width 75 -height 50 frame .f2 -width 100 -height 95 @@ -1721,7 +1588,6 @@ test grid-16.11 {layout uniform (shrink)} -body { } -cleanup { grid_reset 16.11 } -result {{0 0 100 95} {100 0 100 95} {0 0 50 95} {50 0 100 95}} - test grid-16.12 {layout uniform (grow)} -body { frame .f1 -width 40 -height 50 frame .f2 -width 50 -height 95 @@ -1737,7 +1603,6 @@ test grid-16.12 {layout uniform (grow)} -body { set res {} lappend res [grid bbox . 0 0] [grid bbox . 1 0] lappend res [grid bbox . 2 0] [grid bbox . 3 0] - grid propagate . 0 . configure -width 350 -height 95 update @@ -1747,15 +1612,12 @@ test grid-16.12 {layout uniform (grow)} -body { grid_reset 16.12 } -result [list {0 0 50 95} {50 0 50 95} {100 0 100 95} {200 0 70 95} \ {0 0 70 95} {70 0 50 95} {120 0 140 95} {260 0 90 95}] - test grid-16.13 {layout span} -body { frame .f1 -width 24 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid .f3 - - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 3 4 0} {1 2 1 2} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1768,22 +1630,19 @@ test grid-16.13 {layout span} -body { } lappend res $res2 } - set res + return $res # The last result below should ideally be 8 8 8 126 but the current # implementation is not exact enough. } -cleanup { grid_reset 16.13 } -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ [list 18 38 18 76 0] [list 7 8 9 126 0]] - test grid-16.14 {layout span} -body { frame .f1 -width 110 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid .f3 - - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 3 4 0} {1 2 1 3} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1796,20 +1655,17 @@ test grid-16.14 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.14 } -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ [list 27 55 28 40 0] [list 36 37 37 40 0]] - test grid-16.15 {layout span} -body { frame .f1 -width 24 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid x .f3 - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 0 1 0} {0 0 0 0} {1 0 0 6}} { for {set c 0} {$c < 4} {incr c} { @@ -1822,12 +1678,11 @@ test grid-16.15 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.15 } -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 0 0 112 38 0] \ [list 0 37 37 76 0] [list 0 12 12 126 0]] - test grid-16.16 {layout span} -body { frame .f1 -width 64 -height 20 frame .f2 -width 38 -height 20 @@ -1835,11 +1690,9 @@ test grid-16.16 {layout span} -body { frame .f4 -width 15 -height 20 frame .f5 -width 18 -height 20 frame .f6 -width 20 -height 20 - grid .f1 - x .f2 grid .f3 - - - grid .f4 .f5 .f6 - set res {} foreach w {{1 1 5 1} {0 0 1 0} {1 3 4 0} {1 2 1 2} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1852,16 +1705,15 @@ test grid-16.16 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.16 } -result [list [list 30 34 43 43 0] [list 30 34 48 38 0] [list 22 42 48 38 0] \ [list 25 39 29 57 0] [list 30 34 22 64 0]] - test grid-16.17 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2 3} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid columnconfigure . {0 1} -weight 1 -minsize 0 @@ -1877,21 +1729,18 @@ test grid-16.17 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2 3} { lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i] } - set a + return $a } -cleanup { grid_reset 16.17 } -result {25-25-1 25-25-1 100-75-1 100-75-1 25-25-0 25-25-0 100-75-1 100-75-1} - test grid-16.18 {layout span} -body { frame .f1 -width 30 -height 20 frame .f2 -width 166 -height 20 frame .f3 -width 39 -height 20 frame .f4 -width 10 -height 20 - grid .f1 .f3 - grid .f2 - .f4 grid columnconfigure . 0 -weight 1 - set res {} foreach w {{1 0 0} {0 1 0} {0 0 1}} { for {set c 0} {$c < 3} {incr c} { @@ -1904,11 +1753,10 @@ test grid-16.18 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.18 } -result [list [list 137 29 10] [list 30 136 10] [list 98 68 10]] - test grid-16.19 {layout span} -constraints { knownBug } -body { # This test shows the problem in Bug 2075285 # Several overlapping multi-span widgets is a weak spot @@ -1918,26 +1766,22 @@ test grid-16.19 {layout span} -constraints { knownBug } -body { frame .f2 -width 20 -height 20 frame .f3 -width 10 -height 20 frame .f4 -width 20 -height 20 - grid .f1 - - - - - -sticky we grid .f2 - .f3 - .f4 - -sticky we grid columnconfigure . {1 5} -weight 1 - set res {} update for {set c 0} {$c <= 5} {incr c} { lappend res [lindex [grid bbox . $c 0] 2] } - set res + return $res } -cleanup { grid_reset 16.19 } -result [list 0 45 5 5 0 45] - test grid-17.1 {forget and pending idle handlers} -body { # This test is intended to detect a crash caused by a failure to remove # pending idle handlers when grid forget is invoked. - toplevel .t wm geometry .t +0+0 frame .t.f @@ -1948,7 +1792,6 @@ test grid-17.1 {forget and pending idle handlers} -body { grid forget .t.f.l grid forget .t.f destroy .t - toplevel .t frame .t.f label .t.f.l -text foobar @@ -1974,7 +1817,7 @@ test grid-18.1 {test respect for internalborder} -body { update lappend res [winfo geometry .pack.lf.f] destroy .pack - set res + return $res } -result {196x188+2+10 177x186+5+7} test grid-18.2 {test support for minreqsize} -body { toplevel .pack @@ -1990,10 +1833,9 @@ test grid-18.2 {test support for minreqsize} -body { update lappend res [winfo geometry .pack.lf] destroy .pack - set res + return $res } -result {162x127+0+0 172x112+0+0} - test grid-19.1 {uniform realloc} -body { # Use a lot of uniform groups to test the reallocation mechanism for {set t 0} {$t < 100} {incr t 2} { @@ -2008,7 +1850,6 @@ test grid-19.1 {uniform realloc} -body { grid_reset 19.1 } -result {0 0 600 20} - test grid-20.1 {recalculate size after removal (destroy)} -body { label .l1 -text l1 grid .l1 -row 2 -column 2 @@ -2019,7 +1860,6 @@ test grid-20.1 {recalculate size after removal (destroy)} -body { } -cleanup { grid_reset 20.1 } -result {1 1} - test grid-20.2 {recalculate size after removal (forget)} -body { label .l1 -text l1 grid .l1 -row 2 -column 2 @@ -2031,58 +1871,50 @@ test grid-20.2 {recalculate size after removal (forget)} -body { grid_reset 20.2 } -result {1 1} - test grid-21.1 {anchor} -body { grid anchor . 1 xxx } -cleanup { grid_reset 21.1 } -returnCodes error -result {wrong # args: should be "grid anchor window ?anchor?"} - test grid-21.2 {anchor} -body { grid anchor . } -cleanup { grid_reset 21.2 } -result {nw} - test grid-21.3 {anchor} -body { grid anchor . se;grid anchor . } -cleanup { grid_reset 21.3 } -result {se} - test grid-21.4 {anchor} -body { grid anchor .x } -cleanup { grid_reset 21.4 } -returnCodes error -result {bad window path name ".x"} - test grid-21.5 {anchor} -body { grid anchor . x } -cleanup { grid_reset 21.5 } -returnCodes error -result {bad anchor "x": must be n, ne, e, se, s, sw, w, nw, or center} - test grid-21.6 {anchor} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 . configure -width 300 -height 250 - set res {} foreach a {n ne e se s sw w nw center} { grid anchor . $a update lappend res [grid bbox .] } - set res + return $res } -cleanup { grid_reset 21.6 } -result [list {37 0 225 150} {75 0 225 150} {75 50 225 150} {75 100 225 150} \ {37 100 225 150} {0 100 225 150} {0 50 225 150} {0 0 225 150} \ {37 50 225 150}] - test grid-21.7 {anchor} -body { # Test with a non-symmetric internal border. # This only tests vertically, there is currently no way to get @@ -2091,15 +1923,13 @@ test grid-21.7 {anchor} -body { frame .f.x -width 20 -height 20 .f configure -labelwidget .f.x pack .f -fill both -expand 1 - foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -in .f -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -in .f -row $i -column $i -sticky nswe } pack propagate . 0 grid propagate .f 0 . configure -width 300 -height 250 - set res {} foreach a {n ne e se s sw w nw center} { grid anchor .f $a @@ -2107,7 +1937,7 @@ test grid-21.7 {anchor} -body { lappend res [grid bbox .f] } pack propagate . 1 ; wm geometry . {} - set res + return $res } -cleanup { grid_reset 21.7 } -result [list {37 20 225 150} {75 20 225 150} {75 60 225 150} {75 100 225 150} \ @@ -2117,17 +1947,15 @@ test grid-21.7 {anchor} -body { test grid-22.1 {remove: basic argument checking} { list [catch {grid remove foo} msg] $msg } {1 {bad window path name "foo"}} - test grid-22.2 {remove} { button .c grid [button .b] set a [grid slaves .] grid remove .b .c lappend a [grid slaves .] - set a + return $a } {.b {}} grid_reset 22.2 - test grid-22.3 {remove} { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns @@ -2136,7 +1964,6 @@ test grid-22.3 {remove} { grid info .c } {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx 3 -pady 4 -sticky ns} grid_reset 22.3 - test grid-22.3.1 {remove} { frame .a button .c @@ -2146,7 +1973,6 @@ test grid-22.3.1 {remove} { grid info .c } {-in .a -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.3.1 - test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { frame .f -bd 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 @@ -2160,7 +1986,6 @@ test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { lappend x [winfo ismapped .f2] } {1 0} grid_reset 22.4 - test grid-22.5 {remove} { frame .a button .c @@ -2173,7 +1998,11 @@ test grid-22.5 {remove} { grid info .c } {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.5 - + # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/text.test b/tests/text.test index f8cb3d7..5089bb1 100644 --- a/tests/text.test +++ b/tests/text.test @@ -1397,7 +1397,7 @@ abcdefghijklm .t replace 3.1 2.3 foo } -cleanup { destroy .t -} -returnCodes {error} -result {Index "2.3" before "3.1" in the text} +} -returnCodes {error} -result {index "2.3" before "3.1" in the text} test text-8.20 {TextWidgetCmd procedure, "replace" option} -setup { text .t } -body { @@ -3705,7 +3705,7 @@ test text-22.1 {TextSearchCmd procedure, argument parsing} -body { .t search - } -cleanup { destroy .t -} -returnCodes {error} -result {bad switch "-": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} +} -returnCodes error -result {ambiguous switch "-": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} test text-22.2 {TextSearchCmd procedure, -backwards option} -body { text .t .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" @@ -3769,7 +3769,7 @@ test text-22.10 {TextSearchCmd procedure, -n ambiguous option} -body { .t search -n BaR 1.1 } -cleanup { destroy .t -} -returnCodes {error} -result {bad switch "-n": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} +} -returnCodes error -result {ambiguous switch "-n": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} test text-22.11 {TextSearchCmd procedure, -nocase option} -body { text .t .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test index d8bc65d..aa7e64a 100644 --- a/tests/ttk/treeview.test +++ b/tests/ttk/treeview.test @@ -405,7 +405,7 @@ test treeview-7.1 "move" -body { test treeview-7.2 "illegal move" -body { .tv move d d2 end -} -returnCodes 1 -result "Cannot insert d as a descendant of d2" +} -returnCodes 1 -result "Cannot insert d as descendant of d2" test treeview-7.3 "illegal move has no effect" -body { consistencyCheck .tv @@ -426,7 +426,7 @@ test treeview-7.5 "replace children - precondition" -body { test treeview-7.6 "Replace children - illegal move" -body { .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3] -} -returnCodes 1 -result "Cannot insert newnode.n1 as a descendant of newnode.n1" +} -returnCodes 1 -result "Cannot insert newnode.n1 as descendant of newnode.n1" consistencyCheck .tv diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test index def709e..e58b021 100644 --- a/tests/ttk/ttk.test +++ b/tests/ttk/ttk.test @@ -48,7 +48,7 @@ test ttk-6.4 "Destroy widget in configure" -setup { pack [ttk::checkbutton .b] set rc [catch { .b configure -variable OUCH } msg] list $rc $msg [winfo exists .b] [info commands .b] -} -result [list 1 "Widget has been destroyed" 0 {}] +} -result [list 1 "widget has been destroyed" 0 {}] test ttk-6.5 "Clean up -textvariable traces" -body { foreach class {ttk::button ttk::checkbutton ttk::radiobutton} { @@ -121,7 +121,7 @@ test ttk-construction-failure-2 "Destroy widget in constructor" -setup { [winfo exists .b] \ [info commands .b] \ ; -} -result [list 1 "Widget has been destroyed" 0 {}] +} -result [list 1 "widget has been destroyed" 0 {}] test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body { # see #2298720 @@ -222,15 +222,11 @@ test ttk-2.8 "bug 3223850: button state disabled during click" -setup { foreach wc $widgetClasses { test ttk-coreoptions-$wc "$wc has all core options" -body { ttk::$wc .w - foreach option { - -class - -style - -cursor - -takefocus - } { + foreach option {-class -style -cursor -takefocus} { .w cget $option } - destroy .w + } -cleanup { + catch {destroy .w} } } diff --git a/unix/tkUnix.c b/unix/tkUnix.c index 841a1b7..c6fff82 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -13,7 +13,14 @@ #include "tkInt.h" #ifdef HAVE_XSS -#include <X11/extensions/scrnsaver.h> +# include <X11/extensions/scrnsaver.h> +# ifdef __APPLE__ +/* Support for weak-linked libXss. */ +# define HaveXSSLibrary() (XScreenSaverQueryInfo != NULL) +# else +/* Other platforms always link libXss. */ +# define HaveXSSLibrary() (1) +# endif #endif /* @@ -26,7 +33,7 @@ * server" command. * * Results: - * None. + * Sets the interpreter result. * * Side effects: * None. @@ -41,14 +48,11 @@ TkGetServerInfo( Tk_Window tkwin) /* Token for window; this selects a particular * display and server. */ { - char buffer[8 + TCL_INTEGER_SPACE * 2]; - char buffer2[TCL_INTEGER_SPACE]; - - sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)), - ProtocolRevision(Tk_Display(tkwin))); - sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin))); - Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)), - buffer2, (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("X%dR%d %s %d", + ProtocolVersion(Tk_Display(tkwin)), + ProtocolRevision(Tk_Display(tkwin)), + ServerVendor(Tk_Display(tkwin)), + VendorRelease(Tk_Display(tkwin)))); } /* @@ -207,13 +211,9 @@ Tk_GetUserInactiveTime( * on some buggy versions of XFree86. */ - if ( -#ifdef __APPLE__ - XScreenSaverQueryInfo != NULL && /* Support for weak-linked libXss. */ -#endif - XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) && - XScreenSaverQueryVersion(dpy, &major, &minor)) { - + if (HaveXSSLibrary() + && XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) + && XScreenSaverQueryVersion(dpy, &major, &minor)) { XScreenSaverInfo *info = XScreenSaverAllocInfo(); if (info == NULL) { diff --git a/unix/tkUnixCursor.c b/unix/tkUnixCursor.c index bbf5206..5266bde 100644 --- a/unix/tkUnixCursor.c +++ b/unix/tkUnixCursor.c @@ -182,7 +182,7 @@ static const struct TkCursorName { static Cursor CreateCursorFromTableOrFile(Tcl_Interp *interp, Tk_Window tkwin, int argc, const char **argv, const struct TkCursorName *tkCursorPtr); - + /* *---------------------------------------------------------------------- * @@ -275,8 +275,9 @@ TkGetCursorByName( bg.red = bg.green = bg.blue = 65535; } else { if (TkParseColor(display, Tk_Colormap(tkwin), argv[1], &fg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", argv[1], - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", argv[1])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } if (argc == 2) { @@ -284,8 +285,9 @@ TkGetCursorByName( maskIndex = namePtr->shape; } else if (TkParseColor(display, Tk_Colormap(tkwin), argv[2], &bg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", argv[2], - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", argv[2])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } } @@ -293,7 +295,9 @@ TkGetCursorByName( if (dispPtr->cursorFont == None) { dispPtr->cursorFont = XLoadFont(display, CURSORFONT); if (dispPtr->cursorFont == None) { - Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't load cursor font", -1)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "FONT", NULL); goto cleanup; } } @@ -306,8 +310,10 @@ TkGetCursorByName( */ if (!inTkTable && Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get cursor from a file in", - " a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get cursor from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "CURSOR_FILE", NULL); cursorPtr = NULL; goto cleanup; } @@ -347,10 +353,11 @@ TkGetCursorByName( if (argv) { ckfree(argv); } - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); return NULL; } - + /* *---------------------------------------------------------------------- * @@ -419,8 +426,9 @@ CreateCursorFromTableOrFile( data = TkGetBitmapData(NULL, tkCursorPtr->data, NULL, &width, &height, &xHot, &yHot); if (data == NULL) { - Tcl_AppendResult(interp, "error reading bitmap data for \"", - argv[0], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap data for \"%s\"", argv[0])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "BITMAP_DATA", NULL); goto cleanup; } @@ -430,20 +438,22 @@ CreateCursorFromTableOrFile( if (TkReadBitmapFile(display, drawable, &argv[0][1], (unsigned *) &width, (unsigned *) &height, &source, &xHot, &yHot) != BitmapSuccess) { - Tcl_AppendResult(interp, "cleanup reading bitmap file \"", - &argv[0][1], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cleanup reading bitmap file \"%s\"", &argv[0][1])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "BITMAP_FILE", NULL); goto cleanup; } } if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) { if (inTkTable) { - Tcl_AppendResult(interp, "bad hot spot in bitmap data for \"", - argv[0], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad hot spot in bitmap data for \"%s\"", argv[0])); } else { - Tcl_AppendResult(interp, "bad hot spot in bitmap file \"", - &argv[0][1], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad hot spot in bitmap file \"%s\"", &argv[0][1])); } + Tcl_SetErrorCode(interp, "TK", "CURSOR", "HOTSPOT", NULL); goto cleanup; } @@ -457,8 +467,9 @@ CreateCursorFromTableOrFile( } else if (argc == 2) { fgColor = argv[1]; if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", - fgColor, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fgColor)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } if (inTkTable) { @@ -476,13 +487,15 @@ CreateCursorFromTableOrFile( bgColor = argv[3]; } if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", - fgColor, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fgColor)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } if (TkParseColor(display, Tk_Colormap(tkwin), bgColor, &bg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", - bgColor, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", bgColor)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } } @@ -511,8 +524,9 @@ CreateCursorFromTableOrFile( data = TkGetBitmapData(NULL, tkCursorPtr->mask, NULL, &maskWidth, &maskHeight, &dummy1, &dummy2); if (data == NULL) { - Tcl_AppendResult(interp, "error reading bitmap mask data for \"", - argv[0], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap mask data for \"%s\"", argv[0])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "MASK_DATA", NULL); goto cleanup; } @@ -524,15 +538,17 @@ CreateCursorFromTableOrFile( if (TkReadBitmapFile(display, drawable, argv[1], (unsigned int *) &maskWidth, (unsigned int *) &maskHeight, &mask, &dummy1, &dummy2) != BitmapSuccess) { - Tcl_AppendResult(interp, "cleanup reading bitmap file \"", - argv[1], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cleanup reading bitmap file \"%s\"", argv[1])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "MASK_FILE", NULL); goto cleanup; } } if ((maskWidth != width) || (maskHeight != height)) { - Tcl_SetResult(interp, "source and mask bitmaps have different sizes", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "source and mask bitmaps have different sizes", -1)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "SIZE_MATCH", NULL); goto cleanup; } @@ -548,7 +564,7 @@ CreateCursorFromTableOrFile( } return cursor; } - + /* *---------------------------------------------------------------------- * @@ -598,7 +614,7 @@ TkCreateCursorFromData( } return (TkCursor *) cursorPtr; } - + /* *---------------------------------------------------------------------- * @@ -625,7 +641,7 @@ TkpFreeCursor( XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor); Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor); } - + /* * Local Variables: * mode: c diff --git a/unix/tkUnixEmbed.c b/unix/tkUnixEmbed.c index bd5c512..8a4c368 100644 --- a/unix/tkUnixEmbed.c +++ b/unix/tkUnixEmbed.c @@ -106,12 +106,13 @@ TkpUseWindow( Tk_ErrorHandler handler; Container *containerPtr; XWindowAttributes parentAtts; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window != None) { - Tcl_AppendResult(interp, - "can't modify container after widget is created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, string, &id) != TCL_OK) { @@ -120,12 +121,12 @@ TkpUseWindow( parent = (Window) id; usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent); - if (usePtr != NULL) { - if (!(usePtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, "window \"", usePtr->pathName, - "\" doesn't have -container option set", NULL); - return TCL_ERROR; - } + if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); + return TCL_ERROR; } /* @@ -145,8 +146,9 @@ TkpUseWindow( Tk_DeleteErrorHandler(handler); if (anyError) { if (interp != NULL) { - Tcl_AppendResult(interp, "couldn't create child of window \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't create child of window \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "NO_TARGET", NULL); } return TCL_ERROR; } @@ -215,7 +217,7 @@ TkpMakeWindow( * the window is to be created. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_EMBEDDED) { @@ -271,7 +273,7 @@ TkpMakeContainer( { TkWindow *winPtr = (TkWindow *) tkwin; Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -331,7 +333,7 @@ EmbedErrorProc( XErrorEvent *errEventPtr) /* Points to information about error (not * used). */ { - int *iPtr = (int *) clientData; + int *iPtr = clientData; *iPtr = 1; return 0; @@ -361,7 +363,7 @@ EmbeddedEventProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; if (eventPtr->type == DestroyNotify) { EmbedWindowDeleted(winPtr); @@ -393,10 +395,10 @@ ContainerEventProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; Container *containerPtr; Tk_ErrorHandler errHandler; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -498,7 +500,7 @@ EmbedStructureProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - Container *containerPtr = (Container *) clientData; + Container *containerPtr = clientData; Tk_ErrorHandler errHandler; if (eventPtr->type == ConfigureNotify) { @@ -545,7 +547,7 @@ EmbedFocusProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - Container *containerPtr = (Container *) clientData; + Container *containerPtr = clientData; Tk_ErrorHandler errHandler; Display *display; @@ -703,7 +705,7 @@ TkpGetOtherWindow( * window. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; @@ -749,7 +751,7 @@ TkpRedirectKeyEvent( { Container *containerPtr; Window saved; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -821,7 +823,7 @@ TkpClaimFocus( { XEvent event; Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(topLevelPtr->flags & TK_EMBEDDED)) { @@ -872,7 +874,7 @@ TkpTestembedCmd( Container *containerPtr; Tcl_DString dString; char buffer[50]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { @@ -942,7 +944,7 @@ EmbedWindowDeleted( * deleted. */ { Container *containerPtr, *prevPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1000,7 +1002,7 @@ TkUnixContainerId( TkWindow *winPtr) /* Tk's structure for an embedded window. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; @@ -1132,8 +1134,7 @@ TkpMakeTransparentWindowExist( * TkpCreateBusy -- * * Construct the platform-specific parts of a busy window. Note that this - * postpones the actual creation of the window resource until later. The - * GetParent() function is a helper for this. + * postpones the actual creation of the window resource until later. * * Results: * None. @@ -1144,22 +1145,6 @@ TkpMakeTransparentWindowExist( *---------------------------------------------------------------------- */ -static inline Window -GetParent( - Display *display, - Window window) -{ - Window root, parent; - Window *dummy; - unsigned int count; - - if (XQueryTree(display, window, &root, &parent, &dummy, &count) > 0) { - XFree(dummy); - return parent; - } - return None; -} - void TkpCreateBusy( Tk_FakeWin *winPtr, @@ -1168,6 +1153,9 @@ TkpCreateBusy( Tk_Window tkParent, TkBusy busy) { + Window root, parent, *dummy; + unsigned int count; + if (winPtr->flags & TK_REPARENTED) { /* * This works around a bug in the implementation of menubars for @@ -1177,7 +1165,13 @@ TkpCreateBusy( * by determining the parent via the native API calls. */ - *parentPtr = GetParent(Tk_Display(tkRef), Tk_WindowId(tkRef)); + if (XQueryTree(Tk_Display(tkRef), Tk_WindowId(tkRef), &root, + &parent, &dummy, &count) > 0) { + XFree(dummy); + *parentPtr = parent; + } else { + *parentPtr = None; + } } else { *parentPtr = Tk_WindowId(tkParent); } diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index 136d69f..a4998aa 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -587,7 +587,7 @@ UtfToUcs2beProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - if ((flags & TCL_ENCODING_END) == 0) { + if (!(flags & TCL_ENCODING_END)) { srcClose -= TCL_UTF_MAX; } @@ -1648,7 +1648,7 @@ InitFont( pageMap = fontPtr->subFontArray[0].fontMap[0]; for (i = 0; i < 256; i++) { if ((minHi > 0) || (i < minLo) || (i > maxLo) - || (((pageMap[i>>3] >> (i&7)) & 1) == 0)) { + || !((pageMap[i>>3] >> (i&7)) & 1)) { n = 0; } else if (fontStructPtr->per_char == NULL) { n = fontStructPtr->max_bounds.width; diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index 172d5ca..4bb462e 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.c @@ -243,7 +243,7 @@ TkSelPropProc( long buffer[TK_SEL_WORDS_AT_ONCE]; TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display); Tk_ErrorHandler errorHandler; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -552,12 +552,12 @@ TkSelEventProc( break; } if (eventPtr->xselection.property == None) { - Tcl_SetResult(retrPtr->interp, NULL, TCL_STATIC); - Tcl_AppendResult(retrPtr->interp, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", Tk_GetAtomName(tkwin, retrPtr->selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, retrPtr->target), - "\" not defined", NULL); + Tk_GetAtomName(tkwin, retrPtr->target))); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", + "NONE", NULL); retrPtr->result = TCL_ERROR; return; } @@ -574,8 +574,9 @@ TkSelEventProc( return; } if (bytesAfter != 0) { - Tcl_SetResult(retrPtr->interp, "selection property too large", - TCL_STATIC); + Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj( + "selection property too large", -1)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE",NULL); retrPtr->result = TCL_ERROR; XFree(propInfo); return; @@ -583,13 +584,13 @@ TkSelEventProc( if ((type == XA_STRING) || (type == dispPtr->textAtom) || (type == dispPtr->compoundTextAtom)) { Tcl_Encoding encoding; - if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, + if (format != 8) { + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; return; } @@ -631,12 +632,11 @@ TkSelEventProc( char *propData = propInfo; if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; return; } @@ -673,11 +673,11 @@ TkSelEventProc( Tcl_DString ds; if (format != 32 && format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad format for selection: wanted \"32\" or " - "\"8\", got \"%d\"", format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "bad format for selection: wanted \"32\" or " + "\"8\", got \"%d\"", format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; return; } @@ -735,7 +735,7 @@ static void SelTimeoutProc( ClientData clientData) /* Information about retrieval in progress. */ { - register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; + register TkSelRetrievalInfo *retrPtr = clientData; /* * Make sure that the retrieval is still in progress. Then see how long @@ -753,8 +753,9 @@ SelTimeoutProc( * selection return. */ - Tcl_SetResult(retrPtr->interp, "selection owner didn't respond", - TCL_STATIC); + Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj( + "selection owner didn't respond", -1)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "IGNORED", NULL); retrPtr->result = TCL_ERROR; } else { retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, @@ -805,7 +806,7 @@ ConvertSelection( Tk_ErrorHandler errorHandler; TkSelectionInfo *infoPtr; TkSelInProgress ip; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1, @@ -874,7 +875,7 @@ ConvertSelection( } goto refuse; } - incr.numConversions /= 2; /* Two atoms per conversion. */ + incr.numConversions /= 2; /* Two atoms per conversion. */ } /* @@ -967,8 +968,9 @@ ConvertSelection( * allows us to pass our utf-8 information untouched. */ - XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type, 8, - PropModeReplace, (unsigned char *) buffer, numItems); + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + property, type, 8, PropModeReplace, + (unsigned char *) buffer, numItems); } else if ((type == XA_STRING) || (type == winPtr->dispPtr->compoundTextAtom)) { Tcl_DString ds; @@ -986,8 +988,9 @@ ConvertSelection( encoding = Tcl_GetEncoding(NULL, "iso2022"); } Tcl_UtfToExternalDString(encoding, (char *) buffer, -1, &ds); - XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type, 8, - PropModeReplace, (unsigned char *) Tcl_DStringValue(&ds), + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + property, type, 8, PropModeReplace, + (unsigned char *) Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); if (encoding) { Tcl_FreeEncoding(encoding); @@ -1000,9 +1003,9 @@ ConvertSelection( goto refuse; } format = 32; - XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type, - format, PropModeReplace, (unsigned char *) propPtr, - numItems); + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + property, type, format, PropModeReplace, + (unsigned char *) propPtr, numItems); ckfree(propPtr); } } @@ -1014,7 +1017,8 @@ ConvertSelection( */ if (incr.numIncrs > 0) { - XSelectInput(reply.xsel.display, reply.xsel.requestor, PropertyChangeMask); + XSelectInput(reply.xsel.display, reply.xsel.requestor, + PropertyChangeMask); incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, &incr); incr.idleTime = 0; incr.reqWindow = reply.xsel.requestor; @@ -1023,8 +1027,8 @@ ConvertSelection( tsdPtr->pendingIncrs = &incr; } if (multiple) { - XChangeProperty(reply.xsel.display, reply.xsel.requestor, reply.xsel.property, - XA_ATOM, 32, PropModeReplace, + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + reply.xsel.property, XA_ATOM, 32, PropModeReplace, (unsigned char *) incr.multAtoms, (int) incr.numConversions*2); } else { @@ -1052,7 +1056,7 @@ ConvertSelection( } Tcl_DeleteTimerHandler(incr.timeout); errorHandler = Tk_CreateErrorHandler(winPtr->display, - -1, -1,-1, (int (*)()) NULL, NULL); + -1, -1, -1, (int (*)()) NULL, NULL); XSelectInput(reply.xsel.display, reply.xsel.requestor, 0L); Tk_DeleteErrorHandler(errorHandler); if (tsdPtr->pendingIncrs == &incr) { @@ -1114,7 +1118,7 @@ SelRcvIncrProc( ClientData clientData, /* Information about retrieval. */ register XEvent *eventPtr) /* X PropertyChange event. */ { - register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; + register TkSelRetrievalInfo *retrPtr = clientData; char *propInfo, **propInfoPtr = &propInfo; Atom type; int format, result; @@ -1135,8 +1139,9 @@ SelRcvIncrProc( return; } if (bytesAfter != 0) { - Tcl_SetResult(retrPtr->interp, "selection property too large", - TCL_STATIC); + Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj( + "selection property too large", -1)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE", NULL); retrPtr->result = TCL_ERROR; goto done; } @@ -1150,12 +1155,11 @@ SelRcvIncrProc( Tcl_DString *dstPtr, temp; if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; goto done; } @@ -1257,11 +1261,11 @@ SelRcvIncrProc( Tcl_DString ds; if (format != 32 && format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad format for selection: wanted \"32\" or " - "\"8\", got \"%d\"", format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "bad format for selection: wanted \"32\" or " + "\"8\", got \"%d\"", format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; goto done; } @@ -1362,7 +1366,7 @@ IncrTimeoutProc( * retrieval for which we are selection * owner. */ { - register IncrInfo *incrPtr = (IncrInfo *) clientData; + register IncrInfo *incrPtr = clientData; incrPtr->idleTime++; if (incrPtr->idleTime >= 5) { diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index 13f2f04..54c3cf2 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -984,15 +984,19 @@ Tk_SendCmd( i++; break; } else { - Tcl_AppendResult(interp, "bad option \"", argv[i], - "\": must be -async, -displayof, or --", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be -async, -displayof, or --", + argv[i])); + Tcl_SetErrorCode(interp, "TK", "SEND", "OPTION", NULL); return TCL_ERROR; } } if (argc < (i+2)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?-option value ...? interpName arg ?arg ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong # args: should be " + "\"%s ?-option value ...? interpName arg ?arg ...?\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } destName = argv[i]; @@ -1067,7 +1071,10 @@ Tk_SendCmd( commWindow = RegFindName(regPtr, destName); RegClose(regPtr); if (commWindow == None) { - Tcl_AppendResult(interp, "no application named \"",destName,"\"",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no application named \"%s\"", destName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "APPLICATION", destName, + NULL); return TCL_ERROR; } @@ -1190,12 +1197,10 @@ Tk_SendCmd( ckfree(pending.errorInfo); } if (pending.errorCode != NULL) { - Tcl_Obj *errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1); - - Tcl_SetObjErrorCode(interp, errorObjPtr); + Tcl_SetObjErrorCode(interp, Tcl_NewStringObj(pending.errorCode, -1)); ckfree(pending.errorCode); } - Tcl_SetResult(interp, pending.result, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(pending.result, -1)); ckfree(pending.result); return pending.code; } @@ -1228,6 +1233,7 @@ TkGetInterpNames( { TkWindow *winPtr = (TkWindow *) tkwin; NameRegistry *regPtr; + Tcl_Obj *resultObj = Tcl_NewObj(); char *p; /* @@ -1262,7 +1268,8 @@ TkGetInterpNames( * The application still exists; add its name to the result. */ - Tcl_AppendElement(interp, entryName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(entryName, -1)); } else { int count; @@ -1285,6 +1292,7 @@ TkGetInterpNames( } } RegClose(regPtr); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1986,7 +1994,7 @@ TkpTestsendCmd( *p = '\n'; } } - Tcl_SetResult(interp, property, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(property, -1)); } if (property != NULL) { XFree(property); @@ -2010,10 +2018,7 @@ TkpTestsendCmd( Tcl_DStringFree(&tmp); } } else if (strcmp(argv[1], "serial") == 0) { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", localData.sendSerial+1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewIntObj(localData.sendSerial+1)); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be bogus, prop, or serial", NULL); diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 99fcf73..3362081 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -41,6 +41,7 @@ typedef struct ProtocolHandler { /* * Data for [wm attributes] command: */ + typedef struct { double alpha; /* Transparency; 0.0=transparent, 1.0=opaque */ int topmost; /* Flag: true=>stay-on-top */ @@ -277,6 +278,22 @@ typedef struct TkWmInfo { #define WM_WITHDRAWN 0x4000 /* + * Wrapper for XGetWindowProperty and XChangeProperty to make them a *bit* + * less verbose. + */ + +#define GetWindowProperty(wrapperPtr, atom, length, type, typePtr, formatPtr, numItemsPtr, bytesAfterPtr, itemsPtr) \ + (XGetWindowProperty((wrapperPtr)->display, (wrapperPtr)->window, \ + (atom), 0, (long) (length), False, (type), \ + (typePtr), (formatPtr), (numItemsPtr), (bytesAfterPtr), \ + (unsigned char **) (itemsPtr)) == Success) +#define SetWindowProperty(wrapperPtr, atomName, type, width, data, length) \ + XChangeProperty((wrapperPtr)->display, (wrapperPtr)->window, \ + Tk_InternAtom((Tk_Window) wrapperPtr, (atomName)), \ + (type), (width), PropModeReplace, (unsigned char *) (data), \ + (int) (length)) + +/* * This module keeps a list of all top-level windows, primarily to simplify * the job of Tk_CoordsToWindow. The list is called firstWmPtr and is stored * in the TkDisplay structure. @@ -697,7 +714,6 @@ TkWmMapWindow( if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, &textProp) != 0) { unsigned long pid = (unsigned long) getpid(); - Atom atom; XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, &textProp); @@ -710,10 +726,8 @@ TkWmMapWindow( * _NET_WM_PID requires that to be set too. */ - atom = Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PID"); - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - atom, XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) &pid, 1); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_PID", + XA_CARDINAL, 32, &pid, 1); } Tcl_DStringFree(&ds); } @@ -1041,9 +1055,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, - ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1072,8 +1085,10 @@ Tk_WmObjCmd( winPtr = (TkWindow *) targetWin; if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -1183,12 +1198,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1203,8 +1219,9 @@ WmAspectCmd( } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -1263,10 +1280,8 @@ WmSetAttribute( } opacity = 0xFFFFFFFFul * wmPtr->reqState.alpha; - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_WINDOW_OPACITY"), - XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opacity, - 1L); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_WINDOW_OPACITY", + XA_CARDINAL, 32, &opacity, 1L); wmPtr->attributes.alpha = wmPtr->reqState.alpha; break; @@ -1450,7 +1465,8 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } @@ -1492,9 +1508,8 @@ WmClientCmd( * be set too. */ - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PID"), - XA_CARDINAL,32, PropModeReplace, (unsigned char*)&pid, 1); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_PID", XA_CARDINAL, + 32, &pid, 1); } Tcl_DStringFree(&ds); } @@ -1530,8 +1545,7 @@ WmColormapwindowsCmd( Window *cmapList; TkWindow *winPtr2; int count, i, windowObjc, gotToplevel; - Tcl_Obj **windowObjv; - char buffer[20]; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1546,6 +1560,7 @@ WmColormapwindowsCmd( wmPtr->wrapperPtr->window, &cmapList, &count) == 0) { return TCL_OK; } + resultObj = Tcl_NewObj(); for (i = 0; i < count; i++) { if ((i == (count-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { @@ -1554,13 +1569,15 @@ WmColormapwindowsCmd( winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display, cmapList[i]); if (winPtr2 == NULL) { - sprintf(buffer, "0x%lx", cmapList[i]); - Tcl_AppendElement(interp, buffer); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_ObjPrintf("0x%lx", cmapList[i])); } else { - Tcl_AppendElement(interp, winPtr2->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(winPtr2->pathName, -1)); } } XFree((char *) cmapList); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) @@ -1638,7 +1655,8 @@ WmCommandCmd( if (wmPtr->cmdArgv != NULL) { char *arg = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - Tcl_SetResult(interp, arg, TCL_DYNAMIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, -1)); + ckfree(arg); } return TCL_OK; } @@ -1700,13 +1718,17 @@ WmDeiconifyCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } wmPtr->flags &= ~WM_WITHDRAWN; @@ -1751,8 +1773,8 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } @@ -1844,7 +1866,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1854,8 +1875,7 @@ WmFrameCmd( if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(buf, "0x%x", (unsigned) window); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) window)); return TCL_OK; } @@ -1894,8 +1914,6 @@ WmGeometryCmd( return TCL_ERROR; } if (objc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1907,9 +1925,8 @@ WmGeometryCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, - ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d", + width, height, xSign, wmPtr->x, ySign, wmPtr->y)); return TCL_OK; } argv3 = Tcl_GetString(objv[3]); @@ -1957,12 +1974,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1989,19 +2007,27 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseWidth can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseHeight can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widthInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "heightInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -2049,7 +2075,7 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } @@ -2123,10 +2149,9 @@ WmIconbitmapCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap), - TCL_STATIC); + wmPtr->hints.icon_pixmap), -1)); } return TCL_OK; } @@ -2181,29 +2206,38 @@ WmIconifyCmd( return TCL_ERROR; } if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } if (TkpWmSetState(winPtr, IconicState) == 0) { - Tcl_SetResult(interp, - "couldn't send iconify message to window manager", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't send iconify message to window manager", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -2244,9 +2278,9 @@ WmIconmaskCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), - TCL_STATIC); + -1)); } return TCL_OK; } @@ -2302,9 +2336,9 @@ WmIconnameCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), - TCL_STATIC); + if (wmPtr->iconName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->iconName, -1)); + } return TCL_OK; } else { if (wmPtr->iconName != NULL) { @@ -2373,8 +2407,10 @@ WmIconphotoCmd( for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -2498,11 +2534,11 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } @@ -2584,15 +2620,18 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "INNER", NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", Tk_PathName(wmPtr2->iconFor), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { @@ -2625,9 +2664,10 @@ WmIconwindowCmd( if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(wmPtr2->wrapperPtr), Tk_ScreenNumber(tkwin2)) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send withdraw message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } WaitForMapNotify((TkWindow *) tkwin2, 0); @@ -2667,9 +2707,10 @@ WmManageCmd( if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", Tk_PathName(frameWin), - "\" is not manageable: must be a frame, labelframe or " - "toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a frame," + " labelframe or toplevel", Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -2731,11 +2772,12 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2789,10 +2831,11 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minWidth); + results[1] = Tcl_NewIntObj(wmPtr->minHeight); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2901,11 +2944,14 @@ WmPositionfromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { @@ -2968,11 +3014,14 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + Tcl_Obj *resultObj = Tcl_NewObj(); + for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -2984,7 +3033,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -2996,8 +3046,9 @@ WmProtocolCmd( */ if (strcmp(Tcl_GetString(objv[3]), "_NET_WM_PING") == 0) { - Tcl_SetResult(interp, "may not alter handling of that protocol", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not alter handling of that protocol", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "PROTOCOL", "RESERVED", NULL); return TCL_ERROR; } @@ -3066,12 +3117,11 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) @@ -3130,11 +3180,14 @@ WmSizefromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } @@ -3198,11 +3251,15 @@ WmStackorderCmd( if (objc == 3) { windows = TkWmStackorderToplevel(winPtr); if (windows != NULL) { + Tcl_Obj *resultObj = Tcl_NewObj(); + /* ASSERT: true [Bug 1789819]*/ for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj((*window_ptr)->pathName, -1)); } ckfree(windows); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } } else { @@ -3216,20 +3273,24 @@ WmStackorderCmd( winPtr2 = (TkWindow *) relWin; if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -3239,9 +3300,10 @@ WmStackorderCmd( */ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); - if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } @@ -3309,9 +3371,10 @@ WmStateCmd( } if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } @@ -3325,42 +3388,53 @@ WmStateCmd( (void) TkpWmSetState(winPtr, NormalState); } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } if (TkpWmSetState(winPtr, IconicState) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send iconify message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { /* OPT_WITHDRAWN */ wmPtr->flags |= WM_WITHDRAWN; if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send withdraw message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } } else { + const char *state; + if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + state = "icon"; } else if (wmPtr->withdrawn) { - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + state = "withdrawn"; } else if (Tk_IsMapped((Tk_Window) winPtr) || ((wmPtr->flags & WM_NEVER_MAPPED) && (wmPtr->hints.initial_state == NormalState))) { - Tcl_SetResult(interp, "normal", TCL_STATIC); + state = "normal"; } else { - Tcl_SetResult(interp, "iconic", TCL_STATIC); + state = "iconic"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(state, -1)); } return TCL_OK; } @@ -3399,10 +3473,11 @@ WmTitleCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (char *) - ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), - TCL_STATIC); - return TCL_OK; + if (wmPtr->title) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->title, -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); + } } else { if (wmPtr->title != NULL) { ckfree(wmPtr->title); @@ -3493,9 +3568,10 @@ WmTransientCmd( Tk_MakeWindowExist((Tk_Window) masterPtr); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } @@ -3505,15 +3581,17 @@ WmTransientCmd( } if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if (masterPtr == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } else if (masterPtr != wmPtr->masterPtr) { /* @@ -3538,9 +3616,10 @@ WmTransientCmd( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) { if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send withdraw message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { @@ -3589,15 +3668,17 @@ WmWithdrawCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } wmPtr->flags |= WM_WITHDRAWN; if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't send withdraw message to window manager", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -4052,6 +4133,8 @@ ReparentEvent( unsigned dummy; Tk_ErrorHandler handler; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; + Atom WM_ROOT = Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"); + Atom SWM_ROOT = Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"); /* * Identify the root window for wrapperPtr. This is tricky because of @@ -4065,15 +4148,11 @@ ReparentEvent( wmPtr->vRoot = None; handler = Tk_CreateErrorHandler(wrapperPtr->display, -1,-1,-1, NULL,NULL); vrPtrPtr = &virtualRootPtr; /* Silence GCC warning */ - if (((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, - Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"), 0, (long) 1, - False, XA_WINDOW, &actualType, &actualFormat, &numItems, - &bytesAfter, (unsigned char **) vrPtrPtr) == Success) + if ((GetWindowProperty(wrapperPtr, WM_ROOT, 1, XA_WINDOW, + &actualType, &actualFormat, &numItems, &bytesAfter, vrPtrPtr) && (actualType == XA_WINDOW)) - || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, - Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1, - False, XA_WINDOW, &actualType, &actualFormat, &numItems, - &bytesAfter, (unsigned char **) vrPtrPtr) == Success) + || (GetWindowProperty(wrapperPtr, SWM_ROOT, 1, XA_WINDOW, + &actualType, &actualFormat, &numItems, &bytesAfter, vrPtrPtr) && (actualType == XA_WINDOW))) { if ((actualFormat == 32) && (numItems == 1)) { vRoot = wmPtr->vRoot = *virtualRootPtr; @@ -4285,11 +4364,9 @@ PropertyEvent( unsigned char *propertyValue = 0; long maxLength = 1024; - if (XGetWindowProperty( - wrapperPtr->display, wrapperPtr->window, _NET_WM_STATE, - 0l, maxLength, False, XA_ATOM, + if (GetWindowProperty(wrapperPtr, _NET_WM_STATE, maxLength, XA_ATOM, &actualType, &actualFormat, &numItems, &bytesAfter, - &propertyValue) == Success) { + &propertyValue)) { CheckNetWmState(wmPtr, (Atom *) propertyValue, (int) numItems); XFree(propertyValue); } @@ -4590,7 +4667,7 @@ UpdateGeometryInfo( if (((width != winPtr->changes.width) || (height != winPtr->changes.height)) && (wmPtr->gridWin == NULL) - && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) { + && !(wmPtr->sizeHintsFlags & (PMinSize|PMaxSize))) { wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) { @@ -4848,10 +4925,8 @@ UpdateTitle( Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_NAME"), - XA_UTF8_STRING, 8, PropModeReplace, - (const unsigned char *) string, (signed int) strlen(string)); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_NAME", XA_UTF8_STRING, 8, + string, strlen(string)); /* * Set icon name: @@ -4863,11 +4938,8 @@ UpdateTitle( Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON_NAME"), - XA_UTF8_STRING, 8, PropModeReplace, - (const unsigned char *) wmPtr->iconName, - (signed int) strlen(wmPtr->iconName)); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_ICON_NAME", + XA_UTF8_STRING, 8, wmPtr->iconName, strlen(wmPtr->iconName)); } } @@ -4898,14 +4970,8 @@ UpdatePhotoIcon( size = winPtr->dispPtr->iconDataSize; } if (data != NULL) { - /* - * Set icon: - */ - - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON"), - XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) data, size); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_ICON", XA_CARDINAL, 32, + data, size); } } @@ -5046,11 +5112,10 @@ UpdateNetWmState( atoms[numAtoms++] = Tk_InternAtom(tkwin, "_NET_WM_STATE_FULLSCREEN"); } - XChangeProperty(Tk_Display(tkwin), wmPtr->wrapperPtr->window, - Tk_InternAtom(tkwin, "_NET_WM_STATE"), XA_ATOM, 32, - PropModeReplace, (unsigned char *) atoms, numAtoms); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_STATE", XA_ATOM, 32, atoms, + numAtoms); } - + /* *---------------------------------------------------------------------- * @@ -5348,25 +5413,26 @@ UpdateHints( * * SetNetWmType -- * - * Set the extended window manager hints for a toplevel window - * to the types provided. The specification states that this - * may be a list of window types in preferred order. To permit - * for future type definitions, the set of names is unconstrained - * and names are converted to upper-case and appended to - * "_NET_WM_WINDOW_TYPE_" before being converted to an Atom. + * Set the extended window manager hints for a toplevel window to the + * types provided. The specification states that this may be a list of + * window types in preferred order. To permit for future type + * definitions, the set of names is unconstrained and names are converted + * to upper-case and appended to "_NET_WM_WINDOW_TYPE_" before being + * converted to an Atom. * *---------------------------------------------------------------------- */ static int -SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) +SetNetWmType( + TkWindow *winPtr, + Tcl_Obj *typePtr) { - Atom typeAtom, *atoms = NULL; + Atom *atoms = NULL; WmInfo *wmPtr; - TkWindow *wrapperPtr; Tcl_Obj **objv; int objc, n; - Tk_Window tkwin = (Tk_Window)winPtr; + Tk_Window tkwin = (Tk_Window) winPtr; Tcl_Interp *interp = Tk_Interp(tkwin); if (TCL_OK != Tcl_ListObjGetElements(interp, typePtr, &objc, &objv)) { @@ -5401,11 +5467,9 @@ SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } - wrapperPtr = wmPtr->wrapperPtr; - typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); - XChangeProperty(Tk_Display(tkwin), wrapperPtr->window, typeAtom, - XA_ATOM, 32, PropModeReplace, (unsigned char *) atoms, objc); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_WINDOW_TYPE", XA_ATOM, 32, + atoms, objc); ckfree(atoms); return TCL_OK; @@ -5416,22 +5480,22 @@ SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) * * GetNetWmType -- * - * Read the extended window manager type hint from a window - * and return as a list of names suitable for use with - * SetNetWmType. + * Read the extended window manager type hint from a window and return as + * a list of names suitable for use with SetNetWmType. * *---------------------------------------------------------------------- */ static Tcl_Obj * -GetNetWmType(TkWindow *winPtr) +GetNetWmType( + TkWindow *winPtr) { Atom typeAtom, actualType, *atoms; int actualFormat; unsigned long n, count, bytesAfter; unsigned char *propertyValue = NULL; long maxLength = 1024; - Tk_Window tkwin = (Tk_Window)winPtr; + Tk_Window tkwin = (Tk_Window) winPtr; TkWindow *wrapperPtr; Tcl_Obj *typePtr; Tcl_Interp *interp; @@ -5446,13 +5510,12 @@ GetNetWmType(TkWindow *winPtr) wrapperPtr = winPtr->wmInfoPtr->wrapperPtr; typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); - if (Success == XGetWindowProperty(wrapperPtr->display, - wrapperPtr->window, typeAtom, 0L, maxLength, False, - XA_ATOM, &actualType, &actualFormat, &count, - &bytesAfter, &propertyValue)) { - atoms = (Atom *)propertyValue; + if (GetWindowProperty(wrapperPtr, typeAtom, maxLength, XA_ATOM, + &actualType, &actualFormat, &count, &bytesAfter, &propertyValue)){ + atoms = (Atom *) propertyValue; for (n = 0; n < count; ++n) { const char *name = Tk_GetAtomName(tkwin, atoms[n]); + if (strncmp("_NET_WM_WINDOW_TYPE_", name, 20) == 0) { Tcl_ExternalToUtfDString(NULL, name+20, -1, &ds); Tcl_UtfToLower(Tcl_DStringValue(&ds)); @@ -5570,7 +5633,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; flags |= WM_UPDATE_SIZE_HINTS; } @@ -5596,7 +5659,9 @@ ParseGeometry( return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } @@ -6067,7 +6132,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } @@ -6138,10 +6203,8 @@ UpdateWmProtocols( *(atomPtr++) = protPtr->protocol; } } - XChangeProperty(wmPtr->winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_PROTOCOLS"), - XA_ATOM, 32, PropModeReplace, (unsigned char *) arrayPtr, - atomPtr-arrayPtr); + SetWindowProperty(wmPtr->wrapperPtr, "WM_PROTOCOLS", XA_ATOM, 32, + arrayPtr, atomPtr-arrayPtr); ckfree(arrayPtr); } @@ -6331,7 +6394,7 @@ TkWmStackorderToplevel( goto done; case 1: hPtr = Tcl_FirstHashEntry(&table, &search); - windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr); + windows[0] = Tcl_GetHashValue(hPtr); windows[1] = NULL; goto done; } @@ -6349,13 +6412,16 @@ TkWmStackorderToplevel( for (i = 0; i < numChildren; i++) { hPtr = Tcl_FindHashEntry(&table, (char *) children[i]); if (hPtr != NULL) { - childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr); + childWinPtr = Tcl_GetHashValue(hPtr); *window_ptr++ = childWinPtr; } } - /* ASSERT: window_ptr - windows == table.numEntries + + /* + * ASSERT: window_ptr - windows == table.numEntries * (#matched toplevel windows == #children) [Bug 1789819] */ + *window_ptr = NULL; if (numChildren) { XFree((char *) children); @@ -7309,14 +7375,13 @@ TkpWmSetState( * * RemapWindows * - * Adjust parent/child relation ships of - * the given window hierarchy. + * Adjust parent/child relationships of the given window hierarchy. * * Results: - * none + * None * * Side effects: - * keeps windowing system (X11) happy + * Keeps windowing system (X11) happy * *---------------------------------------------------------------------- */ diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c index dcbce6c..2501688 100644 --- a/win/tkWinClipboard.c +++ b/win/tkWinClipboard.c @@ -162,9 +162,10 @@ TkSelGetSelection( return result; error: - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), Tk_GetAtomName(tkwin, target))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL); return TCL_ERROR; } diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c index 8366db3..622ba4d 100644 --- a/win/tkWinCursor.c +++ b/win/tkWinCursor.c @@ -72,8 +72,7 @@ static struct CursorName { */ #define TK_DEFAULT_CURSOR IDC_ARROW - - + /* *---------------------------------------------------------------------- * @@ -131,8 +130,9 @@ TkGetCursorByName( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get cursor from a file in", - " a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get cursor from a file in a safe interpreter",-1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "CURSOR_FILE", NULL); ckfree(argv); ckfree(cursorPtr); return NULL; @@ -166,13 +166,15 @@ TkGetCursorByName( ckfree(cursorPtr); badCursorSpec: ckfree(argv); - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); return NULL; } ckfree(argv); return (TkCursor *) cursorPtr; } - + /* *---------------------------------------------------------------------- * @@ -201,7 +203,7 @@ TkCreateCursorFromData( { return NULL; } - + /* *---------------------------------------------------------------------- * @@ -225,7 +227,7 @@ TkpFreeCursor( { /* TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr; */ } - + /* *---------------------------------------------------------------------- * @@ -260,7 +262,7 @@ TkpSetCursor( SetCursor(hcursor); } } - + /* * Local Variables: * mode: c diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 4d60105..c64df72 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -361,9 +361,9 @@ Tk_ChooseColorObjCmd( return TCL_ERROR; } if (i + 1 == objc) { - string = Tcl_GetString(optionPtr); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL); return TCL_ERROR; } @@ -424,13 +424,11 @@ Tk_ChooseColorObjCmd( /* * User has selected a color */ - char color[100]; - sprintf(color, "#%02x%02x%02x", + Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x", GetRValue(chooseColor.rgbResult), GetGValue(chooseColor.rgbResult), - GetBValue(chooseColor.rgbResult)); - Tcl_AppendResult(interp, color, NULL); + GetBValue(chooseColor.rgbResult))); oldColor = chooseColor.rgbResult; result = TCL_OK; } @@ -583,7 +581,7 @@ GetFileName( Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL; Tcl_DString utfFilterString, utfDirString, ds; Tcl_DString extString, filterString, dirString, titleString; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); static const char *const saveOptionStrings[] = { "-confirmoverwrite", "-defaultextension", "-filetypes", "-initialdir", @@ -594,8 +592,8 @@ GetFileName( "-multiple", "-parent", "-title", "-typevariable", NULL }; enum options { - FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, - FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE + FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, + FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE }; file[0] = '\0'; @@ -619,9 +617,9 @@ GetFileName( } if (i + 1 == objc) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } @@ -647,9 +645,9 @@ GetFileName( if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { goto end; } - Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds), 0, NULL, (char *) file, - sizeof(file), NULL, NULL, NULL); + Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), + Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, + (char *) file, sizeof(file), NULL, NULL, NULL); Tcl_DStringFree(&ds); break; case FILE_PARENT: @@ -870,8 +868,8 @@ GetFileName( Tcl_SetObjResult(interp, returnList); Tcl_DStringFree(&ds); } else { - Tcl_AppendResult(interp, ConvertExternalFilename(ofn.lpstrFile, - &ds), NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + ConvertExternalFilename(ofn.lpstrFile, &ds), -1)); gotFilename = (Tcl_DStringLength(&ds) > 0); Tcl_DStringFree(&ds); } @@ -895,9 +893,11 @@ GetFileName( } } } else if (cdlgerr == FNERR_INVALIDFILENAME) { - Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC); - Tcl_AppendResult(interp, ConvertExternalFilename(ofn.lpstrFile, - &ds), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid filename \"%s\"", + ConvertExternalFilename(ofn.lpstrFile, &ds))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME", + NULL); Tcl_DStringFree(&ds); } else { result = TCL_OK; @@ -962,14 +962,16 @@ OFNHookProc( OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam; /* - * This is weird... or not. The CDN_FILEOK is NOT sent when the selection - * exceeds declared buffer size (the nMaxFile member of the OPENFILENAME - * struct passed to GetOpenFileName function). So, we have to rely on - * the most recent CDN_SELCHANGE then. Unfortunately this means, that - * gathering the selected filenames happens twice when they fit into the - * declared buffer. Luckily, it's not frequent operation so it should - * not incur any noticeable delay. See [tktoolkit-Bugs-2987995] + * This is weird... or not. The CDN_FILEOK is NOT sent when the + * selection exceeds declared buffer size (the nMaxFile member of the + * OPENFILENAME struct passed to GetOpenFileName function). So, we + * have to rely on the most recent CDN_SELCHANGE then. Unfortunately + * this means, that gathering the selected filenames happens twice + * when they fit into the declared buffer. Luckily, it's not frequent + * operation so it should not incur any noticeable delay. See [Bug + * 2987995] */ + if (notifyPtr->hdr.code == CDN_FILEOK || notifyPtr->hdr.code == CDN_SELCHANGE) { int dirsize, selsize; @@ -991,8 +993,10 @@ OFNHookProc( buffersize = (selsize + dirsize + 1); /* - * Just empty the buffer if dirsize indicates an error [Bug 3071836] + * Just empty the buffer if dirsize indicates an error. [Bug + * 3071836] */ + if ((selsize > 1) && (dirsize > 0)) { if (ofnData->dynFileBufferSize < buffersize) { buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR)); @@ -1357,9 +1361,9 @@ Tk_ChooseDirectoryObjCmd( goto cleanup; } if (i + 1 == objc) { - string = Tcl_GetString(optionPtr); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); goto cleanup; } @@ -1369,7 +1373,8 @@ Tk_ChooseDirectoryObjCmd( if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) { goto cleanup; } - Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, &tempString); + Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, + &tempString); uniStr = (TCHAR *) Tcl_DStringValue(&tempString); /* @@ -1461,10 +1466,11 @@ Tk_ChooseDirectoryObjCmd( pidl = SHBrowseForFolder(&bInfo); /* - * This is a fix for Windows 2000, which seems to modify the folder name - * buffer even when the dialog is canceled (in this case the buffer - * contains garbage). See [Bug #3002230] + * This is a fix for Windows 2000, which seems to modify the folder + * name buffer even when the dialog is canceled (in this case the + * buffer contains garbage). See [Bug #3002230] */ + path[0] = '\0'; /* @@ -1473,9 +1479,10 @@ Tk_ChooseDirectoryObjCmd( if (pidl != NULL) { if (!SHGetPathFromIDList(pidl, path)) { - Tcl_SetResult(interp, "Error: Not a file system folder\n", - TCL_VOLATILE); - }; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error: not a file system folder", -1)); + Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "PSEUDO", NULL); + } pMalloc->lpVtbl->Free(pMalloc, (void *) pidl); } else if (_tcslen(cdCBData.retDir) > 0) { _tcscpy(path, cdCBData.retDir); @@ -1502,8 +1509,8 @@ Tk_ChooseDirectoryObjCmd( if (*path) { Tcl_DString ds; - Tcl_AppendResult(interp, ConvertExternalFilename(path, &ds), - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + ConvertExternalFilename(path, &ds), -1)); Tcl_DStringFree(&ds); } @@ -1578,7 +1585,8 @@ ChooseDirectoryValidateProc( Tcl_DStringFree(&initDirString); Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString); Tcl_DStringFree(&tempString); - _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString), MAX_PATH); + _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString), + MAX_PATH); Tcl_DStringFree(&initDirString); if (SetCurrentDirectory(string) == 0) { @@ -1596,7 +1604,9 @@ ChooseDirectoryValidateProc( * User HAS to select a valid directory. */ - wsprintf(selDir, TEXT("Directory '%s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->retDir); + wsprintf(selDir, TEXT("Directory '%s' does not exist,\n" + "please select or enter an existing directory."), + chooseDirSharedData->retDir); MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); chooseDirSharedData->retDir[0] = '\0'; return 1; @@ -1732,7 +1742,6 @@ Tk_MessageBoxObjCmd( for (i = 1; i < objc; i += 2) { int index; - const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -1743,9 +1752,9 @@ Tk_MessageBoxObjCmd( return TCL_ERROR; } if (i + 1 == objc) { - string = Tcl_GetString(optionPtr); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL); return TCL_ERROR; } @@ -1814,9 +1823,10 @@ Tk_MessageBoxObjCmd( } } if (defaultBtnIdx < 0) { - Tcl_AppendResult(interp, "invalid default button \"", - TkFindStateString(buttonMap, defaultBtn), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid default button \"%s\"", + TkFindStateString(buttonMap, defaultBtn))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL); return TCL_ERROR; } break; @@ -1864,9 +1874,8 @@ Tk_MessageBoxObjCmd( EnableWindow(hWnd, 1); Tcl_DecrRefCount(tmpObj); - - Tcl_SetResult(interp, - (char *)TkFindStateString(buttonMap, winCode), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TkFindStateString(buttonMap, winCode), -1)); return TCL_OK; } @@ -1934,6 +1943,7 @@ SetTkDialog( /* * Factored out a common pattern in use in this file. */ + static const char * ConvertExternalFilename( TCHAR *filename, @@ -1969,7 +1979,9 @@ ConvertExternalFilename( */ static Tcl_Obj * -GetFontObj(HDC hdc, LOGFONT *plf) +GetFontObj( + HDC hdc, + LOGFONT *plf) { Tcl_DString ds; Tcl_Obj *resObj; @@ -2001,7 +2013,11 @@ GetFontObj(HDC hdc, LOGFONT *plf) } static void -ApplyLogfont(Tcl_Interp *interp, Tcl_Obj *cmdObj, HDC hdc, LOGFONT *logfontPtr) +ApplyLogfont( + Tcl_Interp *interp, + Tcl_Obj *cmdObj, + HDC hdc, + LOGFONT *logfontPtr) { int objc; Tcl_Obj **objv, **tmpv; @@ -2036,7 +2052,11 @@ typedef struct HookData { } HookData; static UINT_PTR CALLBACK -HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam) +HookProc( + HWND hwndDlg, + UINT msg, + WPARAM wParam, + LPARAM lParam) { CHOOSEFONT *pcf = (CHOOSEFONT *) lParam; HWND hwndCtrl; @@ -2048,7 +2068,7 @@ HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam) phd = (HookData *) pcf->lCustData; phd->hwnd = hwndDlg; if (tsdPtr->debugFlag) { - tsdPtr->debugInterp = (Tcl_Interp *) phd->interp; + tsdPtr->debugInterp = phd->interp; Tcl_DoWhenIdle(SetTkDialog, hwndDlg); } if (phd->titleObj != NULL) { @@ -2115,7 +2135,9 @@ enum FontchooserOption { }; static Tcl_Obj * -FontchooserCget(HookData *hdPtr, int optionIndex) +FontchooserCget( + HookData *hdPtr, + int optionIndex) { Tcl_Obj *resObj = NULL; @@ -2225,16 +2247,18 @@ FontchooserConfigureCmd( return TCL_OK; } if (i + 1 == objc) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(objv[i]), "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL); return TCL_ERROR; } switch (optionIndex) { case FontchooserVisible: { - const char *msg = "cannot change read-only option " + static const char *msg = "cannot change read-only option " "\"-visible\": use the show or hide command"; Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL); return TCL_ERROR; } case FontchooserParent: { @@ -2367,9 +2391,10 @@ FontchooserShowCmd( } fontPtr = (TkFont *) f; cf.Flags |= CF_INITTOLOGFONTSTRUCT; - Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds); - _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds), LF_FACESIZE-1); - Tcl_DStringFree(&ds); + Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds); + _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds), + LF_FACESIZE-1); + Tcl_DStringFree(&ds); lf.lfFaceName[LF_FACESIZE-1] = 0; lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size), GetDeviceCaps(hdc, LOGPIXELSY), 72); diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c index 43cd419..a908a1f 100644 --- a/win/tkWinEmbed.c +++ b/win/tkWinEmbed.c @@ -134,7 +134,7 @@ Tk_DetachEmbeddedWindow( TkpWinToplevelOverrideRedirect(winPtr, 0); } } - + /* *---------------------------------------------------------------------- * @@ -243,8 +243,9 @@ TkpUseWindow( /* if (winPtr->window != None) { - Tcl_AppendResult(interp, - "can't modify container after widget is created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } */ @@ -272,8 +273,9 @@ TkpUseWindow( if (!IsWindow(hwnd)) { if (interp != NULL) { - Tcl_AppendResult(interp, "window \"", string, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "EXIST", NULL); } return TCL_ERROR; } @@ -281,12 +283,15 @@ TkpUseWindow( id = SendMessage(hwnd, TK_INFO, TK_CONTAINER_VERIFY, 0); if (id == PTR2INT(hwnd)) { if (!SendMessage(hwnd, TK_INFO, TK_CONTAINER_ISAVAILABLE, 0)) { - Tcl_AppendResult(interp, "The container is already in use", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "The container is already in use", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "IN_USE", NULL); return TCL_ERROR; } } else if (id == -PTR2INT(hwnd)) { - Tcl_AppendResult(interp, "the window to use is not a Tk container", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the window to use is not a Tk container", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); return TCL_ERROR; } else { /* @@ -300,7 +305,9 @@ TkpUseWindow( sprintf(msg, "Unable to get information of window \"%.80s\". Attach to this\nwindow may have unpredictable results if it is not a valid container.\n\nPress Ok to proceed or Cancel to abort attaching.", string); if (IDCANCEL == MessageBoxA(hwnd, msg, "Tk Warning", MB_OKCANCEL | MB_ICONWARNING)) { - Tcl_SetResult(interp, "Operation has been canceled", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Operation has been canceled", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CANCEL", NULL); return TCL_ERROR; } } @@ -935,7 +942,7 @@ Tk_GetEmbeddedHWnd( } return NULL; } - + /* *---------------------------------------------------------------------- * diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 245639d..0955de1 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -155,7 +155,7 @@ static void DrawWindowsSystemBitmap(Display *display, Drawable drawable, GC gc, const RECT *rectPtr, int bitmapID, int alignFlags); static void FreeID(WORD commandID); -static char * GetEntryText(TkMenuEntry *mePtr); +static char * GetEntryText(TkMenuEntry *mePtr); static void GetMenuAccelGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int *widthPtr, @@ -188,6 +188,26 @@ static LRESULT CALLBACK TkWinMenuProc(HWND hwnd, UINT message, WPARAM wParam, static LRESULT CALLBACK TkWinEmbeddedMenuProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); +static inline void +ScheduleMenuReconfigure( + TkMenu *menuPtr) +{ + if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { + menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; + Tcl_DoWhenIdle(ReconfigureWindowsMenu, menuPtr); + } +} + +static inline void +CallPendingReconfigureImmediately( + TkMenu *menuPtr) +{ + if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { + Tcl_CancelIdleCall(ReconfigureWindowsMenu, menuPtr); + ReconfigureWindowsMenu(menuPtr); + } +} + /* *---------------------------------------------------------------------- * @@ -213,7 +233,7 @@ GetNewID( TkMenuEntry *mePtr, /* The menu we are working with. */ WORD *menuIDPtr) /* The resulting id. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); WORD curID = tsdPtr->lastCommandID; @@ -265,7 +285,7 @@ static void FreeID( WORD commandID) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -274,7 +294,8 @@ FreeID( if (tsdPtr->menuHWND != NULL) { Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + commandID); + INT2PTR(commandID)); + if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } @@ -307,14 +328,14 @@ TkpNewMenu( HMENU winMenuHdl; Tcl_HashEntry *hashEntryPtr; int newEntry; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); winMenuHdl = CreatePopupMenu(); - if (winMenuHdl == NULL) { - Tcl_AppendResult(menuPtr->interp, "No more menus can be allocated.", - (char *) NULL); + Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj( + "No more menus can be allocated.", -1)); + Tcl_SetErrorCode(interp, "TK", "MENU", "SYSTEM_RESOURCES", NULL); return TCL_ERROR; } @@ -353,11 +374,11 @@ TkpDestroyMenu( { HMENU winMenuHdl = (HMENU) menuPtr->platformData; const char *searchName; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { - Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); + Tcl_CancelIdleCall(ReconfigureWindowsMenu, menuPtr); } if (winMenuHdl == NULL) { @@ -400,6 +421,7 @@ TkpDestroyMenu( if (tsdPtr->menuHWND != NULL) { Tcl_HashEntry *hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl); + if (hashEntryPtr != NULL) { Tcl_DeleteHashEntry(hashEntryPtr); } @@ -437,10 +459,7 @@ TkpDestroyMenuEntry( HMENU winMenuHdl = (HMENU) menuPtr->platformData; if (NULL != winMenuHdl) { - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } + ScheduleMenuReconfigure(menuPtr); } FreeID((WORD) PTR2INT(mePtr->platformEntryData)); mePtr->platformEntryData = NULL; @@ -549,7 +568,7 @@ static void ReconfigureWindowsMenu( ClientData clientData) /* The menu we are rebuilding */ { - TkMenu *menuPtr = (TkMenu *) clientData; + TkMenu *menuPtr = clientData; TkMenuEntry *mePtr; HMENU winMenuHdl = (HMENU) menuPtr->platformData; char *itemText = NULL; @@ -676,23 +695,17 @@ ReconfigureWindowsMenu( && (menuPtr->parentTopLevelPtr != NULL) && (systemMenuPtr->masterMenuPtr == menuRefPtr->menuPtr)) { - HMENU systemMenuHdl = - (HMENU) systemMenuPtr->platformData; + HMENU systemMenuHdl = (HMENU) systemMenuPtr->platformData; HWND wrapper = TkWinGetWrapperWindow(menuPtr ->parentTopLevelPtr); + if (wrapper != NULL) { DestroyMenu(systemMenuHdl); systemMenuHdl = GetSystemMenu(wrapper, FALSE); systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU; systemMenuPtr->platformData = (TkMenuPlatformData) systemMenuHdl; - if (!(systemMenuPtr->menuFlags - & MENU_RECONFIGURE_PENDING)) { - systemMenuPtr->menuFlags - |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, - (ClientData) systemMenuPtr); - } + ScheduleMenuReconfigure(systemMenuPtr); } } } @@ -752,15 +765,12 @@ TkpPostMenu( POINT point; Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin); int oldServiceMode = Tcl_GetServiceMode(); - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->inPostMenu++; - if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { - Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); - ReconfigureWindowsMenu((ClientData) menuPtr); - } + CallPendingReconfigureImmediately(menuPtr); result = TkPreprocessMenu(menuPtr); if (result != TCL_OK) { @@ -855,12 +865,7 @@ TkpMenuNewEntry( if (GetNewID(mePtr, &commandID) != TCL_OK) { return TCL_ERROR; } - - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } - + ScheduleMenuReconfigure(menuPtr); mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR(commandID); return TCL_OK; @@ -923,11 +928,12 @@ UpdateEmbeddedMenu( { RECT rc; HWND hMenuWnd = (HWND)clientData; + GetClientRect(hMenuWnd, &rc); InvalidateRect(hMenuWnd, &rc, FALSE); UpdateWindow(hMenuWnd); } - + /* *---------------------------------------------------------------------- * @@ -954,7 +960,7 @@ TkWinEmbeddedMenuProc( { static int nIdles = 0; LRESULT lResult = 1; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); switch(message) { @@ -997,7 +1003,7 @@ TkWinEmbeddedMenuProc( } return lResult; } - + /* *---------------------------------------------------------------------- * @@ -1030,7 +1036,7 @@ TkWinHandleMenuEvent( int returnResult = 0; TkMenu *menuPtr; TkMenuEntry *mePtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); switch (*pMessage) { @@ -1038,7 +1044,7 @@ TkWinHandleMenuEvent( hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) *pwParam); if (hashEntryPtr != NULL) { - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); if ((menuPtr->menuRefPtr != NULL) && (menuPtr->menuRefPtr->parentEntryPtr != NULL)) { TkPostSubmenu(menuPtr->interp, @@ -1053,27 +1059,22 @@ TkWinHandleMenuEvent( (char *) *pwParam); if (hashEntryPtr != NULL) { tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); tsdPtr->modalMenuPtr = menuPtr; - if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { - Tcl_CancelIdleCall(ReconfigureWindowsMenu, - (ClientData) menuPtr); - ReconfigureWindowsMenu((ClientData) menuPtr); - } + CallPendingReconfigureImmediately(menuPtr); RecursivelyClearActiveMenu(menuPtr); if (!tsdPtr->inPostMenu) { - Tcl_Interp *interp; + Tcl_Interp *interp = menuPtr->interp; int code; - interp = menuPtr->interp; - Tcl_Preserve((ClientData)interp); + Tcl_Preserve(interp); code = TkPreprocessMenu(menuPtr); if ((code != TCL_OK) && (code != TCL_CONTINUE) && (code != TCL_BREAK)) { Tcl_AddErrorInfo(interp, "\n (menu preprocess)"); Tcl_BackgroundException(interp, code); } - Tcl_Release((ClientData)interp); + Tcl_Release(interp); } TkActivateMenuEntry(menuPtr, -1); *plResult = 0; @@ -1090,11 +1091,11 @@ TkWinHandleMenuEvent( break; } hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + LOWORD(*pwParam)); + INT2PTR(LOWORD(*pwParam))); if (hashEntryPtr == NULL) { break; } - mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr); + mePtr = Tcl_GetHashValue(hashEntryPtr); if (mePtr != NULL) { TkMenuReferences *menuRefPtr; TkMenuEntry *parentEntryPtr; @@ -1126,13 +1127,13 @@ TkWinHandleMenuEvent( } interp = menuPtr->interp; - Tcl_Preserve((ClientData)interp); + Tcl_Preserve(interp); code = TkInvokeMenu(interp, menuPtr, mePtr->index); if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (menu invoke)"); Tcl_BackgroundException(interp, code); } - Tcl_Release((ClientData)interp); + Tcl_Release(interp); *plResult = 0; returnResult = 1; } @@ -1147,7 +1148,7 @@ TkWinHandleMenuEvent( Tcl_UniChar *wlabel, menuChar; *plResult = 0; - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); /* * Assume we have something directly convertable to Tcl_UniChar. * True at least for wide systems. @@ -1279,7 +1280,7 @@ TkWinHandleMenuEvent( hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) *plParam); if (hashEntryPtr != NULL) { - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); } } @@ -1292,10 +1293,9 @@ TkWinHandleMenuEvent( mePtr = menuPtr->entries[entryIndex]; } else { hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + entryIndex); + INT2PTR(entryIndex)); if (hashEntryPtr != NULL) { - mePtr = (TkMenuEntry *) - Tcl_GetHashValue(hashEntryPtr); + mePtr = Tcl_GetHashValue(hashEntryPtr); } } } @@ -1384,7 +1384,7 @@ TkpSetWindowMenuBar( TkMenu *menuPtr) /* The menu we are inserting */ { HMENU winMenuHdl; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (menuPtr != NULL) { @@ -1402,10 +1402,7 @@ TkpSetWindowMenuBar( Tcl_SetHashValue(hashEntryPtr, menuPtr); menuPtr->platformData = (TkMenuPlatformData) winMenuHdl; TkWinSetMenu(tkwin, winMenuHdl); - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } + ScheduleMenuReconfigure(menuPtr); } else { TkWinSetMenu(tkwin, NULL); } @@ -1784,7 +1781,7 @@ DrawMenuEntryAccelerator( COLORREF oldFgColor = gc->foreground; gc->foreground = GetSysColor(COLOR_3DHILIGHT); - if ((mePtr->entryFlags & ENTRY_PLATFORM_FLAG1) == 0) { + if (!(mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)) { Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, leftEdge + 1, baseline + 1); } @@ -1851,6 +1848,7 @@ DrawMenuEntryArrow( mePtr->menuPtr->tkwin, (mePtr->activeBorderPtr == NULL) ? mePtr->menuPtr->activeBorderPtr : mePtr->activeBorderPtr)); + gc->background = activeBgColor->pixel; } @@ -2207,6 +2205,7 @@ DrawMenuEntryLabel( haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight); haveImage = 1; } @@ -2316,8 +2315,9 @@ DrawMenuEntryLabel( */ if ((mePtr->state == ENTRY_DISABLED) && - ((mePtr->entryFlags & ENTRY_PLATFORM_FLAG1) == 0)) { + !(mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)) { COLORREF oldFgColor = gc->foreground; + gc->foreground = GetSysColor(COLOR_3DHILIGHT); Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, mePtr->labelLength, leftEdge + textXOffset + 1, @@ -2450,12 +2450,7 @@ TkpConfigureMenuEntry( register TkMenuEntry *mePtr)/* Information about menu entry; may or may * not already have values for some fields. */ { - TkMenu *menuPtr = mePtr->menuPtr; - - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } + ScheduleMenuReconfigure(mePtr->menuPtr); return TCL_OK; } @@ -2671,6 +2666,7 @@ GetMenuLabelGeometry( haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); haveImage = 1; } else { @@ -3029,11 +3025,8 @@ TkpMenuNotifyToplevelCreate( if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) { for (menuPtr = menuRefPtr->menuPtr->masterMenuPtr; menuPtr != NULL; menuPtr = menuPtr->nextInstancePtr) { - if ((menuPtr->menuType == MENUBAR) - && !(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, - (ClientData) menuPtr); + if (menuPtr->menuType == MENUBAR) { + ScheduleMenuReconfigure(menuPtr); } } } @@ -3063,8 +3056,9 @@ HWND Tk_GetMenuHWND( Tk_Window tkwin) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TkMenuInit(); return tsdPtr->embeddedMenuHWND; } @@ -3114,7 +3108,7 @@ static void MenuThreadExitHandler( ClientData clientData) /* Not used */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); DestroyWindow(tsdPtr->menuHWND); @@ -3332,7 +3326,7 @@ TkpMenuInit(void) Tcl_Panic("Failed to register embedded menu window class"); } - TkCreateExitHandler(MenuExitHandler, (ClientData) NULL); + TkCreateExitHandler(MenuExitHandler, NULL); SetDefaults(1); } @@ -3356,7 +3350,7 @@ TkpMenuInit(void) void TkpMenuThreadInit(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, TEXT("MenuWindow"), WS_POPUP, @@ -3377,7 +3371,7 @@ TkpMenuThreadInit(void) Tcl_InitHashTable(&tsdPtr->winMenuTable, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(&tsdPtr->commandTable, TCL_ONE_WORD_KEYS); - TkCreateThreadExitHandler(MenuThreadExitHandler, (ClientData) NULL); + TkCreateThreadExitHandler(MenuThreadExitHandler, NULL); } /* diff --git a/win/tkWinSend.c b/win/tkWinSend.c index b3edc62..a40c238 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -1,4 +1,4 @@ -/* +`/* * tkWinSend.c -- * * This file provides functions that implement the "send" command, @@ -55,7 +55,7 @@ typedef struct { int initialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * Functions internal to this file. @@ -66,12 +66,12 @@ static void CmdDeleteProc(ClientData clientData); static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp); static void RevokeObjectRegistration(RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static HRESULT BuildMoniker(const char *name, LPMONIKER *pmk); #ifdef TK_SEND_ENABLED_ON_WINDOWS static HRESULT RegisterInterp(const char *name, RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static int FindInterpreterObject(Tcl_Interp *interp, const char *name, LPDISPATCH *ppdisp); static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, @@ -85,7 +85,7 @@ static Tcl_EventProc SendEventProc; #define TRACE SendTrace #else #define TRACE 1 ? ((void)0) : SendTrace -#endif +#endif /* DEBUG || _DEBUG */ /* *-------------------------------------------------------------- @@ -136,9 +136,7 @@ Tk_SetAppName( HRESULT hr = S_OK; interp = winPtr->mainPtr->interp; - - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Initialise the COM library for this interpreter just once. @@ -147,8 +145,9 @@ Tk_SetAppName( if (tsdPtr->initialized == 0) { hr = CoInitialize(0); if (FAILED(hr)) { - Tcl_SetResult(interp, - "failed to initialize the COM library", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "failed to initialize the COM library", -1)); + Tcl_SetErrorcode(interp, "TK", "SEND", "COM", NULL); return ""; } tsdPtr->initialized = 1; @@ -363,8 +362,10 @@ Tk_SendObjCmd( */ if (displayPtr) { - Tcl_SetResult(interp, "option not implemented: \"displayof\" is " - "not available for this platform.", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "option not implemented: \"displayof\" is not available" + " for this platform.", -1)); + Tcl_SetErrorcode(interp, "TK", "SEND", "DISPLAYOF_WIN", NULL); result = TCL_ERROR; } @@ -436,9 +437,10 @@ FindInterpreterObject( pUnkInterp->lpVtbl->Release(pUnkInterp); } else { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "no application named \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no application named \"%s\"", name)); + Tcl_SetErrorcode(interp, "TK", "LOOKUP", "APPLICATION", + NULL); result = TCL_ERROR; } @@ -553,7 +555,7 @@ RevokeObjectRegistration( riPtr->name = NULL; } } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -580,7 +582,7 @@ InterpDeleteProc( { CoUninitialize(); } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -701,7 +703,7 @@ RegisterInterp( Tcl_DStringFree(&dString); return hr; } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -782,21 +784,14 @@ Send( * variables. */ - if (hr == DISP_E_EXCEPTION) { + if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) { Tcl_Obj *opError, *opErrorCode, *opErrorInfo; - if (ei.bstrSource != NULL) { - int len; - const char *szErrorInfo; - - opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); - Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); - Tcl_SetObjErrorCode(interp, opErrorCode); - - Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); - szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len); - Tcl_AddObjErrorInfo(interp, szErrorInfo, len); - } + opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); + Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); + Tcl_SetObjErrorCode(interp, opErrorCode); + Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); + Tcl_AppendObjToErrorInfo(interp, opErrorInfo); } /* @@ -852,7 +847,7 @@ Win32ErrorObj( errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); #else errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); -#endif +#endif /* _UNICODE */ if (lpBuffer != sBuffer) { LocalFree((HLOCAL)lpBuffer); @@ -864,7 +859,7 @@ Win32ErrorObj( /* * ---------------------------------------------------------------------- * - * SetErrorInfo -- + * TkWinSend_SetExcepInfo -- * * Convert the error information from a Tcl interpreter into a COM * exception structure. This information is then registered with the COM @@ -881,48 +876,51 @@ Win32ErrorObj( */ void -SetExcepInfo( - Tcl_Interp* interp, +TkWinSend_SetExcepInfo( + Tcl_Interp *interp, EXCEPINFO *pExcepInfo) { - if (pExcepInfo) { - Tcl_Obj *opError, *opErrorInfo, *opErrorCode; - ICreateErrorInfo *pCEI; - IErrorInfo *pEI, **ppEI = &pEI; - HRESULT hr; - - opError = Tcl_GetObjResult(interp); - opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo",NULL, TCL_GLOBAL_ONLY); - opErrorCode = Tcl_GetVar2Ex(interp, "errorCode",NULL, TCL_GLOBAL_ONLY); - - if (Tcl_IsShared(opErrorCode)) { - Tcl_Obj *ec = Tcl_DuplicateObj(opErrorCode); - - Tcl_IncrRefCount(ec); - Tcl_DecrRefCount(opErrorCode); - opErrorCode = ec; - } - Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + Tcl_Obj *opError, *opErrorInfo, *opErrorCode; + ICreateErrorInfo *pCEI; + IErrorInfo *pEI, **ppEI = &pEI; + HRESULT hr; - pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); - pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); - pExcepInfo->scode = E_FAIL; + if (!pExcepInfo) { + return; + } - hr = CreateErrorInfo(&pCEI); - if (SUCCEEDED(hr)) { - hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); - hr = pCEI->lpVtbl->SetDescription(pCEI, - pExcepInfo->bstrDescription); - hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); - hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, - (void**) ppEI); - if (SUCCEEDED(hr)) { - SetErrorInfo(0, pEI); - pEI->lpVtbl->Release(pEI); - } - pCEI->lpVtbl->Release(pCEI); - } + opError = Tcl_GetObjResult(interp); + opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + opErrorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + + /* + * Pack the trace onto the end of the Tcl exception descriptor. + */ + + opErrorCode = Tcl_DuplicateObj(opErrorCode); + Tcl_IncrRefCount(opErrorCode); + Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + /* TODO: Handle failure to append */ + + pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); + pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); + Tcl_DecrRefCount(opErrorCode); + pExcepInfo->scode = E_FAIL; + + hr = CreateErrorInfo(&pCEI); + if (!SUCCEEDED(hr)) { + return; + } + + hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); + hr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription); + hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); + hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void **) ppEI); + if (SUCCEEDED(hr)) { + SetErrorInfo(0, pEI); + pEI->lpVtbl->Release(pEI); } + pCEI->lpVtbl->Release(pCEI); } /* diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c index c67e533..83dd56b 100644 --- a/win/tkWinSendCom.c +++ b/win/tkWinSendCom.c @@ -100,7 +100,6 @@ TkWinSendCom_CreateInstance( ISupportErrorInfo_Release, ISupportErrorInfo_InterfaceSupportsErrorInfo, }; - HRESULT hr = S_OK; TkWinSendCom *obj = NULL; /* @@ -111,21 +110,19 @@ TkWinSendCom_CreateInstance( obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom)); if (obj == NULL) { *ppv = NULL; - hr = E_OUTOFMEMORY; - } else { - obj->lpVtbl = &vtbl; - obj->lpVtbl2 = &vtbl2; - obj->refcount = 0; - obj->interp = interp; - - /* - * lock the interp? Tcl_AddRef/Retain? - */ - - hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv); + return E_OUTOFMEMORY; } - return hr; + obj->lpVtbl = &vtbl; + obj->lpVtbl2 = &vtbl2; + obj->refcount = 0; + obj->interp = interp; + + /* + * lock the interp? Tcl_AddRef/Retain? + */ + + return obj->lpVtbl->QueryInterface((IDispatch *) obj, riid, ppv); } /* @@ -147,7 +144,7 @@ static void TkWinSendCom_Destroy( LPDISPATCH pdisp) { - CoTaskMemFree((void*)pdisp); + CoTaskMemFree((void *) pdisp); } /* @@ -169,17 +166,17 @@ WinSendCom_QueryInterface( void **ppvObject) { HRESULT hr = E_NOINTERFACE; - TkWinSendCom *this = (TkWinSendCom*)This; + TkWinSendCom *this = (TkWinSendCom *) This; *ppvObject = NULL; if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0 || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) { - *ppvObject = (void**)this; + *ppvObject = (void **) this; this->lpVtbl->AddRef(This); hr = S_OK; } else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) { - *ppvObject = (void**)(this + 1); - this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1)); + *ppvObject = (void **) (this + 1); + this->lpVtbl2->AddRef((ISupportErrorInfo *) (this + 1)); hr = S_OK; } return hr; @@ -316,16 +313,16 @@ ISupportErrorInfo_QueryInterface( REFIID riid, void **ppvObject) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); - return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject); + return this->lpVtbl->QueryInterface((IDispatch *) this, riid, ppvObject); } static STDMETHODIMP_(ULONG) ISupportErrorInfo_AddRef( ISupportErrorInfo *This) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); return InterlockedIncrement(&this->refcount); } @@ -334,9 +331,9 @@ static STDMETHODIMP_(ULONG) ISupportErrorInfo_Release( ISupportErrorInfo *This) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); - return this->lpVtbl->Release((IDispatch*)this); + return this->lpVtbl->Release((IDispatch *) this); } static STDMETHODIMP @@ -380,17 +377,15 @@ Async( if (FAILED(hr)) { Tcl_SetObjResult(obj->interp, Tcl_NewStringObj( "invalid args: Async(command)", -1)); - SetExcepInfo(obj->interp, pExcepInfo); + TkWinSend_SetExcepInfo(obj->interp, pExcepInfo); hr = DISP_E_EXCEPTION; } - if (SUCCEEDED(hr)) { - if (obj->interp) { - Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, - (int) SysStringLen(vCmd.bstrVal)); + if (SUCCEEDED(hr) && obj->interp) { + Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, + (int) SysStringLen(vCmd.bstrVal)); - TkWinSend_QueueCommand(obj->interp, scriptPtr); - } + TkWinSend_QueueCommand(obj->interp, scriptPtr); } VariantClear(&vCmd); @@ -427,29 +422,36 @@ Send( HRESULT hr = S_OK; int result = TCL_OK; VARIANT v; + register Tcl_Interp *interp = obj->interp; + Tcl_Obj *scriptPtr; + if (interp == NULL) { + return S_OK; + } VariantInit(&v); hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR); - if (SUCCEEDED(hr)) { - if (obj->interp) { - Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, - (int)SysStringLen(v.bstrVal)); - - result = Tcl_EvalObjEx(obj->interp, scriptPtr, - TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); - if (pvResult) { - VariantInit(pvResult); - pvResult->vt = VT_BSTR; - pvResult->bstrVal = SysAllocString( - Tcl_GetUnicode(Tcl_GetObjResult(obj->interp))); - } - if (result == TCL_ERROR) { - hr = DISP_E_EXCEPTION; - SetExcepInfo(obj->interp, pExcepInfo); - } - } - VariantClear(&v); + if (!SUCCEEDED(hr)) { + return hr; + } + + scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, (int) SysStringLen(v.bstrVal)); + Tcl_Preserve(interp); + Tcl_IncrRefCount(scriptPtr); + result = Tcl_EvalObjEx(interp, scriptPtr, + TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(scriptPtr); + if (pvResult != NULL) { + VariantInit(pvResult); + pvResult->vt = VT_BSTR; + pvResult->bstrVal = SysAllocString(Tcl_GetUnicode( + Tcl_GetObjResult(interp))); + } + if (result == TCL_ERROR) { + hr = DISP_E_EXCEPTION; + TkWinSend_SetExcepInfo(interp, pExcepInfo); } + Tcl_Release(interp); + VariantClear(&v); return hr; } diff --git a/win/tkWinSendCom.h b/win/tkWinSendCom.h index 4928bc7..cd6ec18 100644 --- a/win/tkWinSendCom.h +++ b/win/tkWinSendCom.h @@ -45,11 +45,11 @@ typedef struct { * TkWinSendCom public functions */ -HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp, +MODULE_SCOPE HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv); -int TkWinSend_QueueCommand(Tcl_Interp *interp, +MODULE_SCOPE int TkWinSend_QueueCommand(Tcl_Interp *interp, Tcl_Obj *cmdPtr); -void SetExcepInfo(Tcl_Interp *interp, +MODULE_SCOPE void TkWinSend_SetExcepInfo(Tcl_Interp *interp, EXCEPINFO *pExcepInfo); #endif /* _tkWinSendCom_h_INCLUDE */ diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 45ccbe2..efed842 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -74,7 +74,7 @@ typedef struct ProtocolHandler { typedef struct TkWmStackorderToplevelPair { Tcl_HashTable *table; - TkWindow **window_ptr; + TkWindow **windowPtr; } TkWmStackorderToplevelPair; /* @@ -972,8 +972,10 @@ WinSetIcon( } if (!(Tk_IsTopLevel(tkw))) { - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkw), - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", Tk_PathName(tkw))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", Tk_PathName(tkw), + NULL); return TCL_ERROR; } if (Tk_WindowId(tkw) == None) { @@ -1006,7 +1008,9 @@ WinSetIcon( if (!initialized) { if (InitWindowClass(titlebaricon) != TCL_OK) { - Tcl_AppendResult(interp, "Unable to set icon", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Unable to set icon", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "FAILED", NULL); return TCL_ERROR; } } else { @@ -1061,8 +1065,9 @@ WinSetIcon( wmPtr = ((TkWindow *) tkw)->wmInfoPtr; hwnd = wmPtr->wrapper; if (hwnd == NULL) { - Tcl_AppendResult(interp, - "Can't set icon; window has no wrapper.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Can't set icon; window has no wrapper.", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "WRAPPER", NULL); return TCL_ERROR; } } @@ -1575,8 +1580,9 @@ ReadIconOrCursorFromFile( channel = Tcl_FSOpenFileChannel(interp, fileName, "r", 0); if (channel == NULL) { - Tcl_AppendResult(interp, "Error opening file \"", - Tcl_GetString(fileName), "\" for reading", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error opening file \"%s\" for reading: %s", + Tcl_GetString(fileName), Tcl_PosixError(interp))); return NULL; } if (Tcl_SetChannelOption(interp, channel, "-translation", "binary") @@ -1602,7 +1608,7 @@ ReadIconOrCursorFromFile( lpIR->nNumImages = ReadICOHeader(channel); if (lpIR->nNumImages == -1) { - Tcl_AppendResult(interp, "Invalid file header", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid file header", -1)); Tcl_Close(NULL, channel); ckfree(lpIR); return NULL; @@ -1628,7 +1634,9 @@ ReadIconOrCursorFromFile( dwBytesRead = Tcl_Read(channel, (char *) lpIDE, (int) (lpIR->nNumImages * sizeof(ICONDIRENTRY))); if (dwBytesRead != lpIR->nNumImages * sizeof(ICONDIRENTRY)) { - Tcl_AppendResult(interp, "Error reading file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file: %s", Tcl_PosixError(interp))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "READ", NULL); Tcl_Close(NULL, channel); ckfree(lpIDE); ckfree(lpIR); @@ -1660,7 +1668,8 @@ ReadIconOrCursorFromFile( */ if (Tcl_Seek(channel, lpIDE[i].dwImageOffset, FILE_BEGIN) == -1) { - Tcl_AppendResult(interp, "Error seeking in file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error seeking in file: %s", Tcl_PosixError(interp))); goto readError; } @@ -1671,7 +1680,8 @@ ReadIconOrCursorFromFile( dwBytesRead = Tcl_Read(channel, (char *)lpIR->IconImages[i].lpBits, (int) lpIDE[i].dwBytesInRes); if (dwBytesRead != lpIDE[i].dwBytesInRes) { - Tcl_AppendResult(interp, "Error reading file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file: ", Tcl_PosixError(interp))); goto readError; } @@ -1680,8 +1690,9 @@ ReadIconOrCursorFromFile( */ if (!AdjustIconImagePointers(&lpIR->IconImages[i])) { - Tcl_AppendResult(interp, "Error converting to internal format", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Error converting to internal format", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "FORMAT", NULL); goto readError; } lpIR->IconImages[i].hIcon = @@ -1694,11 +1705,6 @@ ReadIconOrCursorFromFile( ckfree(lpIDE); Tcl_Close(NULL, channel); - if (lpIR == NULL) { - Tcl_AppendResult(interp, "Reading of ", Tcl_GetString(fileName), - " failed!", NULL); - return NULL; - } return lpIR; readError: @@ -2817,9 +2823,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, - ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -2848,8 +2853,10 @@ Tk_WmObjCmd( } if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -2959,9 +2966,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - wmPtr->minAspect.x, wmPtr->minAspect.y, - wmPtr->maxAspect.x, wmPtr->maxAspect.y)); + Tcl_Obj *results[4]; + + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -2975,7 +2986,9 @@ WmAspectCmd( return TCL_ERROR; } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -3093,8 +3106,10 @@ WmAttributesCmd( stylePtr = &exStyle; styleBit = WS_EX_TOPMOST; if ((i < objc-1) && (winPtr->flags & TK_EMBEDDED)) { - Tcl_AppendResult(interp, "can't set topmost flag on ", - winPtr->pathName, ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set topmost flag on %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "TOPMOST", NULL); return TCL_ERROR; } } else { @@ -3249,10 +3264,11 @@ WmAttributesCmd( if (fullscreen_attr_changed) { if (fullscreen_attr) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, "\": override-redirect flag is set", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\":" + " override-redirect flag is set", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } @@ -3266,10 +3282,10 @@ WmAttributesCmd( (WidthOfScreen(Tk_Screen(winPtr)) > wmPtr->maxWidth)) || ((wmPtr->maxHeight > 0) && (HeightOfScreen(Tk_Screen(winPtr)) > wmPtr->maxHeight))) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, "\": max width/height is too small", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\":" + " max width/height is too small", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "SMALL_MAX", NULL); return TCL_ERROR; } } @@ -3315,7 +3331,8 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } @@ -3375,10 +3392,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2, **winPtr2Ptr = &winPtr2; + TkWindow **cmapList, *winPtr2, **winPtr2Ptr = &winPtr2; int i, windowObjc, gotToplevel; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -3386,13 +3402,16 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) @@ -3477,8 +3496,10 @@ WmCommandCmd( } if (objc == 3) { if (wmPtr->cmdArgv != NULL) { - char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - Tcl_SetResult(interp, merged, TCL_DYNAMIC); + char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(merged, -1)); + ckfree(merged); } return TCL_OK; } @@ -3540,14 +3561,18 @@ WmDeiconifyCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { if (!SendMessage(wmPtr->wrapper, TK_DEICONIFY, 0, 0)) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: the container does not support the request", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -3595,8 +3620,8 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } @@ -3800,9 +3825,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - wmPtr->reqGridWidth, wmPtr->reqGridHeight, - wmPtr->widthInc, wmPtr->heightInc)); + Tcl_Obj *results[4]; + + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -3829,19 +3858,27 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseWidth can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseHeight can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widthInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "heightInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -3887,7 +3924,7 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } @@ -3954,8 +3991,9 @@ WmIconbitmapCmd( const char *argv3 = Tcl_GetString(objv[3]); if (strcmp(argv3, "-default")) { - Tcl_AppendResult(interp, "illegal option \"", argv3, - "\" must be \"-default\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "illegal option \"%s\" must be \"-default\"", argv3)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONBITMAP", "OPTION",NULL); return TCL_ERROR; } useWinPtr = NULL; @@ -3965,9 +4003,9 @@ WmIconbitmapCmd( */ if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), - TCL_STATIC); + -1)); } return TCL_OK; } @@ -4026,6 +4064,7 @@ WmIconbitmapCmd( */ Pixmap pixmap; + Tcl_ResetResult(interp); pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string); if (pixmap == None) { @@ -4080,24 +4119,33 @@ WmIconifyCmd( } if (winPtr->flags & TK_EMBEDDED) { if (!SendMessage(wmPtr->wrapper, TK_ICONIFY, 0, 0)) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: the container does not support the request", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } } if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -4139,9 +4187,9 @@ WmIconmaskCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), - TCL_STATIC); + -1)); } return TCL_OK; } @@ -4196,9 +4244,8 @@ WmIconnameCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (wmPtr->iconName ? wmPtr->iconName : ""), -1)); return TCL_OK; } else { if (wmPtr->iconName != NULL) { @@ -4274,8 +4321,10 @@ WmIconphotoCmd( for (i = startObj; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } } @@ -4325,8 +4374,10 @@ WmIconphotoCmd( &bgraPixel.voidPtr, NULL, 0); if (!iconInfo.hbmColor) { ckfree(lpIR); - Tcl_AppendResult(interp, "failed to create color bitmap for \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create color bitmap for \"%s\"", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "BITMAP", NULL); return TCL_ERROR; } @@ -4355,8 +4406,10 @@ WmIconphotoCmd( if (!iconInfo.hbmMask) { DeleteObject(iconInfo.hbmColor); ckfree(lpIR); - Tcl_AppendResult(interp, "failed to create mask bitmap for \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create mask bitmap for \"%s\"", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "MASK", NULL); return TCL_ERROR; } @@ -4375,8 +4428,10 @@ WmIconphotoCmd( */ ckfree(lpIR); - Tcl_AppendResult(interp, "failed to create icon for \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create icon for \"%s\"", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "ICON", NULL); return TCL_ERROR; } lpIR->IconImages[i-startObj].Width = width; @@ -4433,8 +4488,11 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", - wmPtr->hints.icon_x, wmPtr->hints.icon_y)); + Tcl_Obj *results[2]; + + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } @@ -4488,7 +4546,7 @@ WmIconwindowCmd( } if (objc == 3) { if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon)); } return TCL_OK; } @@ -4513,15 +4571,18 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "INNER", NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", Tk_PathName(wmPtr2->iconFor), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { @@ -4589,9 +4650,10 @@ WmManageCmd( if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", - Tk_PathName(frameWin), "\" is not manageable: must be " - "a frame, labelframe or toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a frame," + " labelframe or toplevel", Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -4645,8 +4707,12 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { + Tcl_Obj *results[2]; + GetMaxSize(wmPtr, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", width, height)); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -4692,8 +4758,12 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { + Tcl_Obj *results[2]; + GetMinSize(wmPtr, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", width, height)); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -4742,8 +4812,9 @@ WmOverrideredirectCmd( if (winPtr->flags & TK_EMBEDDED) { curValue = SendMessage(wmPtr->wrapper, TK_OVERRIDEREDIRECT, -1, -1)-1; if (curValue < 0) { - Tcl_AppendResult(interp, - "Container does not support overrideredirect", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Container does not support overrideredirect", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { @@ -4816,11 +4887,14 @@ WmPositionfromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { @@ -4872,6 +4946,7 @@ WmProtocolCmd( Atom protocol; const char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -4882,11 +4957,13 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol), -1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -4898,7 +4975,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -4967,9 +5045,11 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1)); + Tcl_Obj *results[2]; + + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) @@ -5033,11 +5113,14 @@ WmSizefromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } @@ -5085,13 +5168,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { "isabove", "isbelow", NULL }; enum options { OPT_ISABOVE, OPT_ISBELOW }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -5104,14 +5188,18 @@ WmStackorderCmd( if (windows == NULL) { Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } + Tcl_SetObjResult(interp, resultObj); ckfree(windows); return TCL_OK; } else { TkWindow *winPtr2, **winPtr2Ptr = &winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) winPtr2Ptr) != TCL_OK) { @@ -5119,20 +5207,24 @@ WmStackorderCmd( } if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -5143,22 +5235,23 @@ WmStackorderCmd( windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = (windowPtr - windows); } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = (windowPtr - windows); } } if (index1 == -1) { Tcl_Panic("winPtr window not found"); - } - if (index2 == -1) { + } else if (index2 == -1) { Tcl_Panic("winPtr2 window not found"); } @@ -5218,9 +5311,10 @@ WmStateCmd( } if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, @@ -5254,9 +5348,10 @@ WmStateCmd( } if (state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) { - Tcl_AppendResult(interp, "can't change state of ", - winPtr->pathName, - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: the container does not support the request", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -5272,13 +5367,19 @@ WmStateCmd( */ } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", - winPtr->pathName, "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -5291,31 +5392,26 @@ WmStateCmd( Tcl_Panic("wm state not matched"); } } else { + const char *stateStr = ""; + if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + stateStr = "icon"; } else { int state; if (winPtr->flags & TK_EMBEDDED) { - state = SendMessage(wmPtr->wrapper, TK_STATE, -1, -1)-1; + state = SendMessage(wmPtr->wrapper, TK_STATE, -1, -1) - 1; } else { state = wmPtr->hints.initial_state; } switch (state) { - case NormalState: - Tcl_SetResult(interp, "normal", TCL_STATIC); - break; - case IconicState: - Tcl_SetResult(interp, "iconic", TCL_STATIC); - break; - case WithdrawnState: - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); - break; - case ZoomState: - Tcl_SetResult(interp, "zoomed", TCL_STATIC); - break; + case NormalState: stateStr = "normal"; break; + case IconicState: stateStr = "iconic"; break; + case WithdrawnState: stateStr = "withdrawn"; break; + case ZoomState: stateStr = "zoomed"; break; } } + Tcl_SetObjResult(interp, Tcl_NewStringObj(stateStr, -1)); } return TCL_OK; } @@ -5368,12 +5464,13 @@ WmTitleCmd( GetWindowText(wrapper, buf, size); Tcl_WinTCharToUtf(buf, -1, &titleString); - Tcl_SetResult(interp, Tcl_DStringValue(&titleString), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_DStringValue(&titleString), + Tcl_DStringLength(&titleString))); Tcl_DStringFree(&titleString); } else { - Tcl_SetResult(interp, (char *) - ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (wmPtr->title ? wmPtr->title : winPtr->nameUid), -1)); } } else { if (wmPtr->title != NULL) { @@ -5429,7 +5526,7 @@ WmTransientCmd( } if (objc == 3) { if (masterPtr != NULL) { - Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(masterPtr)); } return TCL_OK; } @@ -5462,24 +5559,27 @@ WmTransientCmd( Tk_MakeWindowExist((Tk_Window) masterPtr); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } wmPtr2 = masterPtr->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if (masterPtr == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } else if (masterPtr != wmPtr->masterPtr) { /* @@ -5547,15 +5647,19 @@ WmWithdrawCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { if (SendMessage(wmPtr->wrapper, TK_WITHDRAW, 0, 0) < 0) { - Tcl_AppendResult(interp, "can't withdraw", Tcl_GetString(objv[2]), - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: the container does not support the request", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { @@ -6252,7 +6356,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; } } @@ -6277,7 +6381,9 @@ ParseGeometry( return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } @@ -6444,7 +6550,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; } @@ -6579,7 +6685,7 @@ TkWmStackorderToplevelEnumProc( fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd, childWinPtr, childWinPtr->pathName); */ - *(pair->window_ptr)-- = childWinPtr; + *(pair->windowPtr)-- = childWinPtr; } return TRUE; } @@ -6689,14 +6795,14 @@ TkWmStackorderToplevel( */ pair.table = &table; - pair.window_ptr = windows + table.numEntries; - *pair.window_ptr-- = NULL; + pair.windowPtr = windows + table.numEntries; + *pair.windowPtr-- = NULL; if (EnumWindows((WNDENUMPROC) TkWmStackorderToplevelEnumProc, (LPARAM) &pair) == 0) { ckfree(windows); windows = NULL; - } else if (pair.window_ptr != (windows-1)) { + } else if (pair.windowPtr != (windows-1)) { Tcl_Panic("num matched toplevel windows does not equal num children"); } diff --git a/win/tkWinX.c b/win/tkWinX.c index e85b7e7..22edb60 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -120,20 +120,19 @@ TkGetServerInfo( Tk_Window tkwin) /* Token for window; this selects a particular * display and server. */ { - char buffer[60]; OSVERSIONINFO os; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); GetVersionEx(&os); - sprintf(buffer, "Windows %d.%d %d %s", (int)os.dwMajorVersion, - (int)os.dwMinorVersion, (int)os.dwBuildNumber, + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Windows %d.%d %d %s", + (int) os.dwMajorVersion, (int) os.dwMinorVersion, + (int) os.dwBuildNumber, #ifdef _WIN64 "Win64" #else "Win32" #endif - ); - Tcl_SetResult(interp, buffer, TCL_VOLATILE); + )); } /* diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c index 08e8a8e..8666b65 100644 --- a/win/ttkWinXPTheme.c +++ b/win/ttkWinXPTheme.c @@ -1062,7 +1062,8 @@ GetSysFlagFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr) if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) return TCL_ERROR; if (objc != 2) { - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } for (i = 0; i < objc; ++i) { @@ -1116,8 +1117,9 @@ Ttk_CreateVsapiElement( O_HALFHEIGHT, O_HALFWIDTH }; if (objc < 2) { - Tcl_AppendResult(interp, - "missing required arguments 'class' and/or 'partId'", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing required arguments 'class' and/or 'partId'", -1)); + Tcl_SetErrorCode(interp, "TTK", "VSAPI", "REQUIRED", NULL); return TCL_ERROR; } @@ -1132,8 +1134,10 @@ Ttk_CreateVsapiElement( for (i = 3; i < objc; i += 2) { int tmp = 0; if (i == objc -1) { - Tcl_AppendResult(interp, "Missing value for \"", - Tcl_GetString(objv[i]), "\".", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Missing value for \"%s\".", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, |