diff options
| -rw-r--r-- | doc/FindPhoto.3 | 14 | ||||
| -rw-r--r-- | generic/tkFrame.c | 24 | ||||
| -rw-r--r-- | generic/tkInt.h | 3 | ||||
| -rw-r--r-- | generic/tkText.c | 294 | ||||
| -rw-r--r-- | generic/tkWindow.c | 309 | ||||
| -rw-r--r-- | tests/safe.test | 2 |
6 files changed, 329 insertions, 317 deletions
diff --git a/doc/FindPhoto.3 b/doc/FindPhoto.3 index d6ccb5b..e4d83f0 100644 --- a/doc/FindPhoto.3 +++ b/doc/FindPhoto.3 @@ -99,6 +99,8 @@ being written to the photo image. particular photo image to the other procedures. The parameter is the name of the image, that is, the name specified to the \fBimage create photo\fR command, or assigned by that command if no name was specified. +If \fIimageName\fR does not exist or is not a photo image, +\fBTk_FindPhoto\fR returns NULL. .PP \fBTk_PhotoPutBlock\fR is used to supply blocks of image data to be displayed. The call affects an area of the image of size @@ -181,6 +183,18 @@ in the structure pointed to by the \fIblockPtr\fR parameter with values that describe the address and layout of the image data that the photo image has stored internally. The values are valid until the image is destroyed or its size is changed. +.PP +It is possible to modify an image by writing directly to the data +the \fIpixelPtr\fR field points to. The size of the image cannot be +changed this way, though. +Also, changes made by writing directly to \fIpixelPtr\fR will not be +immediately visible, but only after a call to +\fBTk_ImageChanged\fR or after an event that causes the interested +widgets to redraw themselves. +For these reasons usually it is preferable to make changes to +a copy of the image data and write it back with +\fBTk_PhotoPutBlock\fR or \fBTk_PhotoPutZoomedBlock\fR. +.PP \fBTk_PhotoGetImage\fR returns 1 for compatibility with the corresponding procedure in the old photo widget. .PP diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 057b4b8..f6edfb0 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -447,6 +447,30 @@ TkCreateFrame( return result; } +int +TkListCreateFrame( + ClientData clientData, /* Either NULL or pointer to option table. */ + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Obj *listObj, /* List of arguments. */ + int toplevel, /* Non-zero means create a toplevel window, + * zero means create a frame. */ + Tcl_Obj *nameObj) /* Should only be non-NULL if there is no main + * window associated with the interpreter. + * Gives the base name to use for the new + * application. */ + +{ + int objc; + Tcl_Obj **objv; + + if (TCL_OK != Tcl_ListObjGetElements(interp, listObj, &objc, &objv)) { + return TCL_ERROR; + } + return CreateFrame(clientData, interp, objc, objv, + toplevel ? TYPE_TOPLEVEL : TYPE_FRAME, + nameObj ? Tcl_GetString(nameObj) : NULL); +} + static int CreateFrame( ClientData clientData, /* NULL. */ diff --git a/generic/tkInt.h b/generic/tkInt.h index 029f0f1..dd5dcad 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1217,6 +1217,9 @@ MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp, MODULE_SCOPE int TkInitFontchooser(Tcl_Interp *interp, ClientData clientData); MODULE_SCOPE void TkpWarpPointer(TkDisplay *dispPtr); +MODULE_SCOPE int TkListCreateFrame(ClientData clientData, + Tcl_Interp *interp, Tcl_Obj *listObj, + int toplevel, Tcl_Obj *nameObj); #ifdef _WIN32 #define TkParseColor XParseColor diff --git a/generic/tkText.c b/generic/tkText.c index e028a54..8698825 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -123,7 +123,7 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BOOLEAN, "-autoseparators", "autoSeparators", "AutoSeparators", DEF_TEXT_AUTO_SEPARATORS, -1, Tk_Offset(TkText, autoSeparators), - TK_OPTION_DONT_SET_DEFAULT, 0, 0}, + TK_OPTION_DONT_SET_DEFAULT, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_TEXT_BG_COLOR, -1, Tk_Offset(TkText, border), 0, DEF_TEXT_BG_MONO, 0}, @@ -195,7 +195,7 @@ static const Tk_OptionSpec optionSpecs[] = { 0, 0, 0}, {TK_OPTION_INT, "-maxundo", "maxUndo", "MaxUndo", DEF_TEXT_MAX_UNDO, -1, Tk_Offset(TkText, maxUndo), - TK_OPTION_DONT_SET_DEFAULT, 0, 0}, + TK_OPTION_DONT_SET_DEFAULT, 0, 0}, {TK_OPTION_PIXELS, "-padx", "padX", "Pad", DEF_TEXT_PADX, -1, Tk_Offset(TkText, padX), 0, 0, TK_TEXT_LINE_GEOMETRY}, @@ -242,7 +242,7 @@ static const Tk_OptionSpec optionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BOOLEAN, "-undo", "undo", "Undo", DEF_TEXT_UNDO, -1, Tk_Offset(TkText, undo), - TK_OPTION_DONT_SET_DEFAULT, 0 , 0}, + TK_OPTION_DONT_SET_DEFAULT, 0 , 0}, {TK_OPTION_INT, "-width", "width", "Width", DEF_TEXT_WIDTH, -1, Tk_Offset(TkText, width), 0, 0, TK_TEXT_LINE_GEOMETRY}, @@ -923,43 +923,43 @@ TextWidgetObjCmd( * We're going to count up all display lines in the logical * line of 'indexFromPtr' up to, but not including the logical * line of 'indexToPtr' (except if this line is elided), and - * then subtract off what came in too much from elided lines, - * also subtract off what we didn't want from 'from' and add + * then subtract off what came in too much from elided lines, + * also subtract off what we didn't want from 'from' and add * on what we didn't count from 'to'. */ - while (TkTextIndexCmp(&index,indexToPtr) < 0) { + while (TkTextIndexCmp(&index,indexToPtr) < 0) { value += TkTextUpdateOneLine(textPtr, index.linePtr, - 0, &index, 0); + 0, &index, 0); } - index2 = index; - - /* - * Now we need to adjust the count to: - * - subtract off the number of display lines between - * indexToPtr and index2, since we might have skipped past - * indexToPtr, if we have several logical lines in a - * single display line - * - subtract off the number of display lines overcounted - * in the first logical line - * - add on the number of display lines in the last logical - * line - * This logic is still ok if both indexFromPtr and indexToPtr - * are in the same logical line. - */ - - index = *indexToPtr; - index.byteIndex = 0; - while (TkTextIndexCmp(&index,&index2) < 0) { - value -= TkTextUpdateOneLine(textPtr, index.linePtr, - 0, &index, 0); - } + index2 = index; + + /* + * Now we need to adjust the count to: + * - subtract off the number of display lines between + * indexToPtr and index2, since we might have skipped past + * indexToPtr, if we have several logical lines in a + * single display line + * - subtract off the number of display lines overcounted + * in the first logical line + * - add on the number of display lines in the last logical + * line + * This logic is still ok if both indexFromPtr and indexToPtr + * are in the same logical line. + */ + + index = *indexToPtr; + index.byteIndex = 0; + while (TkTextIndexCmp(&index,&index2) < 0) { + value -= TkTextUpdateOneLine(textPtr, index.linePtr, + 0, &index, 0); + } index.linePtr = indexFromPtr->linePtr; index.byteIndex = 0; while (1) { TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL); - if (TkTextIndexCmp(&index,indexFromPtr) >= 0) { + if (TkTextIndexCmp(&index,indexFromPtr) >= 0) { break; } TkTextIndexForwBytes(textPtr, &index, 1, &index); @@ -971,7 +971,7 @@ TextWidgetObjCmd( index.byteIndex = 0; while (1) { TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL); - if (TkTextIndexCmp(&index,indexToPtr) >= 0) { + if (TkTextIndexCmp(&index,indexToPtr) >= 0) { break; } TkTextIndexForwBytes(textPtr, &index, 1, &index); @@ -1399,14 +1399,14 @@ TextWidgetObjCmd( result = TextPeerCmd(textPtr, interp, objc, objv); break; case TEXT_PENDINGSYNC: { - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - result = TCL_ERROR; - goto done; - } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj(TkTextPendingsync(textPtr))); - break; + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + result = TCL_ERROR; + goto done; + } + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(TkTextPendingsync(textPtr))); + break; } case TEXT_REPLACE: { const TkTextIndex *indexFromPtr, *indexToPtr; @@ -1539,7 +1539,7 @@ TextWidgetObjCmd( textPtr->afterSyncCmd = cmd; } else { textPtr->afterSyncCmd = cmd; - Tcl_DoWhenIdle(RunAfterSyncCmd, (ClientData) textPtr); + Tcl_DoWhenIdle(RunAfterSyncCmd, (ClientData) textPtr); } break; } else if (objc != 2) { @@ -2195,10 +2195,10 @@ ConfigureText( * Also, clamp the insert and current (unshared) marks to the new * -startline/-endline range limits of the widget. All other (shared) * marks are unchanged. - * The return value of TkTextMarkNameToIndex does not need to be - * checked: "insert" and "current" marks always exist, and the - * purpose of the code below precisely is to move them inside the - * -startline/-endline range. + * The return value of TkTextMarkNameToIndex does not need to be + * checked: "insert" and "current" marks always exist, and the + * purpose of the code below precisely is to move them inside the + * -startline/-endline range. */ textPtr->sharedTextPtr->stateEpoch++; @@ -2258,18 +2258,18 @@ ConfigureText( */ if (textPtr->selTagPtr->selBorder == NULL) { - textPtr->selTagPtr->border = textPtr->selBorder; + textPtr->selTagPtr->border = textPtr->selBorder; } else { - textPtr->selTagPtr->selBorder = textPtr->selBorder; + textPtr->selTagPtr->selBorder = textPtr->selBorder; } if (textPtr->selTagPtr->borderWidthPtr != textPtr->selBorderWidthPtr) { textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr; textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth; } if (textPtr->selTagPtr->selFgColor == NULL) { - textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr; + textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr; } else { - textPtr->selTagPtr->selFgColor = textPtr->selFgColorPtr; + textPtr->selTagPtr->selFgColor = textPtr->selFgColorPtr; } textPtr->selTagPtr->affectsDisplay = 0; textPtr->selTagPtr->affectsDisplayGeometry = 0; @@ -2296,11 +2296,11 @@ ConfigureText( || (textPtr->selTagPtr->selFgColor != NULL) || (textPtr->selTagPtr->fgStipple != None) || (textPtr->selTagPtr->overstrikeString != NULL) - || (textPtr->selTagPtr->overstrikeColor != NULL) + || (textPtr->selTagPtr->overstrikeColor != NULL) || (textPtr->selTagPtr->underlineString != NULL) || (textPtr->selTagPtr->underlineColor != NULL) - || (textPtr->selTagPtr->lMarginColor != NULL) - || (textPtr->selTagPtr->rMarginColor != NULL)) { + || (textPtr->selTagPtr->lMarginColor != NULL) + || (textPtr->selTagPtr->rMarginColor != NULL)) { textPtr->selTagPtr->affectsDisplay = 1; } TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, 1); @@ -2424,7 +2424,7 @@ TextWorldChanged( textPtr->charHeight = 1; } if (textPtr->charHeight != oldCharHeight) { - TkBTreeClientRangeChanged(textPtr, textPtr->charHeight); + TkBTreeClientRangeChanged(textPtr, textPtr->charHeight); } border = textPtr->borderWidth + textPtr->highlightWidth; Tk_GeometryRequest(textPtr->tkwin, @@ -2884,7 +2884,7 @@ TextPushUndoAction( } if (!canUndo || canRedo) { - GenerateUndoStackEvent(textPtr); + GenerateUndoStackEvent(textPtr); } } @@ -3222,11 +3222,11 @@ DeleteIndexRange( resetView = 1; line = line1; byteIndex = tPtr->topIndex.byteIndex; - } else { - /* - * Deletion range starts after the top line. This peers's view - * will not need to be reset. Nothing to do. - */ + } else { + /* + * Deletion range starts after the top line. This peers's view + * will not need to be reset. Nothing to do. + */ } } else if (index2.linePtr == tPtr->topIndex.linePtr) { /* @@ -3243,11 +3243,11 @@ DeleteIndexRange( } else { byteIndex -= (index2.byteIndex - index1.byteIndex); } - } else { - /* - * Deletion range ends before the top line. This peers's view - * will not need to be reset. Nothing to do. - */ + } else { + /* + * Deletion range ends before the top line. This peers's view + * will not need to be reset. Nothing to do. + */ } if (resetView) { lineAndByteIndex[resetViewCount] = line; @@ -3292,43 +3292,43 @@ DeleteIndexRange( TkTextIndex indexTmp; if (tPtr == textPtr) { - if (viewUpdate) { - /* - * line cannot be before -startline of textPtr because - * this line corresponds to an index which is necessarily - * between "1.0" and "end" relative to textPtr. - * Therefore no need to clamp line to the -start/-end - * range. - */ + if (viewUpdate) { + /* + * line cannot be before -startline of textPtr because + * this line corresponds to an index which is necessarily + * between "1.0" and "end" relative to textPtr. + * Therefore no need to clamp line to the -start/-end + * range. + */ TkTextMakeByteIndex(sharedTextPtr->tree, textPtr, line, byteIndex, &indexTmp); TkTextSetYView(tPtr, &indexTmp, 0); } } else { - TkTextMakeByteIndex(sharedTextPtr->tree, tPtr, line, + TkTextMakeByteIndex(sharedTextPtr->tree, tPtr, line, byteIndex, &indexTmp); - /* - * line may be before -startline of tPtr and must be - * clamped to -startline before providing it to - * TkTextSetYView otherwise lines before -startline - * would be displayed. - * There is no need to worry about -endline however, - * because the view will only be reset if the deletion - * involves the TOP line of the screen - */ - - if (tPtr->start != NULL) { - int start; - TkTextIndex indexStart; - - start = TkBTreeLinesTo(NULL, tPtr->start); - TkTextMakeByteIndex(sharedTextPtr->tree, NULL, start, + /* + * line may be before -startline of tPtr and must be + * clamped to -startline before providing it to + * TkTextSetYView otherwise lines before -startline + * would be displayed. + * There is no need to worry about -endline however, + * because the view will only be reset if the deletion + * involves the TOP line of the screen + */ + + if (tPtr->start != NULL) { + int start; + TkTextIndex indexStart; + + start = TkBTreeLinesTo(NULL, tPtr->start); + TkTextMakeByteIndex(sharedTextPtr->tree, NULL, start, 0, &indexStart); - if (TkTextIndexCmp(&indexTmp, &indexStart) < 0) { - indexTmp = indexStart; - } - } + if (TkTextIndexCmp(&indexTmp, &indexStart) < 0) { + indexTmp = indexStart; + } + } TkTextSetYView(tPtr, &indexTmp, 0); } } @@ -5183,7 +5183,7 @@ TextEditCmd( static const char *const editOptionStrings[] = { "canundo", "canredo", "modified", "redo", "reset", "separator", - "undo", NULL + "undo", NULL }; enum editOptions { EDIT_CANUNDO, EDIT_CANREDO, EDIT_MODIFIED, EDIT_REDO, EDIT_RESET, @@ -5202,25 +5202,25 @@ TextEditCmd( switch ((enum editOptions) index) { case EDIT_CANREDO: - if (objc != 3) { - Tcl_WrongNumArgs(interp, 3, objv, NULL); - return TCL_ERROR; - } - if (textPtr->sharedTextPtr->undo) { - canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); - } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canRedo)); - break; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (textPtr->sharedTextPtr->undo) { + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canRedo)); + break; case EDIT_CANUNDO: - if (objc != 3) { - Tcl_WrongNumArgs(interp, 3, objv, NULL); - return TCL_ERROR; - } - if (textPtr->sharedTextPtr->undo) { - canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); - } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canUndo)); - break; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (textPtr->sharedTextPtr->undo) { + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canUndo)); + break; case EDIT_MODIFIED: if (objc == 3) { Tcl_SetObjResult(interp, @@ -5254,38 +5254,38 @@ TextEditCmd( */ if ((!oldModified) != (!setModified)) { - GenerateModifiedEvent(textPtr); + GenerateModifiedEvent(textPtr); } break; case EDIT_REDO: - if (objc != 3) { + if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); - if (TextEditRedo(textPtr, rangesObj)) { + if (TextEditRedo(textPtr, rangesObj)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1)); Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL); return TCL_ERROR; } else { Tcl_SetObjResult(interp, rangesObj); } - canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); - if (!canUndo || !canRedo) { - GenerateUndoStackEvent(textPtr); - } + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + if (!canUndo || !canRedo) { + GenerateUndoStackEvent(textPtr); + } break; case EDIT_RESET: if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } - canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); - canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); TkUndoClearStacks(textPtr->sharedTextPtr->undoStack); - if (canUndo || canRedo) { - GenerateUndoStackEvent(textPtr); - } + if (canUndo || canRedo) { + GenerateUndoStackEvent(textPtr); + } break; case EDIT_SEPARATOR: if (objc != 3) { @@ -5295,11 +5295,11 @@ TextEditCmd( TkUndoInsertUndoSeparator(textPtr->sharedTextPtr->undoStack); break; case EDIT_UNDO: - if (objc != 3) { + if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } - canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); if (TextEditUndo(textPtr, rangesObj)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1)); Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL); @@ -5307,10 +5307,10 @@ TextEditCmd( } else { Tcl_SetObjResult(interp, rangesObj); } - canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); - if (!canRedo || !canUndo) { - GenerateUndoStackEvent(textPtr); - } + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + if (!canRedo || !canUndo) { + GenerateUndoStackEvent(textPtr); + } break; } return TCL_OK; @@ -5405,8 +5405,8 @@ TextGetText( * * Send an event that the text was modified. This is equivalent to: * event generate $textWidget <<Modified>> - * for all peers of $textWidget. -* + * for all peers of $textWidget. + * * Results: * None * @@ -5421,9 +5421,9 @@ GenerateModifiedEvent( TkText *textPtr) /* Information about text widget. */ { for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL; - textPtr = textPtr->next) { - Tk_MakeWindowExist(textPtr->tkwin); - TkSendVirtualEvent(textPtr->tkwin, "Modified", NULL); + textPtr = textPtr->next) { + Tk_MakeWindowExist(textPtr->tkwin); + TkSendVirtualEvent(textPtr->tkwin, "Modified", NULL); } } @@ -5451,9 +5451,9 @@ GenerateUndoStackEvent( TkText *textPtr) /* Information about text widget. */ { for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL; - textPtr = textPtr->next) { - Tk_MakeWindowExist(textPtr->tkwin); - TkSendVirtualEvent(textPtr->tkwin, "UndoStack", NULL); + textPtr = textPtr->next) { + Tk_MakeWindowExist(textPtr->tkwin); + TkSendVirtualEvent(textPtr->tkwin, "UndoStack", NULL); } } @@ -5508,7 +5508,7 @@ UpdateDirtyFlag( } if (sharedTextPtr->isDirty == 0 || oldDirtyFlag == 0) { - GenerateModifiedEvent(sharedTextPtr->peers); + GenerateModifiedEvent(sharedTextPtr->peers); } } @@ -5537,21 +5537,21 @@ RunAfterSyncCmd( int code; if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { - /* - * The widget has been deleted. Don't do anything. - */ + /* + * The widget has been deleted. Don't do anything. + */ - if (--textPtr->refCount == 0) { - ckfree((char *) textPtr); - } - return; + if (--textPtr->refCount == 0) { + ckfree((char *) textPtr); + } + return; } Tcl_Preserve((ClientData) textPtr->interp); code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); if (code == TCL_ERROR) { - Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); - Tcl_BackgroundError(textPtr->interp); + Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); + Tcl_BackgroundError(textPtr->interp); } Tcl_Release((ClientData) textPtr->interp); Tcl_DecrRefCount(textPtr->afterSyncCmd); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index b5cbbab..7afb031 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -54,12 +54,6 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * The Mutex below is used to lock access to the Tk_Uid structs above. - */ - -TCL_DECLARE_MUTEX(windowMutex) - -/* * Default values for "changes" and "atts" fields of TkWindows. Note that Tk * always requests all events for all windows, except StructureNotify events * on internal windows: these events are generated internally. @@ -206,40 +200,6 @@ static const TkCmd commands[] = { }; /* - * The variables and table below are used to parse arguments from the "argv" - * variable in Tk_Init. - */ - -static int synchronize = 0; -static char *name = NULL; -static char *display = NULL; -static char *geometry = NULL; -static char *colormap = NULL; -static char *use = NULL; -static char *visual = NULL; -static int rest = 0; - -static const Tk_ArgvInfo argTable[] = { - {"-colormap", TK_ARGV_STRING, NULL, (char *) &colormap, - "Colormap for main window"}, - {"-display", TK_ARGV_STRING, NULL, (char *) &display, - "Display to use"}, - {"-geometry", TK_ARGV_STRING, NULL, (char *) &geometry, - "Initial geometry for window"}, - {"-name", TK_ARGV_STRING, NULL, (char *) &name, - "Name to use for application"}, - {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, - "Use synchronous mode for display server"}, - {"-visual", TK_ARGV_STRING, NULL, (char *) &visual, - "Visual for main window"}, - {"-use", TK_ARGV_STRING, NULL, (char *) &use, - "Id of window in which to embed application"}, - {"--", TK_ARGV_REST, (char *) 1, (char *) &rest, - "Pass all remaining arguments through to script"}, - {NULL, TK_ARGV_END, NULL, NULL, NULL} -}; - -/* * Forward declarations to functions defined later in this file: */ @@ -3028,16 +2988,51 @@ MODULE_SCOPE const TkStubs tkStubs; */ static int +CopyValue( + ClientData dummy, + Tcl_Obj *objPtr, + void *dstPtr) +{ + *(Tcl_Obj **)dstPtr = objPtr; + return 1; +} + +static int Initialize( Tcl_Interp *interp) /* Interpreter to initialize. */ { - char *p; - int argc, code; - const char **argv; - const char *args[20]; - const char *argString = NULL; - Tcl_DString class; + int code = TCL_OK; ThreadSpecificData *tsdPtr; + Tcl_Obj *value = NULL; + Tcl_Obj *cmd; + + Tcl_Obj *nameObj = NULL; + Tcl_Obj *classObj = NULL; + Tcl_Obj *displayObj = NULL; + Tcl_Obj *colorMapObj = NULL; + Tcl_Obj *useObj = NULL; + Tcl_Obj *visualObj = NULL; + Tcl_Obj *geometryObj = NULL; + + int sync = 0; + + const Tcl_ArgvInfo table[] = { + {TCL_ARGV_CONSTANT, "-sync", INT2PTR(1), &sync, + "Use synchronous mode for display server", NULL}, + {TCL_ARGV_FUNC, "-colormap", CopyValue, &colorMapObj, + "Colormap for main window", NULL}, + {TCL_ARGV_FUNC, "-display", CopyValue, &displayObj, + "Display to use", NULL}, + {TCL_ARGV_FUNC, "-geometry", CopyValue, &geometryObj, + "Initial geometry for window", NULL}, + {TCL_ARGV_FUNC, "-name", CopyValue, &nameObj, + "Name to use for application", NULL}, + {TCL_ARGV_FUNC, "-visual", CopyValue, &visualObj, + "Visual for main window", NULL}, + {TCL_ARGV_FUNC, "-use", CopyValue, &useObj, + "Id of window in which to embed application", NULL}, + TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END + }; /* * Ensure that we are getting a compatible version of Tcl. @@ -3056,23 +3051,6 @@ Initialize( tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* - * Start by initializing all the static variables to default acceptable - * values so that no information is leaked from a previous run of this - * code. - */ - - Tcl_MutexLock(&windowMutex); - synchronize = 0; - name = NULL; - display = NULL; - geometry = NULL; - colormap = NULL; - use = NULL; - visual = NULL; - rest = 0; - argv = NULL; - - /* * We start by resetting the result because it might not be clean. */ @@ -3084,8 +3062,6 @@ Initialize( * master. */ - Tcl_DString ds; - /* * Step 1 : find the master and construct the interp name (could be a * function if new APIs were ok). We could also construct the path @@ -3095,18 +3071,13 @@ Initialize( Tcl_Interp *master = interp; - while (1) { + while (Tcl_IsSafe(master)) { master = Tcl_GetMaster(master); if (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; - } - if (!Tcl_IsSafe(master)) { - /* Found the trusted master. */ - break; + return TCL_ERROR; } } @@ -3116,39 +3087,30 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "error in Tcl_GetInterpPath", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); - goto done; + Tcl_Panic("Tcl_GetInterpPath broken!"); } /* - * Build the string to eval. + * Build the command to eval in trusted master. */ - Tcl_DStringInit(&ds); - Tcl_DStringAppendElement(&ds, "::safe::TkInit"); - Tcl_DStringAppendElement(&ds, Tcl_GetString(Tcl_GetObjResult(master))); - + cmd = Tcl_NewListObj(2, NULL); + Tcl_ListObjAppendElement(NULL, cmd, + Tcl_NewStringObj("::safe::TkInit", -1)); + Tcl_ListObjAppendElement(NULL, cmd, Tcl_GetObjResult(master)); + /* * Step 2 : Eval in the master. The argument is the *reversed* interp * path of the slave. */ - code = Tcl_EvalEx(master, Tcl_DStringValue(&ds), -1, 0); + Tcl_IncrRefCount(cmd); + code = Tcl_EvalObjEx(master, cmd, 0); + Tcl_DecrRefCount(cmd); + Tcl_TransferResult(master, code, interp); if (code != TCL_OK) { - /* - * We might want to transfer the error message or not. We don't. - * (No API to do it and maybe security reasons). - */ - - Tcl_DStringFree(&ds); - 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; + return code; } - Tcl_DStringFree(&ds); /* * Use the master's result as argv. Note: We don't use the Obj @@ -3156,7 +3118,7 @@ Initialize( * changing the code below. */ - argString = Tcl_GetString(Tcl_GetObjResult(master)); + value = Tcl_GetObjResult(interp); } else { /* * If there is an "argv" variable, get its value, extract out relevant @@ -3164,50 +3126,67 @@ Initialize( * that we used. */ - argString = Tcl_GetVar2(interp, "argv", NULL, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); } - if (argString != NULL) { - char buffer[TCL_INTEGER_SPACE]; - if (Tcl_SplitList(interp, argString, &argc, &argv) != TCL_OK) { - argError: + if (value) { + int objc; + Tcl_Obj **objv, **rest; + Tcl_Obj *parseList = Tcl_NewListObj(1, NULL); + + Tcl_ListObjAppendElement(NULL, parseList, Tcl_NewObj()); + + Tcl_IncrRefCount(value); + if (TCL_OK != Tcl_ListObjAppendList(interp, parseList, value) || + TCL_OK != Tcl_ListObjGetElements(NULL, parseList, &objc, &objv) || + TCL_OK != Tcl_ParseArgsObjv(interp, table, &objc, objv, &rest)) { Tcl_AddErrorInfo(interp, "\n (processing arguments in argv variable)"); code = TCL_ERROR; - goto done; } - if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, - argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS) - != TCL_OK) { - goto argError; + if (code == TCL_OK) { + Tcl_SetVar2Ex(interp, "argv", NULL, + Tcl_NewListObj(objc-1, rest+1), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "argc", NULL, + Tcl_NewIntObj(objc-1), TCL_GLOBAL_ONLY); + ckfree(rest); + } + Tcl_DecrRefCount(parseList); + if (code != TCL_OK) { + goto done; } - p = Tcl_Merge(argc, argv); - Tcl_SetVar2(interp, "argv", NULL, p, TCL_GLOBAL_ONLY); - sprintf(buffer, "%d", argc); - Tcl_SetVar2(interp, "argc", NULL, buffer, TCL_GLOBAL_ONLY); - ckfree(p); } /* * Figure out the application's name and class. */ - Tcl_DStringInit(&class); - if (name == NULL) { - int offset; + /* + * If we got no -name argument, fetch from TkpGetAppName(). + */ - TkpGetAppName(interp, &class); - offset = Tcl_DStringLength(&class)+1; - Tcl_DStringSetLength(&class, offset); - Tcl_DStringAppend(&class, Tcl_DStringValue(&class), offset-1); - name = Tcl_DStringValue(&class) + offset; - } else { - Tcl_DStringAppend(&class, name, -1); + if (nameObj == NULL) { + Tcl_DString nameDS; + + Tcl_DStringInit(&nameDS); + TkpGetAppName(interp, &nameDS); + nameObj = Tcl_NewStringObj(Tcl_DStringValue(&nameDS), + Tcl_DStringLength(&nameDS)); + Tcl_DStringFree(&nameDS); } - p = Tcl_DStringValue(&class); - if (*p) { - Tcl_UtfToTitle(p); + /* + * The -class argument is always the ToTitle of the -name + */ + + { + int numBytes; + const char *bytes = Tcl_GetStringFromObj(nameObj, &numBytes); + + classObj = Tcl_NewStringObj(bytes, numBytes); + + numBytes = Tcl_UtfToTitle(Tcl_GetString(classObj)); + Tcl_SetObjLength(classObj, numBytes); } /* @@ -3215,15 +3194,14 @@ Initialize( * information parsed from argv, if any. */ - args[0] = "toplevel"; - args[1] = "."; - args[2] = "-class"; - args[3] = Tcl_DStringValue(&class); - argc = 4; - if (display != NULL) { - args[argc] = "-screen"; - args[argc+1] = display; - argc += 2; + cmd = Tcl_NewStringObj("toplevel . -class", -1); + + Tcl_ListObjAppendElement(NULL, cmd, classObj); + classObj = NULL; + + if (displayObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-screen", -1)); + Tcl_ListObjAppendElement(NULL, cmd, displayObj); /* * If this is the first application for this process, save the display @@ -3232,36 +3210,35 @@ Initialize( */ if (tsdPtr->numMainWindows == 0) { - Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "env", "DISPLAY", displayObj, TCL_GLOBAL_ONLY); } + displayObj = NULL; } - if (colormap != NULL) { - args[argc] = "-colormap"; - args[argc+1] = colormap; - argc += 2; - colormap = NULL; + if (colorMapObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-colormap", -1)); + Tcl_ListObjAppendElement(NULL, cmd, colorMapObj); + colorMapObj = NULL; } - if (use != NULL) { - args[argc] = "-use"; - args[argc+1] = use; - argc += 2; - use = NULL; + if (useObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-use", -1)); + Tcl_ListObjAppendElement(NULL, cmd, useObj); + useObj = NULL; } - if (visual != NULL) { - args[argc] = "-visual"; - args[argc+1] = visual; - argc += 2; - visual = NULL; + if (visualObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-visual", -1)); + Tcl_ListObjAppendElement(NULL, cmd, visualObj); + visualObj = NULL; } - args[argc] = NULL; - code = TkCreateFrame(NULL, interp, argc, args, 1, name); - Tcl_DStringFree(&class); + code = TkListCreateFrame(NULL, interp, cmd, 1, nameObj); + + Tcl_DecrRefCount(cmd); + if (code != TCL_OK) { goto done; } Tcl_ResetResult(interp); - if (synchronize) { + if (sync) { XSynchronize(Tk_Display(Tk_MainWindow(interp)), True); } @@ -3270,19 +3247,19 @@ Initialize( * geometry into the "geometry" variable. */ - if (geometry != NULL) { - Tcl_DString buf; + if (geometryObj) { + + Tcl_SetVar2Ex(interp, "geometry", NULL, geometryObj, TCL_GLOBAL_ONLY); - Tcl_SetVar2(interp, "geometry", NULL, geometry, TCL_GLOBAL_ONLY); - Tcl_DStringInit(&buf); - Tcl_DStringAppend(&buf, "wm geometry . ", -1); - Tcl_DStringAppend(&buf, geometry, -1); - code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); - Tcl_DStringFree(&buf); + cmd = Tcl_NewStringObj("wm geometry .", -1); + Tcl_ListObjAppendElement(NULL, cmd, geometryObj); + Tcl_IncrRefCount(cmd); + code = Tcl_EvalObjEx(interp, cmd, 0); + Tcl_DecrRefCount(cmd); + geometryObj = NULL; if (code != TCL_OK) { goto done; } - geometry = NULL; } /* @@ -3319,10 +3296,6 @@ Initialize( * console window interpreter. */ - Tcl_MutexUnlock(&windowMutex); - if (argv != NULL) { - ckfree(argv); - } code = TkpInit(interp); if (code == TCL_OK) { @@ -3355,12 +3328,10 @@ tkInit", -1, 0); TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr); } - return code; - done: - Tcl_MutexUnlock(&windowMutex); - if (argv != NULL) { - ckfree(argv); + if (value) { + Tcl_DecrRefCount(value); + value = NULL; } return code; } diff --git a/tests/safe.test b/tests/safe.test index e7ed6c7..69a67ba 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -187,7 +187,7 @@ test safe-5.1 {loading Tk in safe interps without master's clearance} -body { interp eval $i {load {} Tk} } -cleanup { safe::interpDelete $i -} -returnCodes error -result {not allowed to start Tk by master's safe::TkInit} +} -returnCodes error -result {not allowed} test safe-5.2 {multi-level Tk loading with clearance} -setup { set safeParent [safe::interpCreate] } -body { |