1#!/bin/sh
2# The next line is executed by /bin/sh, but not tcl \
3exec wish $0 ${1+"$@"}
4
5# tour --
6#
7#	Tour of the megawidget of package ::Widget
8#
9# Copyright (c) 1997 Jeffrey Hobbs
10#
11
12package require Tk
13if {![info exists TOUR(LOADED)]} {
14    set TOUR(SCRIPT) [info script]
15    if {[lsearch -exact $auto_path [file dirname $TOUR(SCRIPT)]]==-1} {
16	lappend auto_path [file dirname $TOUR(SCRIPT)]
17    }
18    if {[string compare unix $tcl_platform(platform)]} {
19	# get rid of the console on windows/mac
20	catch {rename console winconsole}
21    }
22    set TOUR(LOADED) 0
23}
24
25## AllWidgets will end up including:
26# Widget
27#   ::Utility
28#   ::Utility::dump
29#   ::Utility::string
30#   ::Utility::number
31#   ::Utility::tk
32#   ::Utility::expand
33# BalloonHelp
34# Calculator
35# Combobox
36# Console
37# Hierarchy
38# Megalist
39# Pane
40# Progressbar
41# Tabnotebook
42# Ventry
43package require AllWidgets
44
45destroy .tab .exit
46
47tabnotebook .tab
48button .exit -text "Exit" -command exit
49
50namespace import -force ::Utility::*
51
52grid .tab -sticky news
53grid .exit -sticky ew
54grid rowconfigure . 0 -weight 1
55grid columnconfig . 0 -weight 1
56
57foreach n {
58    Main Combobox Console Hierarchy Megalist Progressbar Ventry Script
59} {
60    set TOUR($n) [frame .tab.[string tolower $n]]
61    .tab add $n -window $TOUR($n)
62}
63.tab activate Main
64
65# get_comments --
66#
67#   Gets the major comments out of a file.  If not a real filename,
68#   assume it is a package name that has a particular ifneeded setup.
69#
70# Arguments:
71#   file	file to get comments out of.
72# Results:
73#   Returns the related comments.
74#
75proc get_comments {file} {
76    if {![file exists $file]} {
77	set version [package provide $file]
78	if {[string match {} $version]} { return "## No Comments Found" }
79	set loadstr [package ifneeded $file $version]
80	if {[string match tclPkgSetup* $loadstr]} {
81	    set file [lindex [lindex [lindex $loadstr 4] 0] 0]
82	} else {
83	    # this expects 8.1 regexps
84	    regexp {(\w+.tcl)} $loadstr file
85	}
86	if {![file exists $file]} {
87	    return "## Couldn't determine file for package '$file'"
88	}
89    }
90    set fid [open $file]
91    set comments {}
92    set last 0
93    while {[gets $fid line] != -1} {
94	if {[string match "##*" $line]} {
95	    append comments $line\n
96	    set last 1
97	} elseif {$last} {
98	    append comments \n
99	    set last 0
100	}
101    }
102    return $comments
103}
104
105
106## Main Tab
107##
108set f $TOUR(Main)
109pack [scrolledtext $f.t] -fill both -expand 1
110$f.t insert 1.0 "Welcome to the widget tour.
111
112In the above tabs you will find basic examples with small feature
113descriptions of the various widgets in this package.
114
115This tour itself uses the Tabnotebook widget as the basic container
116for the widget tour.
117"
118
119## Combobox Tab
120##
121set f $TOUR(Combobox)
122scrolledtext $f.t -height 5
123frame $f.p
124pack [combobox $TOUR(Combobox).p.c1 -labeltext "Basic Combobox: "] -fill x
125pack [combobox $TOUR(Combobox).p.c2 -width 15 -textvariable myvar \
126	-list {{first choice} {second} {another choice} {final choice}}]
127pane $f.t $f.p -orient vertical -dynamic yes
128
129$f.t insert 1.0 "Combobox class widget.
130
131The combobox emulates the Tix widget of the same name.
132
133Major comments for class:
134[get_comments Combobox]
135"
136
137## Console Tab
138##
139set f $TOUR(Console)
140pack [scrolledtext $f.t -height 5] -fill x
141pack [console $f.c -height 10] -fill both -expand 1
142pane $f.t $f.c -orient vertical
143
144$f.t insert 1.0 "Console class widget.
145
146This is an interactive console for Tcl/Tk derived from TkCon.  It
147presents an interactive window into the interpreter, with many
148features to assist in interactive debugging.
149
150Major comments for class:
151[get_comments Console]
152"
153
154## Hierarchy Tab
155##
156set f $TOUR(Hierarchy)
157scrolledtext $f.t -height 5
158frame $f.p
159set TOUR(Hierarchy,w) [hierarchy_widget $f.p.w -root .]
160set TOUR(Hierarchy,d) [hierarchy_dir $f.p.d -root [file dirname [pwd]] \
161	-showparent "Parent" -showfiles 1]
162pane $f.t $f.p -orient vertical
163pane $f.p.w $f.p.d -dynamic 1
164
165
166
167## Megalist Tab
168##
169set f $TOUR(Megalist)
170pack [scrolledtext $f.t -height 5] -fill x
171
172$f.t insert 1.0 "Major comments for class Megalist:
173[get_comments Megalist]
174"
175
176## Progressbar Tab
177##
178set f $TOUR(Progressbar)
179pack [scrolledtext $f.t -height 5] -fill x
180
181$f.t insert 1.0 "Major comments for class Progressbar:
182[get_comments Progressbar]
183"
184
185## Ventry Tab
186##
187set f $TOUR(Ventry)
188pack [scrolledtext $f.t -height 5] -fill x
189pack [ventry $f.v1 -labeltext "Integers:" -labelwidth 14 -validate key \
190	-vcmd {regexp {^[-+]?[0-9]*$} %P}] -fill x
191pack [ventry $f.v2 -labeltext "Max 8 chars:" -labelwidth 14 -validate key \
192	-vcmd {expr {[string length %P]<=8}}] -fill x
193pack [ventry $f.v3 -labeltext "Date on focus:" -labelwidth 14 \
194	-validate focusout -validatecmd {check_date %W %s} \
195	-invalidcmd {warn "Invalid Date specified"}] -fill x
196
197proc check_date {w date} {
198    if {[string match {} $date]} { return 1 }
199    $w delete 0 end
200    set code [validate date $date]
201    if {$code} {
202	$w insert 0 [clock format [clock scan $date]]
203    } else {
204	focus -force [$w subwidget entry]
205    }
206    return $code
207}
208
209$f.t insert 1.0 "Ventry class widget.
210
211Major comments for class:
212[get_comments Ventry]
213"
214
215## Script Tab
216##
217set f $TOUR(Script)
218scrolledtext $f.t -wrap none
219button $f.rerun -text "Rerun Buffer" -command rerun
220button $f.reload -text "Reload Script" -command {reload 1}
221
222grid $f.t -
223grid $f.rerun $f.reload
224grid rowconfig $f 0 -weight 1
225grid columnconfig $f 0 -weight 1
226grid columnconfig $f 1 -weight 1
227
228proc reload {{force 0}} {
229    global TOUR
230
231    set text $TOUR(Script).t
232    $text delete 1.0 end
233    if {$force || !$TOUR(LOADED)} {
234	if {[catch {open $TOUR(SCRIPT)} fid]} {
235	    $text insert 1.0 $fid
236	} else {
237	    $text insert 1.0 [read $fid]
238	    close $fid
239	}
240    } else {
241	$text insert 1.0 $TOUR(BUFFER)
242    }
243    set TOUR(BUFFER) [$text get 1.0 end-1c]
244}
245
246proc rerun {} {
247    global TOUR
248    ## Get data from text widget
249    set TOUR(BUFFER) [$TOUR(Script).t get 1.0 end-1c]
250    uplevel \#0 $TOUR(BUFFER)
251}
252
253reload
254
255## Balloon Help
256##
257balloonhelp clear
258balloonhelp .exit "The Exit Button"
259balloonhelp $TOUR(Hierarchy,w) "Widget hierarchy"
260balloonhelp $TOUR(Hierarchy,d) "Directory hierarchy"
261
262set TOUR(LOADED) 1
263