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