diff options
author | Kevin Walzer <kw@codebykevin.com> | 2021-05-04 01:49:16 (GMT) |
---|---|---|
committer | Kevin Walzer <kw@codebykevin.com> | 2021-05-04 01:49:16 (GMT) |
commit | 249d4d6a55951db95a5ad1ebc5c936de7ceebb79 (patch) | |
tree | 7ff298b2e13b71df2df2ce0d4d903dcee53da22a | |
parent | 2a68d36c72614dce510f0e4eec0f8d86ff63f9d9 (diff) | |
parent | b7f7761103b50f503f235dc961feb6f1b0697648 (diff) | |
download | tk-249d4d6a55951db95a5ad1ebc5c936de7ceebb79.zip tk-249d4d6a55951db95a5ad1ebc5c936de7ceebb79.tar.gz tk-249d4d6a55951db95a5ad1ebc5c936de7ceebb79.tar.bz2 |
Merge trunk
54 files changed, 1057 insertions, 531 deletions
diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index b5198e0..191d477 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -89,18 +89,18 @@ jobs: cd /tmp/dist echo "VERSION=`ls -d tk* | sed 's/tk//'`" >> $GITHUB_ENV - name: Upload Source Distribution - if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} + if: ${{ env.BUILD_CONFIG_ID == 'gcc-no' }} uses: actions/upload-artifact@v2 with: - name: Tk ${{ env.VERSION }} Source distribution (unofficial) + name: Tk ${{ env.VERSION }} Source distribution (snapshot) path: | /tmp/dist/tk* !/tmp/dist/tk*/html/** - name: Upload Documentation Distribution - if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} + if: ${{ env.BUILD_CONFIG_ID == 'gcc-no' }} uses: actions/upload-artifact@v2 with: - name: Tk ${{ env.VERSION }} HTML documentation (unofficial) + name: Tk ${{ env.VERSION }} HTML documentation (snapshot) path: /tmp/dist/tk*/html test: runs-on: ubuntu-20.04 diff --git a/.github/workflows/linux-with-tcl8-build.yml b/.github/workflows/linux-with-tcl8-build.yml index 4e56b64..0ceae80 100644 --- a/.github/workflows/linux-with-tcl8-build.yml +++ b/.github/workflows/linux-with-tcl8-build.yml @@ -105,7 +105,7 @@ jobs: if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} uses: actions/upload-artifact@v2 with: - name: Tk ${{ env.VERSION }} Source distribution (unofficial) + name: Tk ${{ env.VERSION }} Source distribution (snapshot) path: | /tmp/dist/tk* !/tmp/dist/tk*/html/** @@ -113,7 +113,7 @@ jobs: if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} uses: actions/upload-artifact@v2 with: - name: Tk ${{ env.VERSION }} HTML documentation (unofficial) + name: Tk ${{ env.VERSION }} HTML documentation (snapshot) path: /tmp/dist/tk*/html test: runs-on: ubuntu-20.04 diff --git a/.github/workflows/linux-with-tcl9-build.yml b/.github/workflows/linux-with-tcl9-build.yml index 5335708..3ae4b28 100644 --- a/.github/workflows/linux-with-tcl9-build.yml +++ b/.github/workflows/linux-with-tcl9-build.yml @@ -101,20 +101,6 @@ jobs: run: | cd /tmp/dist echo "VERSION=`ls -d tk* | sed 's/tk//'`" >> $GITHUB_ENV - - name: Upload Source Distribution - if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} - uses: actions/upload-artifact@v2 - with: - name: Tk ${{ env.VERSION }} Source distribution (unofficial) - path: | - /tmp/dist/tk* - !/tmp/dist/tk*/html/** - - name: Upload Documentation Distribution - if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} - uses: actions/upload-artifact@v2 - with: - name: Tk ${{ env.VERSION }} HTML documentation (unofficial) - path: /tmp/dist/tk*/html test: runs-on: ubuntu-20.04 strategy: diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 2454aea..7ff914f 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -54,16 +54,16 @@ jobs: tar -cf ${BUILD_NAME}.tar ${BUILD_NAME} working-directory: ${{ env.INST_DIR }} env: - BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_unofficial + BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_snapshot - name: Upload uses: actions/upload-artifact@v2 with: - name: Wish ${{ env.TCL_PATCHLEVEL }} Linux single-file build (unofficial) + name: Wish ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot) path: ${{ env.INST_DIR }}/*.tar - name: Describe Installation Zip Contents if: ${{ always() }} run: | - unzip -l wish${{ env.TCL_PATCHLEVEL }}_unofficial || true + unzip -l wish${{ env.TCL_PATCHLEVEL }}_snapshot || true working-directory: ${{ env.INST_DIR }} macos: name: macOS @@ -135,18 +135,18 @@ jobs: to mark the executable as runnable on your machine. EOF $CREATE_DMG \ - --volname "TclTk $TCL_PATCHLEVEL (unofficial)" \ + --volname "TclTk $TCL_PATCHLEVEL (snapshot)" \ --window-pos 200 120 \ --window-size 800 400 \ - "TclTk-$TCL_PATCHLEVEL-(unofficial).dmg" \ + "TclTk-$TCL_PATCHLEVEL-(snapshot).dmg" \ "contents/" working-directory: ${{ env.INST_DIR }} env: - BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_unofficial + BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_snapshot - name: Upload uses: actions/upload-artifact@v2 with: - name: Wish ${{ env.TCL_PATCHLEVEL }} macOS single-file build (unofficial) + name: Wish ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot) path: ${{ env.INST_DIR }}/*.dmg win: name: Windows @@ -202,9 +202,9 @@ jobs: cp ${TK_BIN} combined/${BUILD_NAME}.exe working-directory: install env: - BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_unofficial + BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_snapshot - name: Upload uses: actions/upload-artifact@v2 with: - name: Wish ${{ env.TCL_PATCHLEVEL }} Windows single-file build (unofficial) - path: install/combined/wish${{ env.TCL_PATCHLEVEL }}_unofficial.exe + name: Wish ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot) + path: install/combined/wish${{ env.TCL_PATCHLEVEL }}_snapshot.exe @@ -2033,7 +2033,7 @@ In the descriptions below, is dependent on the value of the \fBtcl_wordchars\fR variable. See \fBtclvars\fR(n). .IP [1] -Clicking mouse button 1 positions the insertion cursor just before the +Clicking mouse button 1 positions the insertion cursor at the closest edge of the character underneath the mouse cursor, sets the input focus to this widget, and clears any selection in the widget. Dragging with mouse button 1 strokes out a selection between the insertion cursor and the character under the diff --git a/generic/tkImgPhInstance.c b/generic/tkImgPhInstance.c index d8244de..2f6b288 100644 --- a/generic/tkImgPhInstance.c +++ b/generic/tkImgPhInstance.c @@ -38,7 +38,7 @@ extern int _XInitImageFuncPtrs(XImage *image); * Forward declarations */ -#ifndef TKPUTIMAGE_CAN_BLEND +#ifndef TK_CAN_RENDER_RGBA static void BlendComplexAlpha(XImage *bgImg, PhotoInstance *iPtr, int xOffset, int yOffset, int width, int height); #endif @@ -416,7 +416,7 @@ TkImgPhotoGet( * *---------------------------------------------------------------------- */ -#ifndef TKPUTIMAGE_CAN_BLEND +#ifndef TK_CAN_RENDER_RGBA #ifndef _WIN32 #define GetRValue(rgb) (UCHAR(((rgb) & red_mask) >> red_shift)) #define GetGValue(rgb) (UCHAR(((rgb) & green_mask) >> green_shift)) @@ -582,7 +582,7 @@ BlendComplexAlpha( } #undef ALPHA_BLEND } -#endif /* TKPUTIMAGE_CAN_BLEND */ +#endif /* TK_CAN_RENDER_RGBA */ /* *---------------------------------------------------------------------- @@ -614,7 +614,7 @@ TkImgPhotoDisplay( * to imageX and imageY. */ { PhotoInstance *instancePtr = (PhotoInstance *)clientData; -#ifndef TKPUTIMAGE_CAN_BLEND +#ifndef TK_CAN_RENDER_RGBA XVisualInfo visInfo = instancePtr->visualInfo; #endif @@ -627,9 +627,10 @@ TkImgPhotoDisplay( return; } -#ifdef TKPUTIMAGE_CAN_BLEND +#ifdef TK_CAN_RENDER_RGBA + /* - * If TkPutImage can handle RGBA Ximages directly there is + * We can use TkpPutRGBAImage to render RGBA Ximages directly so there is * no need to call XGetImage or to do the Porter-Duff compositing by hand. */ @@ -638,11 +639,12 @@ TkImgPhotoDisplay( (unsigned int)instancePtr->width, (unsigned int)instancePtr->height, 0, (unsigned int)(4 * instancePtr->width)); - TkPutImage(NULL, 0, display, drawable, instancePtr->gc, + TkpPutRGBAImage(display, drawable, instancePtr->gc, photo, imageX, imageY, drawableX, drawableY, (unsigned int) width, (unsigned int) height); photo->data = NULL; XDestroyImage(photo); + #else if ((instancePtr->modelPtr->flags & COMPLEX_ALPHA) diff --git a/generic/tkInt.h b/generic/tkInt.h index c171bf0..5b777c6 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -123,6 +123,17 @@ # endif #endif +/* + * Fallback in case Tk is linked against a Tcl version not having TIP #585 + * (TCL_INDEX_TEMP_TABLE flag). This allows to use the internal + * INDEX_TEMP_TABLE flag of Tcl. However this is rather ugly and not robust + * since nothing prevents Tcl from changing the value of its internal flags! + */ + +#if !defined(TCL_INDEX_TEMP_TABLE) +# define TCL_INDEX_TEMP_TABLE 2 +#endif + #ifndef TCL_Z_MODIFIER # if defined(_WIN64) # define TCL_Z_MODIFIER "I" diff --git a/generic/tkObj.c b/generic/tkObj.c index b848822..618281d 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -250,8 +250,8 @@ TkGetIntForIndex( } #if TCL_MAJOR_VERSION < 9 if ((*indexPtr < -1) || (end < -1)) { - return TCL_ERROR; - } + *indexPtr = TCL_INDEX_NONE; + } else #endif if ((*indexPtr + 1) > (end + 1)) { *indexPtr = end + 1; diff --git a/generic/tkText.c b/generic/tkText.c index 09a110d..74f6730 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -3346,7 +3346,7 @@ DeleteIndexRange( TkTextSetYView(tPtr, &indexTmp, 0); } } else { - TkTextMakeByteIndex(sharedTextPtr->tree, tPtr, line, + TkTextMakeByteIndex(sharedTextPtr->tree, NULL, line, byteIndex, &indexTmp); /* * line may be before -startline of tPtr and must be @@ -3355,20 +3355,12 @@ DeleteIndexRange( * 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 + * involves the TOP line of the screen. That said, + * the following call adjusts to both. */ - if (tPtr->start != NULL) { - int start; - TkTextIndex indexStart; + TkTextIndexAdjustToStartEnd(tPtr, &indexTmp, 0); - start = TkBTreeLinesTo(NULL, tPtr->start); - TkTextMakeByteIndex(sharedTextPtr->tree, NULL, start, - 0, &indexStart); - if (TkTextIndexCmp(&indexTmp, &indexStart) < 0) { - indexTmp = indexStart; - } - } TkTextSetYView(tPtr, &indexTmp, 0); } } diff --git a/generic/tkText.h b/generic/tkText.h index e9e6303..faa6014 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -1170,6 +1170,8 @@ MODULE_SCOPE int TkTextYviewCmd(TkText *textPtr, Tcl_Interp *interp, MODULE_SCOPE void TkTextWinFreeClient(Tcl_HashEntry *hPtr, TkTextEmbWindowClient *client); MODULE_SCOPE void TkTextRunAfterSyncCmd(ClientData clientData); +MODULE_SCOPE int TkTextIndexAdjustToStartEnd(TkText *textPtr, + TkTextIndex *indexPtr, int err); #endif /* _TKTEXT */ /* diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c index f242328..5988db7 100644 --- a/generic/tkTextBTree.c +++ b/generic/tkTextBTree.c @@ -1727,6 +1727,26 @@ TkBTreeFindPixelLine( } pixels -= linePtr->pixels[2 * pixelReference]; } + + /* + * Check for any start/end offset for this text widget. + */ + + if (textPtr->start != NULL) { + int lineBoundary = TkBTreeLinesTo(NULL, textPtr->start); + + if (TkBTreeLinesTo(NULL, linePtr) < lineBoundary) { + linePtr = TkBTreeFindLine(tree, NULL, lineBoundary); + } + } + if (textPtr->end != NULL) { + int lineBoundary = TkBTreeLinesTo(NULL, textPtr->end); + + if (TkBTreeLinesTo(NULL, linePtr) > lineBoundary) { + linePtr = TkBTreeFindLine(tree, NULL, lineBoundary); + } + } + if (pixelOffset != NULL && linePtr != NULL) { *pixelOffset = pixels; } diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index aeb5681..fdf1c43 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -769,9 +769,9 @@ EmbImageBboxProc( * index corresponding to the image's position in the text. * * Results: - * The return value is 1 if there is an embedded image by the given name - * in the text widget, 0 otherwise. If the image exists, *indexPtr is - * filled in with its index. + * The return value is TCL_OK if there is an embedded image by the given + * name in the text widget, TCL_ERROR otherwise. If the image exists, + * *indexPtr is filled in with its index. * * Side effects: * None. @@ -789,18 +789,29 @@ TkTextImageIndex( TkTextSegment *eiPtr; if (textPtr == NULL) { - return 0; + return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->imageTable, name); if (hPtr == NULL) { - return 0; + return TCL_ERROR; } eiPtr = (TkTextSegment *)Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->sharedTextPtr->tree; indexPtr->linePtr = eiPtr->body.ei.linePtr; indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr); - return 1; + + /* + * If indexPtr refers to somewhere outside the -startline/-endline + * range limits of the widget, error out since the image indeed is not + * reachable from this text widget (it may be reachable from a peer). + */ + + if (TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 1) == TCL_ERROR) { + return TCL_ERROR; + } + + return TCL_OK; } /* diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index ade889b..bd93258 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -761,11 +761,11 @@ GetIndex( goto done; } - if (TkTextWindowIndex(textPtr, string, indexPtr) != 0) { + if (TkTextWindowIndex(textPtr, string, indexPtr) == TCL_OK) { goto done; } - if (TkTextImageIndex(textPtr, string, indexPtr) != 0) { + if (TkTextImageIndex(textPtr, string, indexPtr) == TCL_OK) { goto done; } @@ -917,7 +917,7 @@ GetIndex( *endOfBase = 0; result = TkTextWindowIndex(textPtr, Tcl_DStringValue(©), indexPtr); *endOfBase = c; - if (result != 0) { + if (result == TCL_OK) { goto gotBase; } } @@ -954,7 +954,7 @@ GetIndex( *endOfBase = 0; result = TkTextImageIndex(textPtr, Tcl_DStringValue(©), indexPtr); *endOfBase = c; - if (result != 0) { + if (result == TCL_OK) { goto gotBase; } } @@ -997,6 +997,7 @@ GetIndex( if (indexPtr->linePtr == NULL) { Tcl_Panic("Bad index created"); } + TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 0); return TCL_OK; error: @@ -1009,6 +1010,67 @@ GetIndex( /* *--------------------------------------------------------------------------- * + * TkTextIndexAdjustToStartEnd -- + * + * Adjust indexPtr to the -startline/-endline range, or just check + * if indexPtr is out of this range. + * + * Results: + * The return value is a standard Tcl return result. If check is true, + * return TCL_ERROR if indexPtr is outside the -startline/-endline + * range (indexPtr is not modified). + * If check is false, adjust indexPtr to -startline/-endline. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TkTextIndexAdjustToStartEnd( + TkText *textPtr, + TkTextIndex *indexPtr, /* Pointer to index. */ + int check) /* 1 means only check indexPtr against + * the -startline/-endline range + * 0 means adjust to this range */ +{ + int bound; + TkTextIndex indexBound; + + if (!textPtr) { + return TCL_OK; + } + if (textPtr->start != NULL) { + bound = TkBTreeLinesTo(NULL, textPtr->start); + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + &indexBound); + if (TkTextIndexCmp(indexPtr, &indexBound) < 0) { + if (check) { + return TCL_ERROR; + } + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + indexPtr); + } + } + if (textPtr->end != NULL) { + bound = TkBTreeLinesTo(NULL, textPtr->end); + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + &indexBound); + if (TkTextIndexCmp(indexPtr, &indexBound) > 0) { + if (check) { + return TCL_ERROR; + } + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + indexPtr); + } + } + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * * TkTextPrintIndex -- * * This function generates a string description of an index, suitable for diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 5d4b5d5..9efa222 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -434,8 +434,6 @@ TkTextMarkNameToIndex( TkTextIndex *indexPtr) /* Index information gets stored here. */ { TkTextSegment *segPtr; - TkTextIndex index; - int start, end; if (textPtr == NULL) { return TCL_ERROR; @@ -456,28 +454,17 @@ TkTextMarkNameToIndex( } TkTextMarkSegToIndex(textPtr, segPtr, indexPtr); - /* If indexPtr refers to somewhere outside the -startline/-endline + /* + * If indexPtr refers to somewhere outside the -startline/-endline * range limits of the widget, error out since the mark indeed is not * reachable from this text widget (it may be reachable from a peer) * (bug 1630271). */ - if (textPtr->start != NULL) { - start = TkBTreeLinesTo(NULL, textPtr->start); - TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, start, 0, - &index); - if (TkTextIndexCmp(indexPtr, &index) < 0) { - return TCL_ERROR; - } - } - if (textPtr->end != NULL) { - end = TkBTreeLinesTo(NULL, textPtr->end); - TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, end, 0, - &index); - if (TkTextIndexCmp(indexPtr, &index) > 0) { - return TCL_ERROR; - } + if (TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 1) == TCL_ERROR) { + return TCL_ERROR; } + return TCL_OK; } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index adf1ad5..d63ad32 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -1320,9 +1320,9 @@ EmbWinDelayedUnmap( * index corresponding to the window's position in the text. * * Results: - * The return value is 1 if there is an embedded window by the given name - * in the text widget, 0 otherwise. If the window exists, *indexPtr is - * filled in with its index. + * The return value is TCL_OK if there is an embedded window by the given + * name in the text widget, TCL_ERROR otherwise. If the window exists, + * *indexPtr is filled in with its index. * * Side effects: * None. @@ -1340,19 +1340,30 @@ TkTextWindowIndex( TkTextSegment *ewPtr; if (textPtr == NULL) { - return 0; + return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->windowTable, name); if (hPtr == NULL) { - return 0; + return TCL_ERROR; } ewPtr = (TkTextSegment *)Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->sharedTextPtr->tree; indexPtr->linePtr = ewPtr->body.ew.linePtr; indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr); - return 1; + + /* + * If indexPtr refers to somewhere outside the -startline/-endline + * range limits of the widget, error out since the window indeed is not + * reachable from this text widget (it may be reachable from a peer). + */ + + if (TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 1) == TCL_ERROR) { + return TCL_ERROR; + } + + return TCL_OK; } /* diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index cc6c6af..36e613e 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -1393,7 +1393,9 @@ EntryIndex( const char *string; if (TCL_OK == TkGetIntForIndex(indexObj, entryPtr->entry.numChars - 1, 1, &idx)) { - if ((idx != TCL_INDEX_NONE) && (idx > entryPtr->entry.numChars)) { + if (idx == TCL_INDEX_NONE) { + idx = 0; + } else if (idx > entryPtr->entry.numChars) { idx = entryPtr->entry.numChars; } *indexPtr = idx; diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index 9896021..876423f 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -44,8 +44,7 @@ namespace eval ttk::theme::aqua { # Entry ttk::style configure TEntry \ -foreground systemTextColor \ - -background systemTextBackgroundColor \ - -fieldbackground systemTextBackgroundColor + -background systemTextBackgroundColor ttk::style map TEntry \ -foreground { disabled systemDisabledControlTextColor @@ -66,8 +65,7 @@ namespace eval ttk::theme::aqua { # Spinbox ttk::style configure TSpinbox \ -foreground systemTextColor \ - -background systemTextBackgroundColor \ - -fieldbackground systemTextBackgroundColor + -background systemTextBackgroundColor ttk::style map TSpinbox \ -foreground { disabled systemDisabledControlTextColor diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index b38925d..d258118 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -74,7 +74,7 @@ #define DEF_BUTTON_HEIGHT "0" #define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR #define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO -#define DEF_BUTTON_HIGHLIGHT "systemButtonFrame" +#define DEF_BUTTON_HIGHLIGHT NORMAL_FG #define DEF_LABEL_HIGHLIGHT_WIDTH "0" //#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS //#define DEF_BUTTON_HIGHLIGHT_WIDTH "4" @@ -123,7 +123,7 @@ #define DEF_CANVAS_CURSOR "" #define DEF_CANVAS_HEIGHT "7c" #define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG -#define DEF_CANVAS_HIGHLIGHT BLACK +#define DEF_CANVAS_HIGHLIGHT NORMAL_FG #define DEF_CANVAS_HIGHLIGHT_WIDTH "3" #define DEF_CANVAS_INSERT_BG BLACK #define DEF_CANVAS_INSERT_BD_COLOR "0" @@ -173,7 +173,7 @@ #define DEF_ENTRY_FONT "TkTextFont" #define DEF_ENTRY_FG NORMAL_FG #define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG -#define DEF_ENTRY_HIGHLIGHT BLACK +#define DEF_ENTRY_HIGHLIGHT NORMAL_FG #define DEF_ENTRY_HIGHLIGHT_WIDTH "3" #define DEF_ENTRY_INSERT_BG NORMAL_FG #define DEF_ENTRY_INSERT_BD_COLOR "0" @@ -215,7 +215,7 @@ #define DEF_FRAME_CURSOR "" #define DEF_FRAME_HEIGHT "0" #define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG -#define DEF_FRAME_HIGHLIGHT BLACK +#define DEF_FRAME_HIGHLIGHT NORMAL_FG #define DEF_FRAME_HIGHLIGHT_WIDTH "0" #define DEF_FRAME_PADX "0" #define DEF_FRAME_PADY "0" @@ -251,7 +251,7 @@ #define DEF_LISTBOX_FG NORMAL_FG #define DEF_LISTBOX_HEIGHT "10" #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG -#define DEF_LISTBOX_HIGHLIGHT BLACK +#define DEF_LISTBOX_HIGHLIGHT NORMAL_FG #define DEF_LISTBOX_HIGHLIGHT_WIDTH "0" #define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_RELIEF "solid" @@ -346,7 +346,7 @@ #define DEF_MENUBUTTON_HEIGHT "0" #define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR #define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO -#define DEF_MENUBUTTON_HIGHLIGHT NORMAL_BG +#define DEF_MENUBUTTON_HIGHLIGHT NORMAL_FG #define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0" #define DEF_MENUBUTTON_IMAGE NULL #define DEF_MENUBUTTON_INDICATOR "1" @@ -375,7 +375,7 @@ #define DEF_MESSAGE_FG NORMAL_FG #define DEF_MESSAGE_FONT "TkDefaultFont" #define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG -#define DEF_MESSAGE_HIGHLIGHT BLACK +#define DEF_MESSAGE_HIGHLIGHT NORMAL_FG #define DEF_MESSAGE_HIGHLIGHT_WIDTH "0" #define DEF_MESSAGE_JUSTIFY "left" #define DEF_MESSAGE_PADX "-1" @@ -441,7 +441,7 @@ #define DEF_SCALE_FROM "0" #define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR #define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO -#define DEF_SCALE_HIGHLIGHT BLACK +#define DEF_SCALE_HIGHLIGHT NORMAL_FG #define DEF_SCALE_HIGHLIGHT_WIDTH "0" #define DEF_SCALE_LABEL "" #define DEF_SCALE_LENGTH "100" @@ -476,7 +476,7 @@ #define DEF_SCROLLBAR_CURSOR "" #define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1" #define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG -#define DEF_SCROLLBAR_HIGHLIGHT BLACK +#define DEF_SCROLLBAR_HIGHLIGHT NORMAL_FG #define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "0" #define DEF_SCROLLBAR_JUMP "0" #define DEF_SCROLLBAR_ORIENT "vertical" diff --git a/macosx/tkMacOSXDraw.c b/macosx/tkMacOSXDraw.c index 37c6097..9f6966a 100644 --- a/macosx/tkMacOSXDraw.c +++ b/macosx/tkMacOSXDraw.c @@ -27,6 +27,7 @@ #ifdef TK_MAC_DEBUG #define TK_MAC_DEBUG_DRAWING #define TK_MAC_DEBUG_IMAGE_DRAWING +#define TK_MAC_DEBUG_CG #endif */ @@ -513,7 +514,7 @@ XDrawSegments( * * XFillPolygon -- * - * Draws a filled polygon. + * Draws a filled polygon using the even-odd fill algorithm, * * Results: * None. @@ -531,7 +532,7 @@ XFillPolygon( GC gc, /* Use this GC. */ XPoint *points, /* Array of points. */ int npoints, /* Number of points. */ - TCL_UNUSED(int), /* Shape to draw. */ + TCL_UNUSED(int), /* Shape to draw. */ int mode) /* Drawing mode. */ { MacDrawable *macWin = (MacDrawable *)d; @@ -1242,6 +1243,12 @@ TkMacOSXSetupDrawingContext( Bool canDraw = true; TKContentView *view = nil; TkMacOSXDrawingContext dc = {}; + CGFloat drawingHeight; + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "TkMacOSXSetupDrawingContext: %s\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None"); +#endif /* * If the drawable is not a pixmap, get the associated NSView. @@ -1273,14 +1280,10 @@ TkMacOSXSetupDrawingContext( */ dc.context = TkMacOSXGetCGContextForDrawable(d); - if (dc.context) { - dc.portBounds = CGContextGetClipBoundingBox(dc.context); - } else { + if (!dc.context) { NSRect drawingBounds, currentBounds; - dc.view = view; dc.context = GET_CGCONTEXT; - dc.portBounds = NSRectToCGRect([view bounds]); if (dc.clipRgn) { CGRect clipBounds; CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, @@ -1332,37 +1335,67 @@ TkMacOSXSetupDrawingContext( * Finish configuring the drawing context. */ - { +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "TkMacOSXSetupDrawingContext: pushing GState for %s\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None"); +#endif + + CGContextSaveGState(dc.context); + CGContextSetTextDrawingMode(dc.context, kCGTextFill); + { /* Restricted scope for t needed for C++ */ + drawingHeight = view ? [view bounds].size.height : + CGContextGetClipBoundingBox(dc.context).size.height; CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, - .ty = dc.portBounds.size.height + .ty = drawingHeight }; - - dc.portBounds.origin.x += macDraw->xOff; - dc.portBounds.origin.y += macDraw->yOff; - CGContextSaveGState(dc.context); - CGContextSetTextDrawingMode(dc.context, kCGTextFill); CGContextConcatCTM(dc.context, t); - if (dc.clipRgn) { + } + if (dc.clipRgn) { #ifdef TK_MAC_DEBUG_DRAWING - CGContextSaveGState(dc.context); - ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); - CGContextSetRGBFillColor(dc.context, 1.0, 0.0, 0.0, 0.1); - CGContextEOFillPath(dc.context); - CGContextRestoreGState(dc.context); + CGContextSaveGState(dc.context); + ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); + CGContextSetRGBFillColor(dc.context, 1.0, 0.0, 0.0, 0.1); + CGContextEOFillPath(dc.context); + CGContextRestoreGState(dc.context); #endif /* TK_MAC_DEBUG_DRAWING */ + if (!HIShapeIsRectangular(dc.clipRgn)) { + + /* + * We expect the clipping path dc.clipRgn to consist of the + * bounding rectangle of the drawable window, together with + * disjoint smaller rectangles inside of it which bound its + * geometric children. In that case the even-odd rule will + * clip to the region inside the large rectangle and outside + * of the smaller rectangles. + */ + + ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "Setting complex clip for %s to:\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None"); + TkMacOSXPrintRectsInRegion(dc.clipRgn); +#endif + + CGContextEOClip(dc.context); + } else { CGRect r; - CGRect b = CGRectApplyAffineTransform( - CGContextGetClipBoundingBox(dc.context), t); - if (!HIShapeIsRectangular(dc.clipRgn) || - !CGRectContainsRect(*HIShapeGetBounds(dc.clipRgn, &r), b)) { - ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); - CGContextEOClip(dc.context); - } + HIShapeGetBounds(dc.clipRgn, &r); + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "Current clip BBox is %s\n", + NSStringFromRect(CGContextGetClipBoundingBox(GET_CGCONTEXT)).UTF8String); + fprintf(stderr, "Setting clip for %s to rect %s:\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None", + NSStringFromRect(r).UTF8String); +#endif + + CGContextClipToRect(dc.context, r); } } if (gc) { @@ -1382,8 +1415,8 @@ TkMacOSXSetupDrawingContext( TkMacOSXSetColorInContext(gc, gc->foreground, dc.context); if (view) { - CGContextSetPatternPhase(dc.context, CGSizeMake( - dc.portBounds.size.width, dc.portBounds.size.height)); + CGSize size = NSSizeToCGSize([view bounds].size); + CGContextSetPatternPhase(dc.context, size); } if (gc->function != GXcopy) { TkMacOSXDbgMsg("Logical functions other than GXcopy are " @@ -1423,13 +1456,9 @@ TkMacOSXSetupDrawingContext( end: #ifdef TK_MAC_DEBUG_DRAWING - if (!canDraw && win != NULL) { - TkWindow *winPtr = TkMacOSXGetTkWindow(win); - - if (winPtr) { - fprintf(stderr, "Cannot draw in %s - postponing.\n", - Tk_PathName(winPtr)); - } + if (!canDraw && macDraw->winPtr != NULL) { + fprintf(stderr, "Cannot draw in %s - postponing.\n", + Tk_PathName(macDraw->winPtr)); } #endif @@ -1464,13 +1493,21 @@ TkMacOSXRestoreDrawingContext( if (dcPtr->context) { CGContextSynchronize(dcPtr->context); CGContextRestoreGState(dcPtr->context); + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "TkMacOSXRestoreDrawingContext: popped GState\n"); +#endif + } if (dcPtr->clipRgn) { CFRelease(dcPtr->clipRgn); + dcPtr->clipRgn = NULL; } + #ifdef TK_MAC_DEBUG bzero(dcPtr, sizeof(TkMacOSXDrawingContext)); -#endif /* TK_MAC_DEBUG */ +#endif + } /* diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 00a0b9e..496dc35 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -1209,16 +1209,18 @@ TkpDrawAngledCharsInContext( TkSetMacColor(gc->foreground, &fg); attributes = [fontPtr->nsAttributes mutableCopy]; [attributes setObject:(id)fg forKey:(id)kCTForegroundColorAttributeName]; + CFRelease(fg); nsFont = [attributes objectForKey:NSFontAttributeName]; [nsFont setInContext:GET_NSCONTEXT(context, NO)]; CGContextSetTextMatrix(context, CGAffineTransformIdentity); attributedString = [[NSAttributedString alloc] initWithString:string attributes:attributes]; + [string release]; typesetter = CTTypesetterCreateWithAttributedString( (CFAttributedStringRef)attributedString); textX += (CGFloat) macWin->xOff; textY += (CGFloat) macWin->yOff; - height = drawingContext.portBounds.size.height; + height = [drawingContext.view bounds].size.height; textY = height - textY; t = CGAffineTransformMake(1.0, 0.0, 0.0, -1.0, 0.0, height); if (angle != 0.0) { @@ -1250,7 +1252,6 @@ TkpDrawAngledCharsInContext( CFRelease(line); CFRelease(typesetter); [attributedString release]; - [string release]; [attributes release]; TkMacOSXRestoreDrawingContext(&drawingContext); } diff --git a/macosx/tkMacOSXImage.c b/macosx/tkMacOSXImage.c index 47e3b70..3ea9bd7 100644 --- a/macosx/tkMacOSXImage.c +++ b/macosx/tkMacOSXImage.c @@ -55,7 +55,8 @@ static void ReleaseData( CGImageRef TkMacOSXCreateCGImageWithXImage( - XImage *image) + XImage *image, + uint32 alphaInfo) { CGImageRef img = NULL; size_t bitsPerComponent, bitsPerPixel; @@ -98,6 +99,7 @@ TkMacOSXCreateCGImageWithXImage( provider, decode, 0); } } else if ((image->format == ZPixmap) && (image->bits_per_pixel == 32)) { + /* * Color image */ @@ -105,6 +107,7 @@ TkMacOSXCreateCGImageWithXImage( CGColorSpaceRef colorspace = CGColorSpaceCreateDeviceRGB(); if (image->width == 0 && image->height == 0) { + /* * CGCreateImage complains on early macOS releases. */ @@ -115,7 +118,7 @@ TkMacOSXCreateCGImageWithXImage( bitsPerPixel = 32; bitmapInfo = (image->byte_order == MSBFirst ? kCGBitmapByteOrder32Little : kCGBitmapByteOrder32Big); - bitmapInfo |= kCGImageAlphaLast; + bitmapInfo |= alphaInfo; data = (char *)memcpy(ckalloc(len), image->data + image->xoffset, len); if (data) { provider = CGDataProviderCreateWithData(data, data, len, @@ -392,14 +395,26 @@ XCreateImage( /* *---------------------------------------------------------------------- * - * XPutImage -- + * TkPutImage, XPutImage, TkpPutRGBAImage -- + * + * These functions, which all have the same signature, copy a rectangular + * subimage of an XImage into a drawable. TkPutImage is an alias for + * XPutImage, which assumes that the XImage data has the structure of a + * 32bpp ZPixmap in which the image data is an array of 32bit integers + * packed with 8 bit values for the Red Green and Blue channels. The + * fourth byte is ignored. The function TkpPutRGBAImage assumes that the + * XImage data has been extended by using the fourth byte to store an + * 8-bit Alpha value. (The Alpha data is assumed not to pre-multiplied). + * The image is then drawn into the drawable using standard Porter-Duff + * Source Atop Composition (kCGBlendModeSourceAtop in Apple's Core + * Graphics). * - * Copies a rectangular subimage of an XImage into a drawable. Currently - * this is only called by TkImgPhotoDisplay, using a Window as the - * drawable. + * The TkpPutRGBAfunction is used by TkImgPhotoDisplay to render photo + * images if the compile-time variable TK_CAN_RENDER_RGBA is defined in + * a platform's tkXXXXPort.h header, as is the case for the macOS Aqua port. * * Results: - * None. + * These functions always return Success. * * Side effects: * Draws the image on the specified drawable. @@ -407,8 +422,14 @@ XCreateImage( *---------------------------------------------------------------------- */ -int -XPutImage( +#define PIXEL_RGBA kCGImageAlphaLast +#define PIXEL_ARGB kCGImageAlphaFirst +#define PIXEL_XRGB kCGImageAlphaNoneSkipFirst +#define PIXEL_RGBX kCGImageAlphaNoneSkipLast + +static int +TkMacOSXPutImage( + uint32_t pixelFormat, Display* display, /* Display. */ Drawable drawable, /* Drawable to place image on. */ GC gc, /* GC to use. */ @@ -429,7 +450,7 @@ XPutImage( } if (dc.context) { CGRect bounds, srcRect, dstRect; - CGImageRef img = TkMacOSXCreateCGImageWithXImage(image); + CGImageRef img = TkMacOSXCreateCGImageWithXImage(image, pixelFormat); /* * The CGContext for a pixmap is RGB only, with A = 0. @@ -456,6 +477,24 @@ XPutImage( TkMacOSXRestoreDrawingContext(&dc); return Success; } + +int XPutImage(Display* display, Drawable drawable, GC gc, XImage* image, + int src_x, int src_y, int dest_x, int dest_y, + unsigned int width, unsigned int height) +{ + return TkMacOSXPutImage(PIXEL_RGBX, display, drawable, gc, image, + src_x, src_y, dest_x, dest_y, width, height); +} + +int TkpPutRGBAImage(Display* display, + Drawable drawable, GC gc, XImage* image, + int src_x, int src_y, int dest_x, int dest_y, + unsigned int width, unsigned int height) +{ + return TkMacOSXPutImage(PIXEL_RGBA, display, drawable, gc, image, + src_x, src_y, dest_x, dest_y, width, height); +} + /* *---------------------------------------------------------------------- @@ -515,51 +554,42 @@ CreateCGImageFromDrawableRect( { MacDrawable *mac_drawable = (MacDrawable *)drawable; CGContextRef cg_context = NULL; + CGRect image_rect = CGRectMake(x, y, width, height); CGImageRef cg_image = NULL, result = NULL; - NSBitmapImageRep *bitmapRep = nil; - NSView *view = nil; + unsigned char *imageData = NULL; if (mac_drawable->flags & TK_IS_PIXMAP) { - /* - * This MacDrawable is a bitmap, so its view is NULL. - */ - - CGRect image_rect = CGRectMake(x, y, width, height); - cg_context = TkMacOSXGetCGContextForDrawable(drawable); - cg_image = CGBitmapContextCreateImage((CGContextRef) cg_context); - if (cg_image) { - result = CGImageCreateWithImageInRect(cg_image, image_rect); - CGImageRelease(cg_image); - } - } else if (TkMacOSXGetNSViewForDrawable(mac_drawable) != nil) { - - /* - * Convert Tk top-left to NSView bottom-left coordinates. - */ - - int view_height = [view bounds].size.height; - NSRect view_rect = NSMakeRect(x + mac_drawable->xOff, - view_height - height - y - mac_drawable->yOff, - width, height); - - /* - * Attempt to copy from the view to a bitmapImageRep. If the view does - * not have a valid CGContext, doing this will silently corrupt memory - * and make a big mess. So, in that case, we just return NULL. - */ - - if (view == [NSView focusView]) { - bitmapRep = [view bitmapImageRepForCachingDisplayInRect: view_rect]; - [view cacheDisplayInRect:view_rect toBitmapImageRep:bitmapRep]; - result = [bitmapRep CGImage]; - CFRelease(bitmapRep); - } else { - TkMacOSXDbgMsg("No CGContext - cannot copy from screen to bitmap."); - result = NULL; + if (cg_context) { + cg_image = CGBitmapContextCreateImage((CGContextRef) cg_context); } } else { - TkMacOSXDbgMsg("Invalid source drawable"); + NSView *view = TkMacOSXGetNSViewForDrawable(mac_drawable); + if (view == nil) { + TkMacOSXDbgMsg("Invalid source drawable"); + return NULL; + } + NSSize size = view.frame.size; + NSUInteger view_width = size.width, view_height = size.height; + NSUInteger bytesPerPixel = 4, + bytesPerRow = bytesPerPixel * view_width, + bitsPerComponent = 8; + imageData = ckalloc(view_height * bytesPerRow); + CGColorSpaceRef colorSpace = CGColorSpaceCreateDeviceRGB(); + cg_context = CGBitmapContextCreate(imageData, view_width, view_height, + bitsPerComponent, bytesPerRow, colorSpace, + kCGImageAlphaPremultipliedLast | kCGBitmapByteOrder32Big); + CFRelease(colorSpace); + [view.layer renderInContext:cg_context]; + } + if (cg_context) { + cg_image = CGBitmapContextCreateImage(cg_context); + CGContextRelease(cg_context); + } + if (cg_image) { + result = CGImageCreateWithImageInRect(cg_image, image_rect); + CGImageRelease(cg_image); } + ckfree(imageData); return result; } @@ -663,11 +693,11 @@ XGetImage( || bytes_per_row < 4 * width || size != bytes_per_row * height) { TkMacOSXDbgMsg("XGetImage: Unrecognized bitmap format"); - CFRelease(bitmapRep); + [bitmapRep release]; return NULL; } memcpy(bitmap, (char *)[bitmapRep bitmapData], size); - CFRelease(bitmapRep); + [bitmapRep release]; /* * When Apple extracts a bitmap from an NSView, it may be in either diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c index 86e3ba7..14d305f 100644 --- a/macosx/tkMacOSXKeyEvent.c +++ b/macosx/tkMacOSXKeyEvent.c @@ -72,6 +72,18 @@ static NSUInteger textInputModifiers; } /* + * Discard repeating KeyDown events if the repeat speed has been set to + * "off" in System Preferences. It is unclear why we get these, but we do. + * See ticket [2ecb09d118]. + */ + + if ([theEvent type] == NSKeyDown && + [theEvent isARepeat] && + [NSEvent keyRepeatDelay] < 0) { + return theEvent; + } + + /* * If a local grab is in effect, key events for windows in the * grabber's application are redirected to the grabber. Key events * for other applications are delivered normally. If a global @@ -262,7 +274,6 @@ static NSUInteger textInputModifiers; */ if (type == NSKeyDown && [theEvent isARepeat]) { - xEvent.xany.type = KeyRelease; Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); xEvent.xany.type = KeyPress; diff --git a/macosx/tkMacOSXNotify.c b/macosx/tkMacOSXNotify.c index 1e78521..bc30949 100644 --- a/macosx/tkMacOSXNotify.c +++ b/macosx/tkMacOSXNotify.c @@ -343,8 +343,9 @@ TkMacOSXNotifyExitHandler( * for all views that need display before it returns. We call it with * deQueue=NO so that it will not change anything on the AppKit event * queue, because we only want the side effect that it runs drawRect. The - * only time when any NSViews have the needsDisplay property set to YES - * is during execution of this function. + * only times when any NSViews have the needsDisplay property set to YES + * are during execution of this function or in the addDirtyRect method + * of TKContentView. * * The reason for running this function as an idle task is to try to * arrange that all widgets will be fully configured before they are @@ -380,7 +381,8 @@ TkMacOSXDrawAllViews( if (dirtyCount) { continue; } - [view setNeedsDisplayInRect:[view tkDirtyRect]]; + [[view layer] setNeedsDisplayInRect:[view tkDirtyRect]]; + [view setNeedsDisplay:YES]; } } else { [window displayIfNeeded]; diff --git a/macosx/tkMacOSXPort.h b/macosx/tkMacOSXPort.h index 39744a7..b977610 100644 --- a/macosx/tkMacOSXPort.h +++ b/macosx/tkMacOSXPort.h @@ -129,11 +129,16 @@ #define TK_DYNAMIC_COLORMAP 0x0fffffff /* - * Inform tkImgPhInstance.c that our tkPutImage can render an image with an - * alpha channel directly into a window. + * Inform tkImgPhInstance.c that we implement TkpPutRGBAImage to render RGBA + * images directly into a window. */ -#define TKPUTIMAGE_CAN_BLEND +#define TK_CAN_RENDER_RGBA + +MODULE_SCOPE int TkpPutRGBAImage( + Display* display, Drawable drawable, GC gc,XImage* image, + int src_x, int src_y, int dest_x, int dest_y, + unsigned int width, unsigned int height); /* * Used by xcolor.c diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index c5b42a0..33df1d8 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -29,6 +29,7 @@ #import <ApplicationServices/ApplicationServices.h> #undef Cursor #import <Cocoa/Cocoa.h> +#import <QuartzCore/QuartzCore.h> #ifndef NO_CARBON_H #import <Carbon/Carbon.h> #endif @@ -206,7 +207,6 @@ typedef struct TkMacOSXDrawingContext { CGContextRef context; NSView *view; HIShapeRef clipRgn; - CGRect portBounds; } TkMacOSXDrawingContext; /* @@ -234,7 +234,8 @@ MODULE_SCOPE OSStatus TkMacOSHIShapeUnionWithRect(HIMutableShapeRef inShape, const CGRect *inRect); MODULE_SCOPE OSStatus TkMacOSHIShapeUnion(HIShapeRef inShape1, HIShapeRef inShape2, HIMutableShapeRef outResult); - +MODULE_SCOPE int TkMacOSXCountRectsInRegion(HIShapeRef shape); +MODULE_SCOPE void TkMacOSXPrintRectsInRegion(HIShapeRef shape); /* * Prototypes of TkAqua internal procs. */ diff --git a/macosx/tkMacOSXRegion.c b/macosx/tkMacOSXRegion.c index f78aa79..b44073a 100644 --- a/macosx/tkMacOSXRegion.c +++ b/macosx/tkMacOSXRegion.c @@ -555,6 +555,55 @@ TkMacOSHIShapeUnion( return result; } +static OSStatus +rectCounter( + TCL_UNUSED(int), + TCL_UNUSED(HIShapeRef), + TCL_UNUSED(const CGRect *), + void *ref) +{ + int *count = (int *)ref; + (*count)++; + return noErr; +} + +static OSStatus +rectPrinter( + TCL_UNUSED(int), + TCL_UNUSED(HIShapeRef), + const CGRect *rect, + TCL_UNUSED(void *)) +{ + if (rect) { + fprintf(stderr, " %s\n", NSStringFromRect(*rect).UTF8String); + } + return noErr; +} + +int +TkMacOSXCountRectsInRegion( + HIShapeRef shape) +{ + int rect_count = 0; + if (!HIShapeIsEmpty(shape)) { + ChkErr(HIShapeEnumerate, shape, + kHIShapeParseFromBottom|kHIShapeParseFromLeft, + rectCounter, &rect_count); + } + return rect_count; +} + +void +TkMacOSXPrintRectsInRegion( + HIShapeRef shape) +{ + if (!HIShapeIsEmpty(shape)) { + ChkErr(HIShapeEnumerate, shape, + kHIShapeParseFromBottom|kHIShapeParseFromLeft, + rectPrinter, NULL); + } +} + /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXSubwindows.c b/macosx/tkMacOSXSubwindows.c index 690b9fc..21e346a 100644 --- a/macosx/tkMacOSXSubwindows.c +++ b/macosx/tkMacOSXSubwindows.c @@ -1440,7 +1440,11 @@ Tk_FreePixmap( if (data) { ckfree(data); } - CFRelease(macPix->context); + /* + * Releasing the context here causes a crash in the 8.7 regression + * tests, but not in 8.6. + * CFRelease(macPix->context); + */ } ckfree(macPix); } diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index d6923db..8b24a65 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -915,11 +915,59 @@ ConfigureRestrictProc( @implementation TKContentView(TKWindowEvent) +- (id)initWithFrame:(NSRect)frame +{ + self = [super initWithFrame:frame]; + if (self) { + /* + * The layer must exist before we set wantsLayer to YES. + */ + + self.layer = [CALayer layer]; + self.wantsLayer = YES; + self.layerContentsRedrawPolicy = NSViewLayerContentsRedrawOnSetNeedsDisplay; + self.layer.contentsGravity = self.layer.contentsAreFlipped ? + kCAGravityTopLeft : kCAGravityBottomLeft; + + /* + * Nothing gets drawn at all if the layer does not have a delegate. + * Currently, we do not implement any methods of the delegate, however. + */ + + self.layer.delegate = (id) self; + } + return self; +} + +/* + * We will just use drawRect. + */ + +- (BOOL) wantsUpdateLayer +{ + return NO; +} + +- (void) viewDidChangeBackingProperties +{ + + /* + * Make sure that the layer uses a contentScale that matches the + * backing scale factor of the screen. This avoids blurry text whe + * the view is on a Retina display, as well as incorrect size when + * the view is on a normal display. + */ + + self.layer.contentsScale = self.window.screen.backingScaleFactor; +} + - (void) addTkDirtyRect: (NSRect) rect { _tkNeedsDisplay = YES; _tkDirtyRect = NSUnionRect(_tkDirtyRect, rect); [NSApp setNeedsToDraw:YES]; + [self setNeedsDisplay:YES]; + [[self layer] setNeedsDisplay]; } - (void) clearTkDirtyRect diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index c78bc02..840964e 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -5516,12 +5516,15 @@ Tk_MacOSXGetTkWindow( void *w) { Window window = None; - TkDisplay *dispPtr = TkGetDisplayList(); if ([(NSWindow *)w respondsToSelector: @selector (tkWindow)]) { window = [(TKWindow *)w tkWindow]; } - return (window != None ? - Tk_IdToWindow(dispPtr->display, window) : NULL); + if (window) { + TkDisplay *dispPtr = TkGetDisplayList(); + return Tk_IdToWindow(dispPtr->display, window); + } else { + return NULL; + } } /* @@ -6259,6 +6262,7 @@ TkMacOSXMakeRealWindowExist( Tk_ChangeWindowAttributes((Tk_Window)winPtr, CWOverrideRedirect, &atts); ApplyContainerOverrideChanges(winPtr, NULL); } + [window display]; } /* @@ -6297,8 +6301,7 @@ TkpRedrawWidget(Tk_Window tkwin) { [view bounds].size.height - tkBounds.bottom, tkBounds.right - tkBounds.left, tkBounds.bottom - tkBounds.top); - [view setTkNeedsDisplay:YES]; - [view setTkDirtyRect:bounds]; + [view addTkDirtyRect:bounds]; } } @@ -6431,6 +6434,19 @@ TkpWmSetState( macWin = TkMacOSXGetNSWindowForDrawable(winPtr->window); + /* + * Make sure windows are updated before the state change. As an exception, + * do not process idle tasks before withdrawing a window. The purpose of + * this is to support the common paradigm of immediately withdrawing the + * root window. Processing idle tasks before changing the state causes the + * root to briefly flash on the screen, which users of this paradigm find + * annoying. Not processing the events does not guarantee that the window + * will not appear but makes it more likely. + */ + + if (state != WithdrawnState) { + while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {}; + } if (state == WithdrawnState) { Tk_UnmapWindow((Tk_Window)winPtr); } else if (state == IconicState) { @@ -6451,8 +6467,9 @@ TkpWmSetState( [macWin orderFront:NSApp]; TkMacOSXZoomToplevel(macWin, state == NormalState ? inZoomIn : inZoomOut); } + /* - * Make sure windows are updated after the state change. + * Make sure windows are updated after the state change too. */ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)){} diff --git a/macosx/ttkMacOSXTheme.c b/macosx/ttkMacOSXTheme.c index a1b5bfb..bc96b6b 100644 --- a/macosx/ttkMacOSXTheme.c +++ b/macosx/ttkMacOSXTheme.c @@ -36,10 +36,13 @@ * Macros for handling drawing contexts. */ -#define BEGIN_DRAWING(d) { \ - TkMacOSXDrawingContext dc; \ - if (!TkMacOSXSetupDrawingContext((d), NULL, &dc)) {return;} -#define END_DRAWING \ +#define BEGIN_DRAWING(d) { \ + TkMacOSXDrawingContext dc; \ + if (!TkMacOSXSetupDrawingContext((d), NULL, &dc)) { \ + return; \ + } \ + +#define END_DRAWING \ TkMacOSXRestoreDrawingContext(&dc);} #define HIOrientation kHIThemeOrientationNormal diff --git a/tests/bind.test b/tests/bind.test index c27412d..58d5799 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -45,7 +45,7 @@ toplevel .top wm geometry .top 50x50-50-50 update event generate .top <Button-1> -warp 1 -update +controlPointerWarpTiming destroy .top test bind-1.1 {bind command} -body { @@ -1047,6 +1047,7 @@ test bind-13.45 {Tk_BindEvent procedure: error in script} -setup { test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -1063,6 +1064,7 @@ test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -1474,6 +1476,7 @@ test bind-15.26 {MatchPatterns procedure, reject a virtual event} -setup { test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -1488,6 +1491,7 @@ test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup { test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -1502,6 +1506,7 @@ test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup { test bind-15.29 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -6248,7 +6253,7 @@ test bind-32.1 {-warp, window was destroyed before the idle callback DoWarp} -se update } -body { event generate .t.f <Button-1> -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming event generate .t.f <ButtonRelease-1> destroy .t.f update ; # shall simply not crash @@ -6829,12 +6834,12 @@ test bind-34.1 {-warp works relatively to a window} -setup { wm geometry .top +200+200 after 10 ; update event generate .top <Motion> -x 20 -y 20 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming set pointerPos1 [winfo pointerxy .top] wm geometry .top +600+600 after 10 ; update event generate .top <Motion> -x 20 -y 20 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming set pointerPos2 [winfo pointerxy .top] # from the first warped position to the second one, the mouse # pointer should have moved the same amount as the window moved @@ -6852,10 +6857,10 @@ test bind-34.2 {-warp works relatively to the screen} -setup { } -body { # Contrary to bind-34.1, we're directly checking screen coordinates event generate {} <Motion> -x 20 -y 20 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming set res [winfo pointerxy .] event generate {} <Motion> -x 200 -y 200 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming lappend res {*}[winfo pointerxy .] } -cleanup { } -result {20 20 200 200} @@ -6873,7 +6878,7 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup { set res {} } -body { event generate {} <Motion> -x 0 -y 0 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming foreach dim [winfo pointerxy .] { if {$dim <= $halo} { lappend res ok @@ -6882,9 +6887,9 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup { } } event generate {} <Motion> -x 100 -y 100 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming event generate {} <Motion> -x -1 -y -1 -warp 1 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming foreach dim [winfo pointerxy .] { if {$dim <= $halo} { lappend res ok @@ -7029,7 +7034,7 @@ test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup { test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup { event generate {} <Motion> -warp 1 -x 50 -y 50 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming toplevel .top grab release .top wm geometry .top 200x200+300+300 @@ -7045,13 +7050,13 @@ test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup { } -body { grab .top event generate .top.l <Motion> -warp 1 -x 10 -y 10 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming foreach {x1 y1} [winfo pointerxy .top.l] {} event generate {} <Motion> -warp 1 -x 50 -y 50 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming grab release .top event generate .top.l <Motion> -warp 1 -x 10 -y 10 - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming foreach {x2 y2} [winfo pointerxy .top.l] {} # success if the coords are the same with or without the grab, and if they # are at (10,10) inside the label widget as requested by the warping diff --git a/tests/constraints.tcl b/tests/constraints.tcl index a89605a..66ac1eb 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -172,6 +172,67 @@ namespace eval tk { return $r } + # + # CONTROL TIMING ASPECTS OF POINTER WARPING + # + # The proc [controlPointerWarpTiming] takes care of the following timing + # details of pointer warping: + # + # a. Allow pointer warping to happen if it was scheduled for execution at + # idle time. + # - In Tk releases 8.6 and older, pointer warping is scheduled for + # execution at idle time + # - In release 8.7 and newer this happens synchronously and no extra + # control is needed. + # The namespace variable idle_pointer_warping records which of these is + # the case. + # + # b. Work around a race condition associated with OS notification of + # mouse motion on Windows. + # + # When calling [event generate $w $event -warp 1 ...], the following + # sequence occurs: + # - At some point in the processing of this command, either via a + # synchronous execution path, or asynchronously at idle time, Tk calls + # an OS function* to carry out the mouse cursor motion. + # - Tk has previously registered a callback function** with the OS, for + # the OS to call in order to notify Tk when a mouse move is completed. + # - Tk doesn't wait for the callback function to receive the notification + # from the OS, but continues processing. This suits most use cases + # because (usually) the notification comes quickly enough + # (range: a few ms?). However ... + # - A problem arises if Tk performs some processing, immediately following + # up on [event generate $w $event -warp 1 ...], and that processing + # relies on the mouse pointer having actually moved. If such processing + # happens just before the notification from the OS has been received, + # Tk will be using not yet updated info (e.g. mouse coordinates). + # + # Hickup, choke etc ... ! + # + # * the function SendInput() of the Win32 API + # ** the callback function is TkWinChildProc() + # + # This timing issue can be addressed by putting the Tk process on hold + # (do nothing at all) for a somewhat extended amount of time, while + # letting the OS complete its job in the meantime. This is what is + # accomplished by calling [after ms]. + # + # ---- + # For the history of this issue please refer to Tk ticket [69b48f427e], + # specifically the comment on 2019-10-27 14:24:26. + # + variable idle_pointer_warping [expr {![package vsatisfies [package provide Tk] 8.7-]}] + proc controlPointerWarpTiming {{duration 50}} { + variable idle_pointer_warping + if {$idle_pointer_warping} { + update idletasks ;# see a. above + } + if {[tk windowingsystem] eq "win32"} { + after $duration ;# see b. above + } + } + namespace export controlPointerWarpTiming + } } diff --git a/tests/entry.test b/tests/entry.test index aef509c..d3b7eef 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -47,7 +47,7 @@ set cy [font metrics {Courier -12} -linespace] test entry-1.1 {configuration option: "background" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -background #ff0000 @@ -57,7 +57,7 @@ test entry-1.1 {configuration option: "background" for entry} -setup { } -result {#ff0000} test entry-1.2 {configuration option: "background" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -background non-existent @@ -67,7 +67,7 @@ test entry-1.2 {configuration option: "background" for entry} -setup { test entry-1.3 {configuration option: "bd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bd 4 @@ -77,7 +77,7 @@ test entry-1.3 {configuration option: "bd" for entry} -setup { } -result 4 test entry-1.4 {configuration option: "bd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bd badValue @@ -87,7 +87,7 @@ test entry-1.4 {configuration option: "bd" for entry} -setup { test entry-1.5 {configuration option: "bg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bg #ff0000 @@ -97,7 +97,7 @@ test entry-1.5 {configuration option: "bg" for entry} -setup { } -result {#ff0000} test entry-1.6 {configuration option: "bg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bg non-existent @@ -107,7 +107,7 @@ test entry-1.6 {configuration option: "bg" for entry} -setup { test entry-1.7 {configuration option: "borderwidth" for entry} -setup { entry .e -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -borderwidth 1.3 @@ -117,7 +117,7 @@ test entry-1.7 {configuration option: "borderwidth" for entry} -setup { } -result 1 test entry-1.8 {configuration option: "borderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -borderwidth badValue @@ -127,7 +127,7 @@ test entry-1.8 {configuration option: "borderwidth" for entry} -setup { test entry-1.9 {configuration option: "cursor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -cursor arrow @@ -137,7 +137,7 @@ test entry-1.9 {configuration option: "cursor" for entry} -setup { } -result {arrow} test entry-1.10 {configuration option: "cursor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -cursor badValue @@ -147,7 +147,7 @@ test entry-1.10 {configuration option: "cursor" for entry} -setup { test entry-1.11 {configuration option: "disabledbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledbackground green @@ -157,7 +157,7 @@ test entry-1.11 {configuration option: "disabledbackground" for entry} -setup { } -result {green} test entry-1.12 {configuration option: "disabledbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledbackground non-existent @@ -167,7 +167,7 @@ test entry-1.12 {configuration option: "disabledbackground" for entry} -setup { test entry-1.13 {configuration option: "disabledforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledforeground blue @@ -177,7 +177,7 @@ test entry-1.13 {configuration option: "disabledforeground" for entry} -setup { } -result {blue} test entry-1.14 {configuration option: "disabledforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledforeground non-existent @@ -187,7 +187,7 @@ test entry-1.14 {configuration option: "disabledforeground" for entry} -setup { test entry-1.15 {configuration option: "exportselection" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -exportselection yes @@ -197,7 +197,7 @@ test entry-1.15 {configuration option: "exportselection" for entry} -setup { } -result 1 test entry-1.16 {configuration option: "exportselection" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -exportselection xyzzy @@ -207,7 +207,7 @@ test entry-1.16 {configuration option: "exportselection" for entry} -setup { test entry-1.17 {configuration option: "fg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -fg #110022 @@ -217,7 +217,7 @@ test entry-1.17 {configuration option: "fg" for entry} -setup { } -result {#110022} test entry-1.18 {configuration option: "fg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -fg non-existent @@ -227,7 +227,7 @@ test entry-1.18 {configuration option: "fg" for entry} -setup { test entry-1.19 {configuration option: "font" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e configure -font {Helvetica -12} @@ -237,7 +237,7 @@ test entry-1.19 {configuration option: "font" for entry} -setup { } -result {Helvetica -12} test entry-1.20 {configuration option: "font" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e configure -font {} @@ -247,7 +247,7 @@ test entry-1.20 {configuration option: "font" for entry} -setup { test entry-1.21 {configuration option: "foreground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -foreground #110022 @@ -257,7 +257,7 @@ test entry-1.21 {configuration option: "foreground" for entry} -setup { } -result {#110022} test entry-1.22 {configuration option: "foreground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -foreground non-existent @@ -267,7 +267,7 @@ test entry-1.22 {configuration option: "foreground" for entry} -setup { test entry-1.23 {configuration option: "highlightbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightbackground #110022 @@ -277,7 +277,7 @@ test entry-1.23 {configuration option: "highlightbackground" for entry} -setup { } -result {#110022} test entry-1.24 {configuration option: "highlightbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightbackground non-existent @@ -287,7 +287,7 @@ test entry-1.24 {configuration option: "highlightbackground" for entry} -setup { test entry-1.25 {configuration option: "highlightcolor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightcolor #110022 @@ -297,7 +297,7 @@ test entry-1.25 {configuration option: "highlightcolor" for entry} -setup { } -result {#110022} test entry-1.26 {configuration option: "highlightcolor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightcolor non-existent @@ -307,7 +307,7 @@ test entry-1.26 {configuration option: "highlightcolor" for entry} -setup { test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightthickness 6 @@ -317,7 +317,7 @@ test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { } -result 6 test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightthickness -2 @@ -327,7 +327,7 @@ test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { } -result 0 test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightthickness badValue @@ -337,7 +337,7 @@ test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { test entry-1.30 {configuration option: "insertbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertbackground #110022 @@ -347,7 +347,7 @@ test entry-1.30 {configuration option: "insertbackground" for entry} -setup { } -result {#110022} test entry-1.31 {configuration option: "insertbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertbackground non-existent @@ -357,7 +357,7 @@ test entry-1.31 {configuration option: "insertbackground" for entry} -setup { test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { entry .e -borderwidth 2 -insertwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertborderwidth 1.3 @@ -367,7 +367,7 @@ test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { } -result 1 test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertborderwidth 2.6x @@ -377,7 +377,7 @@ test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { test entry-1.34 {configuration option: "insertofftime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertofftime 100 @@ -387,7 +387,7 @@ test entry-1.34 {configuration option: "insertofftime" for entry} -setup { } -result 100 test entry-1.35 {configuration option: "insertofftime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertofftime 3.2 @@ -397,7 +397,7 @@ test entry-1.35 {configuration option: "insertofftime" for entry} -setup { test entry-1.36 {configuration option: "insertontime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertontime 100 @@ -407,7 +407,7 @@ test entry-1.36 {configuration option: "insertontime" for entry} -setup { } -result 100 test entry-1.37 {configuration option: "insertontime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertontime 3.2 @@ -417,7 +417,7 @@ test entry-1.37 {configuration option: "insertontime" for entry} -setup { test entry-1.38 {configuration option: "invalidcommand" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -invalidcommand "any string" @@ -428,7 +428,7 @@ test entry-1.38 {configuration option: "invalidcommand" for entry} -setup { test entry-1.39 {configuration option: "invcmd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -invcmd "any string" @@ -439,7 +439,7 @@ test entry-1.39 {configuration option: "invcmd" for entry} -setup { test entry-1.40 {configuration option: "justify" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -justify right @@ -449,7 +449,7 @@ test entry-1.40 {configuration option: "justify" for entry} -setup { } -result {right} test entry-1.41 {configuration option: "justify" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -justify bogus @@ -459,7 +459,7 @@ test entry-1.41 {configuration option: "justify" for entry} -setup { test entry-1.42 {configuration option: "readonlybackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -readonlybackground green @@ -469,7 +469,7 @@ test entry-1.42 {configuration option: "readonlybackground" for entry} -setup { } -result {green} test entry-1.43 {configuration option: "readonlybackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -readonlybackground non-existent @@ -479,7 +479,7 @@ test entry-1.43 {configuration option: "readonlybackground" for entry} -setup { test entry-1.44 {configuration option: "relief" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -relief flat @@ -490,7 +490,7 @@ test entry-1.44 {configuration option: "relief" for entry} -setup { test entry-1.45 {configuration option: "selectbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectbackground #110022 @@ -500,7 +500,7 @@ test entry-1.45 {configuration option: "selectbackground" for entry} -setup { } -result {#110022} test entry-1.46 {configuration option: "selectbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectbackground non-existent @@ -510,7 +510,7 @@ test entry-1.46 {configuration option: "selectbackground" for entry} -setup { test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectborderwidth 1.3 @@ -520,7 +520,7 @@ test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { } -result 1 test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectborderwidth badValue @@ -530,7 +530,7 @@ test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { test entry-1.49 {configuration option: "selectforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectforeground #110022 @@ -540,7 +540,7 @@ test entry-1.49 {configuration option: "selectforeground" for entry} -setup { } -result {#110022} test entry-1.50 {configuration option: "selectforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectforeground non-existent @@ -550,7 +550,7 @@ test entry-1.50 {configuration option: "selectforeground" for entry} -setup { test entry-1.51 {configuration option: "show" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -show * @@ -561,7 +561,7 @@ test entry-1.51 {configuration option: "show" for entry} -setup { test entry-1.52 {configuration option: "state" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -state n @@ -571,7 +571,7 @@ test entry-1.52 {configuration option: "state" for entry} -setup { } -result {normal} test entry-1.53 {configuration option: "state" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -state bogus @@ -581,7 +581,7 @@ test entry-1.53 {configuration option: "state" for entry} -setup { test entry-1.54 {configuration option: "takefocus" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -takefocus "any string" @@ -592,7 +592,7 @@ test entry-1.54 {configuration option: "takefocus" for entry} -setup { test entry-1.55 {configuration option: "textvariable" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -textvariable i @@ -603,7 +603,7 @@ test entry-1.55 {configuration option: "textvariable" for entry} -setup { test entry-1.56 {configuration option: "width" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -width 402 @@ -613,7 +613,7 @@ test entry-1.56 {configuration option: "width" for entry} -setup { } -result 402 test entry-1.57 {configuration option: "width" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -width 3p @@ -623,7 +623,7 @@ test entry-1.57 {configuration option: "width" for entry} -setup { test entry-1.58 {configuration option: "xscrollcommand" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -xscrollcommand {Some command} @@ -659,7 +659,7 @@ test entry-2.2 {Tk_EntryCmd procedure} -body { } -returnCodes error -result {bad window path name "gorp"} test entry-2.3 {Tk_EntryCmd procedure} -body { entry .e - pack .e + pack .e ; update idletasks update list [winfo exists .e] [winfo class .e] [info commands .e] } -cleanup { @@ -685,7 +685,7 @@ test entry-2.5 {Tk_EntryCmd procedure} -body { test entry-3.1 {EntryWidgetCmd procedure} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e @@ -694,7 +694,7 @@ test entry-3.1 {EntryWidgetCmd procedure} -setup { } -returnCodes error -result {wrong # args: should be ".e option ?arg ...?"} test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e bbox @@ -703,7 +703,7 @@ test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e bbox index"} test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e bbox a b @@ -712,7 +712,7 @@ test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e bbox index"} test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e bbox bogus @@ -721,7 +721,7 @@ test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { } -returnCodes error -result {bad entry index "bogus"} test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e bbox 0 @@ -736,7 +736,7 @@ test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): no utf chars @@ -749,7 +749,7 @@ test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): utf at end @@ -762,7 +762,7 @@ test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): utf before index @@ -773,7 +773,7 @@ test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { } -result {31 5 7 13} test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): no chars @@ -785,7 +785,7 @@ test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert 0 "abcdefghij乎klmnop" @@ -824,7 +824,7 @@ test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { } -result 4 test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { llength [.e configure] @@ -877,7 +877,7 @@ test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -returnCodes error -result {bad entry index "bar"} test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -897,7 +897,7 @@ test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result 0123457890 test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update set x {} } -body { @@ -918,7 +918,7 @@ test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result [list "01234乎7890" "0123457890" "012345乎890"] test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -929,7 +929,7 @@ test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result 01234567890 test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -942,7 +942,7 @@ test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result 01234567890 test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1006,7 +1006,7 @@ test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} -setup { } -returnCodes error -result {bad entry index "foo"} test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e index 0 @@ -1015,7 +1015,7 @@ test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { } -returnCodes {ok} -match glob -result {*} test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { # UTF @@ -1047,7 +1047,7 @@ test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -returnCodes error -result {bad entry index "foo"} test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1058,7 +1058,7 @@ test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -result {012xxx34567890} test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1071,7 +1071,7 @@ test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -result 01234567890 test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1091,7 +1091,7 @@ test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e insert index text"} test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan a @@ -1100,7 +1100,7 @@ test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan a b c @@ -1109,7 +1109,7 @@ test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan foobar 20 @@ -1118,7 +1118,7 @@ test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -returnCodes error -result {bad scan option "foobar": must be mark or dragto} test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan mark 20.1 @@ -1131,7 +1131,7 @@ test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} -constraints { fonts } -setup { entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long string, in fact a " @@ -1178,7 +1178,7 @@ test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} -setup } -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} test entry-3.50.1 {EntryWidgetCmd procedure, "select clear" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "0123456789" @@ -1201,7 +1201,7 @@ test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} - } -returnCodes error -result {wrong # args: should be ".e selection present"} test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1213,7 +1213,7 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} - } -result 1 test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1226,7 +1226,7 @@ test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} - } -result 1 test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1253,7 +1253,7 @@ test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} -s } -returnCodes error -result {wrong # args: should be ".e selection adjust index"} test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "0123456789" @@ -1267,7 +1267,7 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} -s } -result 123 test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "0123456789" @@ -1314,7 +1314,7 @@ test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} -se } -returnCodes error -result {selection isn't in widget .e} test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1327,7 +1327,7 @@ test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -se } -result {2 9 3} test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1341,7 +1341,7 @@ test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} -setup { } -result {0 10} test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1355,7 +1355,7 @@ test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} -setup { } -result {2 4} test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1367,7 +1367,7 @@ test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} -setu test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1379,7 +1379,7 @@ test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.0537634 0.2688172} test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e xview gorp @@ -1388,7 +1388,7 @@ test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {bad entry index "gorp"} test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1402,7 +1402,7 @@ test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.107527 0.322581} test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e xview moveto foo bar @@ -1411,7 +1411,7 @@ test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e xview moveto fraction"} test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e xview moveto foo @@ -1420,7 +1420,7 @@ test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {expected floating-point number but got "foo"} test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1432,7 +1432,7 @@ test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.505376 0.720430} test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1443,7 +1443,7 @@ test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e xview scroll number pages|units"} test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1454,7 +1454,7 @@ test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {expected floating-point number but got "gorp"} test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1467,7 +1467,7 @@ test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.193548 0.408602} test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1481,7 +1481,7 @@ test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.397849 0.612903} test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1495,7 +1495,7 @@ test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 32 test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1509,7 +1509,7 @@ test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 29 test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1520,7 +1520,7 @@ test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {bad argument "foobars": must be pages or units} test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1531,7 +1531,7 @@ test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {unknown option "eat": must be moveto or scroll} test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1545,7 +1545,7 @@ test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 0 test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1557,7 +1557,7 @@ test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 73 test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1579,7 +1579,7 @@ test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { test entry-3.82 {EntryWidgetCmd procedure} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e gorp @@ -1593,7 +1593,7 @@ test entry-3.82 {EntryWidgetCmd procedure} -setup { test entry-4.1 {DestroyEntry procedure} -body { entry .e -textvariable x -show * - pack .e + pack .e ; update idletasks .e insert end "Sample text" update destroy .e @@ -1648,7 +1648,7 @@ test entry-5.5 {ConfigureEntry procedure} -setup { .e2 insert end "This is some sample text" .e1 configure -exportselection false .e1 insert end "0123456789" - pack .e1 .e2 + pack .e1 .e2 ; update idletasks .e2 select from 0 .e2 select to 10 lappend x [selection get] @@ -1663,7 +1663,7 @@ test entry-5.5 {ConfigureEntry procedure} -setup { } -result {{This is so} {This is so} 1234} test entry-5.6 {ConfigureEntry procedure} -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e insert end "0123456789" .e select from 1 @@ -1675,7 +1675,7 @@ test entry-5.6 {ConfigureEntry procedure} -setup { } -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} test entry-5.6.1 {ConfigureEntry procedure} -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e insert end "0123456789" .e select from 1 @@ -1689,7 +1689,7 @@ test entry-5.6.1 {ConfigureEntry procedure} -setup { test entry-5.7 {ConfigureEntry procedure} -setup { entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -width 4 -xscrollcommand scroll .e insert end "01234567890" @@ -1708,7 +1708,7 @@ test entry-5.8 {ConfigureEntry procedure} -constraints { fonts failsOnXQuarz } -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 0 -font {Helvetica -12} .e insert end "0123" @@ -1723,7 +1723,7 @@ test entry-5.9 {ConfigureEntry procedure} -constraints { fonts } -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised .e insert end "0123" @@ -1736,7 +1736,7 @@ test entry-5.10 {ConfigureEntry procedure} -constraints { fonts } -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief flat .e insert end "0123" @@ -1747,7 +1747,7 @@ test entry-5.10 {ConfigureEntry procedure} -constraints { } -result {0 0 1 1} test entry-5.11 {ConfigureEntry procedure} -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { # If "0" in selected font had 0 width, caused divide-by-zero error. .e configure -font {{open look glyph}} @@ -1763,7 +1763,7 @@ test entry-6.1 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ -highlightthickness 3 @@ -1777,7 +1777,7 @@ test entry-6.2 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ -justify center -highlightthickness 3 @@ -1791,7 +1791,7 @@ test entry-6.3 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ -justify right -highlightthickness 3 @@ -1803,7 +1803,7 @@ test entry-6.3 {EntryComputeGeometry procedure} -constraints { } -result {3 4} test entry-6.4 {EntryComputeGeometry procedure} -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" @@ -1815,7 +1815,7 @@ test entry-6.4 {EntryComputeGeometry procedure} -setup { } -result 6 test entry-6.5 {EntryComputeGeometry procedure} -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" @@ -1829,7 +1829,7 @@ test entry-6.6 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 10 .e insert end "01234\t67890" @@ -1843,7 +1843,7 @@ test entry-6.7 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 .e insert end "01234567" @@ -1856,7 +1856,7 @@ test entry-6.8 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 .e insert end "01234567" @@ -1869,7 +1869,7 @@ test entry-6.9 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 update @@ -1881,7 +1881,7 @@ test entry-6.10 {EntryComputeGeometry procedure} -constraints { unix fonts } -setup { entry .e -highlightthickness 2 -font {Helvetica -12} - pack .e + pack .e ; update idletasks } -body { .e configure -bd 1 -relief raised -width 0 -show . .e insert 0 12345 @@ -1898,7 +1898,7 @@ test entry-6.11 {EntryComputeGeometry procedure} -constraints { win } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -bd 1 -relief raised -width 0 -show . -font {helvetica 12} .e insert 0 12345 @@ -1922,7 +1922,7 @@ test entry-6.12 {EntryComputeGeometry procedure} -constraints { } -setup { catch {destroy .e} entry .e -font {Courier -12} -bd 2 -relief raised -width 20 - pack .e + pack .e ; update idletasks } -body { .e insert end "012\t456\t" update @@ -1935,7 +1935,7 @@ test entry-6.12 {EntryComputeGeometry procedure} -constraints { test entry-7.1 {InsertChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -1952,7 +1952,7 @@ test entry-7.1 {InsertChars procedure} -setup { test entry-7.2 {InsertChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -1967,7 +1967,7 @@ test entry-7.2 {InsertChars procedure} -setup { } -result {abcdeXXX abcdeXXX {0.000000 1.000000}} test entry-7.3 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -1981,7 +1981,7 @@ test entry-7.3 {InsertChars procedure} -setup { } -result {5 9 5 8} test entry-7.4 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -1995,7 +1995,7 @@ test entry-7.4 {InsertChars procedure} -setup { } -result {2 9 2 8} test entry-7.5 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -2009,7 +2009,7 @@ test entry-7.5 {InsertChars procedure} -setup { } -result {2 9 2 8} test entry-7.6 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -2023,7 +2023,7 @@ test entry-7.6 {InsertChars procedure} -setup { } -result {2 6 2 5} test entry-7.7 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -xscrollcommand scroll .e insert 0 0123456789 @@ -2035,7 +2035,7 @@ test entry-7.7 {InsertChars procedure} -setup { } -result 7 test entry-7.8 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e icursor 4 @@ -2046,7 +2046,7 @@ test entry-7.8 {InsertChars procedure} -setup { } -result 4 test entry-7.9 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 "This is a very long string" update @@ -2058,7 +2058,7 @@ test entry-7.9 {InsertChars procedure} -setup { } -result 7 test entry-7.10 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 "This is a very long string" update @@ -2073,7 +2073,7 @@ test entry-7.11 {InsertChars procedure} -constraints { fonts } -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 "xyzzy" update @@ -2086,7 +2086,7 @@ test entry-7.11 {InsertChars procedure} -constraints { test entry-8.1 {DeleteChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -2102,7 +2102,7 @@ test entry-8.1 {DeleteChars procedure} -setup { test entry-8.2 {DeleteChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -2118,7 +2118,7 @@ test entry-8.2 {DeleteChars procedure} -setup { test entry-8.3 {DeleteChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -2133,7 +2133,7 @@ test entry-8.3 {DeleteChars procedure} -setup { } -result {abc abc {0.000000 1.000000}} test entry-8.4 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2149,7 +2149,7 @@ test entry-8.4 {DeleteChars procedure} -setup { } -result {1 6 1 5} test entry-8.5 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2165,7 +2165,7 @@ test entry-8.5 {DeleteChars procedure} -setup { } -result {1 5 1 4} test entry-8.6 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2181,7 +2181,7 @@ test entry-8.6 {DeleteChars procedure} -setup { } -result {1 2 1 5} test entry-8.7 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2195,7 +2195,7 @@ test entry-8.7 {DeleteChars procedure} -setup { } -returnCodes error -result {selection isn't in widget .e} test entry-8.8 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2211,7 +2211,7 @@ test entry-8.8 {DeleteChars procedure} -setup { } -result {3 4 3 8} test entry-8.9 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789abcde .e select from 3 @@ -2224,7 +2224,7 @@ test entry-8.9 {DeleteChars procedure} -setup { } -returnCodes error -result {selection isn't in widget .e} test entry-8.10 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2240,7 +2240,7 @@ test entry-8.10 {DeleteChars procedure} -setup { } -result {3 5 5 8} test entry-8.11 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2256,7 +2256,7 @@ test entry-8.11 {DeleteChars procedure} -setup { } -result {3 8 4 8} test entry-8.12 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2269,7 +2269,7 @@ test entry-8.12 {DeleteChars procedure} -setup { } -result 1 test entry-8.13 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2282,7 +2282,7 @@ test entry-8.13 {DeleteChars procedure} -setup { } -result 1 test entry-8.14 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2295,7 +2295,7 @@ test entry-8.14 {DeleteChars procedure} -setup { } -result 4 test entry-8.15 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "This is a very long string" @@ -2308,7 +2308,7 @@ test entry-8.15 {DeleteChars procedure} -setup { } -result 1 test entry-8.16 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "This is a very long string" @@ -2321,7 +2321,7 @@ test entry-8.16 {DeleteChars procedure} -setup { } -result 1 test entry-8.17 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "This is a very long string" @@ -2334,7 +2334,7 @@ test entry-8.17 {DeleteChars procedure} -setup { } -result 4 test entry-8.18 {DeleteChars procedure} -constraints failsOnUbuntuNoXft -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "xyzzy" @@ -2373,7 +2373,7 @@ test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { set x abcde set y ab entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 - pack .e + pack .e ; update idletasks .e configure -textvariable x .e configure -textvariable y update @@ -2384,7 +2384,7 @@ test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { test entry-10.2 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" @@ -2397,7 +2397,7 @@ test entry-10.2 {EntrySetValue procedure, updating selection} -setup { test entry-10.3 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" @@ -2410,7 +2410,7 @@ test entry-10.3 {EntrySetValue procedure, updating selection} -setup { test entry-10.4 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" @@ -2423,7 +2423,7 @@ test entry-10.4 {EntrySetValue procedure, updating selection} -setup { test entry-10.5 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 10 -font {Courier -12} -textvariable x .e insert 0 "abcdefghjklmnopqrstuvwxyz" @@ -2438,10 +2438,10 @@ test entry-10.5 {EntrySetValue procedure, updating display position} -setup { test entry-10.6 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 10 -font {Courier -12} -textvariable x - pack .e + pack .e ; update idletasks .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update @@ -2454,11 +2454,11 @@ test entry-10.6 {EntrySetValue procedure, updating display position} -setup { test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks update } -body { .e configure -width 10 -font {Courier -12} -textvariable x - pack .e + pack .e ; update idletasks .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" @@ -2469,10 +2469,10 @@ test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 10 -font {Courier -12} -textvariable x - pack .e + pack .e ; update idletasks .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" @@ -2483,7 +2483,7 @@ test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { test entry-11.1 {EntryEventProc procedure} -setup { entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} - pack .e + pack .e ; update idletasks } -body { .e insert 0 abcdefg destroy .e @@ -2515,7 +2515,7 @@ test entry-12.1 {EntryCmdDeletedProc procedure} -body { test entry-13.1 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2532,7 +2532,7 @@ test entry-13.2 {GetEntryIndex procedure} -body { } -returnCodes error -result {bad entry index "abogus"} test entry-13.3 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2545,7 +2545,7 @@ test entry-13.3 {GetEntryIndex procedure} -setup { } -result 1 test entry-13.4 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2558,7 +2558,7 @@ test entry-13.4 {GetEntryIndex procedure} -setup { } -result 4 test entry-13.5 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2579,7 +2579,7 @@ test entry-13.6 {GetEntryIndex procedure} -setup { } -returnCodes error -result {bad entry index "ebogus"} test entry-13.7 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2598,7 +2598,7 @@ test entry-13.8 {GetEntryIndex procedure} -setup { } -returnCodes error -result {bad entry index "ibogus"} test entry-13.9 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2620,7 +2620,7 @@ test entry-13.10 {GetEntryIndex procedure} -constraints x11 -body { # selection range is reset. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2640,7 +2640,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints aquaOrWin32 -body { # entry, the old range will be rehighlighted. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2658,7 +2658,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints aquaOrWin32 -body { test entry-13.12 {GetEntryIndex procedure} -constraints x11 -body { # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2677,7 +2677,7 @@ test entry-13.12 {GetEntryIndex procedure} -constraints x11 -body { test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2694,7 +2694,7 @@ test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { test entry-13.13 {GetEntryIndex procedure} -constraints win -body { # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2714,7 +2714,7 @@ test entry-13.14 {GetEntryIndex procedure} -constraints win -body { # entry, the old range will be rehighlighted. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2734,7 +2734,7 @@ test entry-13.14.1 {GetEntryIndex procedure} -constraints win -body { # entry, the old range will be rehighlighted. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2760,7 +2760,7 @@ test entry-13.15 {GetEntryIndex procedure} -body { test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2771,7 +2771,7 @@ test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2782,7 +2782,7 @@ test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2793,7 +2793,7 @@ test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2804,7 +2804,7 @@ test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2815,7 +2815,7 @@ test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.21 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2825,7 +2825,7 @@ test entry-13.21 {GetEntryIndex procedure} -body { } -result 9 test entry-13.22 {GetEntryIndex procedure} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e index 1xyz @@ -2835,7 +2835,7 @@ test entry-13.22 {GetEntryIndex procedure} -setup { test entry-13.23 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2846,7 +2846,7 @@ test entry-13.23 {GetEntryIndex procedure} -body { test entry-13.24 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2857,7 +2857,7 @@ test entry-13.24 {GetEntryIndex procedure} -body { test entry-13.25 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2870,7 +2870,7 @@ test entry-13.26 {GetEntryIndex procedure} -constraints fonts -body { selection clear .e .e configure -show . .e insert 0 XXXYZZY - pack .e + pack .e ; update idletasks update list [.e index @7] [.e index @8] } -cleanup { @@ -2930,7 +2930,7 @@ test entry-15.1 {EntryLostSelection} -body { # is scrollcommand needed here?? test entry-16.1 {EntryVisibleRange procedure} -constraints fonts -body { entry .e -width 10 -font {Helvetica -12} - pack .e + pack .e ; update idletasks update .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] @@ -2941,7 +2941,7 @@ test entry-16.2 {EntryVisibleRange procedure} -constraints { unix fonts } -body { entry .e -show X -width 10 -font {Helvetica -12} - pack .e + pack .e ; update idletasks update .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] @@ -2952,7 +2952,7 @@ test entry-16.3 {EntryVisibleRange procedure} -constraints { win } -body { entry .e -show . -width 10 -font {Helvetica -12} - pack .e + pack .e ; update idletasks update .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX format {%.6f %.6f} {*}[.e xview] @@ -2969,7 +2969,7 @@ test entry-16.4 {EntryVisibleRange procedure} -body { test entry-17.1 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} - pack .e + pack .e ; update idletasks update idletasks set timeout [after 500 {set scrollInfo {-1000000 -1000000}}] .e delete 0 end @@ -2982,7 +2982,7 @@ test entry-17.1 {EntryUpdateScrollbar procedure} -body { } -result {0.000000 1.000000} test entry-17.2 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} - pack .e + pack .e ; update idletasks set timeout [after 500 {set scrollInfo {-1000000 -1000000}}] .e insert 0 0123456789abcdef .e xview 3 @@ -2994,7 +2994,8 @@ test entry-17.2 {EntryUpdateScrollbar procedure} -body { } -result {0.187500 0.812500} test entry-17.3 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} - pack .e + pack .e ; update idletasks + update idletasks set timeout [after 500 {set scrollInfo {-1000000 -1000000}}] .e insert 0 abcdefghijklmnopqrs .e xview 6 @@ -3011,7 +3012,7 @@ test entry-17.4 {EntryUpdateScrollbar procedure} -setup { } } -body { entry .e -width 5 - pack .e + pack .e ; update idletasks update idletasks .e configure -xscrollcommand thisisnotacommand vwait x @@ -3054,7 +3055,7 @@ test entry-19.1 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a set ::vVals } -cleanup { @@ -3069,7 +3070,7 @@ test entry-19.2 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a ;# previous settings .e insert 1 b return $::vVals @@ -3085,7 +3086,7 @@ test entry-19.3 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 ab ;# previous settings .e insert end c set ::vVals @@ -3101,7 +3102,7 @@ test entry-19.4 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 abc ;# previous settings .e insert 1 123 list $::vVals $::e @@ -3117,7 +3118,7 @@ test entry-19.5 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a123bc ;# previous settings .e delete 2 set ::vVals @@ -3133,7 +3134,7 @@ test entry-19.6 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a13bc ;# previous settings .e configure -validate key .e delete 1 3 @@ -3150,7 +3151,7 @@ test entry-19.7 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abc ;# previous settings set ::vVals {} .e insert end d @@ -3167,7 +3168,7 @@ test entry-19.8 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e configure -validate focus ;# previous settings .e insert end abcd ;# previous settings focus -force .e @@ -3186,7 +3187,7 @@ test entry-19.9 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings focus -force .e ;# previous settings update ;# previous settings @@ -3207,7 +3208,7 @@ test entry-19.10 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings focus -force .e # update necessary to process FocusIn event @@ -3225,7 +3226,7 @@ test entry-19.11 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings focus -force .e ;# previous settings # update necessary to process FocusIn event @@ -3246,7 +3247,7 @@ test entry-19.12 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 abcd ;# previous settings focus -force .e # update necessary to process FocusIn event @@ -3264,7 +3265,7 @@ test entry-19.13 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} focus -force . @@ -3283,7 +3284,7 @@ test entry-19.14 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} ;# previous settings focus -force .e @@ -3302,7 +3303,7 @@ test entry-19.15 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} ;# previous settings focus -force .e ;# previous settings @@ -3325,7 +3326,7 @@ test entry-19.16 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} ;# previous settings focus -force .e ;# previous settings @@ -3348,7 +3349,7 @@ test entry-19.17 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::e newdata list [.e cget -validate] $::vVals @@ -3366,7 +3367,7 @@ test entry-19.18 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks set ::e newdata ;# previous settings .e configure -validate all set ::e nextdata @@ -3386,7 +3387,7 @@ test entry-19.19 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks set ::e nextdata ;# previous settings .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] @@ -3409,7 +3410,7 @@ test entry-19.20 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks set ::e nextdata ;# previous settings .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] ;# prev .e validate ;# previous settings @@ -3432,7 +3433,7 @@ test entry-19.21 {entry widget validation - bug 40e4bf6198} -setup { entry .e -validate key \ -validatecommand [list doval2 %W %d %i %P %s %S %v %V] \ -textvariable ::e - pack .e + pack .e ; update idletasks set ::e origdata .e insert 0 A list [.e cget -validate] [.e get] $::e $::vVals diff --git a/tests/event.test b/tests/event.test index 03405dd..fe23743 100644 --- a/tests/event.test +++ b/tests/event.test @@ -829,8 +829,11 @@ test event-9 {no <Enter> event is generated for the container window when its bind .top <Enter> {lappend res %W} pack [frame .top.f -bg green -width 50 -height 50] -anchor se -side bottom tkwait visibility .top.f + after 50 + update + focus -force .top.f event generate .top.f <Motion> -warp 1 -x 25 -y 25 ; # <Enter> sent to .top and .top.f - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming update ; # idletasks not enough destroy .top.f ; # no <Enter> event sent update diff --git a/tests/font.test b/tests/font.test index d490c64..8dce1f8 100644 --- a/tests/font.test +++ b/tests/font.test @@ -523,16 +523,16 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { destroy .t.f catch {font delete xyz} pack [label .t.f] - update + update idletasks } -body { font create xyz -family times -size 20 .t.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0 set a1 [font measure xyz "abcd"] - update + update idletasks set b1 [winfo reqwidth .t.f] font configure xyz -family helvetica -size 20 set a2 [font measure xyz "abcd"] - update + update idletasks set b2 [winfo reqwidth .t.f] expr {$a1==$b1 && $a2==$b2} } -cleanup { diff --git a/tests/imgPNG.test b/tests/imgPNG.test index 522dca7..ab65842 100644 --- a/tests/imgPNG.test +++ b/tests/imgPNG.test @@ -1159,6 +1159,7 @@ test imgPNG-4.4 {file output with metadata} -setup { i1 cget -metadata } -cleanup { image delete i1 + file delete $path } -result {DPI 99.9998 aspect 2.0} } diff --git a/tests/menu.test b/tests/menu.test index fdd5969..f830156 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -3958,8 +3958,7 @@ test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over update # simulate mouse click on the menubutton, which posts its menu event generate .top.mb <Button-1> -warp 1 - update - after 50 + controlPointerWarpTiming event generate .top.mb <ButtonRelease-1> update # simulate mouse click on the menu again, i.e. without diff --git a/tests/scale.test b/tests/scale.test index 9c1ab21..e9b300b 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1473,17 +1473,18 @@ test scale-20.3 {Bug [2262543fff] - Scale widget unexpectedly fires command call test scale-20.4 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 4} -setup { catch {destroy .s} set res {} - set commandedVar -1 } -body { scale .s -from 1 -to 50 -command {set commandedVar} - .s set 10 pack .s + update idletasks + .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] + set commandedVar -1 vwait commandedVar ; # -command callback shall fire set res [list [.s get] $commandedVar] } -cleanup { - destroy .s after cancel $timeout + destroy .s } -result {10 10} test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 5} -setup { catch {destroy .s} @@ -1492,6 +1493,7 @@ test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 pack .s + update idletasks .s set 10 .s configure -command {set commandedVar} update ; # -command callback shall NOT fire @@ -1506,6 +1508,7 @@ test scale-20.6 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 pack .s + update idletasks .s configure -command {set commandedVar} .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] @@ -1522,6 +1525,7 @@ test scale-20.7 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 -command {set commandedVar} pack .s + update idletasks .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] vwait commandedVar ; # -command callback shall fire @@ -1538,6 +1542,7 @@ test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar} pack .s + update idletasks .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] vwait commandedVar ; # -command callback shall fire diff --git a/tests/text.test b/tests/text.test index 3778a12..5ec97eb 100644 --- a/tests/text.test +++ b/tests/text.test @@ -7492,10 +7492,10 @@ test text-32.3 {peer widget -start, -endline and deletion (bug 1630262)} -setup .pt delete 2.0 3.0 # moreover -startline shall be correct # (was wrong before fixing bug 1630262) - lappend res [.t cget -start] [.pt cget -start] + lappend res [.t cget -start] [.pt cget -start] [.t get @0,0 "@0,0 lineend"] } -cleanup { destroy .pt -} -result {4 3} +} -result {4 3 {Line 5}} test text-32.4 {peer widget -start, -endline and deletion (bug 1630262)} -setup { destroy .t .pt diff --git a/tests/textDisp.test b/tests/textDisp.test index a2e960f..540ae31 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1668,6 +1668,21 @@ test textDisp-11.21 {TkTextSetYView, window height smaller than the line height} .top.t see 1.0 .top.t index @0,[expr {$lineheight - 2}] } {1.0} +test textDisp-11.22 {TkTextSetYView, peer has -startline} { + .top.t delete 1.0 end + for {set i 1} {$i <= 50} {incr i} { + .top.t insert end "Line $i\n" + } + pack [.top.t peer create .top.p] -side left + pack [scrollbar .top.sb -command {.top.p yview}] -side left -fill y + .top.p configure -startline 5 -endline 35 -yscrollcommand {.top.sb set} + updateText + .top.p yview moveto 0 + updateText + set res [.top.p get @0,0 "@0,0 lineend"] + destroy .top.p + set res +} {Line 5} .t configure -wrap word .t delete 50.0 51.0 @@ -2360,45 +2375,61 @@ test textDisp-17.5 {TkTextScanCmd procedure} { test textDisp-17.6 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 + updateText .t scan mark 40 60 .t scan dragto 35 55 + updateText .t index @0,0 } {4.7} test textDisp-17.7 {TkTextScanCmd procedure} {textfonts} { .t yview 10.0 .t xview moveto 0 + updateText .t xview scroll 20 units + updateText .t scan mark -10 60 .t scan dragto -5 65 + updateText .t index @0,0 set x [.t index @0,0] .t scan dragto 0 [expr {70 + $fixedDiff}] + updateText list $x [.t index @0,0] } {6.12 2.5} test textDisp-17.8 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 + updateText .t scan mark 0 60 .t scan dragto 30 100 + updateText .t scan dragto 25 95 + updateText .t index @0,0 } {4.7} test textDisp-17.9 {TkTextScanCmd procedure} {textfonts} { .t yview end .t xview moveto 0 + updateText .t xview scroll 100 units + updateText .t scan mark 90 60 .t scan dragto 10 0 + updateText .t scan dragto 14 5 + updateText .t index @0,0 -} {18.44} +} {14.44} .t configure -wrap word test textDisp-17.10 {TkTextScanCmd procedure, word wrapping} {textfonts} { .t yview 10.0 + updateText .t scan mark -10 60 .t scan dragto -5 65 + updateText set x [.t index @0,0] .t scan dragto 0 [expr {70 + $fixedDiff}] + updateText list $x [.t index @0,0] } {9.0 8.0} .t configure -xscrollcommand scroll -yscrollcommand {} diff --git a/tests/textIndex.test b/tests/textIndex.test index 2d42b8e..f2cccac 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -964,6 +964,43 @@ test textIndex-25.1 {IndexCountBytesOrdered, bug [3f1f79abcf]} { destroy .t2 } {} +test textIndex-26.1 {GetIndex restricts the returned index to -starline/-endline in peers, bug [34db75c0ac]} { + set res {} + pack [text .t2] + .t2 insert end "line 1\nline 2\nline 3\nline 4\nline 5\nline 6\n" + pack [.t2 peer create .p2 -startline 2 -endline 3] + lappend res [.p2 index "end"] + lappend res [.p2 index "end lineend"] + lappend res [.p2 index "end display lineend"] + destroy .t2 .p2 + set res +} {2.0 2.0 2.0} +test textIndex-26.2 {GetIndex errors out if mark, image, window, or tag is outside peer -starline/-endline, bug [34db75c0ac]} { + set res {} + pack [text .t2] + .t2 insert end "line 1\nline 2\nline 3\nline 4\nline 5\nline 6\n" + pack [.t2 peer create .p2 -startline 2 -endline 3] + .p2 configure -startline 3 -endline {} + .t2 mark set mymark 1.0 + catch {.p2 index mymark} msg + lappend res [.t2 index mymark] $msg + image create photo redsquare -width 5 -height 5 + redsquare put red -to 0 0 4 4 + .t2 image create 1.0 -image redsquare + catch {.p2 index redsquare} msg + lappend res [.t2 index redsquare] $msg + frame .f -width 10 -height 10 -bg blue + .t2 window create 1.2 -window .f + catch {.p2 index .f} msg + lappend res [.t2 index .f] $msg + .t2 tag add mytag 1.3 + catch {.p2 index mytag.first} msg + lappend res [.t2 index mytag.first] $msg + destroy .t2 .p2 + set res +} {1.0 {bad text index "mymark"} 1.0 {bad text index "redsquare"} 1.2\ + {bad text index ".f"} 1.3 {text doesn't contain any characters tagged with "mytag"}} + # cleanup rename textimage {} catch {destroy .t} diff --git a/tests/textMark.test b/tests/textMark.test index 938ce7f..bbe839f 100644 --- a/tests/textMark.test +++ b/tests/textMark.test @@ -182,6 +182,17 @@ test textMark-6.5 {insert and current marks in an empty peer - bug 3487407} -bod } -cleanup { .t configure -startline {} -endline {} } -result {1.0} +test textMark-6.6 {attempt to move the insert mark beyond peer -endline - bug 34db75c0ac} -body { + .t peer create .p -startline 1 -endline 2 + pack .p + update + .p mark set insert 1.2 + focus -force .p + event generate .p <<NextLine>> ; # shall not error out + set res [.p index insert] +} -cleanup { + destroy .p +} -result {1.9} test textMark-7.1 {MarkFindNext - invalid mark name} -body { .t mark next bogus diff --git a/tests/textTag.test b/tests/textTag.test index b703a81..2d25f4c 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -1237,7 +1237,8 @@ set y5 [expr [lindex $c 1] + [lindex $c 3]/2] test textTag-15.1 {TkTextBindProc} -setup { .t tag delete x y wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { bind .t <ButtonRelease> {lappend x up} .t tag bind x <ButtonRelease> {lappend x x-up} @@ -1263,7 +1264,8 @@ test textTag-15.1 {TkTextBindProc} -setup { test textTag-15.2 {TkTextBindProc} -setup { .t tag delete x y wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag bind x <Enter> {lappend x x-enter} .t tag bind x <Button> {lappend x x-down} @@ -1292,7 +1294,8 @@ test textTag-15.2 {TkTextBindProc} -setup { test textTag-15.3 {TkTextBindProc} -setup { .t tag delete x y wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag bind x <Enter> {lappend x x-enter} .t tag bind x <Button-1> {lappend x x-down} @@ -1326,7 +1329,8 @@ test textTag-15.3 {TkTextBindProc} -setup { test textTag-16.1 {TkTextPickCurrent procedure} -setup { .t tag delete {*}[.t tag names] wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1 set x [.t index current] @@ -1349,7 +1353,8 @@ test textTag-16.2 {TkTextPickCurrent procedure} -constraints { } -setup { .t tag delete {*}[.t tag names] wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming .t configure -font $textWidgetFont -wrap none } -body { .t tag configure big -font $bigFont @@ -1371,7 +1376,8 @@ test textTag-16.3 {TkTextPickCurrent procedure} -setup { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { foreach i {a b c d} { .t tag bind $i <Enter> "lappend x enter-$i" @@ -1399,7 +1405,8 @@ test textTag-16.4 {TkTextPickCurrent procedure} -setup { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { foreach i {a b c d} { .t tag bind $i <Enter> "lappend x enter-$i" @@ -1428,7 +1435,8 @@ test textTag-16.5 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming .t configure -font $textWidgetFont -wrap none } -body { .t tag configure big -font $bigFont @@ -1449,7 +1457,8 @@ test textTag-16.6 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming .t configure -font $textWidgetFont -wrap none } -body { .t tag configure big -font $bigFont @@ -1471,7 +1480,8 @@ test textTag-16.7 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming .t configure -font $textWidgetFont -wrap none } -body { .t tag configure big -font $bigFont @@ -1504,7 +1514,8 @@ test textTag-17.1 {insert procedure inserts tags} -setup { test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { destroy .t wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { text .t -width 30 -height 4 -relief sunken -borderwidth 10 \ -highlightthickness 10 -pady 2 @@ -1521,6 +1532,10 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { set res {} # Bindings must not trigger on the widget border, only over # the actual tagged characters themselves. + # Note that we don't need to call controlPointerWarpTiming + # in the following six calls because we're not checking that + # the mouse pointer has actually moved but rather that the + # tag binding mechanism of the text widget correctly triggers. event gen .t <Motion> -warp 1 -x 0 -y 0 ; update event gen .t <Motion> -warp 1 -x 10 -y 10 ; update event gen .t <Motion> -warp 1 -x 25 -y 25 ; update diff --git a/tests/textWind.test b/tests/textWind.test index 55128be..d7dab90 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -1406,7 +1406,7 @@ test textWind-17.1 {peer widgets and embedded windows} -setup { .t window create 1.3 -window .f toplevel .tt pack [.t peer create .tt.t] - update ; update + update destroy .t .tt winfo exists .f } -result 0 @@ -1420,7 +1420,7 @@ test textWind-17.2 {peer widgets and embedded windows} -setup { .t window create 1.4 -window .f toplevel .tt pack [.t peer create .tt.t] - update ; update + update destroy .t .tt.t insert 1.0 "foo" update @@ -1435,7 +1435,7 @@ test textWind-17.3 {peer widget and -create} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - update ; update + update .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} update destroy .t .tt @@ -1451,7 +1451,7 @@ test textWind-17.4 {peer widget deleted one window shouldn't delete others} -set toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} - update ; update + update destroy .tt lappend res [.t get 1.2] update @@ -1469,7 +1469,7 @@ test textWind-17.5 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} - update ; update + update list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] } -cleanup { destroy .tt .t @@ -1484,7 +1484,7 @@ test textWind-17.6 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} - update ; update + update list [.t window configure 1.2 -window] \ [.tt.t window configure 1.2 -window] } -cleanup { @@ -1500,7 +1500,7 @@ test textWind-17.7 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - update ; update + update list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] } -cleanup { destroy .tt .t @@ -1515,7 +1515,7 @@ test textWind-17.8 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - update ; update + update list [.t window configure 1.2 -window] \ [.tt.t window configure 1.2 -window] } -cleanup { @@ -1531,7 +1531,7 @@ test textWind-17.9 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - update ; update + update .tt.t window configure 1.2 -window [frame .tt.t.f -width 10 -height 20 -bg red] list [.t window configure 1.2 -window] [.tt.t window configure 1.2 -window] } -cleanup { @@ -1541,26 +1541,34 @@ test textWind-17.9 {peer widget window configuration} -setup { test textWind-17.10 {peer widget window configuration} -setup { destroy .t .tt } -body { + set res {} pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] + update idletasks .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] + update idletasks + # There should be a window in the main widget but not in the peer. + lappend res [.t window configure 1.2 -window] + lappend res [.tt.t window configure 1.2 -window] .tt.t window create 1.2 -window [frame .tt.t.f -width 25 -height 20 -bg blue] - update ; update - .t window configure 1.2 -create \ - {destroy %W.f ; frame %W.f -width 50 -height 7 -bg red} - .tt.t window configure 1.2 -window {} + update idletasks + .t window configure 1.2 -create {destroy %W.f ; frame %W.f -width 50 -height 7 -bg red} + update idletasks + # The main widget should not have changed. + lappend res [.t window configure 1.2 -window] .t window configure 1.2 -window {} - set res [list [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window]] + .tt.t window configure 1.2 -window {} update - lappend res [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window] + # Nothing should have changed. + lappend res [.t window configure 1.2 -window] + lappend res [.tt.t window configure 1.2 -window] } -cleanup { destroy .tt .t -} -result {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} +} -result {{-window {} {} {} .t.f} {-window {} {} {} {}} {-window {} {} {} .t.f}\ +{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} test textWind-18.1 {embedded window deletion triggered by a script bound to <Map>} -setup { catch {destroy .t .f .f2} diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test index fc2f9d3..5bd85cb 100644 --- a/tests/ttk/entry.test +++ b/tests/ttk/entry.test @@ -67,6 +67,12 @@ test entry-1.7 "Deletion - insert cursor in the middle " -body { .e index insert } -result 0 +test entry-1.8 "Index is between 0 and end" -body { + .e delete 0 end + .e insert end abcde + set res [list [.e index -1] [.e index -4] [.e index 999]] +} -result {0 0 5} + test entry-1.done "Cleanup" -body { destroy .e } # Scrollbar tests. @@ -87,7 +93,7 @@ test entry-2.1.1 "Create entry before scrollbar - scrollbar catches up" -constra pack [ttk::scrollbar .tsb -orient horizontal -command [list .te xview]] \ -expand false -fill x update ; # no error - lappend res [expr [lindex [.tsb get] 1] < 1] ; # scrollbar did update + set res [expr [lindex [.tsb get] 1] < 1] ; # scrollbar did update } -result 1 -cleanup {destroy .te .tsb} test entry-2.2 "Initial scroll position" -body { diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test index abd2a0f..e2b91f6 100644 --- a/tests/ttk/spinbox.test +++ b/tests/ttk/spinbox.test @@ -138,14 +138,18 @@ test spinbox-1.8.3 "option -validate" -setup { } -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none} test spinbox-1.8.4 "-validate option: " -setup { - set ::spinbox_test {} ttk::spinbox .sb -from 0 -to 100 + set ::spinbox_test {} } -body { - .sb configure -validate all -validatecommand {lappend ::spinbox_test %P} + .sb configure -validate all -validatecommand {set ::spinbox_test %P} pack .sb + update idletasks .sb set 50 focus -force .sb - after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait + set ::spinbox_wait 0 + set timer [after 100 {set ::spinbox_wait 1}] + vwait ::spinbox_wait + after cancel $timer set ::spinbox_test } -cleanup { destroy .sb diff --git a/tests/ttk/validate.test b/tests/ttk/validate.test index 8b48d2a..90b09f7 100644 --- a/tests/ttk/validate.test +++ b/tests/ttk/validate.test @@ -78,54 +78,63 @@ test validate-1.7 {entry widget validation - vmode focus} -body { } -result {} test validate-1.8 {entry widget validation - vmode focus} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force .e - # update necessary to process FocusIn event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} focus focusin} test validate-1.9 {entry widget validation - vmode focus} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force . - # update necessary to process FocusOut event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} focus focusout} .e configure -validate all test validate-1.10 {entry widget validation - vmode all} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force .e - # update necessary to process FocusIn event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} all focusin} test validate-1.11 {entry widget validation} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force . - # update necessary to process FocusOut event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} all focusout} .e configure -validate focusin test validate-1.12 {entry widget validation} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force .e - # update necessary to process FocusIn event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} focusin focusin} test validate-1.13 {entry widget validation} -body { set ::vVals {} focus -force . - # update necessary to process FocusOut event update set ::vVals } -result {} .e configure -validate focuso test validate-1.14 {entry widget validation} -body { + set ::vVals {} focus -force .e - # update necessary to process FocusIn event update set ::vVals } -result {} diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test index ea0063f..d4f7259 100644 --- a/tests/unixEmbed.test +++ b/tests/unixEmbed.test @@ -1301,6 +1301,7 @@ test unixEmbed-11.2 {mouse coordinates in embedded toplevels} -constraints { wm geometry .main 200x400+100+100 update idletasks focus -force .main + after 100 set x [expr {[winfo x .main ] + [winfo x .main.b] + 40}] set y [expr {[winfo y .main ] + [winfo y .main.b] + 38}] lappend result [winfo containing $x $y] diff --git a/tests/unixWm.test b/tests/unixWm.test index 2ff2d28..d54bc69 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -33,24 +33,27 @@ proc makeToplevels {} { } } -# On macOS windows are not allowed to overlap the menubar at the top -# of the screen. So tests which move a window and then check whether -# it got moved to the requested location should use a y coordinate -# larger than the height of the menubar (normally 23 pixels). +# On macOS windows are not allowed to overlap the menubar at the top of the +# screen or the dock. So tests which move a window and then check whether it +# got moved to the requested location should use a y coordinate larger than the +# height of the menubar (normally 23 pixels) and an x coordinate larger than the +# width of the dock, if it happens to be on the left. if {[tk windowingsystem] eq "aqua"} { set mb [expr [menubarheight] + 1] + set X 100 set Y0 $mb set Y2 [expr $mb + 2] set Y5 [expr $mb + 5] } else { + set X 20 set Y0 0 set Y2 2 set Y5 5 } set i 1 -foreach geom "+$Y0+80 +80+$Y0 +0+$Y0" { +foreach geom "+$X+80 +80+$Y0 +$X+$Y0" { destroy .t test unixWm-1.$i {initial window position} unix { toplevel .t -width 200 -height 150 @@ -104,7 +107,7 @@ foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { } set i 1 -foreach geom "+20+80 +100+40 +0+$Y0" { +foreach geom "+$X+80 +$X+40 +$X+$Y0" { test unixWm-4.$i {moving window while withdrawn} unix { wm withdraw .t update idletasks @@ -188,27 +191,27 @@ test unixWm-5.7 {compounded state changes} {unix nonPortable} { destroy .t toplevel .t -width 200 -height 100 -wm geom .t +10+$Y0 +wm geom .t +100+$Y0 wm minsize .t 1 1 update test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update wm geom .t -} 180x150+10+$Y0 +} 180x150+100+$Y0 test unixWm-6.2 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 update wm geom .t -} 250x60+10+$Y0 +} 250x60+100+$Y0 test unixWm-6.3 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 wm geom .t {} update wm geom .t -} 170x140+10+$Y0 +} 170x140+100+$Y0 test unixWm-6.4 {size changes} {unix nonPortable userInteraction} { wm minsize .t 1 1 update @@ -1364,14 +1367,14 @@ test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on gr test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix { destroy .t toplevel .t - wm geometry .t 200x100+0+$Y0 + wm geometry .t 200x100+100+$Y0 listbox .t.l -height 20 -width 20 pack .t.l -fill both -expand 1 update .t.l configure -setgrid 1 update wm geometry .t -} "20x20+0+$Y0" +} "20x20+100+$Y0" test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} unix { destroy .t diff --git a/unix/configure b/unix/configure index 579bd0d..c05d9b4 100755 --- a/unix/configure +++ b/unix/configure @@ -7665,7 +7665,7 @@ if test $tk_aqua = yes; then printf "%s\n" "#define MAC_OSX_TK 1" >>confdefs.h - LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit -framework Security" + LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit -framework QuartzCore -framework Security" if test -d /System/Library/Frameworks/UserNotifications.framework; then LIBS="$LIBS -framework UserNotifications" fi diff --git a/unix/configure.ac b/unix/configure.ac index b6f602b..adbf461 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -303,7 +303,7 @@ fi if test $tk_aqua = yes; then AC_DEFINE(MAC_OSX_TK, 1, [Are we building TkAqua?]) - LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit -framework Security" + LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit -framework QuartzCore -framework Security" if test -d /System/Library/Frameworks/UserNotifications.framework; then LIBS="$LIBS -framework UserNotifications" fi diff --git a/win/makefile.vc b/win/makefile.vc index dec4505..ee42f1e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -93,6 +93,12 @@ USE_WIDECHAR_API = 0 # the build configuration, macros, output directories etc.
!include "rules-ext.vc"
+!if ($(TCL_MAJOR_VERSION) > 8) || ($(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) > 6)
+USING_PRE87_TCL = 0
+!else
+USING_PRE87_TCL = 1
+!endif
+
# TCLINSTALL is set to 1 by rules.vc to indicate we are building against
# an installed Tcl and 0 if building against Tcl source. Tk needs the latter.
!if $(TCLINSTALL)
@@ -128,6 +134,10 @@ TK_EMBED_SCRIPTS = $(STATIC_BUILD) !endif
!endif
+!if $(USING_PRE87_TCL)
+TK_EMBED_SCRIPTS = 0
+!endif
+
TK_NO_DEPRECATED = 0
!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]
!if [nmakehlp -f $(CHECKS) "nodep"]
@@ -354,7 +364,6 @@ PRJ_DEFINES = /DBUILD_ttk $(CONFIG_DEFS) /Dinline=__inline /D_CRT_SECURE_NO_DEPR # Additional Link libraries needed beyond those in rules.vc
PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib
-
#---------------------------------------------------------------------
# TkTest flags
#---------------------------------------------------------------------
@@ -367,7 +376,10 @@ TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) # Project specific targets
#---------------------------------------------------------------------
-release: setup $(TKSTUBLIB) $(WISH) libtkzip embed
+release: setup $(TKSTUBLIB) $(WISH)
+!if !$(USING_PRE87_TCL)
+release: libtkzip embed
+!endif
all: release $(CAT32)
core: setup $(TKSTUBLIB) $(TKLIB)
cwish: $(WISHC)
@@ -764,7 +776,9 @@ install-libraries: @$(CPY) "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11\"
+!if !$(USING_PRE87_TCL)
@$(CPY) "$(TKSCRIPTZIP)" "$(LIB_INSTALL_DIR)"
+!endif
!if !$(TK_EMBED_SCRIPTS)
@echo installing script library
@$(CPY) "$(LIBDIR)\*" "$(SCRIPT_INSTALL_DIR)\"
diff --git a/win/rules.vc b/win/rules.vc index 85c37f2..19f0dd8 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1260,7 +1260,13 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" # Various output paths
PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
+!if $(TCL_MAJOR_VERSION) == 8
+PRJLIBNAME = $(PRJLIBNAME8)
+!else
+PRJLIBNAME = $(PRJLIBNAME9)
+!endif
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
@@ -1590,12 +1596,22 @@ default-target: $(DEFAULT_BUILD_TARGET) !if $(MULTIPLATFORM_INSTALL)
default-pkgindex:
+ @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } >> $(OUT_DIR)\pkgIndex.tcl
!else
default-pkgindex:
+ @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+ [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } >> $(OUT_DIR)\pkgIndex.tcl
!endif
default-pkgindex-tea:
@@ -1604,6 +1620,8 @@ default-pkgindex-tea: @PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME)
@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME)
@PKG_LIB_FILE@ $(PRJLIBNAME)
+@PKG_LIB_FILE8@ $(PRJLIBNAME8)
+@PKG_LIB_FILE9@ $(PRJLIBNAME9)
<<
default-install: default-install-binaries default-install-libraries
diff --git a/xlib/ximage.c b/xlib/ximage.c index aaab946..b3a8f20 100644 --- a/xlib/ximage.c +++ b/xlib/ximage.c @@ -51,11 +51,13 @@ XCreateBitmapFromData( } ximage = XCreateImage(display, NULL, 1, XYBitmap, 0, (char*) data, width, height, 8, (width + 7) / 8); - ximage->bitmap_bit_order = LSBFirst; - _XInitImageFuncPtrs(ximage); - TkPutImage(NULL, 0, display, pix, gc, ximage, 0, 0, 0, 0, width, height); - ximage->data = NULL; - XDestroyImage(ximage); + if (ximage) { + ximage->bitmap_bit_order = LSBFirst; + _XInitImageFuncPtrs(ximage); + TkPutImage(NULL, 0, display, pix, gc, ximage, 0, 0, 0, 0, width, height); + ximage->data = NULL; + XDestroyImage(ximage); + } XFreeGC(display, gc); return pix; } |