diff options
114 files changed, 5177 insertions, 3943 deletions
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..e99740c 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", "CREATION", NULL); return TCL_ERROR; } @@ -229,8 +230,10 @@ 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); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "TARGET", NULL); return TCL_ERROR; } } @@ -312,8 +315,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..dda4b7e 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; 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..2f1caa1 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,14 @@ 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", "WM", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -687,7 +688,7 @@ Tk_WmObjCmd( /* This should not happen */ return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -723,12 +724,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 +745,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 +760,7 @@ WmAspectCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -932,7 +936,7 @@ WmSetAttribute( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1007,7 +1011,7 @@ WmGetAttribute( } return result; } - + /* *---------------------------------------------------------------------- * @@ -1045,16 +1049,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 +1069,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 +1083,7 @@ WmAttributesCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1115,7 +1119,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 +1139,7 @@ WmClientCmd( strcpy(wmPtr->clientMachine, argv3); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1174,7 +1179,7 @@ WmColormapwindowsCmd( Tk_MakeWindowExist((Tk_Window) winPtr); 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); @@ -1182,7 +1187,7 @@ WmColormapwindowsCmd( 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 +1226,7 @@ WmColormapwindowsCmd( return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1258,8 +1263,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 +1287,7 @@ WmCommandCmd( wmPtr->cmdArgv = cmdArgv; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1315,20 +1320,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 +1375,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 +1391,7 @@ WmFocusmodelCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1409,7 +1418,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 +1455,7 @@ WmForgetCmd( return TCL_OK; #endif } - + /* *---------------------------------------------------------------------- * @@ -1472,7 +1483,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 +1492,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 +1531,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 +1542,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 +1555,7 @@ WmGeometryCmd( } return ParseGeometry(interp, argv3, winPtr); } - + /* *---------------------------------------------------------------------- * @@ -1577,6 +1583,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 +1592,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 +1625,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 +1643,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 +1686,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 +1712,7 @@ WmGroupCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1739,8 +1749,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 +1781,7 @@ WmIconbitmapCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1801,30 +1812,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 +1878,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 +1900,7 @@ WmIconmaskCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1933,7 +1952,7 @@ WmIconnameCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -1985,8 +2004,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", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -1999,7 +2020,7 @@ WmIconphotoCmd( return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2034,11 +2055,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 +2067,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 +2076,7 @@ WmIconpositionCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2091,7 +2112,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 +2129,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 +2163,7 @@ WmIconwindowCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2165,7 +2190,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 +2203,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 +2235,7 @@ WmManageCmd( return TCL_OK; #endif } - + /* *---------------------------------------------------------------------- * @@ -2240,15 +2269,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 +2287,7 @@ WmMaxsizeCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2291,11 +2321,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 +2339,7 @@ WmMinsizeCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2354,7 +2385,7 @@ WmOverrideredirectCmd( ApplyMasterOverrideChanges(winPtr, NULL); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2393,9 +2424,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 +2449,7 @@ WmPositionfromCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2475,7 +2506,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 +2542,7 @@ WmProtocolCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2545,16 +2577,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 +2609,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 +2655,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 +2681,7 @@ WmSizefromCmd( WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2705,25 +2735,27 @@ WmStackorderCmd( 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,7 +2766,9 @@ 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; } @@ -2769,7 +2803,7 @@ WmStackorderCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2808,19 +2842,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 +2870,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 +2892,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 +2901,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 +2951,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 +2962,7 @@ WmTitleCmd( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -2957,7 +3000,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 +3018,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 +3029,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 +3054,7 @@ WmTransientCmd( ApplyMasterOverrideChanges(winPtr, NULL); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -3040,14 +3087,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 +3112,7 @@ WmUpdateGeom( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3169,7 +3218,7 @@ Tk_SetGrid( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3226,7 +3275,7 @@ Tk_UnsetGrid( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3276,7 +3325,7 @@ TopLevelEventProc( Tcl_Panic("recieved unwanted reparent event"); } } - + /* *---------------------------------------------------------------------- * @@ -3311,7 +3360,7 @@ TopLevelReqProc( wmPtr->flags |= WM_UPDATE_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3438,13 +3487,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; } /* @@ -3528,7 +3577,7 @@ UpdateGeometryInfo( wmPtr->flags &= ~WM_SYNC_PENDING; } } - + /* *---------------------------------------------------------------------- * @@ -3554,7 +3603,7 @@ UpdateSizeHints( wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS; } - + /* *---------------------------------------------------------------------- * @@ -3692,10 +3741,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 +3842,7 @@ Tk_GetRootCoords( *xPtr = x; *yPtr = y; } - + /* *---------------------------------------------------------------------- * @@ -3911,7 +3962,7 @@ Tk_CoordsToWindow( } return (Tk_Window) winPtr; } - + /* *---------------------------------------------------------------------- * @@ -4004,7 +4055,7 @@ Tk_TopCoordsToWindow( *newY = y; return (Tk_Window) winPtr; } - + /* *---------------------------------------------------------------------- * @@ -4071,7 +4122,7 @@ UpdateVRootGeometry( goto noVRoot; } } - + /* *---------------------------------------------------------------------- * @@ -4128,7 +4179,7 @@ Tk_GetVRootGeometry( *widthPtr = wmPtr->vRootWidth; *heightPtr = wmPtr->vRootHeight; } - + /* *---------------------------------------------------------------------- * @@ -4182,7 +4233,7 @@ Tk_MoveToplevelWindow( UpdateGeometryInfo(winPtr); } } - + /* *---------------------------------------------------------------------- * @@ -4296,7 +4347,7 @@ TkWmRestackToplevel( SendBehind(macWindow, otherMacWindow); } } - + /* *---------------------------------------------------------------------- * @@ -4387,7 +4438,7 @@ TkWmAddToColormapWindows( * we don't support colormaps. If we did they would be installed here. */ } - + /* *---------------------------------------------------------------------- * @@ -4456,7 +4507,7 @@ TkWmRemoveFromColormapWindows( } } } - + /* *---------------------------------------------------------------------- * @@ -4484,7 +4535,7 @@ TkGetPointerCoords( { XQueryPointer(NULL, None, NULL, NULL, xPtr, yPtr, NULL, NULL, NULL); } - + /* *---------------------------------------------------------------------- * @@ -4543,7 +4594,7 @@ InitialWindowBounds( geometry->right = wmPtr->x + winPtr->changes.width; geometry->bottom = wmPtr->y + winPtr->changes.height; } - + /* *---------------------------------------------------------------------- * @@ -4583,7 +4634,7 @@ TkMacOSXResizable( return true; } } - + /* *---------------------------------------------------------------------- * @@ -4651,7 +4702,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 +4757,7 @@ TkMacOSXGrowToplevel( } return false; } - + /* *---------------------------------------------------------------------- * @@ -4744,7 +4795,7 @@ TkSetWMName( CFRelease(title); } } - + /* *---------------------------------------------------------------------- * @@ -4771,7 +4822,7 @@ TkGetTransientMaster( } return None; } - + /* *---------------------------------------------------------------------- * @@ -4803,7 +4854,7 @@ TkMacOSXGetXWindow( } return (Window) Tcl_GetHashValue(hPtr); } - + /* *---------------------------------------------------------------------- * @@ -4862,7 +4913,7 @@ TkMacOSXIsWindowZoomed( return IsWindowInStandardState(TkMacOSXDrawableWindow(winPtr->window), &idealSize, NULL); } - + /* *---------------------------------------------------------------------- * @@ -4884,7 +4935,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 +4997,7 @@ TkMacOSXZoomToplevel( (zoomPart == inZoomIn ? NormalState : ZoomState); return true; } - + /* *---------------------------------------------------------------------- * @@ -4994,9 +5045,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 +5065,7 @@ TkUnsupported1ObjCmd( /* won't be reached */ return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -5142,14 +5193,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 +5209,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 +5267,7 @@ WmWinStyle( } return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -5254,7 +5305,7 @@ TkpMakeMenuWindow( winPtr->wmInfoPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; } } - + /* *---------------------------------------------------------------------- * @@ -5359,7 +5410,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 +5456,7 @@ TkMacOSXMakeRealWindowExist( } #endif /* TK_MAC_DEBUG_WINDOWS */ } - + /* *---------------------------------------------------------------------- * @@ -5441,7 +5492,7 @@ TkMacOSXRegisterOffScreenWindow( } Tcl_SetHashValue(valueHashPtr, window); } - + /* *---------------------------------------------------------------------- * @@ -5475,7 +5526,7 @@ TkMacOSXUnregisterMacWindow( Tcl_DeleteHashEntry(entryPtr); } } - + /* *---------------------------------------------------------------------- * @@ -5507,7 +5558,7 @@ TkMacOSXSetScrollbarGrow( winPtr->privatePtr->toplevel->winPtr->wmInfoPtr->scrollWinPtr = NULL; } } - + /* *---------------------------------------------------------------------- * @@ -5540,7 +5591,7 @@ TkWmFocusToplevel( } return winPtr; } - + /* *---------------------------------------------------------------------- * @@ -5570,7 +5621,7 @@ TkpGetWrapperWindow( } return winPtr; } - + /* *---------------------------------------------------------------------- * @@ -5630,7 +5681,7 @@ TkpWmSetState( TkMacOSXZoomToplevel(macWin, inZoomOut); } } - + /* *---------------------------------------------------------------------- * @@ -5660,7 +5711,7 @@ TkpIsWindowFloating( GetWindowClass(wRef, &class); return (class == kFloatingWindowClass); } - + /* *---------------------------------------------------------------------- * @@ -5683,7 +5734,7 @@ TkMacOSXWindowClass( { return winPtr->wmInfoPtr->macClass; } - + /* *-------------------------------------------------------------- * @@ -5718,7 +5769,7 @@ TkMacOSXWindowOffset( *xOffset = winPtr->wmInfoPtr->xInParent; *yOffset = winPtr->wmInfoPtr->yInParent; } - + /* *---------------------------------------------------------------------- * @@ -5744,7 +5795,7 @@ TkpGetMS(void) Tcl_GetTime(&now); return (long) now.sec * 1000 + now.usec / 1000; } - + /* *---------------------------------------------------------------------- * @@ -5772,7 +5823,7 @@ XSetInputFocus( * Don't need to do a thing. Tk manages the focus for us. */ } - + /* *---------------------------------------------------------------------- * @@ -5818,7 +5869,7 @@ TkpChangeFocus( return NextRequest(winPtr->display); } - + /* *---------------------------------------------------------------------- * @@ -5865,7 +5916,7 @@ WmStackorderToplevelWrapperMap( WmStackorderToplevelWrapperMap(childPtr, display, table); } } - + /* *---------------------------------------------------------------------- * @@ -5943,7 +5994,7 @@ TkWmStackorderToplevel( Tcl_DeleteHashTable(&table); return windows; } - + /* *---------------------------------------------------------------------- * @@ -6034,7 +6085,7 @@ ApplyWindowClassAttributeChanges( + strWidths.bottom; } } - + /* *---------------------------------------------------------------------- * @@ -6100,7 +6151,7 @@ ApplyMasterOverrideChanges( } } } - + /* *---------------------------------------------------------------------- * @@ -6154,7 +6205,7 @@ WmGetWindowGroup( } return group; } - + /* *---------------------------------------------------------------------- * @@ -6182,7 +6233,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 +6243,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 +6291,7 @@ TkMacOSXMakeFullscreen( TkMacOSXEnterExitFullscreen(winPtr, IsWindowActive(window)); return result; } - + /* *---------------------------------------------------------------------- * @@ -6287,7 +6339,7 @@ TkMacOSXEnterExitFullscreen( } } } - + /* *---------------------------------------------------------------------- * @@ -6384,7 +6436,7 @@ GetMinSize( *minWidthPtr = minWidth; *minHeightPtr = minHeight; } - + /* *---------------------------------------------------------------------- * @@ -6440,7 +6492,7 @@ GetMaxSize( *maxHeightPtr = maxHeight; } } - + /* *---------------------------------------------------------------------- * @@ -6486,7 +6538,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..56f628b 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,19 +180,17 @@ 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) { @@ -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", "ARG", "BAD_TYPE", 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..93a6a52 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -2924,8 +2924,10 @@ 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", NULL); return TCL_ERROR; } @@ -2939,13 +2941,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 +3025,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 +3168,17 @@ HandleEventGenerate( value = Tcl_GetString(valuePtr); keysym = TkStringToKeysym(value); if (keysym == NoSymbol) { - Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", 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", NULL); return TCL_ERROR; } if (!(flags & KEY) @@ -3400,8 +3407,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 +3504,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", NULL); return TCL_ERROR; } @@ -3558,8 +3569,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 +3663,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 +3693,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 +3822,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 +3863,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; } @@ -3918,8 +3941,10 @@ ParseEventDescription( } else if (eventFlags & KEY) { goto getKeysym; } else if ((eventFlags & BUTTON) == 0) { - Tcl_AppendResult(interp, "specified button \"", field, - "\" for non-button event", NULL); + 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,8 +3954,9 @@ 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", NULL); count = 0; goto done; } @@ -3938,15 +3964,17 @@ ParseEventDescription( patPtr->eventType = KeyPress; eventMask = KeyPressMask; } else if ((eventFlags & KEY) == 0) { - Tcl_AppendResult(interp, "specified keysym \"", field, - "\" for non-key event", NULL); + 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 +3986,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; } diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index b0d1ecc..0815b3b 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,9 @@ 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", NULL); } goto error; } @@ -487,8 +491,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..8fd53fa 100644 --- a/generic/tkBusy.c +++ b/generic/tkBusy.c @@ -687,8 +687,9 @@ 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", NULL); return NULL; } return Tcl_GetHashValue(hPtr); diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index 6cbc89b..d32c717 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_AppendResult(interp, Tcl_GetString(psObj), NULL); + 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", "ARCSTYLE", NULL); *stylePtr = PIESLICE_STYLE; return TCL_ERROR; } diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index ea16a29..65c4b59 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_AppendResult(interp, Tcl_GetString(psObj), NULL); + 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..ce51759 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", "ITEMINDEX", "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", "ARROWSHAPE", 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_AppendResult(interp, Tcl_GetString(psObj), NULL); + 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..7e2834d 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", "ITEMINDEX", "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_AppendResult(interp, Tcl_GetString(psObj), NULL); + 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..b6e9a33 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", "CANVAS", "PS", "SAFE", NULL); result = TCL_ERROR; goto cleanup; } @@ -376,8 +387,10 @@ TkCanvPostscriptCmd( goto cleanup; } if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", psInfo.channelName, - "\" wasn't opened for writing", NULL); + 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..d972d48 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", "ITEMINDEX", "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_AppendResult(interp, Tcl_GetString(psObj), NULL); + 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..120afd2 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,9 @@ 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", NULL); return TCL_ERROR; } smooth = &methods->smooth; @@ -878,7 +893,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 +901,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 +924,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 +1269,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 +1378,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 +1398,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 +1411,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 +1420,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 +1748,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 +1759,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 +1850,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..7ca7c9d 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_AppendResult(interp, Tcl_GetString(psObj), NULL); + } else { + Tcl_DiscardInterpState(interpState); + } + Tcl_DecrRefCount(psObj); return result; } diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 14d8261..c696d65 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -928,8 +928,9 @@ 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", "CANVASITEM", NULL); result = TCL_ERROR; goto done; } @@ -953,8 +954,9 @@ 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", "CANVASITEM", NULL); result = TCL_ERROR; goto done; } @@ -1030,10 +1032,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 +1276,9 @@ 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", "CANVASITEM", NULL); result = TCL_ERROR; goto done; } @@ -1545,8 +1548,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 +1652,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 +1779,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 +1856,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 +1936,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 +2032,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 +2040,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 +2078,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 +2086,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 +2311,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", "SCROLLREGION", NULL); badRegion: ckfree(canvasPtr->regionString); ckfree(argv2); @@ -3583,8 +3593,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 +3643,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 +3668,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 +3732,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 +3745,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 +3765,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 +3779,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; } @@ -4339,8 +4363,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 { 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..08eb377 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", 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", 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", 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", 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,9 @@ 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", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); @@ -1643,8 +1656,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", NULL); return TCL_ERROR; } @@ -1764,8 +1779,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", "LOOKUP", "VISUAL", NULL); return TCL_ERROR; } resultPtr = Tcl_NewObj(); @@ -1860,8 +1876,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 +1902,9 @@ 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", NULL); return TCL_ERROR; } @@ -2058,8 +2075,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 +2115,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 9383a92..1bfb037 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..5d963d4 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -946,16 +946,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 +1158,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 +1227,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 +1346,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 +1371,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 +1771,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 +2153,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/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..2e400b8 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -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); @@ -616,8 +617,9 @@ Tk_FontObjCmd( nfPtr = Tcl_GetHashValue(namedHashPtr); } if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) { - Tcl_AppendResult(interp, "named font \"", string, - "\" doesn't exist", NULL); + 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: { @@ -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; } @@ -949,8 +951,9 @@ TkCreateNamedFont( nfPtr = Tcl_GetHashValue(namedHashPtr); if (nfPtr->deletePending == 0) { 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; } @@ -3403,8 +3409,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; } @@ -3646,8 +3654,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 +3703,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; } @@ -4077,7 +4088,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: diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 55f5d51..f09369e 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -548,8 +548,9 @@ CreateFrame( * are being destroyed. Let an error be thrown. */ - Tcl_AppendResult(interp, "unable to create widget \"", - Tcl_GetString(objv[1]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to create widget \"%s\"", Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "APP_GONE", NULL); newWin = NULL; } else { /* @@ -562,9 +563,11 @@ CreateFrame( goto error; } else { /* - * Mark Tk frames as suitable candidates for [wm manage] + * Mark Tk frames as suitable candidates for [wm manage]. */ + TkWindow *winPtr = (TkWindow *)newWin; + winPtr->flags |= TK_WM_MANAGEABLE; } if (className == NULL) { @@ -669,8 +672,10 @@ CreateFrame( if (framePtr->useThis == NULL) { TkpMakeContainer(framePtr->tkwin); } else { - Tcl_AppendResult(interp, "A window cannot have both the -use ", - "and the -container option set.", 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; } } @@ -765,6 +770,7 @@ FrameWidgetObjCmd( for (i = 2; i < objc; i++) { const char *arg = Tcl_GetStringFromObj(objv[i], &length); + if (length < 2) { continue; } @@ -785,23 +791,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 +1016,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 +1044,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..e825c7b 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; @@ -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", "BADTIME", 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; } /* diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 70d463e..8714969 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -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", "UNREACHABLE", 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; } @@ -994,9 +996,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", "NOINDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1007,9 +1009,10 @@ 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_ObjPrintf( + "%s %s: must specify a single element on retrieval", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1017,6 +1020,7 @@ GridRowColumnConfigureCommand( Tcl_AppendResult(interp, " (when retreiving options only integer indices are " "allowed)", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1073,19 +1077,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 +1122,20 @@ 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( + "%s %s: the window \"%s\" is not managed by \"%s\"", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]), + Tcl_GetString(lObjv[j]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "GRID_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( + "%s %s: illegal index \"%s\"", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]), + Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1148,10 +1155,12 @@ 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 %s: \"%s\" is out of range", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]), + Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", + NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1185,11 +1194,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 +1212,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 +1262,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 +1371,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 +1391,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 +2539,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 +2580,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 +3005,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 +3034,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 +3071,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 +3136,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 +3166,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 +3179,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 +3195,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 +3208,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 +3221,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 +3232,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 +3255,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 +3268,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 +3336,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 +3350,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 +3413,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 +3431,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 +3485,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); @@ -3497,6 +3536,7 @@ StickyToString( char *result) /* Where to put the result. */ { int count = 0; + if (flags&STICK_NORTH) { result[count++] = 'n'; } diff --git a/generic/tkImage.c b/generic/tkImage.c index 5fa3671..bb115f6 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", 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", 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", NULL); } return NULL; } diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 82374cb..56ad066 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -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; } } @@ -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", "IMAGE", "BITMAP", "SAFE", 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: @@ -1151,9 +1163,10 @@ ImgBmapPsImagemask( }; if (width*height > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unable to generate postscript for bitmaps " - "larger than 60000 pixels", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to generate postscript for bitmaps larger than 60000" + " pixels", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OUTSIZE", NULL); return TCL_ERROR; } 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..aff2496 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; } @@ -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/tkImgPhoto.c b/generic/tkImgPhoto.c index 5b172f1..3eff18d 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -562,17 +562,20 @@ 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", 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", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -624,8 +627,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 +676,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", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -719,9 +724,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", + NULL); return TCL_ERROR; } } else { @@ -770,7 +778,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 +790,10 @@ 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", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -792,9 +802,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; } @@ -876,8 +887,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", "PHOTO", "NON_RECTANGULAR", + NULL); break; } @@ -920,8 +934,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 +1007,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", "PHOTO", "SAFE", NULL); return TCL_ERROR; } @@ -1031,8 +1047,10 @@ 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", "PHOTO", "BAD_FROM", NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1052,7 +1070,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 +1163,10 @@ 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", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -1180,8 +1202,10 @@ 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", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -1244,8 +1268,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", "PHOTO", "SAFE", NULL); return TCL_ERROR; } @@ -1270,8 +1295,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", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -1338,19 +1364,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; } @@ -1486,9 +1512,9 @@ ParseSubcommandOptions( */ if ((allowedOptions & bit) == 0) { + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unrecognized option \"", - Tcl_GetString(objv[index]), - "\": must be ", NULL); + Tcl_GetString(objv[index]), "\": must be ", NULL); bit = 1; for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((allowedOptions & bit) != 0) { @@ -1502,6 +1528,7 @@ ParseSubcommandOptions( } bit <<= 1; } + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_OPTION", NULL); return TCL_ERROR; } @@ -1523,8 +1550,10 @@ ParseSubcommandOptions( return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "the \"-background\" option ", - "requires a value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-background\" option requires a value", -1)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if (bit == OPT_FORMAT) { @@ -1537,8 +1566,10 @@ ParseSubcommandOptions( *optIndexPtr = ++index; optPtr->format = objv[index]; } else { - Tcl_AppendResult(interp, "the \"-format\" option ", - "requires a value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-format\" option requires a value", -1)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if (bit == OPT_COMPOSITE) { @@ -1565,8 +1596,11 @@ ParseSubcommandOptions( } *optIndexPtr = index; } else { - Tcl_AppendResult(interp, "the \"-compositingrule\" option ", - "requires a value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-compositingrule\" option requires a value", + -1)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { @@ -1591,9 +1625,11 @@ ParseSubcommandOptions( } if (numValues == 0) { - Tcl_AppendResult(interp, "the \"", option, "\" option ", - "requires one ", maxValues == 2? "or two": "to four", - " integer values", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires one %s integer values", + option, (maxValues == 2) ? "or two": "to four")); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } *optIndexPtr = (index += numValues); @@ -1618,8 +1654,10 @@ 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value(s) for the -from option must be" + " non-negative", -1)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } if (numValues <= 2) { @@ -1641,8 +1679,10 @@ 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value(s) for the -to option must be non-negative", + -1)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_TO", NULL); return TCL_ERROR; } if (numValues <= 2) { @@ -1659,8 +1699,10 @@ 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value(s) for the -zoom option must be positive", + -1)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_ZOOM", NULL); return TCL_ERROR; } optPtr->zoomX = values[0]; @@ -1730,8 +1772,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", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if ((args[j][1] == 'f') && @@ -1741,8 +1785,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", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } @@ -1832,8 +1878,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 +1898,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", "PHOTO", "SAFE", NULL); goto errorExit; } @@ -1876,8 +1925,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 +1956,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 +2402,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", "PHOTO", "NOT_FILE_FORMAT", + NULL); return TCL_ERROR; } } @@ -2382,8 +2436,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", "PHOTO", "NOT_FILE_FORMAT", + NULL); return TCL_ERROR; } } @@ -2405,11 +2462,15 @@ 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", NULL); } else { - Tcl_AppendResult(interp, - "couldn't recognize data in image file \"", fileName, "\"", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't recognize data in image file \"%s\"", + fileName)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; @@ -2480,8 +2541,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", "PHOTO", "NOT_DATA_FORMAT", + NULL); return TCL_ERROR; } } @@ -2504,8 +2568,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", "PHOTO", "NOT_DATA_FORMAT", + NULL); return TCL_ERROR; } } @@ -2521,10 +2588,14 @@ 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", 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", "PHOTO", "UNRECOGNIZED_DATA", + NULL); } return TCL_ERROR; } @@ -2641,8 +2712,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 +3109,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 +3508,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 +3583,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/tkListbox.c b/generic/tkListbox.c index 7faa44b..355db5b 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", "ITEMIDX", 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", "ITEMIDX", 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..24f7e39 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", "OPTIONDB", "SAFE", 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..4fada47 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -152,11 +152,13 @@ void TkPrintPadAmount( Tcl_Interp *interp, /* 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]; + if (halfSpace*2 == allSpace) { sprintf(buffer, " -%.10s %d", switchName, halfSpace); } else { @@ -238,8 +240,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 +274,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 +297,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", NULL); return TCL_ERROR; } return ConfigureSlaves(interp, tkwin, objc-2, objv+2); @@ -333,8 +338,9 @@ 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"); @@ -1096,9 +1102,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: \"%s\" should be followed by options", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -1120,8 +1127,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 +1188,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: window \"%s\" option must be" + " followed by screen distance", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -1207,8 +1218,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 +1231,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 +1550,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 +1576,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 +1597,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 +1656,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 +1681,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 +1773,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..b6080b1 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -658,10 +658,12 @@ 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", "PANEDWIN", "UNMANAGED", NULL); + } result = TCL_ERROR; } else { Tcl_SetObjResult(interp, resultObj); @@ -700,15 +702,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 +776,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 +802,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 +863,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 +1088,6 @@ PanedWindowSashCommand( return TCL_ERROR; } - Tcl_ResetResult(interp); switch ((enum sashOptions) index) { case SASH_COORD: if (objc != 4) { @@ -1099,8 +1100,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_IDX", NULL); return TCL_ERROR; } slavePtr = pwPtr->slaves[sash]; @@ -1121,8 +1123,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_IDX", NULL); return TCL_ERROR; } @@ -1156,8 +1159,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_IDX", NULL); return TCL_ERROR; } @@ -2398,10 +2402,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 +2659,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 +2963,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 +3039,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..8fe2bd1 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -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; } @@ -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) diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index 630737c..2dadf29 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; 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..fb06093 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); 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..7978793 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", "VALUE", "INDEXOPT", NULL); + result = TCL_ERROR; + goto done; } case TEXT_DEBUG: if (objc > 3) { @@ -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", "INDEXORDER", NULL); result = TCL_ERROR; goto done; } @@ -2054,9 +2060,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", "INDEXORDER", NULL); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -2089,6 +2095,7 @@ ConfigureText( /* Nothing tagged with "sel" */ } else { int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr); + if (line < start) { selChanged = 1; } else { @@ -3657,13 +3664,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 +3704,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 +3733,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 +3786,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 +4414,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", "TABSTOP", NULL); goto error; } @@ -4433,11 +4447,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", "TABSTOP", NULL); goto error; #endif /* _TK_ALLOW_DECREASING_TABS */ } @@ -4568,10 +4582,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 +4591,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) { @@ -4748,8 +4761,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, @@ -5122,7 +5134,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 +5159,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; 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..0bb8f41 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 { @@ -323,11 +328,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 +375,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 +411,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..4fe97eb 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", "ILLEGAL_API_USAGE", NULL); return TCL_ERROR; } @@ -835,10 +837,10 @@ GetIndex( 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", NULL); Tcl_DStringFree(©); return TCL_ERROR; } @@ -1001,8 +1003,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..52df787 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, @@ -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\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_MARK", 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); @@ -843,28 +850,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 +953,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 +969,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 9afda0a..b3160b8 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -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, @@ -879,12 +879,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++; } @@ -895,7 +895,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); @@ -1050,7 +1050,7 @@ FindTag( const char *str; str = Tcl_GetStringFromObj(tagName, &len); - if (len == 3 && !strcmp(str,"sel")) { + if (len == 3 && !strcmp(str, "sel")) { return textPtr->selTagPtr; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable, @@ -1059,8 +1059,10 @@ 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", NULL); } return NULL; } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index 58d3198..d9dcecf 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) { @@ -436,9 +440,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 +853,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 +913,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/tkUtil.c b/generic/tkUtil.c index 5282708..6095054 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -84,18 +84,20 @@ TkStateParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", - " value \"", value, "\": must be normal", NULL); - if (flags&1) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value \"%s\": must be normal", + ((flags & 4) ? "-default" : "state"), value)); + if (flags & 1) { Tcl_AppendResult(interp, ", active", NULL); } - if (flags&2) { + if (flags & 2) { Tcl_AppendResult(interp, ", hidden", NULL); } - if (flags&3) { + if (flags & 3) { Tcl_AppendResult(interp, ",", NULL); } Tcl_AppendResult(interp, " or disabled", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL); *statePtr = TK_STATE_NORMAL; return TCL_ERROR; } @@ -195,8 +197,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; } @@ -376,8 +380,8 @@ TkOffsetParseProc( return TCL_OK; badTSOffset: - Tcl_AppendResult(interp, "bad offset \"", value, - "\": expected \"x,y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad offset \"%s\": expected \"x,y\"", value)); if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { Tcl_AppendResult(interp, ", \"#x,y\"", NULL); } @@ -385,6 +389,7 @@ TkOffsetParseProc( Tcl_AppendResult(interp, ", <index>", NULL); } Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL); return TCL_ERROR; } @@ -481,7 +486,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 +651,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 +664,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 +681,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 +758,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; } @@ -914,8 +930,10 @@ TkFindStateNum( if (interp != NULL) { mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, - "\": must be ", mPtr->strKey, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + option, strKey, mPtr->strKey)); + Tcl_SetErrorCode(interp, "TK", "VALUE", option, NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, ((mPtr[1].strKey != NULL) ? ", " : ", or "), @@ -970,8 +988,11 @@ TkFindStateNumObj( if (interp != NULL) { mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), - " value \"", key, "\": must be ", mPtr->strKey, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + Tcl_GetString(optionPtr), key, mPtr->strKey)); + Tcl_SetErrorCode(interp, "TK", "VALUE", Tcl_GetString(optionPtr), + NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, ((mPtr[1].strKey != NULL) ? ", " : ", or "), @@ -1007,24 +1028,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 +1054,12 @@ TkBackgroundEvalObjv( Tcl_BackgroundException(interp, r); } - Tcl_Release(interp); - /* - * Restore the state of the interpreter + * 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. - */ - - 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..5f03f39 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,8 +202,10 @@ Tk_GetVisual( } } if (template.class == -1) { - Tcl_AppendResult(interp, "unknown or ambiguous visual name \"", - string, "\": class must be ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown or ambiguous visual name \"%s\": class must be ", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUAL", NULL); for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { Tcl_AppendResult(interp, dictPtr->name, ", ", NULL); } @@ -215,10 +217,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 +237,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 +404,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..8b39da1 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) { @@ -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. @@ -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); @@ -964,7 +969,7 @@ TkCreateMainWindow( 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 +977,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 +1035,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 +1099,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 +1183,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", "WINDOWPATH", NULL); return NULL; } numChars = (int) (p-pathName); @@ -1206,13 +1214,15 @@ 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); + 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 +1364,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 +1392,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); @@ -1751,6 +1761,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 +2339,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 +2349,9 @@ 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", "VALUE", "WINDOWNAME", NULL); } return NULL; } @@ -2591,9 +2604,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 +2664,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 +2854,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 +2924,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 +2997,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 +3016,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 +3101,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 +3119,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 +3146,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 +3413,7 @@ Tk_PkgInitStubsCheck( } return actualVersion; } + /* * Local Variables: * mode: c diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index 6eccf51..c85751e 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -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..559d5d9 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; } @@ -875,8 +876,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", NULL); return 0; } @@ -915,8 +917,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", 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..12d481f 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", "SASHIDX", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c index a71ae21..151dc4d 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", "LOOKUP", "STATE", 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..6e7b477 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", 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,9 @@ 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", NULL); return TCL_ERROR; } @@ -1550,7 +1558,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", NULL); return TCL_ERROR; } @@ -1574,7 +1584,9 @@ 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", 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/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 d6ce254..8499faa 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", "CREATION", NULL); return TCL_ERROR; } @@ -229,8 +230,10 @@ 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); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "TARGET", NULL); return TCL_ERROR; } } @@ -305,15 +308,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 722ac9d..48ac5b2 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -704,10 +704,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 f2cb572..2aad32e 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,9 @@ 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", "WM", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -1013,12 +1012,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 +1033,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 +1275,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 +1295,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 +1345,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; } @@ -1402,7 +1405,7 @@ WmColormapwindowsCmd( Tk_MakeWindowExist((Tk_Window) winPtr); 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); @@ -1410,7 +1413,7 @@ WmColormapwindowsCmd( 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 +1479,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 +1541,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 +1598,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 +1640,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 +1658,9 @@ WmForgetCmd( TkMapTopFrame(frameWin); } else { - /* Already not managed by wm - ignore it */ + /* + * Already not managed by wm - ignore it. + */ } return TCL_OK; } @@ -1687,7 +1692,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 +1701,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 +1740,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 +1751,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 +1792,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 +1801,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 +1834,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 +1852,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 +1895,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 +1959,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 +2022,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 +2086,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 +2216,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", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -2247,16 +2265,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 +2324,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 +2345,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 +2406,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 +2476,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 +2530,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 +2584,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 +2636,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 { @@ -2664,6 +2701,7 @@ WmProtocolCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); return TCL_ERROR; } + if (objc == 3) { /* * Return a list of all defined protocols for the window. @@ -2676,6 +2714,7 @@ WmProtocolCmd( } return TCL_OK; } + protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); if (objc == 4) { /* @@ -2685,7 +2724,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 +2795,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 +2874,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; } @@ -2920,20 +2962,22 @@ 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); + } 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,7 +2988,9 @@ 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; } @@ -2958,8 +3004,7 @@ WmStackorderCmd( } if (index1 == -1) { Tcl_Panic("winPtr window not found"); - } - if (index2 == -1) { + } else if (index2 == -1) { Tcl_Panic("winPtr2 window not found"); } @@ -2977,7 +3022,6 @@ WmStackorderCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } - return TCL_OK; } /* @@ -3016,21 +3060,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 +3091,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 +3113,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 +3122,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 +3171,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 +3223,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 +3241,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 +3252,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 +3309,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); @@ -3906,7 +3969,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 +4308,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); @@ -4974,78 +5039,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 +5171,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 +5205,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 +5240,6 @@ WmWinStyle( Tcl_Panic("invalid class"); } - attributeList = Tcl_NewListObj(0, NULL); attributes = wmPtr->attributes; @@ -5194,7 +5247,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 +5256,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 +5312,6 @@ WmWinStyle( return TCL_ERROR; } - return TCL_OK; } @@ -5421,7 +5473,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]; @@ -6280,10 +6332,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; @@ -6573,8 +6626,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..0f0feeb 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -59,7 +59,7 @@ test grid-1.4 {basic argument checking} -body { 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 . } -returnCodes error -result {can't manage ".": it's a top-level window} @@ -546,7 +546,7 @@ test grid-9.5 {slaves} -body { } -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} +} -returnCodes error -result {-3 is an invalid value: should NOT be < 0} test grid-9.7 {slaves} -body { grid slaves . -foo 3 } -returnCodes error -result {bad option "-foo": must be -column or -row} @@ -865,12 +865,12 @@ test grid-10.35 {column/row configure} -body { lappend res [catch {grid .f -row 9998 -rowspan 2} msg] $msg ; update set 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 @@ -889,10 +889,10 @@ test grid-10.36 {column/row configure} -body { update set 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 @@ -909,7 +909,7 @@ test grid-11.2 {default widget placement} -body { 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 @@ -930,7 +930,7 @@ test grid-11.5 {default widget placement} -body { 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} { @@ -955,7 +955,7 @@ test grid-11.7 {default widget placement} -body { 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 @@ -963,7 +963,7 @@ test grid-11.8 {default widget placement} -body { 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 @@ -971,7 +971,7 @@ test grid-11.9 {default widget placement} -body { 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} { @@ -1210,7 +1210,7 @@ test grid-13.1 {-in} -body { 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 @@ -1219,7 +1219,7 @@ 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 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..3103cc1 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", "FGCOL", 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", "BGCOL", 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", "CURSOR", "SAFE", 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", "BITMAPDATA", 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", "BITMAPFILE", 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", "FGCOL", 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", "FGCOL", 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", "BGCOL", 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", "MASKDATA", -1); 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", "MASKFILE", -1); 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", -1); 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..d94157c 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) { @@ -122,8 +123,10 @@ TkpUseWindow( 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); + 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 +148,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", "CHILD", NULL); } return TCL_ERROR; } @@ -215,7 +219,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 +275,7 @@ TkpMakeContainer( { TkWindow *winPtr = (TkWindow *) tkwin; Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -331,7 +335,7 @@ EmbedErrorProc( XErrorEvent *errEventPtr) /* Points to information about error (not * used). */ { - int *iPtr = (int *) clientData; + int *iPtr = clientData; *iPtr = 1; return 0; @@ -361,7 +365,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 +397,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 +502,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 +549,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 +707,7 @@ TkpGetOtherWindow( * window. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; @@ -749,7 +753,7 @@ TkpRedirectKeyEvent( { Container *containerPtr; Window saved; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -821,7 +825,7 @@ TkpClaimFocus( { XEvent event; Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(topLevelPtr->flags & TK_EMBEDDED)) { @@ -872,7 +876,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 +946,7 @@ EmbedWindowDeleted( * deleted. */ { Container *containerPtr, *prevPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1000,7 +1004,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 +1136,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 +1147,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 +1155,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 +1167,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/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..e2d1e39 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,9 @@ 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", NULL); return TCL_ERROR; } @@ -1190,12 +1196,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; } @@ -1986,7 +1990,7 @@ TkpTestsendCmd( *p = '\n'; } } - Tcl_SetResult(interp, property, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(property, -1)); } if (property != NULL) { XFree(property); @@ -2010,10 +2014,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 48d9021..0142768 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,16 @@ typedef struct TkWmInfo { #define WM_WITHDRAWN 0x4000 /* + * Wrapper for XGetWindowProperty to make it 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) + +/* * 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. @@ -1041,9 +1052,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 +1082,9 @@ 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", NULL); return TCL_ERROR; } @@ -1183,12 +1194,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 +1215,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; @@ -1450,7 +1463,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; } @@ -1530,8 +1544,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 +1559,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 +1568,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 +1654,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 +1717,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 +1772,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 +1865,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 +1874,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 +1913,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 +1924,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 +1973,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 +2006,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 +2074,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 +2148,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 +2205,40 @@ 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", "CANNOT_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", "CANNOT_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", "CANNOT_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", "CANNOT_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 +2279,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 +2337,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 +2408,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 +2535,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 +2621,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", "ICONWIN", "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", "ICONWIN", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { @@ -2625,9 +2665,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 +2708,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", "TYPE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -2731,11 +2773,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 +2832,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 +2945,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 +3015,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 +3034,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 +3047,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 +3118,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 +3181,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 +3252,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 +3274,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 +3301,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", "STACK", "INTERNAL", NULL); return TCL_ERROR; } @@ -3309,9 +3372,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 +3389,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", + "ICONIFY_REDIRECTED", 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", + "ICONIFY_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 +3474,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 +3569,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 +3582,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 +3617,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 +3669,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 +4134,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 +4149,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 +4365,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); } @@ -5446,13 +5524,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)); @@ -5596,7 +5673,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; } @@ -6353,9 +6432,11 @@ TkWmStackorderToplevel( *window_ptr++ = childWinPtr; } } + /* ASSERT: window_ptr - windows == table.numEntries * (#matched toplevel windows == #children) [Bug 1789819] */ + *window_ptr = NULL; if (numChildren) { XFree((char *) children); 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..e7dbc65 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", "CURSOR", "SAFE", 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..7f96ec2 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,10 @@ 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", "INVALIDFILENAME", NULL); Tcl_DStringFree(&ds); } else { result = TCL_OK; @@ -962,14 +961,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 +992,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 +1360,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 +1372,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 +1465,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 +1478,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 +1508,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 +1584,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 +1603,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 +1741,6 @@ Tk_MessageBoxObjCmd( for (i = 1; i < objc; i += 2) { int index; - const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -1743,9 +1751,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 +1822,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 +1873,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 +1942,7 @@ SetTkDialog( /* * Factored out a common pattern in use in this file. */ + static const char * ConvertExternalFilename( TCHAR *filename, @@ -1969,7 +1978,9 @@ ConvertExternalFilename( */ static Tcl_Obj * -GetFontObj(HDC hdc, LOGFONT *plf) +GetFontObj( + HDC hdc, + LOGFONT *plf) { Tcl_DString ds; Tcl_Obj *resObj; @@ -2001,7 +2012,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 +2051,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 +2067,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 +2134,9 @@ enum FontchooserOption { }; static Tcl_Obj * -FontchooserCget(HookData *hdPtr, int optionIndex) +FontchooserCget( + HookData *hdPtr, + int optionIndex) { Tcl_Obj *resObj = NULL; @@ -2225,16 +2246,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 +2390,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..7ea4222 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", "USED", 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", "NOT", 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..f12e965 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -274,7 +274,8 @@ FreeID( if (tsdPtr->menuHWND != NULL) { Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + commandID); + INT2PTR(commandID)); + if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } @@ -311,10 +312,10 @@ TkpNewMenu( 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; } @@ -923,11 +924,12 @@ UpdateEmbeddedMenu( { RECT rc; HWND hMenuWnd = (HWND)clientData; + GetClientRect(hMenuWnd, &rc); InvalidateRect(hMenuWnd, &rc, FALSE); UpdateWindow(hMenuWnd); } - + /* *---------------------------------------------------------------------- * @@ -997,7 +999,7 @@ TkWinEmbeddedMenuProc( } return lResult; } - + /* *---------------------------------------------------------------------- * @@ -1090,7 +1092,7 @@ TkWinHandleMenuEvent( break; } hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + LOWORD(*pwParam)); + INT2PTR(LOWORD(*pwParam))); if (hashEntryPtr == NULL) { break; } @@ -1292,7 +1294,7 @@ TkWinHandleMenuEvent( mePtr = menuPtr->entries[entryIndex]; } else { hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + entryIndex); + INT2PTR(entryIndex)); if (hashEntryPtr != NULL) { mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr); 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..0686348 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -972,8 +972,9 @@ 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", NULL); return TCL_ERROR; } if (Tk_WindowId(tkw) == None) { @@ -1006,7 +1007,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 +1064,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 +1579,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 +1607,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 +1633,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 +1667,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 +1679,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 +1689,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 +1704,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 +2822,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 +2852,9 @@ 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", NULL); return TCL_ERROR; } @@ -2959,9 +2964,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 +2984,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 +3104,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 +3262,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 +3280,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 +3329,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; } @@ -3477,8 +3492,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 +3557,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", "DEICONIFY", "WHAT", NULL); return TCL_ERROR; } return TCL_OK; @@ -3595,8 +3616,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 +3821,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 +3854,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 +3920,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 +3987,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 +3999,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 +4060,7 @@ WmIconbitmapCmd( */ Pixmap pixmap; + Tcl_ResetResult(interp); pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string); if (pixmap == None) { @@ -4080,24 +4115,35 @@ 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", "CANNOT_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", "CANNOT_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", "CANNOT_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", "CANNOT_ICONIFY", "ICON", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -4139,9 +4185,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 +4242,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 +4319,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 +4372,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 +4404,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 +4426,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 +4486,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 +4544,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 +4569,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", "ICONWIN", "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", "ICONWIN", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { @@ -4589,9 +4648,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", "TYPE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -4645,8 +4705,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 +4756,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 +4810,10 @@ 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", "OVERRIDE_REDIRECT", "WHAT", + NULL); return TCL_ERROR; } } else { @@ -4816,11 +4886,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') { @@ -4898,7 +4971,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 +5041,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 +5109,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; } @@ -5111,7 +5190,7 @@ WmStackorderCmd( 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 +5198,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,7 +5226,9 @@ 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", "INTERNAL", NULL); return TCL_ERROR; } @@ -5157,8 +5242,7 @@ WmStackorderCmd( } if (index1 == -1) { Tcl_Panic("winPtr window not found"); - } - if (index2 == -1) { + } else if (index2 == -1) { Tcl_Panic("winPtr2 window not found"); } @@ -5218,9 +5302,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 +5339,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", "STATE", "WHAT", NULL); return TCL_ERROR; } return TCL_OK; @@ -5272,13 +5358,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", + "ICONIFY_REDIRECTED", 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", + "ICONIFY_TRANSIENT", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -5291,31 +5383,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 +5455,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 +5517,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 +5550,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 +5638,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", "WITHDRAW", "WHAT", NULL); return TCL_ERROR; } } else { @@ -6277,7 +6372,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; } 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..a343216 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, "TCL", "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, "TCL", "VSAPI", "MISSING", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, |