diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-10-02 08:34:42 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-10-02 08:34:42 (GMT) |
commit | 6ea2c1ade6b63859abac22e42468ba744523fb67 (patch) | |
tree | d0f61064e70d9f49462dc6bc54b9cf8f6cfb2a17 | |
parent | 272678ee37956bea49401b322ec32afd4fcc4753 (diff) | |
parent | 4825038074a1722f54708e7e47cdf60b7d407de8 (diff) | |
download | tk-6ea2c1ade6b63859abac22e42468ba744523fb67.zip tk-6ea2c1ade6b63859abac22e42468ba744523fb67.tar.gz tk-6ea2c1ade6b63859abac22e42468ba744523fb67.tar.bz2 |
Merge trunk
-rw-r--r-- | doc/grid.n | 2 | ||||
-rw-r--r-- | generic/tkFont.c | 16 | ||||
-rw-r--r-- | generic/tkGrid.c | 15 | ||||
-rw-r--r-- | generic/tkMenu.c | 4 | ||||
-rw-r--r-- | generic/tkPack.c | 9 | ||||
-rw-r--r-- | generic/tkPkgConfig.c | 3 | ||||
-rw-r--r-- | generic/tkPlace.c | 33 | ||||
-rw-r--r-- | generic/tkUtil.c | 2 | ||||
-rw-r--r-- | library/demos/widget | 8 | ||||
-rw-r--r-- | tests/bind.test | 5 | ||||
-rw-r--r-- | tests/entry.test | 5 | ||||
-rw-r--r-- | tests/font.test | 440 | ||||
-rw-r--r-- | tests/fontchooser.test | 5 | ||||
-rw-r--r-- | tests/grid.test | 2 | ||||
-rw-r--r-- | tests/oldpack.test | 4 | ||||
-rw-r--r-- | tests/pack.test | 2 | ||||
-rw-r--r-- | tests/pkgconfig.test | 4 | ||||
-rw-r--r-- | tests/place.test | 2 | ||||
-rw-r--r-- | tests/safe.test | 5 | ||||
-rw-r--r-- | tests/scrollbar.test | 17 | ||||
-rw-r--r-- | tests/spinbox.test | 5 | ||||
-rw-r--r-- | tests/textDisp.test | 2 | ||||
-rw-r--r-- | tests/textTag.test | 9 | ||||
-rw-r--r-- | tests/unixFont.test | 3 | ||||
-rw-r--r-- | unix/tkUnix.c | 2 | ||||
-rw-r--r-- | win/tkWinX.c | 6 |
26 files changed, 328 insertions, 282 deletions
@@ -301,7 +301,7 @@ The size is determined either by the \fIcontent\fR occupying the largest row or column, or the largest column or row with a \fB\-minsize\fR, \fB\-weight\fR, or \fB\-pad\fR that is non-zero. .TP -\fBgrid content fI\window\fR ?\fI\-option value\fR? +\fBgrid content \fIwindow\fR ?\fI\-option value\fR? . If no options are supplied, a list of all of the content in \fIwindow\fR is returned, most recently managed first. diff --git a/generic/tkFont.c b/generic/tkFont.c index 7155cc1..79c8d54 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -741,7 +741,7 @@ Tk_FontObjCmd( } case FONT_METRICS: { Tk_Font tkfont; - int skip, index, i; + int skip, i; const TkFontMetrics *fmPtr; static const char *const switches[] = { "-ascent", "-descent", "-linespace", "-fixed", NULL @@ -1968,7 +1968,7 @@ Tk_ComputeTextLayout( int *heightPtr) /* Filled with height of string. */ { TkFont *fontPtr = (TkFont *) tkfont; - const char *start, *end, *special; + const char *start, *endp, *special; int n, y, bytesThisChunk, maxChunks, curLine, layoutHeight; int baseline, height, curX, newX, maxWidth, *lineLengths; TextLayout *layoutPtr; @@ -2016,12 +2016,12 @@ Tk_ComputeTextLayout( curX = 0; - end = Tcl_UtfAtIndex(string, numChars); + endp = Tcl_UtfAtIndex(string, numChars); special = string; flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES; flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE; - for (start = string; start < end; ) { + for (start = string; start < endp; ) { if (start >= special) { /* * Find the next special character in the string. @@ -2032,7 +2032,7 @@ Tk_ComputeTextLayout( * whitespace set. */ - for (special = start; special < end; special++) { + for (special = start; special < endp; special++) { if (!(flags & TK_IGNORE_NEWLINES)) { if ((*special == '\n') || (*special == '\r')) { break; @@ -2066,7 +2066,7 @@ Tk_ComputeTextLayout( } } - if ((start == special) && (special < end)) { + if ((start == special) && (special < endp)) { /* * Handle the special character. * @@ -2083,7 +2083,7 @@ Tk_ComputeTextLayout( start++; curX = newX; flags &= ~TK_AT_LEAST_ONE; - if ((start < end) && + if ((start < endp) && ((wrapLength <= 0) || (newX <= wrapLength))) { /* * More chars can still fit on this line. @@ -2105,7 +2105,7 @@ Tk_ComputeTextLayout( * Consume all extra spaces at end of line. */ - while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */ + while ((start < endp) && isspace(UCHAR(*start))) { /* INTL: ISO space */ if (!(flags & TK_IGNORE_NEWLINES)) { if ((*start == '\n') || (*start == '\r')) { break; diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 51b9512..f5100ba 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -341,6 +341,11 @@ Tk_GridObjCmd( "content", "forget", "info", "location", "propagate", "remove", "rowconfigure", "size", "slaves", NULL }; + static const char *const optionStringsNoDep[] = { + "anchor", "bbox", "columnconfigure", "configure", + "content", "forget", "info", "location", "propagate", + "remove", "rowconfigure", "size", NULL + }; enum options { GRID_ANCHOR, GRID_BBOX, GRID_COLUMNCONFIGURE, GRID_CONFIGURE, GRID_CONTENT, GRID_FORGET, GRID_INFO, GRID_LOCATION, GRID_PROPAGATE, @@ -361,8 +366,16 @@ Tk_GridObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + if (Tcl_GetIndexFromObjStruct(NULL, objv[1], optionStrings, sizeof(char *), "option", 0, &index) != TCL_OK) { + /* + * Call it again without the deprecated ones to get a proper error + * message. This works well since there can't be any ambiguity between + * deprecated and new options. + */ + + Tcl_GetIndexFromObjStruct(interp, objv[1], optionStringsNoDep, + sizeof(char *), "option", 0, &index); return TCL_ERROR; } diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 0a297a6..a67be21 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -1630,7 +1630,6 @@ ConfigureMenu( } } else if ((menuListPtr->numEntries > 0) && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) { - int i; Tcl_EventuallyFree(menuListPtr->entries[0], (Tcl_FreeProc *) DestroyMenuEntry); @@ -1825,7 +1824,6 @@ PostProcessEntry( if ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) { Tcl_Obj *valuePtr; - const char *name; if (mePtr->namePtr == NULL) { if (mePtr->labelPtr == NULL) { @@ -2735,7 +2733,7 @@ CloneMenu( && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) { TkMenu *newMenuPtr = menuRefPtr->menuPtr; Tcl_Obj *newObjv[3]; - int i, numElements; + int numElements; /* * Now put this newly created menu into the parent menu's instance diff --git a/generic/tkPack.c b/generic/tkPack.c index 00597b3..239b00a 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -203,6 +203,8 @@ Tk_PackObjCmd( "after", "append", "before", "unpack", #endif /* !TK_NO_DEPRECATED */ "configure", "content", "forget", "info", "propagate", "slaves", NULL }; + static const char *const optionStringsNoDep[] = { + "configure", "content", "forget", "info", "propagate", NULL }; enum options { #ifndef TK_NO_DEPRECATED PACK_AFTER, PACK_APPEND, PACK_BEFORE, PACK_UNPACK, @@ -222,19 +224,16 @@ Tk_PackObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + if (Tcl_GetIndexFromObjStruct(NULL, objv[1], optionStrings, sizeof(char *), "option", 0, &index) != TCL_OK) { -#ifndef TK_NO_DEPRECATED /* * Call it again without the deprecated ones to get a proper error * message. This works well since there can't be any ambiguity between * deprecated and new options. */ - Tcl_ResetResult(interp); - Tcl_GetIndexFromObjStruct(interp, objv[1], &optionStrings[4], + Tcl_GetIndexFromObjStruct(interp, objv[1], optionStringsNoDep, sizeof(char *), "option", 0, &index); -#endif /* TK_NO_DEPRECATED */ return TCL_ERROR; } diff --git a/generic/tkPkgConfig.c b/generic/tkPkgConfig.c index fe084bf..ed8fb0b 100644 --- a/generic/tkPkgConfig.c +++ b/generic/tkPkgConfig.c @@ -100,6 +100,9 @@ static const Tcl_Config cfg[] = { {"profiled", CFG_PROFILED}, {"64bit", CFG_64}, {"optimized", CFG_OPTIMIZED}, +#ifdef TK_NO_DEPRECATED + {"nodeprecated", "1"}, +#endif {"mem_debug", CFG_MEMDEBUG}, {"fontsystem", CFG_FONTSYSTEM}, diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 7625362..8d6b87e 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -216,6 +216,9 @@ Tk_PlaceObjCmd( static const char *const optionStrings[] = { "configure", "content", "forget", "info", "slaves", NULL }; + static const char *const optionStringsNoDep[] = { + "configure", "content", "forget", "info", NULL + }; enum options { PLACE_CONFIGURE, PLACE_CONTENT, PLACE_FORGET, PLACE_INFO, PLACE_SLAVES }; int index; @@ -278,6 +281,14 @@ Tk_PlaceObjCmd( if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, sizeof(char *), "option", 0, &index) != TCL_OK) { + /* + * Call it again without the deprecated ones to get a proper error + * message. This works well since there can't be any ambiguity between + * deprecated and new options. + */ + + Tcl_GetIndexFromObjStruct(interp, objv[1], optionStringsNoDep, + sizeof(char *), "option", 0, &index); return TCL_ERROR; } @@ -666,10 +677,10 @@ ConfigureContent( goto scheduleLayout; } else if (mask & IN_MASK) { /* -in changed */ - Tk_Window tkwin; + Tk_Window win; Tk_Window ancestor; - tkwin = contentPtr->inTkwin; + win = contentPtr->inTkwin; /* * Make sure that the new container is either the logical parent of the @@ -677,19 +688,19 @@ ConfigureContent( * aren't the same. */ - for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) { + for (ancestor = win; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(contentPtr->tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't place \"%s\" relative to \"%s\"", - Tk_PathName(contentPtr->tkwin), Tk_PathName(tkwin))); + Tk_PathName(contentPtr->tkwin), Tk_PathName(win))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } - if (contentPtr->tkwin == tkwin) { + if (contentPtr->tkwin == win) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't place \"%s\" relative to itself", Tk_PathName(contentPtr->tkwin))); @@ -701,22 +712,22 @@ ConfigureContent( * Check for management loops. */ - for (container = (TkWindow *)tkwin; container != NULL; + for (container = (TkWindow *)win; container != NULL; container = (TkWindow *)TkGetContainer(container)) { if (container == (TkWindow *)contentPtr->tkwin) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't put \"%s\" inside \"%s\": would cause management loop", - Tk_PathName(contentPtr->tkwin), Tk_PathName(tkwin))); + Tk_PathName(contentPtr->tkwin), Tk_PathName(win))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } } - if (tkwin != Tk_Parent(contentPtr->tkwin)) { - ((TkWindow *)contentPtr->tkwin)->maintainerPtr = (TkWindow *)tkwin; + if (win != Tk_Parent(contentPtr->tkwin)) { + ((TkWindow *)contentPtr->tkwin)->maintainerPtr = (TkWindow *)win; } if ((contentPtr->containerPtr != NULL) - && (contentPtr->containerPtr->tkwin == tkwin)) { + && (contentPtr->containerPtr->tkwin == win)) { /* * Re-using same old container. Nothing to do. */ @@ -729,7 +740,7 @@ ConfigureContent( Tk_UnmaintainGeometry(contentPtr->tkwin, contentPtr->containerPtr->tkwin); } UnlinkContent(contentPtr); - containerWin = tkwin; + containerWin = win; } /* diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 6ff1ee0..0541830 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1130,7 +1130,7 @@ TkMakeEnsemble( dictObj = Tcl_NewObj(); for (i = 0; map[i].name != NULL ; ++i) { - Tcl_Obj *nameObj, *fqdnObj; + Tcl_Obj *fqdnObj; nameObj = Tcl_NewStringObj(map[i].name, -1); fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), diff --git a/library/demos/widget b/library/demos/widget index 58da12f..4f7f715 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -723,10 +723,10 @@ proc PrintTextWin32 {filename} { proc tkAboutDialog {} { tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \ -message [mc "Tk widget demonstration application"] -detail \ -"[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}] -[mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}] -[mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}] -[mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]" +"[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}] +[mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}] +[mc "Copyright © %s" {2001-2009 Donal K. Fellows}] +[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]" } # Local Variables: diff --git a/tests/bind.test b/tests/bind.test index 152fe3e..29f8873 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -13,6 +13,9 @@ eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] + + toplevel .t -width 100 -height 50 wm geom .t +0+0 update idletasks @@ -6017,7 +6020,7 @@ test bind-28.9 {keysym names, Eth -> ETH} -body { } -cleanup { destroy .t.f } -result {<Key-ETH>} -test bind-28.10 {keysym names, Ooblique -> Oslash} -body { +test bind-28.10 {keysym names, Ooblique -> Oslash} -constraints nodeprecated -body { frame .t.f -class Test -width 150 -height 100 bind .t.f <Ooblique> foo bind .t.f diff --git a/tests/entry.test b/tests/entry.test index 262447f..bc246e8 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -11,6 +11,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] + # For xscrollcommand set scrollInfo {} proc scroll args { @@ -2328,7 +2331,7 @@ test entry-8.17 {DeleteChars procedure} -setup { } -cleanup { destroy .e } -result 4 -test entry-8.18 {DeleteChars procedure} -setup { +test entry-8.18 {DeleteChars procedure} -constraints failsOnUbuntuNoXft -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e focus .e diff --git a/tests/font.test b/tests/font.test index 28ac799..f96b122 100644 --- a/tests/font.test +++ b/tests/font.test @@ -14,6 +14,8 @@ tcltest::loadTestedCommands # Some tests require support for 4-byte UTF-8 sequences testConstraint fullutf [expr {[format %c 0x010000] != "\uFFFD"}] testConstraint utfcompat [expr {([string length "\U10000"] == 2) && [package vsatisfies [package provide Tcl] 8]}] +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] set defaultfontlist [font names] @@ -61,9 +63,9 @@ test font-1.1 {TkFontPkgInit} -setup { } -body { interp create foo foo eval { - load {} Tk - wm geometry . +0+0 - update + load {} Tk + wm geometry . +0+0 + update } interp delete foo } -result {} @@ -77,25 +79,25 @@ test font-2.1 {TkFontPkgFree} -setup { # Makes sure that named font was visible only to child interp. foo eval { - load {} Tk - wm geometry . +0+0 - button .b -font {times 16} -text "hi" - pack .b - font create wiggles -family courier -underline 1 - update + load {} Tk + wm geometry . +0+0 + button .b -font {times 16} -text "hi" + pack .b + font create wiggles -family courier -underline 1 + update } lappend x [catch {font configure wiggles} msg; set msg] # Tests cancelling the idle handler for TheWorldHasChanged, # because app goes away before idle serviced. foo eval { - .b config -font wiggles - font config wiggles -size 24 - destroy . + .b config -font wiggles + font config wiggles -size 24 + destroy . } lappend x [foo eval {catch {font families} msg; set msg}] } -cleanup { - interp delete foo + interp delete foo } -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} @@ -137,7 +139,7 @@ test font-4.8 {font command: actual: all attributes} -body { # not (objc > 3) so objPtr = NULL lindex [font actual {-family times}] 0 } -result {-family} -test font-4.9 {font command: actual} -constraints {unix noExceed} -body { +test font-4.9 {font command: actual} -constraints {unix noExceed failsOnUbuntu} -body { # (objc > 3) so objPtr = objv[3 + skip] string tolower [font actual {-family times} -family] } -result {times} @@ -194,7 +196,7 @@ test font-5.4 {font command: configure: get all options} -setup { font create xyz -family xyz lindex [font configure xyz] 1 } -cleanup { - font delete xyz + font delete xyz } -result xyz test font-5.5 {font command: configure: get one option} -setup { clearnondefaultfonts @@ -202,9 +204,9 @@ test font-5.5 {font command: configure: get one option} -setup { # (objc == 4) so objPtr = objv[3] font create xyz -family xyz font configure xyz -family - getnondefaultfonts + getnondefaultfonts } -cleanup { - font delete xyz + font delete xyz } -result xyz test font-5.6 {font command: configure: update existing font} -setup { catch {font delete xyz} @@ -215,7 +217,7 @@ test font-5.6 {font command: configure: update existing font} -setup { update font configure xyz -family } -cleanup { - font delete xyz + font delete xyz } -result xyz test font-5.7 {font command: configure: bad option} -setup { catch {font delete xyz} @@ -223,7 +225,7 @@ test font-5.7 {font command: configure: bad option} -setup { font create xyz font configure xyz -style } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} @@ -243,7 +245,7 @@ test font-6.2 {font command: create: name specified} -setup { font create xyz getnondefaultfonts } -cleanup { - font delete xyz + font delete xyz } -result {xyz} test font-6.3 {font command: create: name not really specified} -setup { clearnondefaultfonts @@ -285,7 +287,7 @@ test font-6.7 {font command: create: already exists} -setup { font create xyz font create xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {named font "xyz" already exists} test font-7.1 {font command: delete: arguments} -body { @@ -294,7 +296,7 @@ test font-7.1 {font command: delete: arguments} -body { } -returnCodes error -result {wrong # args: should be "font delete fontname ?fontname ...?"} test font-7.2 {font command: delete: loop test} -setup { clearnondefaultfonts - set x {} + set x {} } -body { # for (i = 2; i < objc; i++) font create a -underline 1 @@ -310,7 +312,7 @@ test font-7.2 {font command: delete: loop test} -setup { } -result {{a b c d e} d} test font-7.3 {font command: delete: loop test} -setup { clearnondefaultfonts - set x {} + set x {} } -body { # (namedHashPtr == NULL) in middle of loop font create a -underline 1 @@ -343,7 +345,7 @@ test font-7.5 {font command: delete: mark for later deletion} -setup { font actual xyz font configure xyz } -cleanup { - destroy .t.f + destroy .t.f } -returnCodes error -result {named font "xyz" doesn't exist} test font-7.6 {font command: delete: mark for later deletion} -setup { destroy .t.f @@ -357,7 +359,7 @@ test font-7.6 {font command: delete: mark for later deletion} -setup { font delete xyz font actual xyz catch {font configure xyz} - .t.f cget -font + .t.f cget -font } -cleanup { destroy .t.f } -result xyz @@ -383,7 +385,7 @@ test font-8.3 {font command: families: arguments} -body { # (objc - skip != 2) when skip == 2 font families -displayof . xyz } -returnCodes error -result {wrong # args: should be "font families ?-displayof window?"} -test font-8.4 {font command: families} -body { +test font-8.4 {font command: families} -constraints failsOnUbuntu -body { # TkpGetFontFamilies() regexp -nocase times [font families] } -result 1 @@ -515,7 +517,7 @@ test font-12.1 {UpdateDependantFonts procedure: no users} -setup { font create xyz font configure xyz -family times } -cleanup { - font delete xyz + font delete xyz } -result {} test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { destroy .t.f @@ -534,21 +536,21 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { set b2 [winfo reqwidth .t.f] expr {$a1==$b1 && $a2==$b2} } -cleanup { - destroy .t.f + destroy .t.f font delete xyz } -result 1 test font-13.1 {CreateNamedFont: new named font} -setup { catch {font delete xyz} - set x {} + set x {} } -body { # not (new == 0) lappend x [getnondefaultfonts] font create xyz lappend x [getnondefaultfonts] } -cleanup { - font delete xyz + font delete xyz } -result {{} xyz} test font-13.2 {CreateNamedFont: named font already exists} -setup { catch {font delete xyz} @@ -557,7 +559,7 @@ test font-13.2 {CreateNamedFont: named font already exists} -setup { font create xyz font create xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {named font "xyz" already exists} test font-13.3 {CreateNamedFont: named font already exists} -setup { catch {font delete xyz} @@ -566,7 +568,7 @@ test font-13.3 {CreateNamedFont: named font already exists} -setup { font create xyz font create xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {named font "xyz" already exists} test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup { destroy .t.f @@ -581,8 +583,8 @@ test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup { font create xyz -family courier font configure xyz -family } -cleanup { - font delete xyz - destroy .t.f + font delete xyz + destroy .t.f } -result {courier} @@ -591,7 +593,7 @@ test font-14.1 {Tk_GetFont procedure} -body { test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints { - testfont + testfont } -setup { destroy .b1 .b2 } -body { @@ -604,7 +606,7 @@ test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints { destroy .b1 .b2 } -result {{1 0}} test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints { - testfont + testfont } -setup { destroy .b1 .b2 set result {} @@ -619,7 +621,7 @@ test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints { destroy .b2 } -result {{} {{1 1}}} test font-15.3 {Tk_AllocFontFromObj - reuse existing font} -constraints { - testfont + testfont } -setup { destroy .b1 .b2 set result {} @@ -642,7 +644,7 @@ test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} -setup { .t.f config -font {-family fixed} lindex [font actual {-family fixed}] 0 } -cleanup { - destroy .t.f + destroy .t.f } -result {-family} test font-15.5 {Tk_AllocFontFromObj procedure: get named font} -setup { destroy .t.f @@ -654,7 +656,7 @@ test font-15.5 {Tk_AllocFontFromObj procedure: get named font} -setup { font create xyz .t.f config -font xyz } -cleanup { - destroy .t.f + destroy .t.f font delete xyz } -result {} test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} -setup { @@ -665,7 +667,7 @@ test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} -setup { # not (namedHashPtr != NULL) .t.f config -font {times 20} } -cleanup { - destroy .t.f + destroy .t.f } -result {-family} -result {} test font-15.7 {Tk_AllocFontFromObj procedure: get native font} -constraints { unix @@ -709,7 +711,7 @@ test font-15.11 {Tk_AllocFontFromObj procedure: get attribute font} -body { lindex [font actual {plan 9}] 0 } -result {-family} test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup { - destroy .l + destroy .l } -body { # Tk_MeasureChars(fontPtr, "0", ...) label .l -bd 0 -padx 0 -highlightthickness 0 -font $fixed -text "a\tb" @@ -718,7 +720,7 @@ test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup { set res2 [expr [font measure $fixed "0"]*9] expr {$res1 eq $res2} } -cleanup { - destroy .l + destroy .l } -result 1 test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup { destroy .t.f @@ -729,7 +731,7 @@ test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup { .t.f config -text "underline" -font "times -8 underline" update } -cleanup { - destroy .t.f + destroy .t.f } -result {} @@ -741,7 +743,7 @@ test font-16.1 {Tk_NameOfFont procedure} -setup { .t.f config -font -family\ fixed .t.f cget -font } -cleanup { - destroy .t.f + destroy .t.f } -result {-family fixed} @@ -927,7 +929,7 @@ test font-21.5 {Tk_PostscriptFontName procedure: spaces} -constraints { } } -result {LucidaBright} test font-21.6 {Tk_PostscriptFontName procedure: spaces} -constraints { - x11 + x11 failsOnUbuntu } -body { psfontname "{new century schoolbook} 10" } -result {NewCenturySchlbk-Roman} @@ -1449,20 +1451,20 @@ test font-21.66 {Tk_PostscriptFontName procedure: exhaustive} -constraints { test font-22.1 {Tk_TextWidth procedure} -setup { - destroy .t.l + destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ - -text "0" -font "Courier -12" - pack .t.l - set ax [winfo reqwidth .t.l] + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font "Courier -12" + pack .t.l + set ax [winfo reqwidth .t.l] expr {[font measure [.t.l cget -font] "000"] eq $ax*3} } -cleanup { - destroy .t.l + destroy .t.l } -result 1 test font-23.1 {Tk_UnderlineChars procedure} -setup { - destroy .t.t + destroy .t.t } -body { text .t.t .t.t insert 1.0 abc\tdefg @@ -1470,7 +1472,7 @@ test font-23.1 {Tk_UnderlineChars procedure} -setup { .t.t tag add sel 1.0 end update } -cleanup { - destroy .t.t + destroy .t.t } -result {} @@ -1487,27 +1489,27 @@ test font-24.1 {Tk_ComputeTextLayout: empty string} -body { } -result {} test font-24.2 {Tk_ComputeTextLayout: simple string} -body { .t.l config -text "000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ - [expr {[winfo reqheight .t.l] eq $ay}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq $ay}] } -result {1 1} test font-24.3 {Tk_ComputeTextLayout: find special chars} -body { .t.l config -text "000\n000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -result {1 1} test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} -body { .t.l config -text "000\n000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -result {1 1} test font-24.5 {Tk_ComputeTextLayout: break line} -body { .t.l config -text "000\t00000" -wrap [expr 9 * $ax] - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -cleanup { .t.l config -wrap 0 } -result {1 1} @@ -1516,26 +1518,26 @@ test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} -body { } -result {} test font-24.7 {Tk_ComputeTextLayout: special char was \n} -body { .t.l config -text "000\n0000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -result {1 1} test font-24.8 {Tk_ComputeTextLayout: special char was \t} -body { .t.l config -text "000\t00" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] \ - [expr {[winfo reqheight .t.l] eq $ay}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] \ + [expr {[winfo reqheight .t.l] eq $ay}] } -result {1 1} test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} -body { set x {} .t.l config -text "000\t000" - update + update lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] .t.l config -text "000\t000" -wrap [expr 100 * $ax] - update + update lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] return $x } -cleanup { .t.l config -wrap 0 @@ -1543,13 +1545,13 @@ test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} -body { test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body { set x {} .t.l config -text "000\t" - update + update lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] .t.l config -text "000\t00" -wrap [expr $ax * 6] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] return $x } -cleanup { .t.l config -wrap 0 @@ -1557,13 +1559,13 @@ test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body { test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} -body { set x {} .t.l config -text "000 000" -wrap [expr {$ax * 5}] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] .t.l config -text "000 " - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] return $x } -cleanup { .t.l config -wrap 0 @@ -1571,44 +1573,44 @@ test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} -body { test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} -body { set x {} .t.l config -text "000 0000" -wrap [expr {$ax * 5}] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] .t.l config -text "000\t00 0000" -wrap [expr {$ax * 12}] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] return $x } -cleanup { .t.l config -wrap 0 } -result {1 1 1 1} test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} -body { .t.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" - update - list [expr {[winfo reqwidth .t.l] eq 1}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 129}]}] + update + list [expr {[winfo reqwidth .t.l] eq 1}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 129}]}] } -result {1 1} test font-24.14 {Tk_ComputeTextLayout: text ended with \n} -body { set x {} - .t.l config -text "0000" - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] - .t.l config -text "0000\n" - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] - return $x + .t.l config -text "0000" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + .t.l config -text "0000\n" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + set x } -result {1 1 1 1} destroy .t.l test font-24.15 {Tk_ComputeTextLayout: justification} -setup { set x {} - destroy .t.c - canvas .t.c -closeenough 0 - .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" - pack .t.c - update + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update } -body { csetup "000\n00000" .t.c itemconfig text -just left @@ -1620,7 +1622,7 @@ test font-24.15 {Tk_ComputeTextLayout: justification} -setup { .t.c itemconfig text -just left return $x } -cleanup { - destroy .t.c + destroy .t.c } -result {2 1 0} @@ -1632,7 +1634,7 @@ test font-25.1 {Tk_FreeTextLayout procedure} -setup { .t.f config -text foo .t.f config -text boo } -cleanup { - destroy .t.f + destroy .t.f } -result {} @@ -1649,7 +1651,7 @@ test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} -setup { } -body { .t.f config -text foo } -cleanup { - destroy .t.f + destroy .t.f } -result {} test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} -body { csetup "000\t00\n000" @@ -1794,110 +1796,110 @@ pack .t.c update test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} -body { csetup "000\n000\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x 0 -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result 0 test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body { csetup "000\n000\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x $ax -y $ay return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result 5 test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body { csetup "000\n0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x [expr $ax*2] -y $ay return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result {} test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -body { csetup "000\t000\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x [expr $ax*6] -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result 3 test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body { csetup "000\n0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x [expr $ax*2] -y $ay return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result {} test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} -body { csetup "000\n000 000000000" .t.c itemconfig text -width [expr $ax*10] - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x [expr $ax*5] -y $ay .t.c itemconfig text -width 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result {} .t.c itemconfig text -justify center test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} -body { csetup "0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x 0 -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result {} test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} -body { csetup "0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x [expr $ax*2] -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result {} test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body { csetup "0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x $ax -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result 0 test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body { csetup "0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x 0 -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result {} test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body { csetup "000\n0" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x 0 -y $ay @@ -1907,7 +1909,7 @@ test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body { } -result {} test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body { csetup "0\n000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x $ax -y $ay @@ -1918,13 +1920,13 @@ test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body { .t.c itemconfig text -justify left test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body { csetup "000" - .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c <Leave> event generate .t.c <Enter> -x $ax -y 0 return $x } -cleanup { - bind all <Enter> {} + bind all <Enter> {} } -result 1 destroy .t.c @@ -1976,11 +1978,11 @@ destroy .t.c test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setup { - destroy .t.c - canvas .t.c -closeenough 0 - .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" - pack .t.c - update + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update } -body { # If there were a whole bunch of returns or tabs in a row, then the # temporary buffer could overflow and write on the stack. @@ -1993,7 +1995,7 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setu set i [string first "(qwerty" $x] string range $x $i [expr {$i + 278}] } -cleanup { - destroy .t.c + destroy .t.c } -result {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] [(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] [()] @@ -2051,85 +2053,85 @@ test font-34.2 {ConfigAttributesObj procedure: arguments} -setup { test font-34.3 {ConfigAttributesObj procedure: family} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -family xyz - lappend x [font config xyz -family] - font config xyz -family times - lappend x [font config xyz -family] + font create xyz -family xyz + lappend x [font config xyz -family] + font config xyz -family times + lappend x [font config xyz -family] } -cleanup { font delete xyz } -result {xyz times} test font-34.4 {ConfigAttributesObj procedure: size} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -size 20 - lappend x [font config xyz -size] - font config xyz -size 40 - lappend x [font config xyz -size] + font create xyz -size 20 + lappend x [font config xyz -size] + font config xyz -size 40 + lappend x [font config xyz -size] } -cleanup { - font delete xyz + font delete xyz } -result {20 40} test font-34.5 {ConfigAttributesObj procedure: weight} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -weight normal - lappend x [font config xyz -weight] - font config xyz -weight bold - lappend x [font config xyz -weight] + font create xyz -weight normal + lappend x [font config xyz -weight] + font config xyz -weight bold + lappend x [font config xyz -weight] } -cleanup { - font delete xyz + font delete xyz } -result {normal bold} test font-34.6 {ConfigAttributesObj procedure: slant} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -slant roman - lappend x [font config xyz -slant] - font config xyz -slant italic - lappend x [font config xyz -slant] + font create xyz -slant roman + lappend x [font config xyz -slant] + font config xyz -slant italic + lappend x [font config xyz -slant] } -cleanup { - font delete xyz + font delete xyz } -result {roman italic} test font-34.7 {ConfigAttributesObj procedure: underline} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -underline 0 - lappend x [font config xyz -underline] - font config xyz -underline 1 - lappend x [font config xyz -underline] + font create xyz -underline 0 + lappend x [font config xyz -underline] + font config xyz -underline 1 + lappend x [font config xyz -underline] } -cleanup { - font delete xyz + font delete xyz } -result {0 1} test font-34.8 {ConfigAttributesObj procedure: overstrike} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -overstrike 0 - lappend x [font config xyz -overstrike] - font config xyz -overstrike 1 - lappend x [font config xyz -overstrike] + font create xyz -overstrike 0 + lappend x [font config xyz -overstrike] + font config xyz -overstrike 1 + lappend x [font config xyz -overstrike] } -cleanup { - font delete xyz + font delete xyz } -result {0 1} test font-34.9 {ConfigAttributesObj procedure: size} -body { - font create xyz -size xyz + font create xyz -size xyz } -returnCodes error -result {expected integer but got "xyz"} test font-34.10 {ConfigAttributesObj procedure: weight} -body { - font create xyz -weight xyz + font create xyz -weight xyz } -returnCodes error -result {bad -weight value "xyz": must be normal, or bold} test font-34.11 {ConfigAttributesObj procedure: slant} -body { - font create xyz -slant xyz + font create xyz -slant xyz } -returnCodes error -result {bad -slant value "xyz": must be roman, or italic} test font-34.12 {ConfigAttributesObj procedure: underline} -body { - font create xyz -underline xyz + font create xyz -underline xyz } -returnCodes error -result {expected boolean value but got "xyz"} test font-34.13 {ConfigAttributesObj procedure: overstrike} -body { - font create xyz -overstrike xyz + font create xyz -overstrike xyz } -returnCodes error -result {expected boolean value but got "xyz"} @@ -2140,7 +2142,7 @@ test font-35.1 {GetAttributeInfoObj procedure: one attribute} -setup { font create xyz -family xyz font config xyz -family } -cleanup { - font delete xyz + font delete xyz } -result {xyz} @@ -2151,7 +2153,7 @@ test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} -setup { font create xyz font config xyz -xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes { error } -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} @@ -2164,60 +2166,60 @@ test font-37.1 {GetAttributeInfoObj procedure: all attributes} -setup { font create xyz -family xyz font config xyz } -cleanup { - font delete xyz + font delete xyz } -result {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0} test font-37.2 {GetAttributeInfo procedure: family} -setup { catch {font delete xyz} } -body { - font create xyz -family xyz - font config xyz -family + font create xyz -family xyz + font config xyz -family } -cleanup { - font delete xyz + font delete xyz } -result {xyz} test font-37.3 {GetAttributeInfo procedure: size} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -size 20 - font config xyz -size + font create xyz -size 20 + font config xyz -size } -cleanup { - font delete xyz + font delete xyz } -result 20 test font-37.4 {GetAttributeInfo procedure: weight} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -weight normal - font config xyz -weight + font create xyz -weight normal + font config xyz -weight } -cleanup { - font delete xyz + font delete xyz } -result {normal} test font-37.5 {GetAttributeInfo procedure: slant} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -slant italic - font config xyz -slant + font create xyz -slant italic + font config xyz -slant } -cleanup { - font delete xyz + font delete xyz } -result {italic} test font-37.6 {GetAttributeInfo procedure: underline} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -underline yes - font config xyz -underline + font create xyz -underline yes + font config xyz -underline } -cleanup { - font delete xyz + font delete xyz } -result 1 test font-37.7 {GetAttributeInfo procedure: overstrike} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -overstrike no - font config xyz -overstrike + font create xyz -overstrike no + font config xyz -overstrike } -cleanup { - font delete xyz + font delete xyz } -result 0 @@ -2256,7 +2258,7 @@ test font-38.10 {ParseFontNameObj procedure: arguments} -body { font actual {times xyz xyz} } -returnCodes error -result {expected integer but got "xyz"} test font-38.11 {ParseFontNameObj procedure: stylelist loop} -constraints { - unixOrWin + unixOrWin failsOnUbuntuNoXft } -body { lrange [font actual {times 12 bold italic overstrike underline}] 4 end } -result {-weight bold -slant italic -underline 1 -overstrike 1} @@ -2338,21 +2340,21 @@ test font-43.1 {FieldSpecified procedure: specified vs. non-specified} -body { } -result [font actual {times 0} -family] -test font-44.1 {TkFontGetPixels: size < 0} -setup { - set oldscale [tk scaling] +test font-44.1 {TkFontGetPixels: size < 0} -constraints failsOnUbuntuNoXft -setup { + set oldscale [tk scaling] } -body { - tk scaling 0.5 + tk scaling 0.5 font actual {times -12} -size } -cleanup { - tk scaling $oldscale + tk scaling $oldscale } -result 24 -test font-44.2 {TkFontGetPoints: size >= 0} -constraints noExceed -setup { - set oldscale [tk scaling] +test font-44.2 {TkFontGetPoints: size >= 0} -constraints {noExceed failsOnUbuntuNoXft} -setup { + set oldscale [tk scaling] } -body { - tk scaling 0.5 + tk scaling 0.5 font actual {times 12} -size } -cleanup { - tk scaling $oldscale + tk scaling $oldscale } -result 12 @@ -2374,12 +2376,12 @@ test font-45.3 {TkFontGetAliasList: match} -constraints {noExceed} -body { test font-46.1 {font actual, with character, no option, no --} -body { - font actual {times 10} a + font actual {times 10} a } -match glob -result [list -family [font actual {times 10} -family] -size *\ -slant roman -underline 0 -overstrike 0] test font-46.2 {font actual, with character introduced by --} -body { - font actual {times 10} -- - + font actual {times 10} -- - } -match glob -result [list -family [font actual {times 10} -family] -size *\ -slant roman -underline 0 -overstrike 0] diff --git a/tests/fontchooser.test b/tests/fontchooser.test index 97ca859..a9f914d 100644 --- a/tests/fontchooser.test +++ b/tests/fontchooser.test @@ -6,6 +6,9 @@ package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] + # the following helper functions are related to the functions used # in winDialog.test where they are used to send messages to the win32 # dialog (hence the wierdness). @@ -179,7 +182,7 @@ test fontchooser-4.3 {fontchooser -font} -constraints scriptImpl -body { expr {$::testfont ne {}} } -result 1 -test fontchooser-4.4 {fontchooser -font} -constraints scriptImpl -body { +test fontchooser-4.4 {fontchooser -font} -constraints {scriptImpl failsOnUbuntuNoXft} -body { start { tk::fontchooser::Configure -command ApplyFont -font {times 14 bold} tk::fontchooser::Show diff --git a/tests/grid.test b/tests/grid.test index 7f66e0d..b033311 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -45,7 +45,7 @@ test grid-1.1 {basic argument checking} -body { } -returnCodes error -result {wrong # args: should be "grid option arg ?arg ...?"} test grid-1.2 {basic argument checking} -body { grid foo bar -} -returnCodes error -match glob -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, content, forget, info, location, propagate, remove, rowconfigure, *size*} +} -returnCodes error -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, content, forget, info, location, propagate, remove, rowconfigure, or size} test grid-1.3 {basic argument checking} -body { button .b grid .b -row 0 -column diff --git a/tests/oldpack.test b/tests/oldpack.test index 35fd0f6..c3676ec 100644 --- a/tests/oldpack.test +++ b/tests/oldpack.test @@ -457,10 +457,10 @@ test oldpack-8.2 {syntax errors} -body { } -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} test oldpack-8.3 {syntax errors} -body { pack gorp foo -} -returnCodes error -match glob -result {bad option "gorp": must be configure, content, forget, info, *propagate*} +} -returnCodes error -result {bad option "gorp": must be configure, content, forget, info, or propagate} test oldpack-8.4 {syntax errors} -body { pack a .pack -} -returnCodes error -match glob -result {bad option "a": must be configure, content, forget, info, *propagate*} +} -returnCodes error -result {bad option "a": must be configure, content, forget, info, or propagate} test oldpack-8.5 {syntax errors} -body { pack after foobar } -returnCodes error -result {bad window path name "foobar"} diff --git a/tests/pack.test b/tests/pack.test index 02008c7..eb3ca3b 100644 --- a/tests/pack.test +++ b/tests/pack.test @@ -1361,7 +1361,7 @@ test pack-12.46 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { pack lousy .pack -} -returnCodes error -match glob -result {bad option "lousy": must be configure, content, forget, info, *propagate*} +} -returnCodes error -result {bad option "lousy": must be configure, content, forget, info, or propagate} test pack-13.1 {window deletion} -setup { pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom diff --git a/tests/pkgconfig.test b/tests/pkgconfig.test index e080b91..f07ca0f 100644 --- a/tests/pkgconfig.test +++ b/tests/pkgconfig.test @@ -18,7 +18,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test pkgconfig-1.1 {query keys} nonwin { +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] + +test pkgconfig-1.1 {query keys} nodeprecated { lsort [::tk::pkgconfig list] } [list \ 64bit bindir,install bindir,runtime debug demodir,install demodir,runtime \ diff --git a/tests/place.test b/tests/place.test index 3ef1de7..3da19f6 100644 --- a/tests/place.test +++ b/tests/place.test @@ -331,7 +331,7 @@ test place-9.5 {PlaceObjCmd} -setup { place badopt .foo } -cleanup { destroy .foo -} -returnCodes error -match glob -result {bad option "badopt": must be configure, content, forget, *info*} +} -returnCodes error -result {bad option "badopt": must be configure, content, forget, or info} test place-9.6 {PlaceObjCmd, configure errors} -setup { destroy .foo } -body { diff --git a/tests/safe.test b/tests/safe.test index 5a2cd26..3a3b029 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -35,7 +35,10 @@ namespace import -force tcltest::test set hidden_cmds [list bell cd clipboard encoding exec exit \ fconfigure glob grab load menu open pwd selection \ - socket source tcl:encoding:dirs toplevel unload wm] + socket source toplevel unload wm] +if {[package vsatisfies [package provide Tcl] 8.6.7-]} { + lappend hidden_cmds tcl:encoding:dirs +} if {[package vsatisfies [package provide Tcl] 8.7-]} { lappend hidden_cmds file tcl:encoding:system tcl:file:tempdir foreach cmd { diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 20ac275..86e742e 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -12,6 +12,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] proc scroll args { global scrollInfo @@ -316,7 +317,7 @@ destroy .t test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} { list [catch {.s get a} msg] $msg } {1 {wrong # args: should be ".s get"}} -test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} { +test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} nodeprecated { .s set 100 10 13 14 .s get } {100 10 13 14} @@ -401,27 +402,27 @@ test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} { } set result } {0.4 0.4} -test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set abc def ghi jkl} msg] $msg } {1 {expected integer but got "abc"}} -test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set 1 def ghi jkl} msg] $msg } {1 {expected integer but got "def"}} -test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set 1 2 ghi jkl} msg] $msg } {1 {expected integer but got "ghi"}} -test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set 1 2 3 jkl} msg] $msg } {1 {expected integer but got "jkl"}} -test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { .s set -10 50 20 30 .s get } {0 50 0 0} -test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { .s set 100 -10 20 30 .s get } {100 0 20 30} -test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { .s set 100 50 30 20 .s get } {100 50 30 30} diff --git a/tests/spinbox.test b/tests/spinbox.test index 070337d..3f6ac15 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -11,6 +11,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] + # For xscrollcommand set scrollInfo {} proc scroll args { @@ -2618,7 +2621,7 @@ test spinbox-8.17 {DeleteChars procedure} -setup { } -cleanup { destroy .e } -result 4 -test spinbox-8.18 {DeleteChars procedure} -setup { +test spinbox-8.18 {DeleteChars procedure} -constraints failsOnUbuntuNoXft -setup { spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e focus .e diff --git a/tests/textDisp.test b/tests/textDisp.test index 4b6535d..160e1c8 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -111,8 +111,6 @@ wm positionfrom . user wm deiconify . updateText -testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] - # Some window managers (like olwm under SunOS 4.1.3) misbehave in a way # that tends to march windows off the top and left of the screen. If # this happens, some tests will fail because parts of the window will diff --git a/tests/textTag.test b/tests/textTag.test index 94db751..e923611 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -26,6 +26,9 @@ testConstraint haveFontSizes [expr { [font actual $bigFont -size] == 24 } ] +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] + destroy .t text .t -width 20 -height 10 @@ -1342,7 +1345,7 @@ test textTag-16.1 {TkTextPickCurrent procedure} -setup { } -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3} test textTag-16.2 {TkTextPickCurrent procedure} -constraints { - haveFontSizes + haveFontSizes failsOnUbuntuNoXft } -setup { .t tag delete {*}[.t tag names] wm geometry . +200+200 ; update @@ -1438,7 +1441,7 @@ test textTag-16.5 {TkTextPickCurrent procedure} -constraints { } -result {3.2} test textTag-16.6 {TkTextPickCurrent procedure} -constraints { - haveFontSizes + haveFontSizes failsOnUbuntuNoXft } -setup { foreach i {big a b c d} { .t tag remove $i 1.0 end @@ -1460,7 +1463,7 @@ test textTag-16.6 {TkTextPickCurrent procedure} -constraints { } -result {3.1} test textTag-16.7 {TkTextPickCurrent procedure} -constraints { - haveFontSizes + haveFontSizes failsOnUbuntuNoXft } -setup { foreach i {big a b c d} { .t tag remove $i 1.0 end diff --git a/tests/unixFont.test b/tests/unixFont.test index 524191d..41afa6e 100644 --- a/tests/unixFont.test +++ b/tests/unixFont.test @@ -17,6 +17,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] if {[tk windowingsystem] eq "x11"} { set xlsf [auto_execok xlsfonts] @@ -116,7 +117,7 @@ test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} {x11 test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {x11 noExceed failsOnUbuntu} { lindex [font actual {-family courier}] 1 } {courier} -test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} x11 { +test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} {x11 failsOnUbuntuNoXft} { lindex [font actual {-family courier -size 37}] 3 } 37 test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} x11 { diff --git a/unix/tkUnix.c b/unix/tkUnix.c index df70cb0..633b057 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -16,7 +16,7 @@ # include <X11/extensions/scrnsaver.h> # ifdef __APPLE__ /* Support for weak-linked libXss. */ -# define HaveXSSLibrary() (XScreenSaverQueryInfo != NULL) +# define HaveXSSLibrary() (&XScreenSaverQueryInfo != NULL) # else /* Other platforms always link libXss. */ # define HaveXSSLibrary() (1) diff --git a/win/tkWinX.c b/win/tkWinX.c index 661ad29..f60823b 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -349,12 +349,12 @@ TkWinGetPlatformTheme(void) * TK_THEME_WIN_CLASSIC could be set even when running under XP if the * windows classic theme was selected. */ - if ((os.dwMajorVersion == 5) && (os.dwMinorVersion == 1)) { + if (os.dwMajorVersion == 5 && os.dwMinorVersion >= 1) { HKEY hKey; LPCWSTR szSubKey = L"Control Panel\\Appearance"; LPCWSTR szCurrent = L"Current"; DWORD dwSize = 200; - char pBuffer[200]; + WCHAR pBuffer[200]; memset(pBuffer, 0, dwSize); if (RegOpenKeyExW(HKEY_CURRENT_USER, szSubKey, 0L, @@ -363,7 +363,7 @@ TkWinGetPlatformTheme(void) } else { RegQueryValueExW(hKey, szCurrent, NULL, NULL, (LPBYTE) pBuffer, &dwSize); RegCloseKey(hKey); - if (strcmp(pBuffer, "Windows Standard") == 0) { + if (wcscmp(pBuffer, L"Windows Standard") == 0) { tkWinTheme = TK_THEME_WIN_CLASSIC; } else { tkWinTheme = TK_THEME_WIN_XP; |