summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/clrpick.test8
-rw-r--r--tests/cursor.test21
-rw-r--r--tests/entry.test8
-rw-r--r--tests/font.test47
-rw-r--r--tests/macEmbed.test266
-rw-r--r--tests/macFont.test283
-rw-r--r--tests/macMenu.test1546
-rw-r--r--tests/macWinMenu.test102
-rw-r--r--tests/macscrollbar.test92
-rw-r--r--tests/menuDraw.test10
-rw-r--r--tests/safe.test6
-rw-r--r--tests/scrollbar.test58
-rw-r--r--tests/select.test14
-rw-r--r--tests/spinbox.test8
-rw-r--r--tests/text.test8
-rw-r--r--tests/tk.test4
-rw-r--r--tests/winfo.test4
-rw-r--r--tests/wm.test6
18 files changed, 47 insertions, 2444 deletions
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 4e7d9c6..5e19770 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: clrpick.test,v 1.8 2003/04/01 21:06:20 dgp Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.9 2004/03/17 18:15:49 das Exp $
#
package require tcltest 2.1
@@ -172,11 +172,7 @@ test clrpick-2.1 {tk_chooseColor command} \
set color #808040
test clrpick-2.2 {tk_chooseColor command} \
{nonUnixUserInteraction colorsLeftover} {
- if {$tcl_platform(platform) == "macintosh"} {
- set colors "32768 32768 16384"
- } else {
- set colors "128 128 64"
- }
+ set colors "128 128 64"
ToChooseColorByKey $parent 128 128 64
tk_chooseColor -parent $parent -title "choose $colors"
} "$color"
diff --git a/tests/cursor.test b/tests/cursor.test
index ab042d5..9da3539 100644
--- a/tests/cursor.test
+++ b/tests/cursor.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: cursor.test,v 1.10 2003/07/24 02:10:01 patthoyts Exp $
+# RCS: @(#) $Id: cursor.test,v 1.11 2004/03/17 18:15:49 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -260,25 +260,6 @@ foreach cursor {
unset n
# -------------------------------------------------------------------------
-# Check the Mac specific cursors
-set n 0
-foreach cursor {
- text
- cross-hair
-} {
- test cursor-8.$n {check cursor $cursor} \
- -constraints {macOnly} \
- -setup {button .b -text $cursor} \
- -body {
- list [catch {.b configure -cursor $cursor} msg] $msg
- } \
- -cleanup {destroy .b} \
- -result {0 {}}
- incr n
-}
-unset n
-
-# -------------------------------------------------------------------------
destroy .t
diff --git a/tests/entry.test b/tests/entry.test
index 69480b8..a8742b6 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: entry.test,v 1.15 2003/04/01 21:06:22 dgp Exp $
+# RCS: @(#) $Id: entry.test,v 1.16 2004/03/17 18:15:49 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -1201,7 +1201,7 @@ test entry-13.10 {GetEntryIndex procedure} {unixOnly} {
list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in widget .e}}
-test entry-13.11 {GetEntryIndex procedure} {macOrPc} {
+test entry-13.11 {GetEntryIndex procedure} {pcOnly} {
# On mac and pc, when selection is cleared, entry widget remembers
# last selected range. When selection ownership is restored to
# entry, the old range will be rehighlighted.
@@ -1211,10 +1211,10 @@ test entry-13.11 {GetEntryIndex procedure} {macOrPc} {
test entry-13.12 {GetEntryIndex procedure} {unixOnly} {
list [catch {.e index sbogus} msg] $msg
} {1 {selection isn't in widget .e}}
-test entry-13.13 {GetEntryIndex procedure} {macOrPc} {
+test entry-13.13 {GetEntryIndex procedure} {pcOnly} {
list [catch {.e index sbogus} msg] $msg
} {1 {bad entry index "sbogus"}}
-test entry-13.14 {GetEntryIndex procedure} {macOrPc} {
+test entry-13.14 {GetEntryIndex procedure} {pcOnly} {
list [catch {selection get}] [catch {.e index sbogus}]
} {1 1}
test entry-13.15 {GetEntryIndex procedure} {
diff --git a/tests/font.test b/tests/font.test
index 330f12e..ed6a64a 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: font.test,v 1.9 2003/04/01 21:06:29 dgp Exp $
+# RCS: @(#) $Id: font.test,v 1.10 2004/03/17 18:15:49 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -51,7 +51,6 @@ setup
case $tcl_platform(platform) {
unix {set fixed "fixed"}
windows {set fixed "courier 12"}
- macintosh {set fixed "monaco 9"}
}
set times [font actual {times 0} -family]
@@ -135,7 +134,7 @@ test font-4.8 {font command: actual: all attributes} {
# not (objc > 3) so objPtr = NULL
lindex [font actual {-family times}] 0
} {-family}
-test font-4.9 {font command: actual} {macOrUnix noExceed} {
+test font-4.9 {font command: actual} {unixOnly noExceed} {
# (objc > 3) so objPtr = objv[3 + skip]
string tolower [font actual {-family times} -family]
} {times}
@@ -507,11 +506,6 @@ test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
setup
.b.f config -font oemfixed
} {}
-test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
- # not (fontPtr == NULL)
- setup
- .b.f config -font application
-} {}
test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
# (fontPtr == NULL)
list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
@@ -665,15 +659,6 @@ test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
psfontname "{courier new} 10"
} {Courier}
-test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
- psfontname "geneva 10"
-} {Helvetica}
-test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
- psfontname "{new york} 10"
-} {Times-Roman}
-test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
- psfontname "monaco 10"
-} {Courier}
test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
set x [font actual {{lucida bright} 10} -family]
if {[string match lucida*bright $x]} {
@@ -736,27 +721,6 @@ foreach p {
set x
} [lrange $p 1 end]
}
-foreach p {
- {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
- {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
- {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
- {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
- {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
-} {
- test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
- set family [lindex $p 0]
- set x {}
- foreach slant {roman italic} {
- foreach weight {normal bold} {
- lappend x [psfontname [list $family 12 $slant $weight]]
- }
- }
- incr i
- set x
- } [lrange $p 1 end]
-}
test font-22.1 {Tk_TextWidth procedure} {
font measure [.b.l cget -font] "000"
@@ -1266,9 +1230,6 @@ test font-38.9 {ParseFontNameObj procedure: arguments} {
test font-38.10 {ParseFontNameObj procedure: arguments} {
list [catch {font actual {times xyz xyz}} msg] $msg
} {1 {expected integer but got "xyz"}}
-test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} {
- lrange [font actual {times 12 bold italic overstrike underline}] 4 end
-} {-weight bold -slant italic -underline 1 -overstrike 0}
test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
lrange [font actual {times 12 bold italic overstrike underline}] 4 end
} {-weight bold -slant italic -underline 1 -overstrike 1}
@@ -1343,10 +1304,6 @@ tk scaling $oldscale
test font-45.1 {TkFontGetAliasList: no match} {
font actual {snarky 10} -family
} [font actual {-size 10} -family]
-test font-45.2 {TkFontGetAliasList: match} {macOnly} {
- # Result could be either "Times" or "New York"
- font actual {{times new roman} 10} -family
-} [font actual {times 10} -family]
test font-45.3 {TkFontGetAliasList: match} {pcOnly} {
font actual {times 10} -family
} {Times New Roman}
diff --git a/tests/macEmbed.test b/tests/macEmbed.test
deleted file mode 100644
index 8fb2bee..0000000
--- a/tests/macEmbed.test
+++ /dev/null
@@ -1,266 +0,0 @@
-# This file is a Tcl script to test out the procedures in the file
-# tkMacEmbed.c. It is organized in the standard fashion for Tcl
-# tests.
-#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id: macEmbed.test,v 1.9 2003/04/01 21:06:38 dgp Exp $
-
-package require tcltest 2.1
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-
-test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
- catch {destroy .t}
- list [catch {toplevel .t -use xyz} msg] $msg
-} {1 {expected integer but got "xyz"}}
-test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
- catch {destroy .t}
- list [catch {toplevel .t -use 47} msg] $msg
-} {1 {The window ID 47 does not correspond to a valid Tk Window.}}
-
-test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- frame .f2 -container 1 -width 200 -height 50
- pack .f1 .f2
- set w [winfo id .f1]
- toplevel .t -use $w
- list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
-} {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
-test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- frame .f2 -container 1 -width 200 -height 50
- pack .f1 .f2
- set w1 [winfo id .f1]
- set w2 [winfo id .f2]
- toplevel .t1 -use $w1
- toplevel .t2 -use $w2
- testembed
-} {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}}
-
-# Can't think of any way to test the procedures TkpMakeWindow,
-# TkpMakeContainer, or EmbedErrorProc.
-
-test macEmbed-2.1 {EmbeddedEventProc procedure} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1
- testembed
- destroy .t1
- update
- testembed
-} {}
-test macEmbed-2.2 {EmbeddedEventProc procedure} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- toplevel .t1 -use [winfo id .f1]
- update
- destroy .f1
- testembed
-} {}
-test macEmbed-2.3 {EmbeddedEventProc procedure} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- toplevel .t1 -use [winfo id .f1]
- update
- destroy .t1
- update
- list [testembed] [winfo children .]
-} {{} {}}
-
-test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- set x [testembed]
- toplevel .t1 -use $w1
- wm withdraw .t1
- list $x [testembed]
-} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
-test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
- {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1 -bd 2 -relief raised
- update
- wm geometry .t1 +30+40
- update
- wm geometry .t1
-} {200x200+0+0}
-test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
- {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1
- update
- wm geometry .t1 300x100+30+40
- update
- wm geometry .t1
-} {300x100+0+0}
-test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
- deleteWindows
- toplevel .t1 -container 1 -width 200 -height 50
- set w1 [winfo id .t1]
- toplevel .t2 -use $w1
- update
- .t1 configure -width 300 -height 80
- update
- list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
-} {300 80 300x80+0+0}
-test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1
- set x unmapped
- bind .t1 <Map> {set x mapped}
- update
- after 100
- update
- set x
-} {mapped}
-test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- bind .f1 <Destroy> {set x dead}
- set x alive
- toplevel .t1 -use $w1
- update
- destroy .t1
- update
- list $x [winfo exists .f1]
-} {dead 0}
-
-test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1
- update
- .t1 configure -width 180 -height 100
- update
- winfo geometry .t1
-} {180x100+0+0}
-test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1
- update
- set x [testembed]
- destroy .f1
- list $x [testembed]
-} {{{XXX .f1 XXX .t1}} {}}
-
-# Can't think up any tests for TkpGetOtherWindow procedure.
-
-test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
- catch {interp delete child}
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- frame .f2 -width 200 -height 50
- pack .f1 .f2
- interp create child
- child eval "set argv {-use [winfo id .f1]}"
- load {} Tk child
- child eval {
- . configure -bd 2 -highlightthickness 2 -relief sunken
- }
- focus -force .f2
- update
- list [child eval {
- focus .
- set x [list [focus]]
- update
- lappend x [focus]
- }] [focus]
-} {{{} .} .f1}
-catch {interp delete child}
-
-test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- frame .f2 -container 1 -width 200 -height 50
- frame .f3 -container 1 -width 200 -height 50
- frame .f4 -container 1 -width 200 -height 50
- pack .f1 .f2 .f3 .f4
- set x {}
- lappend x [testembed]
- foreach w {.f3 .f4 .f1 .f2} {
- destroy $w
- lappend x [testembed]
- }
- set x
-} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
-test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {testembed macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- set w1 [winfo id .f1]
- toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
- set x {}
- lappend x [testembed]
- destroy .t1
- update
- lappend x [testembed]
-} {{{XXX .f1 XXX .t1}} {}}
-
-test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- toplevel .t1 -use [winfo id .f1] -width 150 -height 80
- update
- wm geometry .t1 +40+50
- update
- wm geometry .t1
-} {150x80+0+0}
-test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
- deleteWindows
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
- toplevel .t1 -use [winfo id .f1] -width 150 -height 80
- update
- wm geometry .t1 70x300+10+20
- update
- wm geometry .t1
-} {70x300+0+0}
-
-
-
-deleteWindows
-
-# cleanup
-cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/macFont.test b/tests/macFont.test
deleted file mode 100644
index 2afc946..0000000
--- a/tests/macFont.test
+++ /dev/null
@@ -1,283 +0,0 @@
-# This file is a Tcl script to test out the procedures in tkMacFont.c.
-# It is organized in the standard fashion for Tcl tests.
-#
-# Some of these tests are visually oriented and cannot be checked
-# programmatically (such as "does an underlined font appear to be
-# underlined?"); these tests attempt to exercise the code in question,
-# but there are no results that can be checked.
-#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id: macFont.test,v 1.7 2003/04/01 21:06:38 dgp Exp $
-
-package require tcltest 2.1
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-
-catch {destroy .b}
-toplevel .b
-update idletasks
-
-set courier {Courier 12}
-set cx [font measure $courier 0]
-
-set fixed {Monaco 12}
-label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed
-pack .b.l
-canvas .b.c -closeenough 0
-
-set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
-pack .b.c
-update
-
-set ax [winfo reqwidth .b.l]
-set ay [winfo reqheight .b.l]
-proc getsize {} {
- update
- return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
-}
-
-testConstraint gothic 0
-set gothic {gothic 12}
-set mx [font measure $gothic \u4e4e]
-if {[font actual $gothic -family] != [font actual system -family]} {
- testConstraint gothic 1
-}
-
-test macFont-1.1 {TkpFontPkgInit} {macOnly} {
-} {}
-
-test macfont-2.1 {TkpGetNativeFont: not native} {macOnly} {
- list [catch {font measure {} xyz} msg] $msg
-} {1 {font "" doesn't exist}}
-test macFont-2.2 {TkpGetNativeFont: native} {macOnly} {
- font measure system "0"
- font measure application "0"
- set x {}
-} {}
-
-test macFont-3.1 {TkpGetFontFromAttributes: no family} {macOnly} {
- font actual {-underline 1} -family
-} [font actual system -family]
-test macFont-3.2 {TkpGetFontFromAttributes: long family name} {macOnly} {
- set x "12345678901234567890123456789012345678901234567890"
- set x "$x$x$x$x$x$x"
- font actual "-family $x" -family
-} [font actual system -family]
-test macFont-3.3 {TkpGetFontFromAttributes: family} {macOnly} {
- font actual {-family Courier} -family
-} {Courier}
-test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {macOnly} {
- set x {}
- lappend x [font actual {-family "Times"} -family]
- lappend x [font actual {-family "Times New Roman"} -family]
-} {Times Times}
-test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {macOnly} {
- set x {}
- lappend x [font actual {-family "Courier"} -family]
- lappend x [font actual {-family "Courier New"} -family]
-} {Courier Courier}
-test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {macOnly} {
- set x {}
- lappend x [font actual {-family "Geneva"} -family]
- lappend x [font actual {-family "Helvetica"} -family]
- lappend x [font actual {-family "Arial"} -family]
-} {Geneva Helvetica Helvetica}
-test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {macOnly} {
- font actual {arial 10} -family
-} {Helvetica}
-test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {macOnly} {
- font actual {{ms sans serif} 10} -family
-} {Chicago}
-test macFont-3.9 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-weight normal} -weight
-} {normal}
-test macFont-3.10 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-weight bold} -weight
-} {bold}
-test macFont-3.11 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-slant roman} -slant
-} {roman}
-test macFont-3.12 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-slant italic} -slant
-} {italic}
-test macFont-3.13 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-underline false} -underline
-} {0}
-test macFont-3.14 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-underline true} -underline
-} {1}
-test macFont-3.15 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-overstrike false} -overstrike
-} {0}
-test macFont-3.16 {TkpGetFontFromAttributes: styles} {macOnly} {
- font actual {-overstrike true} -overstrike
-} {0}
-
-test macFont-4.1 {TkpDeleteFont} {macOnly} {
- font actual {-family xyz}
- set x {}
-} {}
-
-test macFont-5.1 {TkpGetFontFamilies} {macOnly} {
- expr {[lsearch [font families] Geneva] > 0}
-} {1}
-
-test macFont-6.1 {TkpGetSubFonts} {testfont gothic macOnly} {
- .b.l config -text "abc\u4e4e"
- update
- set x [testfont subfonts $fixed]
-} "Monaco [font actual $gothic -family]"
-
-test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {macOnly} {
- .b.l config -wrap 0 -text "000000"
- getsize
-} "[expr $ax*6] $ay"
-test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {macOnly} {
- .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
- getsize
-} "[expr $ax*256] $ay"
-test macFont-7.3 {Tk_MeasureChars: all chars did fit} {macOnly} {
- .b.l config -wrap [expr $ax*10] -text "00000000"
- getsize
-} "[expr $ax*8] $ay"
-test macFont-7.4 {Tk_MeasureChars: not all chars fit} {macOnly} {
- .b.l config -wrap [expr $ax*6] -text "00000000"
- getsize
-} "[expr $ax*6] [expr $ay*2]"
-test macFont-7.5 {Tk_MeasureChars: already saw space in line} {macOnly} {
- .b.l config -wrap [expr $ax*12] -text "000000 0000000"
- getsize
-} "[expr $ax*7] [expr $ay*2]"
-test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {macOnly} {
- .b.l config -wrap [expr $ax*12] -text "000 00 00000"
- getsize
-} "[expr $ax*7] [expr $ay*2]"
-test macFont-7.7 {Tk_MeasureChars: include last partial char} {macOnly} {
- .b.c dchars $t 0 end
- .b.c insert $t 0 "0000"
- .b.c index $t @[expr int($ax*2.5)],1
-} {2}
-test macFont-7.8 {Tk_MeasureChars: at least one char on line} { macOnly} {
- .b.l config -text "000000" -wrap 1
- getsize
-} "$ax [expr $ay*6]"
-test macFont-7.9 {Tk_MeasureChars: whole words} {macOnly} {
- .b.l config -wrap [expr $ax*8] -text "000000 0000"
- getsize
-} "[expr $ax*6] [expr $ay*2]"
-test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {macOnly} {
- .b.l config -wrap [expr $ax*12] -text "0000000000000000"
- getsize
-} "[expr $ax*12] [expr $ay*2]"
-test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {macOnly} {
- font measure system {}
-} {0}
-test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {macOnly} {
- font measure $courier abcd
-} "[expr $cx*4]"
-test macFont-7.13 {Tk_MeasureChars: loop on each char} {macOnly} {
- font measure $courier abcd
-} "[expr $cx*4]"
-test macFont-7.14 {Tk_MeasureChars: p == end} {macOnly} {
- font measure $courier abcd
-} "[expr $cx*4]"
-test macFont-7.15 {Tk_MeasureChars: p > end} {macOnly} {
- font measure $courier abc\xc2
-} "[expr $cx*4]"
-test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} {
- font measure $courier abc\u4e4edef
-} [expr $cx*6+$mx]
-test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} {
- font measure $courier \u4e4edef
-} [expr $mx+$cx*3]
-test macFont-7.18 {Tk_MeasureChars: final measure} {gothic macOnly} {
- font measure $courier \u4e4edef
-} [expr $mx+$cx*3]
-test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} {
- font measure $courier \u4e4e
-} [expr $mx]
-test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {macOnly} {
- .b.l config -wrap [expr $ax*8] -text "000"
- getsize
-} "[expr $ax*3] $ay"
-test macFont-7.21 {Tk_MeasureChars: loop on each char} {macOnly} {
- .b.l config -wrap [expr $ax*8] -text "000"
- getsize
-} "[expr $ax*3] $ay"
-test macFont-7.22 {Tk_MeasureChars: p == end} {macOnly} {
- .b.l config -wrap [expr $ax*8] -text "000"
- getsize
-} "[expr $ax*3] $ay"
-test macFont-7.23 {Tk_MeasureChars: p > end} {macOnly} {
- .b.l config -wrap [expr $ax*8] -text "00\xc2"
- getsize
-} "[expr $ax*3] $ay"
-test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} {
- .b.l config -wrap [expr $ax*8] -text "00\u4e4e00"
- getsize
-} "[expr $ax*4+$mx] $ay"
-test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} {
- .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
- getsize
-} "[expr $mx+$ax*2] $ay"
-test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic macOnly} {
- .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00"
- getsize
-} "[expr $ax*8+$mx*2] $ay"
-test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic macOnly} {
- .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00"
- getsize
-} "[expr $ax*5] [expr $ay*3]"
-test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic macOnly} {
- # even some of the "0"s would fit after \u4e4d, they should all wrap to next line.
- .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00"
- getsize
-} "[expr $ax*6+$mx] [expr $ay*3]"
-test macFont-7.29 {Tk_MeasureChars: final measure} {gothic macOnly} {
- .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
- getsize
-} "[expr $mx+$ax*2] $ay"
-test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} {
- .b.l config -wrap [expr $ax*8] -text "\u4e4e"
- getsize
-} "$mx $ay"
-test macFont-7.31 {Tk_MeasureChars: rest == NULL} {macOnly} {
- .b.l config -wrap [expr $ax*1000] -text 0000
- getsize
-} "[expr $ax*4] $ay"
-test macFont-7.32 {Tk_MeasureChars: rest != NULL} {macOnly} {
- .b.l config -wrap [expr $ax*6] -text "00000000"
- getsize
-} "[expr $ax*6] [expr $ay*2]"
-
-test macFont-8.1 {Tk_DrawChars procedure} {macOnly} {
- .b.l config -text "a"
- update
-} {}
-
-test macFont-9.1 {AllocMacFont: use old font} {macOnly} {
- font create xyz
- button .c -font xyz
- font configure xyz -family times
- update
- destroy .c
- font delete xyz
-} {}
-test macFont-9.2 {AllocMacFont: extract info from style} {macOnly} {
- font actual {Monaco 9 bold italic underline overstrike}
-} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
-test macFont-9.3 {AllocMacFont: extract text metrics} {macOnly} {
- font metric {Geneva 10} -fixed
-} {0}
-test macFont-9.4 {AllocMacFont: extract text metrics} {macOnly} {
- font metric "Monaco 9" -fixed
-} {1}
-
-destroy .b
-
-# cleanup
-cleanupTests
-return
diff --git a/tests/macMenu.test b/tests/macMenu.test
deleted file mode 100644
index ae38a49..0000000
--- a/tests/macMenu.test
+++ /dev/null
@@ -1,1546 +0,0 @@
-# This file is a Tcl script to test menus in Tk. It is
-# organized in the standard fashion for Tcl tests. This
-# file tests the Macintosh-specific features of the menu
-# system.
-#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id: macMenu.test,v 1.8 2003/04/01 21:06:39 dgp Exp $
-
-package require tcltest 2.1
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-
-test macMenu-1.0 {TkMacUseMenuID} {macOnly} {
- # Can't really test TkMacUseMenuID; it's only called on startup.
-} {}
-
-test macMenu-2.1 {GetNewID} {macOnly} {
- catch {destroy .m1}
- list [catch {menu .m1} msg] $msg [destroy .m1]
-} {0 .m1 {}}
-test macMenu-2.2 {GetNewID - cascade menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m2
- list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2]
-} {0 .m2 {} {}}
-test macMenu-2.3 {GetNewID - running out of ids} {macOnly} {
- deleteWindows
- menu .menu
- for {set i 0} {$i < 230} {incr i} {
- menu .m$i
- .menu add cascade -label ".m$i" -menu .m$i
- }
- menu .breaker
- list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
-} {1 {No more menus can be allocated.} {}}
-
-test macMenu-3.1 {FreeID} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {destroy .m1} msg] $msg
-} {0 {}}
-
-# No way to test running out of ids in TkpNewPlatformMenu
-test macMenu-4.1 {TkpNewMenu} {macOnly} {
- catch {destroy .m1}
- list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
-} {0 .m1 0 {}}
-test macMenu-4.2 {TkpNewMenu - checking for help menu when one is there} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- menu .m1
- menu .m1.help -tearoff 0
- .m1.help add command -label Test
- . configure -menu .m1
- raise .
- update
- list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2] [. configure -menu ""]
-} {0 .m2 {} {} {}}
-test macMenu-4.3 {TkpNewMenu - menubar set but different interp} {macOnly} {
- catch {interp delete testinterp}
- catch {destroy .m1}
- interp create testinterp
- load {} Tk testinterp
- interp eval testinterp {raise .}
- interp eval testinterp {menu .m1}
- interp eval testinterp {. configure -menu .m1}
- interp eval testinterp {update}
- list [catch {menu .m1} msg] $msg [destroy .m1] [interp delete testinterp]
-} {0 .m1 {} {}}
-test macMenu-4.4 {TkpNewMenu - menubar set but new menu has different parent} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- menu .m1 -tearoff 0
- .m1 add cascade -menu .m1.help
- menu .m2
- .m2 add cascade -menu .m2.help
- . configure -menu .m1
- raise .
- update
- list [catch {menu .m2.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2]
-} {0 .m2.help {} {} {}}
-test macMenu-4.5 {TkpNewMenu - menubar set, same parent, not .help} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add cascade -menu .m1.help
- . configure -menu .m1
- raise .
- update
- list [catch {menu .m1.foo} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 .m1.foo {} {}}
-test macMenu-4.6 {TkpNewMenu - creating the help menu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add cascade -menu .m1.help
- . configure -menu .m1
- raise .
- update
- list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 .m1.help {} {}}
-
-test macMenu-5.1 {TkpDestroyMenu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {destroy .m1} msg] $msg
-} {0 {}}
-test macMenu-5.2 {TkpDestroyMenu - help menu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add cascade -menu .m1.help
- . configure -menu .m1
- menu .m1.help
- raise .
- update
- list [catch {destroy .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-5.3 {TkpDestroyMenu - idle handler pending} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label test
- list [catch {destroy .m1} msg] $msg
-} {0 {}}
-test macMenu-5.4 {TkpDestroyMenu - idle handler not pending} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label test
- update idletasks
- list [catch {destroy .m1} msg] $msg
-} {0 {}}
-
-test macMenu-6.1 {SetMenuCascade} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- menu .m1
- menu .m2
- list [catch {.m2 add cascade -menu .m1} msg] $msg [destroy .m1 .m2]
-} {0 {} {}}
-test macMenu-6.2 {SetMenuCascade - running out of ids} {macOnly} {
- deleteWindows
- menu .menu
- for {set i 0} {$i < 230} {incr i} {
- menu .m$i
- .menu add cascade -label ".m$i" -menu .m$i
- }
- menu .breaker
- list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
-} {1 {No more menus can be allocated.} {}}
-
-test macMenu-7.1 {TkpDestroyMenuEntry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test"
- list [catch {.m1 delete 1} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-7.2 {TkpDestroyMenuEntry - help menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.help
- menu .m1.help -tearoff 0
- .m1.help add command -label "test"
- . configure -menu .m1
- raise .
- update
- list [catch {.m1.help delete test} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-
-test macMenu-8.1 {GetEntryText} {macOnly} {
- catch {destroy .m1}
- list [catch {menu .m1} msg] $msg [destroy .m1]
-} {0 .m1 {}}
-test macMenu-8.2 {GetEntryText} {macOnly testImageType} {
- catch {destroy .m1}
- catch {image delete image1}
- menu .m1
- image create test image1
- list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
-} {0 {} {} {}}
-test macMenu-8.3 {GetEntryText} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.4 {GetEntryText} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.5 {GetEntryText} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "foo"
- list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.6 {GetEntryText} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label "This is a very long string. 9012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890"} \
- msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.7 {GetEntryText - elipses character} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label "foo..."} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.8 {GetEntryText - false elipses character} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label "foo."} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.9 {GetEntryText - false elipses character} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label "foo.."} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.10 {GetEntryText - false elipses character} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label "foo.b"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-8.11 {GetEntryText - false elipses character} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label "foo..b"} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-
-# test macMenu-9.1 - assumes some fonts
-test macMenu-9.1 {FindMarkCharacter} {macOnly} {
- catch {destroy .m1}
- menu .m1 -font "Helvetica 12" -tearoff 0
- .m1 add checkbutton -label test
- .m1 invoke test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-# All standard fonts have "¥" defined. We can't test further.
-
-test macMenu-10.1 {SetMenuIndicator - cascade entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add cascade -label foo} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-10.2 {SetMenuIndicator - not radio or checkbutton} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label foo} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-10.3 {SetMenuIndicator - indiatorOn false} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add checkbutton -label foo -indicatoron 0} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-10.4 {SetMenuIndicator - entry not selected} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add checkbutton -label foo} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-10.5 {SetMenuIndicator - checkbutton} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo
- list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-10.6 {SetMenuIndicator - radio button} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add radiobutton -label foo
- list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-11.1 {SetMenuTitle} {macOnly} {
- catch {destroy .m1}
- catch {destroy .container}
- menu .container
- menu .m1
-#previous title is .m1
- .container add cascade -label "File" -menu .m1
- list [catch {. configure -menu .container} msg] $msg [. configure -menu ""] [destroy .container .m1]
-} {0 {} {} {}}
-test macMenu-11.2 {SetMenuTitle} {macOnly} {
- menu .container
- menu .m1
- . configure -menu ""
-#previous title is .m1
- .container add cascade -label "F" -menu .m1
- list [catch {. configure -menu .container} msg] $msg [. configure -menu ""] [destroy .container .m1]
-} {0 {} {} {}}
-
-test macMenu-12.1 {TkpConfigureMenuEntry} {macOnly} {
- catch {destroy .m1}
- . configure -menu ""
- menu .m1
- .m1 add cascade -menu .m3
- list [catch {.m1 entryconfigure 1 -menu .m2} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.2 {TkpConfigureMenuEntry} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- . configure -menu ""
- menu .m1
- .m1 add cascade -menu .m3
- menu .m2
- list [catch {.m1 entryconfigure 1 -menu .m2} msg] $msg [destroy .m1 .m2]
-} {0 {} {}}
-test macMenu-12.3 {TkpConfigureMenuEntry - running out of ids} {macOnly} {
- deleteWindows
- menu .menu
- for {set i 0} {$i < 230} {incr i} {
- menu .m$i
- .menu add cascade -label ".m$i" -menu .m$i
- }
- menu .breaker
- list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
-} {1 {No more menus can be allocated.} {}}
-test macMenu-12.4 {TkpConfigureMenuEntry - Control} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Control+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.5 {TkpConfigureMenuEntry - Ctrl} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Ctrl+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.6 {TkpConfigureMenuEntry - Shift} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Shift+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.7 {TkpConfigureMenuEntry - Option} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Opt+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.8 {TkpConfigureMenuEntry - Command} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Command+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.9 {TkpConfigureMenuEntry - Cmd} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Cmd+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.10 {TkpConfigureMenuEntry - Alt} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Alt+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.11 {TkpConfigureMenuEntry - Meta} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Meta+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.12 {TkpConfigureMenuEntry - Two modifiers} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Cmd+Shift+S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.13 {TkpConfigureMenuEntry - dash instead of plus} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -accel "Command-S"} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.14 {TkpConfigureMenuEntry - idler pending} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label test
- list [catch {.m1 entryconfigure test -label test2} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-12.15 {TkpConfigureMenuEntry - idler not pending} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label test
- update idletasks
- list [catch {.m1 entryconfigure test -label test2} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-13.1 {ReconfigureIndividualMenu - getting rid of zero items} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.2 {ReconfigureIndividualMenu - getting rid of one item} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label test
- update idletasks
- .m1 delete test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.3 {ReconfigureIndividualMenu - getting rid of more than one} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label test
- .m1 add command -label test2
- update idletasks
- .m1 entryconfigure test2 -label "test two"
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.4 {ReconfigureIndividualMenu - separator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add separator
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.5 {ReconfigureIndividualMenu - disabled} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command
- .m1 entryconfigure 1 -state disabled
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.6 {ReconfigureIndividualMenu - active} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command
- .m1 entryconfigure 1 -state active
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.7 {ReconfigureIndividualMenu - checkbutton not checked} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.8 {ReconfigureIndividualMenu - checkbutton - indicator off} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label test -indicatoron 0
- .m1 invoke test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.9 {ReconfigureIndividualMenu - checkbutton on} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label test
- .m1 invoke test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.10 {ReconfigureIndividualMenu - radiobutton not checked} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add radiobutton -label test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.11 {ReconfigureIndividualMenu - radiobutton - indicator off} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add radiobutton -label test -indicatoron 0
- .m1 invoke test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.12 {ReconfigureIndividualMenu - radiobutton on} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add radiobutton -label test
- .m1 invoke test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.13 {ReconfigureIndividualMenu} {macOnly} {
- catch {destroy .m1}
- . configure -menu ""
- menu .m1
- .m1 add cascade -menu .m3
- .m1 entryconfigure 1 -menu .m2
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.14 {ReconfigureIndividualMenu} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- . configure -menu ""
- menu .m1
- .m1 add cascade -menu .m3
- menu .m2
- .m1 entryconfigure 1 -menu .m2
- list [catch {update idletasks} msg] $msg [destroy .m1 .m2]
-} {0 {} {}}
-test macMenu-13.15 {ReconfigureIndividualMenu - accelerator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -accel "Command-S"
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.16 {ReconfigureIndividualMenu - parent is disabled} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -label .m1.edit -label "Edit" -state disabled
- menu .m1.edit
- .m1.edit add command -label foo
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-13.17 {ReconfigureIndividualMenu - disabling parent} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -label .m1.edit -label Edit
- menu .m1.edit
- .m1.edit add command -label foo
- .m1 entryconfigure Edit -state disabled
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-14.1 {ReconfigureMacintoshMenu - normal menu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label test
- list [catch {update idletasks} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-14.2 {ReconfigureMacintoshMenu - apple menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.apple
- menu .m1.apple -tearoff 0
- .m1.apple add command -label test
- . configure -menu .m1
- raise .
- list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-14.3 {ReconfigureMacintoshMenu - help menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.help
- menu .m1.help -tearoff 0
- .m1.help add command -label test
- . configure -menu .m1
- raise .
- list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-14.4 {ReconfigureMacintoshMenu - menubar} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.file -label "foo"
- menu .m1.file
- . configure -menu .m1
- raise .
- .m1 entryconfigure foo -label "File"
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-
-test macMenu-15.1 {CompleteIdlers - no idle pending} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label test
- update idletasks
- list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-15.2 {CompleteIdlers - idle pending} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label test
- list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-15.3 {CompleteIdlers - recursive} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.m2 -label test
- menu .m1.m2
- .m1.m2 add command -label test
- list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-#Don't know how to generate nested post menus
-test macMenu-16.1 {TkpPostMenu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -postcommand "destroy .m1"
- list [catch {.m1 post 40 40} msg] $msg
-} {0 {}}
-test macMenu-16.2 {TkpPostMenu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -postcommand "blork"
- list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
-} {1 {invalid command name "blork"} {}}
-# We need to write the interactive test for menu posting.
-
-test macMenu-17.1 {TkpMenuNewEntry - no idle pending} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [catch {.m1 add command -label test} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-17.2 {TkpMenuNewEntry - idle pending} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label test
- list [catch {.m1 add command -label test2} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-18.1 {DrawMenuBarWhenIdle} {macOnly} {
- catch {destroy .m1}
- . configure -menu ""
- menu .m1
- . configure -menu .m1
- list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.2 {DrawMenuBarWhenIdle - clearing old apple menu out} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.apple
- menu .m1.apple
- .m1.apple add command -label test
- . configure -menu .m1
- raise .
- update
- . configure -menu ""
- raise .
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-18.3 {DrawMenuBarWhenIdle - clearing out old help menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.help
- menu .m1.help
- .m1.help add command -label test
- . configure -menu .m1
- raise .
- update
- . configure -menu ""
- raise .
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-18.4 {DrawMenuBarWhenIdle - menu not there} {macOnly} {
- catch {destroy .m1}
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""]
-} {0 {} {}}
-test macMenu-18.5 {DrawMenuBarWhenIdle - menu there} {macOnly} {
- catch {destroy .m1}
- menu .m1
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.6 {DrawMenuBarWhenIdle - no apple menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.7 {DrawMenuBarWhenIdle - apple menu references but not there} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.apple
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.8 {DrawMenuBarWhenIdle - apple menu there} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.apple
- menu .m1.apple
- .m1.apple add command -label test
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.9 {DrawMenuBarWhenIdle - apple menu there; no idle handler} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.apple
- menu .m1.apple
- .m1.apple add command -label test
- . configure -menu .m1
- raise .
- update idletasks
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.10 {DrawMenuBarWhenIdle - no help menu} {macOnly} {
- catch {destroy .m1}
- menu .m1
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.11 {DrawMenuBarWhenIdle - help menu referenced but not there} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.help
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.12 {DrawMenuBarWhenIdle - help menu there} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.help
- menu .m1.help
- .m1.help add command -label test
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.13 {DrawMenuBarWhenIdle - help menu there - no idlers} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.help
- menu .m1.help
- .m1.help add command -label test
- . configure -menu .m1
- raise .
- update idletasks
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-# Can't generate no menubar clone
-test macMenu-18.14 {DrawMenuBarWhenIdle - apple and help menus in tearoff menubar} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -menu .m1.apple
- .m1 add cascade -menu .m1.help
- menu .m1.apple
- menu .m1.help
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.15 {DrawMenuBarWhenIdle - apple and help menus in non-tearoff menubar} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add cascade -menu .m1.apple
- .m1 add cascade -menu .m1.help
- menu .m1.apple
- menu .m1.help
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.16 {DrawMenuBarWhenIdle - no apple menu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.17 {DrawMenuBarWhenIdle - apple menu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- . configure -menu .m1
- .m1 add cascade -menu .m1.apple
- menu .m1.apple
- .m1.apple add cascade -label test -menu .m1.apple.test
- menu .m1.apple.test
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.18 {DrawMenuBarWhenIdle - big for loop} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- menu .m1.apple -tearoff 0
- menu .m1.help -tearoff 0
- menu .m1.foo -tearoff 0
- .m1 add cascade -menu .m1.apple
- .m1 add cascade -menu .m1.help
- .m1 add cascade -label Foo -menu .m1.foo
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-18.19 {DrawMenuBarWhenIdle = disabled menu} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- menu .m1.edit -tearoff 0
- .m1 add cascade -menu .m1.edit -label Edit
- . configure -menu .m1
- raise .
- .m1 entryconfigure Edit -state disabled
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-
-test macMenu-19.1 {RecursivelyInsertMenu} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- catch {destroy .main}
- catch {destroy .t2}
- toplevel .t2 -menu .main
- wm geometry .t2 +0+0
- menu .main
- .main add cascade -menu .m1 -label ".m1"
- menu .m1
- .m1 add command -label "Test 2"
- .m1 add cascade -label ".m2" -menu .m2
- menu .m2
- .m2 add command -label "Test 3"
- list [catch {raise .t2} msg] $msg [destroy .t2 .main .m1 .m2]
-} {0 {} {}}
-test macMenu-19.2 {RecursivelyInsertMenu} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- catch {destroy .main}
- catch {destroy .t2}
- toplevel .t2 -menu .main
- wm geometry .t2 +0+0
- menu .main
- .main add cascade -menu .m1 -label ".m1"
- menu .m1
- .m1 add command -label "Test 2"
- .m1 add cascade -label ".m2" -menu .m2
- menu .m2
- .m2 add command -label "Test 3"
- list [catch {raise .t2} msg] $msg [destroy .t2 .main .m1 .m2]
-} {0 {} {}}
-
-test macMenu-20.1 {SetDefaultMenuBar} {macOnly} {
- . configure -menu ""
- raise .
- list [catch {update} msg] $msg
-} {0 {}}
-
-test macMenu-21.1 {TkpSetMainMenubar - not front window} {macOnly} {
- catch {destroy .m1}
- catch {destroy .t2}
- toplevel .t2
- wm geometry .t2 +50+50
- menu .m1
- raise .
- update
- list [catch {.t2 configure -menu .m1} msg] $msg [destroy .t2] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-21.2 {TkpSetMainMenubar - menu null} {macOnly} {
- . configure -menu ""
- raise .
- list [catch {update} msg] $msg
-} {0 {}}
-test macMenu-21.3 {TkpSetMainMenubar - different interps} {macOnly} {
- catch {destroy .m1}
- catch {interp delete testinterp}
- interp create testinterp
- load {} Tk testinterp
- menu .m1
- . configure -menu .m1
- raise .
- update
- interp eval testinterp {menu .m1}
- interp eval testinterp {. configure -menu .m1}
- interp eval testinterp {raise .}
- list [catch {interp eval testinterp {update}} msg] $msg [interp delete testinterp] [. configure -menu ""] [destroy .m1]
-} {0 {} {} {} {}}
-test macMenu-21.4 {TkpSetMainMenubar - different windows} {macOnly} {
- catch {destroy .m1}
- catch {destroy .t2}
- menu .m1
- . configure -menu .m1
- toplevel .t2
- wm geometry .t2 +50+50
- .t2 configure -menu .m1
- raise .
- update
- raise .t2
- list [catch {update} msg] $msg [destroy .t2] [. configure -menu ""] [destroy .m1]
-} {0 {} {} {} {}}
-test macMenu-21.5 {TkpSetMainMenubar - old menu was null} {macOnly} {
- catch {destroy .m1}
- . configure -menu ""
- update
- menu .m1
- . configure -menu .m1
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test macMenu-21.6 {TkpSetMainMenubar - old menu different} {macOnly} {
- catch {destroy .m1}
- catch {destroy .m2}
- menu .m1
- menu .m2
- . configure -menu .m1
- raise .
- update
- . configure -menu .m2
- raise .
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2]
-} {0 {} {} {} {}}
-test macMenu-21.7 {TkpSetMainMenubar - child window NULL - parent window now} {macOnly} {
- catch {destroy .m1}
- catch {destroy .t2}
- toplevel .t2
- menu .m1
- .m1 add cascade -label Foo -menu .m1.foo
- menu .m1.foo
- .m1.foo add command -label foo
- . configure -menu .m1
- raise .t2
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2]
-} {0 {} {} {} {}}
-test macMenu-21.8 {TkpSetMainMenubar - tearoff window} {macOnly} {
- catch {destroy .t2}
- toplevel .t2 -menu .t2.m1
- menu .t2.m1
- .t2.m1 add cascade -label File -menu .t2.m1.foo
- menu .t2.m1.foo
- .t2.m1.foo add command -label foo
- raise .t2
- tk::TearOffMenu .t2.m1.foo 100 100
- list [catch {update} msg] $msg [destroy .t2]
-} {0 {} {}}
-
-test macMenu-22.1 {TkSetWindowMenuBar} {macOnly} {
-} {}
-
-test macMenu-23.1 {TkMacDispatchMenuEvent} {macOnly} {
- # needs to be interactive.
-} {}
-
-test macMenu-24.1 {GetMenuIndicatorGeometry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo
- .m1 invoke foo
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-
-test macMenu-25.1 {GetMenuAccelGeometry - cascade entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -label foo
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.2 {GetMenuAccelGeometry - no accel} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.3 {GetMenuAccelGeometry - no special chars - arbitrary string} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -accel "Test"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.4 {GetMenuAccelGeometry - Command} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Cmd+S"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.5 {GetMenuAccelGeometry - Control} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Ctrl+S"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.6 {GetMenuAccelGeometry - Shift} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Shift+S"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.7 {GetMenuAccelGeometry - Option} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Opt+S"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.8 {GetMenuAccelGeometry - Combination} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Cmd+Shift+S"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test macMenu-25.9 {GetMenuAccelGeometry - extra text} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Command+Delete"
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-
-test macMenu-26.1 {GetTearoffEntryGeometry} {macOnly} {
- # can't call this on power mac.
-} {}
-
-test macMenu-27.1 {GetMenuSeparatorGeometry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add separator
- list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-
-test macMenu-28.1 {DrawMenuEntryIndicator - non-checkbutton} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo -indicatoron 0
- .m1 invoke foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-28.3 {DrawMenuEntryIndicator - not selected} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo
- .m1 invoke foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add radiobutton -label foo
- .m1 invoke foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-# Cannot reproduce resources missing or color allocation failing easily.
-test macMenu-29.1 {DrawSICN} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Cmd+S"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-# Cannot reproduce resources missing
-test macMenu-30.1 {DrawMenuEntryAccelerator - cascade entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.2 {DrawMenuEntryAccelerator - no accel string} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.3 {DrawMenuEntryAccelerator - random accel string} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.4 {DrawMenuEntryAccelerator - Command} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Cmd+S"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.5 {DrawMenuEntryAccelerator - Option} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Opt+S"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.6 {DrawMenuEntryAccelerator - Shift} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Shift+S"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.7 {DrawMenuEntryAccelerator - Control} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Ctrl+S"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test macMenu-30.8 {DrawMenuEntryAccelerator - combination} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -accel "Cmd+Shift+S"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-31.1 {DrawMenuSeparator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add separator
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-32.1 {TkpDrawMenuEntryLabel} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-
-test macMenu-33.1 {MenuDefProc - No way to test automatically.} {} {}
-test macMenu-34.1 {TkMacHandleTearoffMenu - no way to test automatically} {} {}
-test macMenu-35.1 {TkpInitializeMenuBindings - nothing to do} {} {}
-
-test macMenu-36.1 {TkpComputeMenubarGeometry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -label foo
- . configure -menu .m1
- list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-
-test macMenu-37.1 {DrawTearoffEntry - can't do automatically} {} {}
-test macMenu-38.1 {TkMacSetHelpMenuItemCount - called at boot time} {} {}
-test macMenu-39.1 {TkMacMenuClick - can't do automatically} {} {}
-
-test macMenu-40.1 {TkpDrawMenuEntry - gc for active and not strict motif} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -activeforeground red
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.3 {TkpDrawMenuEntry - gc for active and strict motif} {macOnly} {
- catch {destroy .m1}
- menu .m1
- set tk_strictMotif 1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1] [set tk_strictMotif 0]
-} {{} {} 0}
-test macMenu-40.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} {macOnly} {
- catch {destroy .m1}
- menu .m1 -disabledforeground blue
- .m1 add command -label foo -state disabled -background red
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {macOnly} {
- catch {destroy .m1}
- menu .m1 -disabledforeground blue
- .m1 add command -label foo -state disabled
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {macOnly} {
- catch {destroy .m1}
- menu .m1 -disabledforeground ""
- .m1 add command -label foo -state disabled
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.7 {TkpDrawMenuEntry - gc for normal - custom entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -foreground red
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.8 {TkpDrawMenuEntry - gc for normal} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo -selectcolor orange
- .m1 invoke 1
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label foo
- .m1 invoke 1
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.11 {TkpDrawMenuEntry - border - custom entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -activebackground green
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.12 {TkpDrawMenuEntry - border} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.13 {TkpDrawMenuEntry - active border - strict motif} {macOnly} {
- catch {destroy .m1}
- set tk_strictMotif 1
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1] [set tk_strictMotif 0]
-} {{} {} 0}
-test macMenu-40.14 {TkpDrawMenuEntry - active border - custom entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -activeforeground yellow
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.15 {TkpDrawMenuEntry - active border} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- .m1 entryconfigure 1 -state active
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.16 {TkpDrawMenuEntry - font - custom entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo -font "Helvectica 72"
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.17 {TkpDrawMenuEntry - font} {macOnly} {
- catch {destroy .m1}
- menu .m1 -font "Courier 72"
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.18 {TkpDrawMenuEntry - separator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add separator
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.19 {TkpDrawMenuEntry - standard} {macOnly} {
- catch {destroy .mb}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add cascade -label File -menu .m1.file
- menu .m1.file
- .m1.file add command -label foo
- .m1 entryconfigure File -state disabled
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.21 {TkpDrawMenuEntry - indicator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label macMenu-40.20
- .m1 invoke 0
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label macMenu-40.21 -hidemargin 1
- .m1 invoke 0
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-
-test macMenu-41.1 {TkpComputeStandardMenuGeometry - no entries} {macOnly} {
- catch {destroy .m1}
- menu .m1
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.2 {TkpComputeStandardMenuGeometry - one entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "one"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.3 {TkpComputeStandardMenuGeometry - more than one entry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "one"
- .m1 add command -label "two"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.4 {TkpComputeStandardMenuGeometry - separator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add separator
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.5 {TkpComputeStandardMenuGeometry - standard label geometry} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.6 {TkpComputeStandardMenuGeometry - different font for entry} {macOnly} {
- catch {destroy .m1}
- menu .m1 -font "Helvetica 12"
- .m1 add command -label "test" -font "Courier 12"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.7 {TkpComputeStandardMenuGeometry - second entry larger} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test"
- .m1 add command -label "test test"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.8 {TkpComputeStandardMenuGeometry - first entry larger} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test test"
- .m1 add command -label "test"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.9 {TkpComputeStandardMenuGeometry - accelerator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test" -accel "Ctrl+S"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.10 {TkpComputeStandardMenuGeometry - second accel larger} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test" -accel "1"
- .m1 add command -label "test" -accel "1 1"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.11 {TkpComputeStandardMenuGeometry - second accel smaller} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "test" -accel "1 1"
- .m1 add command -label "test" -accel "1"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.12 {TkpComputeStandardMenuGeometry - indicator} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label test
- .m1 invoke 1
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } {macOnly testImageType} {
- catch {destroy .m1}
- catch {image delete image1}
- image create test image1
- menu .m1
- .m1 add checkbutton -image image1
- .m1 invoke 1
- .m1 add checkbutton -label test
- .m1 invoke 2
- list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-test macMenu-41.14 {TkpComputeStandardMenuGeometry - hidden margin} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add checkbutton -label macMenu-41.15 -hidemargin 1
- .m1 invoke macMenu-41.15
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.15 {TkpComputeStandardMenuGeometry - zero sized menus} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.16 {TkpComputeStandardMenuGeometry - first column bigger} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label one
- .m1 add command -label two
- .m1 add command -label three -columnbreak 1
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.17 {TkpComputeStandardMenuGeometry - second column bigger} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label one
- .m1 add command -label two -columnbreak 1
- .m1 add command -label three
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.18 {TkpComputeStandardMenuGeometry - three columns} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label one
- .m1 add command -label two -columnbreak 1
- .m1 add command -label three
- .m1 add command -label four
- .m1 add command -label five -columnbreak 1
- .m1 add command -label six
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.19 {TkpComputeStandardMenuGeometry - entry without accel long} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label "This is a long item with no accel."
- .m1 add command -label foo -accel "Cmd+S"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-41.20 {TkpComputeStandardMenuGeometry - entry with accel long} {macOnly} {
- catch {destroy .m1}
- menu .m1 -tearoff 0
- .m1 add command -label foo
- .m1 add command -label "This is a long label with an accel." -accel "Cmd+W"
- list [update idletasks] [destroy .m1]
-} {{} {}}
-
-test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "foo"
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testImageType} {
- catch {destroy .m1}
- catch {image delete image1}
- image create test image1
- menu .m1
- .m1 add command -image image1
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testImageType} {
- catch {destroy .m1}
- catch {eval image delete [image names]}
- image create test image1
- image create test image2
- menu .m1
- .m1 add checkbutton -image image1 -selectimage image2
- .m1 invoke 1
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1] [eval image delete [image names]]
-} {{} {} {}}
-test macMenu-42.4 {DrawMenuEntryLabel - drawing a bitmap} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -bitmap questhead
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-42.5 {DrawMenuEntryLabel - drawing null label} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-42.6 {DrawMenuEntryLabel - drawing real label} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "This is a long label" -underline 3
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} {macOnly} {
- catch {destroy .m1}
- menu .m1 -disabledforeground ""
- .m1 add command -label "This is a long label" -state disabled
- set tearoff [tk::TearOffMenu .m1]
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testImageType} {
- catch {destroy .m1}
- catch {image delete image1}
- image create test image1
- menu .m1
- .m1 add command -image image1 -state disabled
- set tearoff [tk::TearOffMenu .m1 100 100]
- list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-
-test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testImageType} {
- catch {destroy .m1}
- catch {image delete image1}
- menu .m1
- image create test image1
- .m1 add command -image image1
- list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-test macMenu-43.2 {GetMenuLabelGeometry - bitmap} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -bitmap questhead
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-43.3 {GetMenuLabelGeometry - no text} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command
- list [update idletasks] [destroy .m1]
-} {{} {}}
-test macMenu-43.4 {GetMenuLabelGeometry - text} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label "This is a test."
- list [update idletasks] [destroy .m1]
-} {{} {}}
-
-test macMenu-44.1 {DrawMenuEntryBackground} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- list [update] [destroy .m1]
-} {{} {}}
-test macMenu-44.2 {DrawMenuEntryBackground} {macOnly} {
- catch {destroy .m1}
- menu .m1
- .m1 add command -label foo
- set tearoff [tk::TearOffMenu .m1 40 40]
- $tearoff activate 0
- list [update] [destroy .m1]
-} {{} {}}
-
-test macMenu-45.1 {TkpMenuInit - called at boot time} {macOnly} {
-} {}
-
-# cleanup
-deleteWindows
-cleanupTests
-return
diff --git a/tests/macWinMenu.test b/tests/macWinMenu.test
deleted file mode 100644
index 935c365..0000000
--- a/tests/macWinMenu.test
+++ /dev/null
@@ -1,102 +0,0 @@
-# This file is a Tcl script to test menus in Tk. It is
-# organized in the standard fashion for Tcl tests. It tests
-# the common implementation of Macintosh and Windows menus.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id: macWinMenu.test,v 1.5 2003/04/01 21:06:41 dgp Exp $
-
-package require tcltest 2.1
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-
-test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
- catch {destroy .m1}
- menu .m1 -postcommand "destroy .m1"
- .m1 add command -label "macWinMenu-1.1: Hit Escape"
- list [catch {.m1 post 40 40} msg] $msg
-} {0 {}}
-test macWinMenu-1.2 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
- catch {destroy .m1}
- catch {destroy .m2}
- set foo1 foo
- set foo2 foo
- menu .m1 -postcommand "set foo1 .m1"
- .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
- menu .m2 -postcommand "set foo2 .m2"
- update idletasks
- list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] \
- [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]
-} {0 .m2 .m1 .m2 {} 0 0}
-
-test macWinMenu-1.3 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
- catch {destroy .l1}
- catch {destroy .m1}
- catch {destroy .m2}
- catch {destroy .m3}
- label .l1 -text "Preparing menus..."
- pack .l1
- update idletasks
- menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
- menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
- menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
- .m1 add cascade -menu .m2 -label "macWinMenu-1.3: Hit Escape (.m2)"
- .m1 add cascade -menu .m3 -label ".m3"
- update idletasks
- list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3]
-} {0 {} {}}
-test macWinMenu-1.4 {PreprocessMenu} {macOrPc} {
- catch {destroy .l1}
- catch {destroy .m1}
- catch {destroy .m2}
- catch {destroy .m3}
- catch {destroy .m4}
- label .l1 -text "Preparing menus..."
- pack .l1
- update idletasks
- menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
- .m1 add cascade -menu .m2 -label "macWinMenu-1.4: Hit Escape (.m2)"
- .m1 add cascade -menu .m3 -label ".m3"
- menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
- .m2 add cascade -menu .m4 -label ".m4"
- menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
- menu .m4 -postcommand ".l1 configure -text \"Destroying .m4...\"; update idletasks; destroy .m4"
- update idletasks
- list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4]
-} {0 {} {}}
-test macWinMenu-1.5 {PreprocessMenu} {macOrPc} {
- catch {destroy .m1}
- catch {destroy .m2}
- menu .m1
- .m1 add cascade -menu .m2 -label "You may need to hit Escape to get this menu to go away."
- menu .m2 -postcommand glorp
- list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2]
-} {1 {invalid command name "glorp"} {}}
-
-test macWinMenu-2.1 {TkPreprocessMenu} {macOrPc nonUnixUserInteraction} {
- catch {destroy .m1}
- set foo test
- menu .m1 -postcommand "set foo 2.1"
- .m1 add command -label "macWinMenu-2.1: Hit Escape"
- list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
-} {0 2.1 2.1 {} {}}
-
-# cleanup
-deleteWindows
-cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/macscrollbar.test b/tests/macscrollbar.test
deleted file mode 100644
index d3d9c6e..0000000
--- a/tests/macscrollbar.test
+++ /dev/null
@@ -1,92 +0,0 @@
-# This file is a Tcl script to test out scrollbar widgets and
-# the "scrollbar" command of Tk. This file only tests Macintosh
-# specific features. It is organized in the standard fashion for
-# Tcl tests.
-#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id: macscrollbar.test,v 1.6 2003/04/01 21:06:41 dgp Exp $
-
-package require tcltest 2.1
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-
-update
-
-# Tests for display and layout
-wm geometry . 50x300
-scrollbar .s
-pack .s -fill y -expand 1
-update
-test macscroll-1.1 {TkpDisplayScrollbar procedure} {macOnly} {
- list [.s configure -width] [.s configure -bd]
-} {{-width width Width 16 16} {-borderwidth borderWidth BorderWidth 0 0}}
-test macscroll-1.2 {TkpDisplayScrollbar procedure} {macOnly} {
- # Exercise drawing 3D relief
- pack .s -fill y -expand 1 -anchor center
- .s configure -bd 4
- update
- focus .s
- update
-} {}
-test macscroll-1.3 {TkpDisplayScrollbar procedure} {macOnly} {
- pack .s -fill y -expand 1 -anchor e
- update
- set x [.s configure -width]
- pack .s -fill y -expand 1 -anchor w
- update
- list [.s configure -width] $x
-} {{-width width Width 16 16} {-width width Width 16 16}}
-test macscroll-1.4 {TkpDisplayScrollbar procedure} {macOnly} {
- wm geometry . 300x50
- .s configure -bd 0 -orient horizontal
- pack .s -fill x -expand 1 -anchor center
- update
- set x [.s configure -width]
- pack .s -fill x -expand 1 -anchor n
- update
- set y [.s configure -width]
- pack .s -fill x -expand 1 -anchor s
- update
- list [.s configure -width] $x $y
-} {{-width width Width 16 16} {-width width Width 16 16} {-width width Width 16 16}}
-test macscroll-1.5 {TkpDisplayScrollbar procedure} {macOnly} {
- wm geometry . 300x16
- .s configure -bd 0 -orient horizontal
- pack .s -fill x -expand 1 -anchor s
- update
- wm geometry . 300x15
- update
- wm geometry . 300x14
- update
-} {}
-test macscroll-1.6 {TkpDisplayScrollbar procedure} {macOnly} {
- # Check the drawing of the resize hack
- wm geometry . 20x300
- wm resizable . 1 1
- .s configure -bd 0 -orient vertical
- pack .s -fill y -expand 1 -anchor e
- update
- set x [.s identify 12 295]
- wm resizable . 0 0
- update
- set y [.s identify 12 295]
- wm resizable . 1 1
- pack .s -fill y -expand 1 -anchor center
- update
- list $x $y [.s identify 12 295]
-} {{} arrow2 arrow2}
-test macscroll-1.7 {TkpDisplayScrollbar procedure} {macOnly} {
- wm geometry . 300x300
- pack .s -fill y -expand 1 -anchor e
- catch {destroy .s2}
- scrollbar .s2 -orient horizontal
- place .s2 -x 0 -y 284 -width 300
-} {}
-
-deleteWindows
-# cleanup
-cleanupTests
-return
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index cfaf236..156ee9f 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menuDraw.test,v 1.6 2003/04/01 21:06:43 dgp Exp $
+# RCS: @(#) $Id: menuDraw.test,v 1.7 2004/03/17 18:15:49 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -346,14 +346,6 @@ test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} {
set tearoff [tk::TearOffMenu .m1 40 40]
list [wm geometry $tearoff 200x100] [update] [destroy .m1]
} {{} {} {}}
-test menuDraw-13.3 {TkMenuEventProc - ActivateNotify} {macOnly} {
- catch {destroy .t2}
- toplevel .t2 -menu .t2.m1
- menu .t2.m1
- .t2.m1 add command -label foo
- tk::TearOffMenu .t2.m1 40 40
- list [catch {update} msg] $msg [destroy .t2]
-} {0 {} {}}
# Testing deletes is hard, and I am going to do my best. Don't know how
# to test the case where we have already cleared the tkwin field in the
# menuPtr.
diff --git a/tests/safe.test b/tests/safe.test
index 11dc76c..e70b675 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: safe.test,v 1.12 2003/09/30 08:36:47 patthoyts Exp $
+# RCS: @(#) $Id: safe.test,v 1.13 2004/03/17 18:15:49 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -34,9 +34,7 @@ tcltest::loadTestedCommands
# The set of hidden commands is platform dependent:
-if {"$tcl_platform(platform)" == "macintosh"} {
- set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
-} elseif {"$tcl_platform(platform)" == "windows"} {
+if {"$tcl_platform(platform)" == "windows"} {
set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} else {
set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm}
diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index 3de4c58..e511948 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scrollbar.test,v 1.10 2003/04/01 21:06:50 dgp Exp $
+# RCS: @(#) $Id: scrollbar.test,v 1.11 2004/03/17 18:15:49 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -170,13 +170,13 @@ scrollbar .s2
test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
list [catch {.s2 cget -bd} msg] $msg
} {0 0}
-test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
+test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {unixOnly} {
list [catch {.s2 cget -bd} msg] $msg
} {0 2}
test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 0}
-test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
+test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {unixOnly} {
list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 1}
destroy .s2
@@ -269,9 +269,6 @@ test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetri
== [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \
/ ($height - 1 - [testmetrics cyvscroll .s]*2)]]
} 1
-test scrollbar-3.40 {ScrollbarWidgetCmd procedure, "fraction" option} {macOnly} {
- .s fraction 4 178
-} {0.97006}
toplevel .t -width 250 -height 100
wm geom .t +0+0
@@ -335,9 +332,6 @@ test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} {
test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} {
.s identify 5 195
} {arrow2}
-test scrollbar-3.55 {ScrollbarWidgetCmd procedure, "identify" option} {macOnly} {
- .s identify 5 195
-} {}
test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} {unixOnly} {
.s identify 0 0
} {}
@@ -438,19 +432,13 @@ update
test scrollbar-6.1 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 3
} {}
-test scrollbar-6.2 {ScrollbarPosition procedure} {macOnly} {
- .s identify 8 3
-} {arrow1}
-test scrollbar-6.3 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.3 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 196
} {}
test scrollbar-6.4 {ScrollbarPosition procedure} {unixOnly} {
.s identify 3 100
} {}
-test scrollbar-6.5 {ScrollbarPosition procedure} {macOnly} {
- .s identify 3 100
-} {trough2}
-test scrollbar-6.6 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.6 {ScrollbarPosition procedure} {unixOnly} {
.s identify 19 100
} {}
test scrollbar-6.7 {ScrollbarPosition procedure} {
@@ -466,15 +454,12 @@ test scrollbar-6.10 {ScrollbarPosition procedure} {
.s identify [winfo width .s] [expr [winfo height .s] / 2]
} {}
-test scrollbar-6.11 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.11 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 4
} {arrow1}
test scrollbar-6.12 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 19
} {arrow1}
-test scrollbar-6.13 {ScrollbarPosition procedure} {macOnly} {
- .s identify 8 19
-} {trough1}
test scrollbar-6.14 {ScrollbarPosition procedure} {pcOnly} {
.s identify [expr [winfo width .s] / 2] 0
} {arrow1}
@@ -482,10 +467,10 @@ test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics pcOnly} {
.s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll] - 1]
} {arrow1}
-test scrollbar-6.16 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.16 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 20
} {trough1}
-test scrollbar-6.17 {ScrollbarPosition procedure} {macOrUnix nonPortable} {
+test scrollbar-6.17 {ScrollbarPosition procedure} {unixOnly nonPortable} {
# Don't know why this is non-portable, but it doesn't work on
# some platforms.
.s identify 8 51
@@ -498,10 +483,10 @@ test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics pcOnly} {
+ [testmetrics cyvscroll] - 1]
} {trough1}
-test scrollbar-6.20 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.20 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 52
} {slider}
-test scrollbar-6.21 {ScrollbarPosition procedure} {macOrUnix nonPortable} {
+test scrollbar-6.21 {ScrollbarPosition procedure} {unixOnly nonPortable} {
# Don't know why this is non-portable, but it doesn't work on
# some platforms.
.s identify 8 83
@@ -515,15 +500,12 @@ test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics pcOnly} {
+ [testmetrics cyvscroll] - 1]
} {slider}
-test scrollbar-6.24 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.24 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 84
} {trough2}
test scrollbar-6.25 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 179
} {trough2}
-test scrollbar-6.26 {ScrollbarPosition procedure} {macOnly} {
- .s identify 8 179
-} {arrow2}
test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics pcOnly knownBug} {
# This asks for 8,21, which is actually the slider, but there is a
# bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value
@@ -537,15 +519,12 @@ test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics pcOnly} {
- [testmetrics cyvscroll] - 1]
} {trough2}
-test scrollbar-6.29 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.29 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 180
} {arrow2}
test scrollbar-6.30 {ScrollbarPosition procedure} {unixOnly} {
.s identify 8 195
} {arrow2}
-test scrollbar-6.31 {ScrollbarPosition procedure} {macOnly} {
- .s identify 8 195
-} {}
test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics pcOnly} {
.s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \
- [testmetrics cyvscroll]]
@@ -554,15 +533,12 @@ test scrollbar-6.33 {ScrollbarPosition procedure} {pcOnly} {
.s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1]
} {arrow2}
-test scrollbar-6.34 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.34 {ScrollbarPosition procedure} {unixOnly} {
.s identify 4 100
} {trough2}
test scrollbar-6.35 {ScrollbarPosition procedure} {unixOnly} {
.s identify 18 100
} {trough2}
-test scrollbar-6.36 {ScrollbarPosition procedure} {macOnly} {
- .s identify 18 100
-} {}
test scrollbar-6.37 {ScrollbarPosition procedure} {pcOnly} {
.s identify 0 100
} {trough2}
@@ -577,7 +553,7 @@ scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2
place .t.s -width 200
.t.s set .2 .4
update
-test scrollbar-6.39 {ScrollbarPosition procedure} {macOrUnix} {
+test scrollbar-6.39 {ScrollbarPosition procedure} {unixOnly} {
.t.s identify 4 8
} {arrow1}
test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} {
@@ -586,9 +562,6 @@ test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} {
test scrollbar-6.41 {ScrollbarPosition procedure} {unixOnly} {
.t.s identify 82 8
} {slider}
-test scrollbar-6.42 {ScrollbarPosition procedure} {macOnly} {
- .t.s identify 82 8
-} {}
test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics pcOnly} {
.t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll] \
- 1] [expr [winfo height .t.s] / 2]
@@ -596,9 +569,6 @@ test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics pcOnly} {
test scrollbar-6.44 {ScrollbarPosition procedure} {unixOnly} {
.t.s identify 100 18
} {trough2}
-test scrollbar-6.45 {ScrollbarPosition procedure} {macOnly} {
- .t.s identify 100 18
-} {}
test scrollbar-6.46 {ScrollbarPosition procedure} {pcOnly} {
.t.s identify 100 [expr [winfo height .t.s] - 1]
} {trough2}
diff --git a/tests/select.test b/tests/select.test
index 04adc6b..24bae6d 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: select.test,v 1.11 2003/11/18 01:47:51 dgp Exp $
+# RCS: @(#) $Id: select.test,v 1.12 2004/03/17 18:15:50 das Exp $
#
# Note: Multiple display selection handling will only be tested if the
@@ -135,7 +135,7 @@ test select-1.4.1 {Tk_CreateSelHandler procedure} {unixOnly} {
selection handle .f1 {handler STRING}
lsort [selection get TARGETS]
} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}
-test select-1.4.2 {Tk_CreateSelHandler procedure} {macOrPc} {
+test select-1.4.2 {Tk_CreateSelHandler procedure} {pcOnly} {
setup
selection handle .f1 {handler TEST} TEST
selection handle .f1 {handler STRING}
@@ -163,7 +163,7 @@ test select-1.6.1 {Tk_CreateSelHandler procedure} {unixOnly} {
selection get -type TEST
list [set selInfo] [lsort [selection get TARGETS]]
} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}}
-test select-1.6.2 {Tk_CreateSelHandler procedure} {macOrPc} {
+test select-1.6.2 {Tk_CreateSelHandler procedure} {pcOnly} {
global selValue selInfo
setup
selection handle .f1 {handler TEST} TEST
@@ -184,7 +184,7 @@ test select-1.7.1 {Tk_CreateSelHandler procedure} {unixOnly} {
list [lsort [selection get -selection PRIMARY TARGETS]] \
[lsort [selection get -selection CLIPBOARD TARGETS]]
} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-1.7.2 {Tk_CreateSelHandler procedure} {macOrPc} {
+test select-1.7.2 {Tk_CreateSelHandler procedure} {pcOnly} {
setup
selection own -selection CLIPBOARD .f1
selection handle -selection CLIPBOARD .f1 {handler TEST} TEST
@@ -227,7 +227,7 @@ test select-2.3 {Tk_DeleteSelHandler procedure} {unixOnly} {
list [lsort [selection get TARGETS]] \
[lsort [selection get -selection CLIPBOARD TARGETS]]
} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-2.4 {Tk_DeleteSelHandler procedure} {macOrPc} {
+test select-2.4 {Tk_DeleteSelHandler procedure} {pcOnly} {
setup
selection handle .f1 {handler STRING}
selection handle -type TEST .f1 {handler TEST}
@@ -236,7 +236,7 @@ test select-2.4 {Tk_DeleteSelHandler procedure} {macOrPc} {
selection handle -type TEST .f1 {}
lappend result [lsort [selection get TARGETS]]
} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}}
-test select-2.5 {Tk_DeleteSelHandler procedure} {macOrPc} {
+test select-2.5 {Tk_DeleteSelHandler procedure} {pcOnly} {
setup
selection handle .f1 {handler STRING}
selection handle -type TEST .f1 {handler TEST}
@@ -245,7 +245,7 @@ test select-2.5 {Tk_DeleteSelHandler procedure} {macOrPc} {
selection handle -type USER .f1 {}
lappend result [lsort [selection get TARGETS]]
} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-2.6 {Tk_DeleteSelHandler procedure} {macOrPc} {
+test select-2.6 {Tk_DeleteSelHandler procedure} {pcOnly} {
setup
selection own -selection CLIPBOARD .f1
selection handle -selection PRIMARY .f1 {handler STRING}
diff --git a/tests/spinbox.test b/tests/spinbox.test
index b9b05f2..90f5df2 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -4,7 +4,7 @@
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: spinbox.test,v 1.7 2003/04/01 21:06:52 dgp Exp $
+# RCS: @(#) $Id: spinbox.test,v 1.8 2004/03/17 18:15:50 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -1139,7 +1139,7 @@ test spinbox-13.10 {GetSpinboxIndex procedure} {unixOnly} {
list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in widget .e}}
-test spinbox-13.11 {GetSpinboxIndex procedure} {macOrPc} {
+test spinbox-13.11 {GetSpinboxIndex procedure} {pcOnly} {
# On mac and pc, when selection is cleared, spinbox widget remembers
# last selected range. When selection ownership is restored to
# spinbox, the old range will be rehighlighted.
@@ -1149,10 +1149,10 @@ test spinbox-13.11 {GetSpinboxIndex procedure} {macOrPc} {
test spinbox-13.12 {GetSpinboxIndex procedure} {unixOnly} {
list [catch {.e index sbogus} msg] $msg
} {1 {selection isn't in widget .e}}
-test spinbox-13.13 {GetSpinboxIndex procedure} {macOrPc} {
+test spinbox-13.13 {GetSpinboxIndex procedure} {pcOnly} {
list [catch {.e index sbogus} msg] $msg
} {1 {bad spinbox index "sbogus"}}
-test spinbox-13.14 {GetSpinboxIndex procedure} {macOrPc} {
+test spinbox-13.14 {GetSpinboxIndex procedure} {pcOnly} {
list [catch {selection get}] [catch {.e index sbogus}]
} {1 1}
test spinbox-13.15 {GetSpinboxIndex procedure} {
diff --git a/tests/text.test b/tests/text.test
index 1672138..2d0ee93 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: text.test,v 1.28 2004/01/07 16:28:45 vincentdarley Exp $
+# RCS: @(#) $Id: text.test,v 1.29 2004/03/17 18:15:50 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -131,9 +131,7 @@ test text-2.4 {Tk_TextCmd procedure} {
list [catch {text .t2 -bd 2 -fg red} msg] $msg \
[lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
} {0 .t2 2 red}
-if {$tcl_platform(platform) == "macintosh"} {
- set relief solid
-} elseif {$tcl_platform(platform) == "windows"} {
+if {$tcl_platform(platform) == "windows"} {
set relief flat
} else {
set relief raised
@@ -1262,7 +1260,7 @@ test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
.t.e select to 1
.t2 tag ranges sel
} {}
-test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
+test text-19.2 {TkTextLostSelection procedure} {pcOnly} {
catch {destroy .t2}
text .t2
.t2 insert 1.0 "abc\ndef\nghijk\n1234"
diff --git a/tests/tk.test b/tests/tk.test
index 0cf566b..7fd3af8 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2002 ActiveState Corporation.
#
-# RCS: @(#) $Id: tk.test,v 1.10 2003/04/01 21:06:55 dgp Exp $
+# RCS: @(#) $Id: tk.test,v 1.11 2004/03/17 18:15:50 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -103,7 +103,7 @@ test tk-4.6 {tk command: useinputmethods: set new} {unixOnly} {
}
set useim
} $useim
-test tk-4.7 {tk command: useinputmethods: set new} {macOrPc} {
+test tk-4.7 {tk command: useinputmethods: set new} {pcOnly} {
# Mac and Windows don't have X Input Methods, so this should
# always return 0
tk useinputmethods 1
diff --git a/tests/winfo.test b/tests/winfo.test
index 71925ae..f2fb1d3 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winfo.test,v 1.10 2003/04/01 21:07:03 dgp Exp $
+# RCS: @(#) $Id: winfo.test,v 1.11 2004/03/17 18:15:50 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -94,7 +94,7 @@ test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} {
test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} {
list [catch {winfo colormapfull foo} msg] $msg
} {1 {bad window path name "foo"}}
-test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} {
+test winfo-3.4 {"winfo colormapfull" command} {unixOnly pseudocolor} {
eatColors .t {-colormap new}
set result [list [winfo colormapfull .] [winfo colormapfull .t]]
.t.c delete 34
diff --git a/tests/wm.test b/tests/wm.test
index a744409..255efc4 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: wm.test,v 1.23 2003/04/01 21:07:04 dgp Exp $
+# RCS: @(#) $Id: wm.test,v 1.24 2004/03/17 18:15:50 das Exp $
# This file tests window manager interactions that work across
# platforms. Window manager tests that only work on a specific
@@ -131,7 +131,7 @@ test wm-attributes-1.2.1 {usage} {pcOnly} {
list [catch {wm attributes . _} err] $err
} {1 {wrong # args: should be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}}
-test wm-attributes-1.2.2 {usage} {macOrUnix} {
+test wm-attributes-1.2.2 {usage} {unixOnly} {
list [catch {wm attributes . _} err] $err
} {1 {wrong # args: should be "wm attributes window"}}
@@ -435,7 +435,7 @@ test wm-iconbitmap-1.1 {usage} {
list [catch {wm iconbitmap} err] $err
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
-test wm-iconbitmap-1.2.1 {usage} {macOrUnix} {
+test wm-iconbitmap-1.2.1 {usage} {unixOnly} {
list [catch {wm iconbitmap .t 12 13} msg] $msg
} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}}
generated by cgit v0.12 at 2024-11-10 12:10:37 (GMT)