summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--tests/entry.test18
-rw-r--r--tests/font.test6
-rw-r--r--tests/spinbox.test23
-rw-r--r--tests/textDisp.test2
-rw-r--r--tests/textWind.test4
-rw-r--r--tests/winFont.test6
-rw-r--r--win/tkWinFont.c16
7 files changed, 42 insertions, 33 deletions
diff --git a/tests/entry.test b/tests/entry.test
index eeebe5d..785dd0b 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -2305,10 +2305,20 @@ test entry-8.18 {DeleteChars procedure} -setup {
.e insert 0 "xyzzy"
update
.e delete 2 4
- winfo reqwidth .e
-} -cleanup {
- destroy .e
-} -result {31}
+ # To check that deletion actually happened we measure the new width
+ # of the widget, based on the measuring width of the remaining text ("xyy")
+ # in the widget. For that purpose we have to mirror the code in tkEntry.c
+ # for computation of the reqwidth
+ # note: XPAD corresponds to the hardcoded #define XPAD 1
+ set XPAD 1
+ set expected [expr { [font measure [.e cget -font] "xyy"] \
+ + 2 * ( [.e cget -borderwidth] + \
+ [.e cget -highlightthickness] + $XPAD ) } ]
+ expr {[winfo reqwidth .e] == $expected}
+} -cleanup {
+ destroy .e
+ unset XPAD expected
+} -result {1}
test entry-9.1 {EntryValueChanged procedure} -setup {
unset -nocomplain x
diff --git a/tests/font.test b/tests/font.test
index 7e37698..b8c0144 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -141,7 +141,7 @@ test font-4.9 {font command: actual} -constraints {unix noExceed} -body {
test font-4.10 {font command: actual} -constraints win -body {
# (objc > 3) so objPtr = objv[3 + skip]
font actual {-family times} -family
-} -result {Times New Roman}
+} -result {times}
test font-4.11 {font command: bad option} -body {
font actual xyz -style
} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}
@@ -153,7 +153,7 @@ test font-4.13 {font command: actual} -body {
} -match glob -result {*}
test font-4.14 {font command: actual} -constraints win -body {
font actual {-family times} -family -- \ud800\udc00
-} -result {Times New Roman}
+} -result {times}
test font-4.15 {font command: actual} -body {
font actual {-family times} -- \udc00\ud800
} -returnCodes 1 -match glob -result {expected a single character but got "*"}
@@ -2345,7 +2345,7 @@ test font-45.1 {TkFontGetAliasList: no match} -body {
} -result [font actual {-size 10} -family]
test font-45.2 {TkFontGetAliasList: match} -constraints win -body {
font actual {times 10} -family
-} -result {Times New Roman}
+} -result {times}
test font-45.3 {TkFontGetAliasList: match} -constraints {unix noExceed} -body {
# can fail on Unix systems that have a real "times new roman" font
font actual {{times new roman} 10} -family
diff --git a/tests/spinbox.test b/tests/spinbox.test
index 206a61d..1f2bdac 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -2607,10 +2607,25 @@ test spinbox-8.18 {DeleteChars procedure} -setup {
.e insert 0 "xyzzy"
update
.e delete 2 4
- winfo reqwidth .e
-} -cleanup {
- destroy .e
-} -result {42}
+ # To check that deletion actually happened we measure the new width
+ # of the widget, based on the measuring width of the remaining text ("xyy")
+ # in the widget. For that purpose we have to mirror the code in tkEntry.c
+ # for computation of the reqwidth
+ # note: XPAD corresponds to the hardcoded #define XPAD 1
+ set XPAD 1
+ set buttonWidth [expr { [font measure [.e cget -font] "0"] + 2 * (1 + $XPAD) }]
+ if {$buttonWidth < 11} {
+ set buttonWidth 11
+ }
+ set expected [expr { [font measure [.e cget -font] "xyy"] \
+ + 2 * ( [.e cget -borderwidth] + \
+ [.e cget -highlightthickness] + $XPAD ) \
+ + $buttonWidth } ]
+ expr {[winfo reqwidth .e] == $expected}
+} -cleanup {
+ destroy .e
+ unset XPAD buttonWidth expected
+} -result {1}
test spinbox-9.1 {SpinboxValueChanged procedure} -setup {
unset -nocomplain x
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 0a72035..9a71d96 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -41,7 +41,7 @@ catch {destroy .f .t}
frame .f -width 100 -height 20
pack .f -side left
-set fixedFont {Courier -12}
+set fixedFont {"Courier New" -12}
# 15 on XP, 13 on Solaris 8
set fixedHeight [font metrics $fixedFont -linespace]
# 7 on all platforms
diff --git a/tests/textWind.test b/tests/textWind.test
index 4008f89..d32bd8d 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -16,7 +16,7 @@ tcltest::loadTestedCommands
option add *Text.borderWidth 2
option add *Text.highlightThickness 2
-option add *Text.font {Courier -12}
+option add *Text.font {"Courier New" -12}
deleteWindows
@@ -27,7 +27,7 @@ update
.t debug on
# 15 on XP, 13 on Solaris 8
-set fixedHeight [font metrics {Courier -12} -linespace]
+set fixedHeight [font metrics {"Courier New" -12} -linespace]
set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP
set color [expr {[winfo depth .t] > 1 ? "green" : "black"}]
diff --git a/tests/winFont.test b/tests/winFont.test
index 08a53ff..93aeca9 100644
--- a/tests/winFont.test
+++ b/tests/winFont.test
@@ -71,7 +71,7 @@ test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} -constraints
lappend x [font actual {-family "Times"} -family]
lappend x [font actual {-family "New York"} -family]
lappend x [font actual {-family "Times New Roman"} -family]
-} -result {{Times New Roman} {Times New Roman} {Times New Roman}}
+} -result {Times Times {Times New Roman}}
test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} -constraints {
win
} -setup {
@@ -80,7 +80,7 @@ test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} -constraint
lappend x [font actual {-family "Courier"} -family]
lappend x [font actual {-family "Monaco"} -family]
lappend x [font actual {-family "Courier New"} -family]
-} -result {{Courier New} {Courier New} {Courier New}}
+} -result {Courier Courier {Courier New}}
test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} -constraints {
win
} -setup {
@@ -89,7 +89,7 @@ test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} -constrai
lappend x [font actual {-family "Helvetica"} -family]
lappend x [font actual {-family "Geneva"} -family]
lappend x [font actual {-family "Arial"} -family]
-} -result {Arial Arial Arial}
+} -result {Helvetica Helvetica Arial}
test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} -constraints {
win
} -body {
diff --git a/win/tkWinFont.c b/win/tkWinFont.c
index 9a32227..c01dc3f 100644
--- a/win/tkWinFont.c
+++ b/win/tkWinFont.c
@@ -2528,22 +2528,6 @@ FamilyExists(
int result;
Tcl_DString faceString;
- /*
- * Just immediately rule out the following fonts, because they look so
- * ugly on windows. The caller's fallback mechanism will cause the
- * corresponding appropriate TrueType fonts to be selected.
- */
-
- if (strcasecmp(faceName, "Courier") == 0) {
- return 0;
- }
- if (strcasecmp(faceName, "Times") == 0) {
- return 0;
- }
- if (strcasecmp(faceName, "Helvetica") == 0) {
- return 0;
- }
-
Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &faceString);
/*
generated by cgit v0.12 at 2024-11-24 03:13:27 (GMT)