Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | #!/bin/sh |
2 | # the next line restarts using wish \ | |
3 | exec wish8.4 "$0" "$@" | |
4 | ||
5 | # widget -- | |
6 | # This script demonstrates the various widgets provided by Tk, | |
7 | # along with many of the features of the Tk toolkit. This file | |
8 | # only contains code to generate the main window for the | |
9 | # application, which invokes individual demonstrations. The | |
10 | # code for the actual demonstrations is contained in separate | |
11 | # ".tcl" files is this directory, which are sourced by this script | |
12 | # as needed. | |
13 | # | |
14 | # RCS: @(#) $Id: widget,v 1.9.2.1 2003/09/25 05:37:48 das Exp $ | |
15 | ||
16 | eval destroy [winfo child .] | |
17 | wm title . "Widget Demonstration" | |
18 | if {[tk windowingsystem] eq "x11"} { | |
19 | # This won't work everywhere, but there's no other way in core Tk | |
20 | # at the moment to display a coloured icon. | |
21 | image create photo TclPowered \ | |
22 | -file [file join $tk_library images logo64.gif] | |
23 | wm iconwindow . [toplevel ._iconWindow] | |
24 | pack [label ._iconWindow.i -image TclPowered] | |
25 | wm iconname . "tkWidgetDemo" | |
26 | } | |
27 | ||
28 | array set widgetFont { | |
29 | main {Helvetica 12} | |
30 | bold {Helvetica 12 bold} | |
31 | title {Helvetica 18 bold} | |
32 | status {Helvetica 10} | |
33 | vars {Helvetica 14} | |
34 | } | |
35 | ||
36 | set widgetDemo 1 | |
37 | set font $widgetFont(main) | |
38 | ||
39 | #---------------------------------------------------------------- | |
40 | # The code below create the main window, consisting of a menu bar | |
41 | # and a text widget that explains how to use the program, plus lists | |
42 | # all of the demos as hypertext items. | |
43 | #---------------------------------------------------------------- | |
44 | ||
45 | menu .menuBar -tearoff 0 | |
46 | .menuBar add cascade -menu .menuBar.file -label "File" -underline 0 | |
47 | menu .menuBar.file -tearoff 0 | |
48 | ||
49 | # On the Mac use the specia .apple menu for the about item | |
50 | if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { | |
51 | .menuBar add cascade -menu .menuBar.apple | |
52 | menu .menuBar.apple -tearoff 0 | |
53 | .menuBar.apple add command -label "About..." -command "aboutBox" | |
54 | } else { | |
55 | .menuBar.file add command -label "About..." -command "aboutBox" \ | |
56 | -underline 0 -accelerator "<F1>" | |
57 | .menuBar.file add sep | |
58 | } | |
59 | ||
60 | .menuBar.file add command -label "Quit" -command "exit" -underline 0 \ | |
61 | -accelerator "Meta-Q" | |
62 | . configure -menu .menuBar | |
63 | bind . <F1> aboutBox | |
64 | ||
65 | frame .statusBar | |
66 | label .statusBar.lab -text " " -relief sunken -bd 1 \ | |
67 | -font $widgetFont(status) -anchor w | |
68 | label .statusBar.foo -width 8 -relief sunken -bd 1 \ | |
69 | -font $widgetFont(status) -anchor w | |
70 | pack .statusBar.lab -side left -padx 2 -expand yes -fill both | |
71 | pack .statusBar.foo -side left -padx 2 | |
72 | pack .statusBar -side bottom -fill x -pady 2 | |
73 | ||
74 | frame .textFrame | |
75 | scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ | |
76 | -takefocus 1 | |
77 | pack .s -in .textFrame -side right -fill y | |
78 | text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ | |
79 | -font $widgetFont(main) -setgrid 1 -highlightthickness 0 \ | |
80 | -padx 4 -pady 2 -takefocus 0 | |
81 | pack .t -in .textFrame -expand y -fill both -padx 1 | |
82 | pack .textFrame -expand yes -fill both | |
83 | ||
84 | # Create a bunch of tags to use in the text widget, such as those for | |
85 | # section titles and demo descriptions. Also define the bindings for | |
86 | # tags. | |
87 | ||
88 | .t tag configure title -font $widgetFont(title) | |
89 | .t tag configure bold -font $widgetFont(bold) | |
90 | ||
91 | # We put some "space" characters to the left and right of each demo description | |
92 | # so that the descriptions are highlighted only when the mouse cursor | |
93 | # is right over them (but not when the cursor is to their left or right) | |
94 | # | |
95 | .t tag configure demospace -lmargin1 1c -lmargin2 1c | |
96 | ||
97 | ||
98 | if {[winfo depth .] == 1} { | |
99 | .t tag configure demo -lmargin1 1c -lmargin2 1c \ | |
100 | -underline 1 | |
101 | .t tag configure visited -lmargin1 1c -lmargin2 1c \ | |
102 | -underline 1 | |
103 | .t tag configure hot -background black -foreground white | |
104 | } else { | |
105 | .t tag configure demo -lmargin1 1c -lmargin2 1c \ | |
106 | -foreground blue -underline 1 | |
107 | .t tag configure visited -lmargin1 1c -lmargin2 1c \ | |
108 | -foreground #303080 -underline 1 | |
109 | .t tag configure hot -foreground red -underline 1 | |
110 | } | |
111 | .t tag bind demo <ButtonRelease-1> { | |
112 | invoke [.t index {@%x,%y}] | |
113 | } | |
114 | set lastLine "" | |
115 | .t tag bind demo <Enter> { | |
116 | set lastLine [.t index {@%x,%y linestart}] | |
117 | .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" | |
118 | .t config -cursor hand2 | |
119 | showStatus [.t index {@%x,%y}] | |
120 | } | |
121 | .t tag bind demo <Leave> { | |
122 | .t tag remove hot 1.0 end | |
123 | .t config -cursor xterm | |
124 | .statusBar.lab config -text "" | |
125 | } | |
126 | .t tag bind demo <Motion> { | |
127 | set newLine [.t index {@%x,%y linestart}] | |
128 | if {[string compare $newLine $lastLine] != 0} { | |
129 | .t tag remove hot 1.0 end | |
130 | set lastLine $newLine | |
131 | ||
132 | set tags [.t tag names {@%x,%y}] | |
133 | set i [lsearch -glob $tags demo-*] | |
134 | if {$i >= 0} { | |
135 | .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" | |
136 | } | |
137 | } | |
138 | showStatus [.t index {@%x,%y}] | |
139 | } | |
140 | ||
141 | # Create the text for the text widget. | |
142 | ||
143 | proc addDemoSection {title demos} { | |
144 | .t insert end "\n" {} $title title " \n " demospace | |
145 | set num 0 | |
146 | foreach {name description} $demos { | |
147 | .t insert end "[incr num]. $description." [list demo demo-$name] | |
148 | .t insert end " \n " demospace | |
149 | } | |
150 | } | |
151 | ||
152 | .t insert end "Tk Widget Demonstrations\n" title | |
153 | .t insert end "\nThis application provides a front end for several short\ | |
154 | scripts that demonstrate what you can do with Tk widgets. Each of\ | |
155 | the numbered lines below describes a demonstration; you can click\ | |
156 | on it to invoke the demonstration. Once the demonstration window\ | |
157 | appears, you can click the " {} "See Code" bold " button to see the\ | |
158 | Tcl/Tk code that created the demonstration. If you wish, you can\ | |
159 | edit the code and click the " {} "Rerun Demo" bold " button in the\ | |
160 | code window to reinvoke the demonstration with the modified code.\n" | |
161 | ||
162 | addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" { | |
163 | label "Labels (text and bitmaps)" | |
164 | unicodeout "Labels and UNICODE text" | |
165 | button "Buttons" | |
166 | check "Check-buttons (select any of a group)" | |
167 | radio "Radio-buttons (select one of a group)" | |
168 | puzzle "A 15-puzzle game made out of buttons" | |
169 | icon "Iconic buttons that use bitmaps" | |
170 | image1 "Two labels displaying images" | |
171 | image2 "A simple user interface for viewing images" | |
172 | labelframe "Labelled frames" | |
173 | } | |
174 | addDemoSection "Listboxes" { | |
175 | states "The 50 states" | |
176 | colors "Colors: change the color scheme for the application" | |
177 | sayings "A collection of famous and infamous sayings" | |
178 | } | |
179 | addDemoSection "Entries and Spin-boxes" { | |
180 | entry1 "Entries without scrollbars" | |
181 | entry2 "Entries with scrollbars" | |
182 | entry3 "Validated entries and password fields" | |
183 | spin "Spin-boxes" | |
184 | form "Simple Rolodex-like form" | |
185 | } | |
186 | addDemoSection "Text" { | |
187 | text "Basic editable text" | |
188 | style "Text display styles" | |
189 | bind "Hypertext (tag bindings)" | |
190 | twind "A text widget with embedded windows" | |
191 | search "A search tool built with a text widget" | |
192 | } | |
193 | addDemoSection "Canvases" { | |
194 | items "The canvas item types" | |
195 | plot "A simple 2-D plot" | |
196 | ctext "Text items in canvases" | |
197 | arrow "An editor for arrowheads on canvas lines" | |
198 | ruler "A ruler with adjustable tab stops" | |
199 | floor "A building floor plan" | |
200 | cscroll "A simple scrollable canvas" | |
201 | } | |
202 | addDemoSection "Scales" { | |
203 | hscale "Horizontal scale" | |
204 | vscale "Vertical scale" | |
205 | } | |
206 | addDemoSection "Paned Windows" { | |
207 | paned1 "Horizontal paned window" | |
208 | paned2 "Vertical paned window" | |
209 | } | |
210 | addDemoSection "Menus" { | |
211 | menu "Menus and cascades (sub-menus)" | |
212 | menubu "Menu-buttons" | |
213 | } | |
214 | addDemoSection "Common Dialogs" { | |
215 | msgbox "Message boxes" | |
216 | filebox "File selection dialog" | |
217 | clrpick "Color picker" | |
218 | } | |
219 | addDemoSection "Miscellaneous" { | |
220 | bitmap "The built-in bitmaps" | |
221 | dialog1 "A dialog box with a local grab" | |
222 | dialog2 "A dialog box with a global grab" | |
223 | } | |
224 | ||
225 | .t configure -state disabled | |
226 | focus .s | |
227 | ||
228 | # positionWindow -- | |
229 | # This procedure is invoked by most of the demos to position a | |
230 | # new demo window. | |
231 | # | |
232 | # Arguments: | |
233 | # w - The name of the window to position. | |
234 | ||
235 | proc positionWindow w { | |
236 | wm geometry $w +300+300 | |
237 | } | |
238 | ||
239 | # showVars -- | |
240 | # Displays the values of one or more variables in a window, and | |
241 | # updates the display whenever any of the variables changes. | |
242 | # | |
243 | # Arguments: | |
244 | # w - Name of new window to create for display. | |
245 | # args - Any number of names of variables. | |
246 | ||
247 | proc showVars {w args} { | |
248 | global widgetFont | |
249 | catch {destroy $w} | |
250 | toplevel $w | |
251 | wm title $w "Variable values" | |
252 | label $w.title -text "Variable values:" -width 20 -anchor center \ | |
253 | -font $widgetFont(vars) | |
254 | pack $w.title -side top -fill x | |
255 | set len 1 | |
256 | foreach i $args { | |
257 | if {[string length $i] > $len} { | |
258 | set len [string length $i] | |
259 | } | |
260 | } | |
261 | foreach i $args { | |
262 | frame $w.$i | |
263 | label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w | |
264 | label $w.$i.value -textvar $i -anchor w | |
265 | pack $w.$i.name -side left | |
266 | pack $w.$i.value -side left -expand 1 -fill x | |
267 | pack $w.$i -side top -anchor w -fill x | |
268 | } | |
269 | button $w.ok -text OK -command "destroy $w" -default active | |
270 | bind $w <Return> "tkButtonInvoke $w.ok" | |
271 | pack $w.ok -side bottom -pady 2 | |
272 | } | |
273 | ||
274 | # invoke -- | |
275 | # This procedure is called when the user clicks on a demo description. | |
276 | # It is responsible for invoking the demonstration. | |
277 | # | |
278 | # Arguments: | |
279 | # index - The index of the character that the user clicked on. | |
280 | ||
281 | proc invoke index { | |
282 | global tk_library | |
283 | set tags [.t tag names $index] | |
284 | set i [lsearch -glob $tags demo-*] | |
285 | if {$i < 0} { | |
286 | return | |
287 | } | |
288 | set cursor [.t cget -cursor] | |
289 | .t configure -cursor watch | |
290 | update | |
291 | set demo [string range [lindex $tags $i] 5 end] | |
292 | uplevel [list source [file join $tk_library demos $demo.tcl]] | |
293 | update | |
294 | .t configure -cursor $cursor | |
295 | ||
296 | .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars" | |
297 | } | |
298 | ||
299 | # showStatus -- | |
300 | # | |
301 | # Show the name of the demo program in the status bar. This procedure | |
302 | # is called when the user moves the cursor over a demo description. | |
303 | # | |
304 | proc showStatus index { | |
305 | global tk_library | |
306 | set tags [.t tag names $index] | |
307 | set i [lsearch -glob $tags demo-*] | |
308 | set cursor [.t cget -cursor] | |
309 | if {$i < 0} { | |
310 | .statusBar.lab config -text " " | |
311 | set newcursor xterm | |
312 | } else { | |
313 | set demo [string range [lindex $tags $i] 5 end] | |
314 | .statusBar.lab config -text "Run the \"$demo\" sample program" | |
315 | set newcursor hand2 | |
316 | } | |
317 | if [string compare $cursor $newcursor] { | |
318 | .t config -cursor $newcursor | |
319 | } | |
320 | } | |
321 | ||
322 | ||
323 | # showCode -- | |
324 | # This procedure creates a toplevel window that displays the code for | |
325 | # a demonstration and allows it to be edited and reinvoked. | |
326 | # | |
327 | # Arguments: | |
328 | # w - The name of the demonstration's window, which can be | |
329 | # used to derive the name of the file containing its code. | |
330 | ||
331 | proc showCode w { | |
332 | global tk_library | |
333 | set file [string range $w 1 end].tcl | |
334 | if ![winfo exists .code] { | |
335 | toplevel .code | |
336 | frame .code.buttons | |
337 | pack .code.buttons -side bottom -fill x | |
338 | button .code.buttons.dismiss -text Dismiss \ | |
339 | -default active -command "destroy .code" | |
340 | button .code.buttons.rerun -text "Rerun Demo" -command { | |
341 | eval [.code.text get 1.0 end] | |
342 | } | |
343 | pack .code.buttons.dismiss .code.buttons.rerun -side left \ | |
344 | -expand 1 -pady 2 | |
345 | frame .code.frame | |
346 | pack .code.frame -expand yes -fill both -padx 1 -pady 1 | |
347 | text .code.text -height 40 -wrap word\ | |
348 | -xscrollcommand ".code.xscroll set" \ | |
349 | -yscrollcommand ".code.yscroll set" \ | |
350 | -setgrid 1 -highlightthickness 0 -pady 2 -padx 3 | |
351 | scrollbar .code.xscroll -command ".code.text xview" \ | |
352 | -highlightthickness 0 -orient horizontal | |
353 | scrollbar .code.yscroll -command ".code.text yview" \ | |
354 | -highlightthickness 0 -orient vertical | |
355 | ||
356 | grid .code.text -in .code.frame -padx 1 -pady 1 \ | |
357 | -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news | |
358 | grid .code.yscroll -in .code.frame -padx 1 -pady 1 \ | |
359 | -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news | |
360 | # grid .code.xscroll -in .code.frame -padx 1 -pady 1 \ | |
361 | # -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news | |
362 | grid rowconfig .code.frame 0 -weight 1 -minsize 0 | |
363 | grid columnconfig .code.frame 0 -weight 1 -minsize 0 | |
364 | } else { | |
365 | wm deiconify .code | |
366 | raise .code | |
367 | } | |
368 | wm title .code "Demo code: [file join $tk_library demos $file]" | |
369 | wm iconname .code $file | |
370 | set id [open [file join $tk_library demos $file]] | |
371 | .code.text delete 1.0 end | |
372 | .code.text insert 1.0 [read $id] | |
373 | .code.text mark set insert 1.0 | |
374 | close $id | |
375 | } | |
376 | ||
377 | # aboutBox -- | |
378 | # | |
379 | # Pops up a message box with an "about" message | |
380 | # | |
381 | proc aboutBox {} { | |
382 | tk_messageBox -icon info -type ok -title "About Widget Demo" -message \ | |
383 | "Tk widget demonstration | |
384 | ||
385 | Copyright (c) 1996-1997 Sun Microsystems, Inc. | |
386 | ||
387 | Copyright (c) 1997-2000 Ajuba Solutions, Inc. | |
388 | ||
389 | Copyright (c) 2001-2002 Donal K. Fellows" | |
390 | } | |
391 | ||
392 | # Local Variables: | |
393 | # mode: tcl | |
394 | # End: |