summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/grid.n2
-rw-r--r--generic/tkFont.c16
-rw-r--r--generic/tkGrid.c15
-rw-r--r--generic/tkMenu.c4
-rw-r--r--generic/tkPack.c9
-rw-r--r--generic/tkPkgConfig.c3
-rw-r--r--generic/tkPlace.c33
-rw-r--r--generic/tkUtil.c2
-rw-r--r--library/demos/widget8
-rw-r--r--tests/bind.test5
-rw-r--r--tests/entry.test5
-rw-r--r--tests/font.test440
-rw-r--r--tests/fontchooser.test5
-rw-r--r--tests/grid.test2
-rw-r--r--tests/oldpack.test4
-rw-r--r--tests/pack.test2
-rw-r--r--tests/pkgconfig.test4
-rw-r--r--tests/place.test2
-rw-r--r--tests/safe.test5
-rw-r--r--tests/scrollbar.test17
-rw-r--r--tests/spinbox.test5
-rw-r--r--tests/textDisp.test2
-rw-r--r--tests/textTag.test9
-rw-r--r--tests/unixFont.test3
-rw-r--r--unix/tkUnix.c2
-rw-r--r--win/tkWinX.c6
26 files changed, 328 insertions, 282 deletions
diff --git a/doc/grid.n b/doc/grid.n
index 004c71e..684474b 100644
--- a/doc/grid.n
+++ b/doc/grid.n
@@ -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;
generated by cgit v0.12 at 2024-11-10 05:23:13 (GMT)