1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#----------------------------------------------------------------------------
# Source this file into a working Tk interpreter to run all the Tcl demos
# in a nice window with buttons for each demo you'd like to run.
#
# Vince Darley
# vince@santafe.edu
#
#----------------------------------------------------------------------------
#
# Set of disabled examples:
# examples 14 and 31 do not work properly
# example 32 has deliberately (not yet) been propagated to all languages
#
set greyedOut {14 31 32}
if {[catch {file readlink [info script]} path]} {
set path [info script]
}
lappend auto_path "[file join [file dirname $path] .. tcl]"
# In order to distinguish whether this is a plserver or wish
# environment we assume that [info nameofexecutable] has the string
# "plserver", "wish" or "tclsh" in it. Some contrived examples can be
# figured out where this assumption is not correct, and for those
# cases we simply emit an error message and return. But normally this
# assumption is correct, and it is certainly correct for our tests.
switch -glob -- [info nameofexecutable] {
"*plserver*" {
# use 'plserver' method
plstdwin .
plxframe .p
set plwin .p.plwin
button .bnextpage -text "Page" -command [list event generate $plwin <Enter>]
}
"*wish*" -
"*tclsh*" {
# use 'wish" method
plstdwin .
plframe .p -eopcmd waitForReturn
set plwin .p
button .bnextpage -text "Page" -command [list $plwin nextpage]
}
default {
puts stderr "Error: argv0 = \"$argv0\"\ndoes not contain either the substrings \"plserver\", \"tclsh\", or \"wish\""
puts stderr "Therefore cannot decide how to proceed with runAllDemos.tcl so giving up"
return
}
}
bind $plwin <Key-Return> stopWaiting
proc stopWaiting {} {
set ::waitForReturn 1
}
proc waitForReturn {} {
.l configure -text "Press <enter> for the next page or complete the program"
vwait ::waitForReturn
}
grid .p -columnspan 5 -sticky news
grid rowconfigure . 0 -weight 1
for {set i 0} {$i < 5} {incr i} {
grid columnconfigure . $i -weight 1
}
# turn on pauses
$plwin cmd plspause 1
button .cexit -text "Quit" -command exit
if {$tcl_platform(platform) != "unix"} {
button .cshell -text "Shell" -command "console show"
}
#
# The reload button is probably not very useful to most users
# as it reloads the set of demos and commands. So disable it
# at least the time being
#
button .creload -text "Reload" -command reload -state disabled
set buttons [concat [info commands .c*] .bnextpage]
proc reload {} {
global demos
foreach demo $demos {
catch {rename $demo {}}
}
auto_reset
}
proc run {demo} {
global plwin
$plwin configure -eopcmd waitForReturn
.l configure -text "Starting $demo"
setButtonState disabled
update idletasks
$plwin cmd plbop
if {[catch {$demo $plwin} err]} {
puts stderr $err
}
$plwin configure -eopcmd [list .bnextpage configure -state normal]
$plwin cmd pleop
.l configure -text "$demo complete"
setButtonState normal
.bnextpage configure -state disabled
}
proc setButtonState {state} {
global greyedOut
foreach b [info commands .b*] {
if { [lsearch $greyedOut [string range $b 2 end]] < 0 } {
$b configure -state $state
} else {
$b configure -state disabled
}
}
}
for {set i 0} {$i <= 33} {incr i} {
set demo x[format "%02d" $i]
button .b$i -text "Demo $i" -command [list run $demo]
lappend demos $demo
lappend buttons .b$i
if {[llength $buttons] == 5} {
eval grid $buttons -sticky ew
set buttons {}
}
}
foreach i $greyedOut {
.b$i configure -state disabled
}
if {[llength $buttons]} {
eval grid $buttons -sticky ew
}
label .l
grid .l -sticky ew -columnspan 5
|
