widget
1 #!/bin/sh 2 # the next line restarts using wish \ 3 exec wish "$0" ${1+"$@"} 4 5 # widget -- 6 # This script demonstrates the various widgets provided by Tk, along with many 7 # of the features of the Tk toolkit. This file only contains code to generate 8 # the main window for the application, which invokes individual 9 # demonstrations. The code for the actual demonstrations is contained in 10 # separate ".tcl" files is this directory, which are sourced by this script as 11 # needed. 12 13 package require Tk 8.5 14 package require msgcat 15 16 eval destroy [winfo child .] 17 set tk_demoDirectory [file join [pwd] [file dirname [info script]]] 18 ::msgcat::mcload $tk_demoDirectory 19 namespace import ::msgcat::mc 20 wm title . [mc "Widget Demonstration"] 21 if {[tk windowingsystem] eq "x11"} { 22 # This won't work everywhere, but there's no other way in core Tk at the 23 # moment to display a coloured icon. 24 image create photo TclPowered \ 25 -file [file join $tk_library images logo64.gif] 26 wm iconwindow . [toplevel ._iconWindow] 27 pack [label ._iconWindow.i -image TclPowered] 28 wm iconname . [mc "tkWidgetDemo"] 29 } 30 31 if {"defaultFont" ni [font names]} { 32 # TIP #145 defines some standard named fonts 33 if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} { 34 # FIX ME: the following technique of cloning the font to copy it works 35 # fine but means that if the system font is changed by Tk 36 # cannot update the copied font. font alias might be useful 37 # here -- or fix the app to use TkDefaultFont etc. 38 font create mainFont {*}[font configure TkDefaultFont] 39 font create fixedFont {*}[font configure TkFixedFont] 40 font create boldFont {*}[font configure TkDefaultFont] -weight bold 41 font create titleFont {*}[font configure TkDefaultFont] -weight bold 42 font create statusFont {*}[font configure TkDefaultFont] 43 font create varsFont {*}[font configure TkDefaultFont] 44 if {[tk windowingsystem] eq "aqua"} { 45 font configure titleFont -size 17 46 } 47 } else { 48 font create mainFont -family Helvetica -size 12 49 font create fixedFont -family Courier -size 10 50 font create boldFont -family Helvetica -size 12 -weight bold 51 font create titleFont -family Helvetica -size 18 -weight bold 52 font create statusFont -family Helvetica -size 10 53 font create varsFont -family Helvetica -size 14 54 } 55 } 56 57 set widgetDemo 1 58 set font mainFont 59 60 image create photo ::img::refresh -format GIF -data { 61 R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp 62 xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR 63 2tICU0gXBQA7 64 } 65 66 image create photo ::img::view -format GIF -data { 67 R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA 68 AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27 69 yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7 70 } 71 72 image create photo ::img::delete -format GIF -data { 73 R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy 74 PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw== 75 } 76 77 image create photo ::img::print -format GIF -data { 78 R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA 79 AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ 80 fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g 81 ryhH5pgnEQA7 82 } 83 84 # Note that this is run through the message catalog! This is because this is 85 # actually an image of a word. 86 image create photo ::img::new -format PNG -data [mc { 87 iVBORw0KGgoAAAANSUhEUgAAAB4AAAAOCAYAAAA45qw5AAACMElEQVR4AeVTAwxd 88 QRCc2tZHGtQ2w9q2bdsOa9u2bUW1bdt2Z372JZe6DapJLqtb3h7+T8yKi5j4CsYD 89 EUQXxETclT7kWOlH2VV+tFkdQHPSwksSISF+BauCqL0qgOcMWgGfgEkaMsHxqUBk 90 3plE/sOnh/qDPAPJH/CKFBivGHWzFwBRnHhlqbu1Mh6CoFNnC/JshQ9p4YC2lrKt 91 DCAV+THiVejyhMjAbrNSrroiEfKR9g7ZfCgOog8QfnUQV62wAk68ndQ9ZbyoWO1H 92 Y6eDY1LCQL6a9ApOp9Hi1T0+gQq2JKMlky/oTKQliKWxEZvyG575kpW4pl1aZnQK 93 CLOVt45Lkp8uXp2SL8KO6uitNTZLdpK6s+I/eZbhpmsmWeOGOVQNKYLITzpKPAO3 94 tY7LSNZ7ccSLxX9y3uuOxRkg3dKESMoCHvL+GRVCutXsB3guLgDCeXOv4iWWkvwG 95 BaS+PmlpK6SI9ApI2oC2UtrwZQEkhkH+NtolVlQXJl1I+QltuU3XEc721bIRFpa8 96 IA5iqTo6vNNWmkNBLQbPeXwF2g17Q94nTQAfY3YzeY+WSu8MDzQ2kpELUhSGJUHE 97 0zeR3rY1L+Xl5G/re+jbiK6KhThwwInsts1fbMUUcpZszKeVtggZEiGdZDe5AtHh 98 7vL4CGiRvvKPS8FAvq9Nr4ZkFadR2y6kggu1z4vlyIbBp6BugQ8JLEg4bTkD9eMZ 99 QZ8hpJ3VvTtuvbWrY/ElvP/9R+Aj3603+iE3fkEAAAAASUVORK5CYII= 100 }] 101 102 #---------------------------------------------------------------- 103 # The code below creates the main window, consisting of a menu bar and a text 104 # widget that explains how to use the program, plus lists all of the demos as 105 # hypertext items. 106 #---------------------------------------------------------------- 107 108 menu .menuBar -tearoff 0 109 110 # On Aqua, just use the default menu. 111 if {[tk windowingsystem] ne "aqua"} { 112 # This is a tk-internal procedure to make i18n easier 113 ::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \ 114 -menu .menuBar.file 115 menu .menuBar.file -tearoff 0 116 ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \ 117 -command {tkAboutDialog} -accelerator [mc "<F1>"] 118 bind . <F1> {tkAboutDialog} 119 .menuBar.file add sep 120 if {[string match win* [tk windowingsystem]]} { 121 # Windows doesn't usually have a Meta key 122 ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ 123 -command {exit} -accelerator [mc "Ctrl+Q"] 124 bind . <[mc "Control-q"]> {exit} 125 } else { 126 ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ 127 -command {exit} -accelerator [mc "Meta-Q"] 128 bind . <[mc "Meta-q"]> {exit} 129 } 130 . configure -menu .menuBar 131 } 132 133 ttk::frame .statusBar 134 ttk::label .statusBar.lab -text " " -anchor w 135 if {[tk windowingsystem] eq "aqua"} { 136 ttk::separator .statusBar.sep 137 pack .statusBar.sep -side top -expand yes -fill x -pady 0 138 } 139 pack .statusBar.lab -side left -padx 2 -expand yes -fill both 140 if {[tk windowingsystem] ne "aqua"} { 141 ttk::sizegrip .statusBar.foo 142 pack .statusBar.foo -side left -padx 2 143 } 144 pack .statusBar -side bottom -fill x -pady 2 145 146 set textheight 30 147 catch { 148 set textheight [expr { 149 ([winfo screenheight .] * 0.7) / 150 [font metrics mainFont -displayof . -linespace] 151 }] 152 } 153 154 ttk::frame .textFrame 155 ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1 156 pack .s -in .textFrame -side right -fill y 157 text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \ 158 -font mainFont -setgrid 1 -highlightthickness 0 \ 159 -padx 4 -pady 2 -takefocus 0 160 pack .t -in .textFrame -expand y -fill both -padx 1 161 pack .textFrame -expand yes -fill both 162 if {[tk windowingsystem] eq "aqua"} { 163 pack configure .statusBar.lab -padx {10 18} -pady {4 6} 164 pack configure .statusBar -pady 0 165 .t configure -padx 10 -pady 0 166 } 167 168 # Create a bunch of tags to use in the text widget, such as those for section 169 # titles and demo descriptions. Also define the bindings for tags. 170 171 .t tag configure title -font titleFont 172 .t tag configure subtitle -font titleFont 173 .t tag configure bold -font boldFont 174 if {[tk windowingsystem] eq "aqua"} { 175 .t tag configure title -spacing1 8 176 .t tag configure subtitle -spacing3 3 177 } 178 179 # We put some "space" characters to the left and right of each demo 180 # description so that the descriptions are highlighted only when the mouse 181 # cursor is right over them (but not when the cursor is to their left or 182 # right). 183 # 184 .t tag configure demospace -lmargin1 1c -lmargin2 1c 185 186 if {[winfo depth .] == 1} { 187 .t tag configure demo -lmargin1 1c -lmargin2 1c \ 188 -underline 1 189 .t tag configure visited -lmargin1 1c -lmargin2 1c \ 190 -underline 1 191 .t tag configure hot -background black -foreground white 192 } else { 193 .t tag configure demo -lmargin1 1c -lmargin2 1c \ 194 -foreground blue -underline 1 195 .t tag configure visited -lmargin1 1c -lmargin2 1c \ 196 -foreground #303080 -underline 1 197 if {[tk windowingsystem] eq "aqua"} { 198 .t tag configure demo -foreground systemLinkColor 199 .t tag configure visited -foreground purple 200 } 201 .t tag configure hot -foreground red -underline 1 202 } 203 .t tag bind demo <ButtonRelease-1> { 204 invoke [.t index {@%x,%y}] 205 } 206 set lastLine "" 207 .t tag bind demo <Enter> { 208 set lastLine [.t index {@%x,%y linestart}] 209 .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" 210 .t config -cursor [::ttk::cursor link] 211 showStatus [.t index {@%x,%y}] 212 } 213 .t tag bind demo <Leave> { 214 .t tag remove hot 1.0 end 215 .t config -cursor [::ttk::cursor text] 216 .statusBar.lab config -text "" 217 } 218 .t tag bind demo <Motion> { 219 set newLine [.t index {@%x,%y linestart}] 220 if {$newLine ne $lastLine} { 221 .t tag remove hot 1.0 end 222 set lastLine $newLine 223 224 set tags [.t tag names {@%x,%y}] 225 set i [lsearch -glob $tags demo-*] 226 if {$i >= 0} { 227 .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" 228 } 229 } 230 showStatus [.t index {@%x,%y}] 231 } 232 233 ############################################################################## 234 # Create the text for the text widget. 235 236 # addFormattedText -- 237 # 238 # Add formatted text (but not hypertext) to the text widget after first 239 # passing it through the message catalog to allow for localization. 240 # Lines starting with @@ are formatting directives (insert title, insert 241 # demo hyperlink, begin newline, or change style) and all other lines 242 # are literal strings to be inserted. Substitutions are performed, 243 # allowing processing pieces through the message catalog. Blank lines 244 # are ignored. 245 # 246 proc addFormattedText {formattedText} { 247 set style normal 248 set isNL 1 249 set demoCount 0 250 set new 0 251 foreach line [split $formattedText \n] { 252 set line [string trim $line] 253 if {$line eq ""} { 254 continue 255 } 256 if {[string match @@* $line]} { 257 set data [string range $line 2 end] 258 set key [lindex $data 0] 259 set values [lrange $data 1 end] 260 switch -exact -- $key { 261 title { 262 .t insert end [mc $values]\n title \n normal 263 } 264 newline { 265 .t insert end \n $style 266 set isNL 1 267 } 268 subtitle { 269 .t insert end "\n" {} [mc $values] subtitle \ 270 " \n " demospace 271 set demoCount 0 272 } 273 demo { 274 set description [lassign $values name] 275 .t insert end "[incr demoCount]. [mc $description]" \ 276 [list demo demo-$name] 277 if {$new} { 278 .t image create end -image ::img::new -padx 5 279 set new 0 280 } 281 .t insert end " \n " demospace 282 } 283 new { 284 set new 1 285 } 286 default { 287 set style $key 288 } 289 } 290 continue 291 } 292 if {!$isNL} { 293 .t insert end " " $style 294 } 295 set isNL 0 296 .t insert end [mc $line] $style 297 } 298 } 299 300 addFormattedText { 301 @@title Tk Widget Demonstrations 302 303 This application provides a front end for several short scripts 304 that demonstrate what you can do with Tk widgets. Each of the 305 numbered lines below describes a demonstration; you can click on 306 it to invoke the demonstration. Once the demonstration window 307 appears, you can click the 308 @@bold 309 See Code 310 @@normal 311 button to see the Tcl/Tk code that created the demonstration. If 312 you wish, you can edit the code and click the 313 @@bold 314 Rerun Demo 315 @@normal 316 button in the code window to reinvoke the demonstration with the 317 modified code. 318 @@newline 319 320 @@subtitle Labels, buttons, checkbuttons, and radiobuttons 321 @@demo label Labels (text and bitmaps) 322 @@demo unicodeout Labels and UNICODE text 323 @@demo button Buttons 324 @@demo check Check-buttons (select any of a group) 325 @@demo radio Radio-buttons (select one of a group) 326 @@demo puzzle A 15-puzzle game made out of buttons 327 @@demo icon Iconic buttons that use bitmaps 328 @@demo image1 Two labels displaying images 329 @@demo image2 A simple user interface for viewing images 330 @@demo labelframe Labelled frames 331 @@demo ttkbut The simple Themed Tk widgets 332 333 @@subtitle Listboxes and Trees 334 @@demo states The 50 states 335 @@demo colors Colors: change the color scheme for the application 336 @@demo sayings A collection of famous and infamous sayings 337 @@demo mclist A multi-column list of countries 338 @@demo tree A directory browser tree 339 340 @@subtitle Entries, Spin-boxes and Combo-boxes 341 @@demo entry1 Entries without scrollbars 342 @@demo entry2 Entries with scrollbars 343 @@demo entry3 Validated entries and password fields 344 @@demo spin Spin-boxes 345 @@demo combo Combo-boxes 346 @@demo form Simple Rolodex-like form 347 348 @@subtitle Text 349 @@demo text Basic editable text 350 @@demo style Text display styles 351 @@demo bind Hypertext (tag bindings) 352 @@demo twind A text widget with embedded windows and other features 353 @@demo search A search tool built with a text widget 354 @@demo textpeer Peering text widgets 355 356 @@subtitle Canvases 357 @@demo items The canvas item types 358 @@demo plot A simple 2-D plot 359 @@demo ctext Text items in canvases 360 @@demo arrow An editor for arrowheads on canvas lines 361 @@demo ruler A ruler with adjustable tab stops 362 @@demo floor A building floor plan 363 @@demo cscroll A simple scrollable canvas 364 @@demo knightstour A Knight's tour of the chess board 365 366 @@subtitle Scales and Progress Bars 367 @@demo hscale Horizontal scale 368 @@demo vscale Vertical scale 369 @@new 370 @@demo ttkscale Themed scale linked to a label with traces 371 @@demo ttkprogress Progress bar 372 373 @@subtitle Paned Windows and Notebooks 374 @@demo paned1 Horizontal paned window 375 @@demo paned2 Vertical paned window 376 @@demo ttkpane Themed nested panes 377 @@demo ttknote Notebook widget 378 379 @@subtitle Menus and Toolbars 380 @@demo menu Menus and cascades (sub-menus) 381 @@demo menubu Menu-buttons 382 @@demo ttkmenu Themed menu buttons 383 @@demo toolbar Themed toolbar 384 385 @@subtitle Common Dialogs 386 @@demo msgbox Message boxes 387 @@demo filebox File selection dialog 388 @@demo clrpick Color picker 389 @@demo fontchoose Font selection dialog 390 391 @@subtitle Animation 392 @@demo anilabel Animated labels 393 @@demo aniwave Animated wave 394 @@demo pendulum Pendulum simulation 395 @@demo goldberg A celebration of Rube Goldberg 396 397 @@subtitle Miscellaneous 398 @@demo bitmap The built-in bitmaps 399 @@demo dialog1 A dialog box with a local grab 400 @@demo dialog2 A dialog box with a global grab 401 } 402 403 ############################################################################## 404 405 .t configure -state disabled 406 focus .s 407 408 # addSeeDismiss -- 409 # Add "See Code" and "Dismiss" button frame, with optional "See Vars" 410 # 411 # Arguments: 412 # w - The name of the frame to use. 413 414 proc addSeeDismiss {w show {vars {}} {extra {}}} { 415 ## See Code / Dismiss buttons 416 ttk::frame $w 417 ttk::separator $w.sep 418 #ttk::frame $w.sep -height 2 -relief sunken 419 grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2 420 ttk::button $w.dismiss -text [mc "Dismiss"] \ 421 -image ::img::delete -compound left \ 422 -command [list destroy [winfo toplevel $w]] 423 ttk::button $w.code -text [mc "See Code"] \ 424 -image ::img::view -compound left \ 425 -command [list showCode $show] 426 set buttons [list x $w.code $w.dismiss] 427 if {[llength $vars]} { 428 ttk::button $w.vars -text [mc "See Variables"] \ 429 -image ::img::view -compound left \ 430 -command [concat [list showVars $w.dialog] $vars] 431 set buttons [linsert $buttons 1 $w.vars] 432 } 433 if {$extra ne ""} { 434 set buttons [linsert $buttons 1 [uplevel 1 $extra]] 435 } 436 grid {*}$buttons -padx 4 -pady 4 437 grid columnconfigure $w 0 -weight 1 438 if {[tk windowingsystem] eq "aqua"} { 439 foreach b [lrange $buttons 1 end] {$b configure -takefocus 0} 440 grid configure $w.sep -pady 0 441 grid configure {*}$buttons -pady {10 12} 442 grid configure [lindex $buttons 1] -padx {16 4} 443 grid configure [lindex $buttons end] -padx {4 18} 444 } 445 return $w 446 } 447 448 # positionWindow -- 449 # This procedure is invoked by most of the demos to position a new demo 450 # window. 451 # 452 # Arguments: 453 # w - The name of the window to position. 454 455 proc positionWindow w { 456 wm geometry $w +300+300 457 } 458 459 # showVars -- 460 # Displays the values of one or more variables in a window, and updates the 461 # display whenever any of the variables changes. 462 # 463 # Arguments: 464 # w - Name of new window to create for display. 465 # args - Any number of names of variables. 466 467 proc showVars {w args} { 468 catch {destroy $w} 469 toplevel $w 470 if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog} 471 wm title $w [mc "Variable values"] 472 473 set b [ttk::frame $w.frame] 474 grid $b -sticky news 475 set f [ttk::labelframe $b.title -text [mc "Variable values:"]] 476 foreach var $args { 477 ttk::label $f.n$var -text "$var:" -anchor w 478 ttk::label $f.v$var -textvariable $var -anchor w 479 grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w 480 } 481 ttk::button $b.ok -text [mc "OK"] \ 482 -command [list destroy $w] -default active 483 bind $w <Return> [list $b.ok invoke] 484 bind $w <Escape> [list $b.ok invoke] 485 486 grid $f -sticky news -padx 4 487 grid $b.ok -sticky e -padx 4 -pady {6 4} 488 if {[tk windowingsystem] eq "aqua"} { 489 $b.ok configure -takefocus 0 490 grid configure $b.ok -pady {10 12} -padx {16 18} 491 grid configure $f -padx 10 -pady {10 0} 492 } 493 grid columnconfig $f 1 -weight 1 494 grid rowconfigure $f 100 -weight 1 495 grid columnconfig $b 0 -weight 1 496 grid rowconfigure $b 0 -weight 1 497 grid columnconfig $w 0 -weight 1 498 grid rowconfigure $w 0 -weight 1 499 } 500 501 # invoke -- 502 # This procedure is called when the user clicks on a demo description. It is 503 # responsible for invoking the demonstration. 504 # 505 # Arguments: 506 # index - The index of the character that the user clicked on. 507 508 proc invoke index { 509 global tk_demoDirectory 510 set tags [.t tag names $index] 511 set i [lsearch -glob $tags demo-*] 512 if {$i < 0} { 513 return 514 } 515 set cursor [.t cget -cursor] 516 .t configure -cursor [::ttk::cursor busy] 517 update 518 set demo [string range [lindex $tags $i] 5 end] 519 uplevel 1 [list source -encoding utf-8 [file join $tk_demoDirectory $demo.tcl]] 520 update 521 .t configure -cursor $cursor 522 523 .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars" 524 } 525 526 # showStatus -- 527 # 528 # Show the name of the demo program in the status bar. This procedure is 529 # called when the user moves the cursor over a demo description. 530 # 531 proc showStatus index { 532 set tags [.t tag names $index] 533 set i [lsearch -glob $tags demo-*] 534 set cursor [.t cget -cursor] 535 if {$i < 0} { 536 .statusBar.lab config -text " " 537 set newcursor [::ttk::cursor text] 538 } else { 539 set demo [string range [lindex $tags $i] 5 end] 540 .statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo] 541 set newcursor [::ttk::cursor link] 542 } 543 if {$cursor ne $newcursor} { 544 .t config -cursor $newcursor 545 } 546 } 547 548 # evalShowCode -- 549 # 550 # Arguments: 551 # w - Name of text widget containing code to eval 552 553 proc evalShowCode {w} { 554 set code [$w get 1.0 end-1c] 555 uplevel #0 $code 556 } 557 558 # showCode -- 559 # This procedure creates a toplevel window that displays the code for a 560 # demonstration and allows it to be edited and reinvoked. 561 # 562 # Arguments: 563 # w - The name of the demonstration's window, which can be used to 564 # derive the name of the file containing its code. 565 566 proc showCode w { 567 global tk_demoDirectory 568 set file [string range $w 1 end].tcl 569 set top .code 570 if {![winfo exists $top]} { 571 toplevel $top 572 if {[tk windowingsystem] eq "x11"} {wm attributes $top -type dialog} 573 574 set t [frame $top.f] 575 set text [text $t.text -font fixedFont -height 24 -wrap word \ 576 -xscrollcommand [list $t.xscroll set] \ 577 -yscrollcommand [list $t.yscroll set] \ 578 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3] 579 ttk::scrollbar $t.xscroll -command [list $t.text xview] \ 580 -orient horizontal 581 ttk::scrollbar $t.yscroll -command [list $t.text yview] \ 582 -orient vertical 583 584 grid $t.text $t.yscroll -sticky news 585 #grid $t.xscroll 586 grid rowconfigure $t 0 -weight 1 587 grid columnconfig $t 0 -weight 1 588 589 set btns [ttk::frame $top.btns] 590 ttk::separator $btns.sep 591 grid $btns.sep -columnspan 4 -row 0 -sticky ew -pady 2 592 ttk::button $btns.dismiss -text [mc "Dismiss"] \ 593 -default active -command [list destroy $top] \ 594 -image ::img::delete -compound left 595 ttk::button $btns.print -text [mc "Print Code"] \ 596 -command [list printCode $text $file] \ 597 -image ::img::print -compound left 598 ttk::button $btns.rerun -text [mc "Rerun Demo"] \ 599 -command [list evalShowCode $text] \ 600 -image ::img::refresh -compound left 601 set buttons [list x $btns.rerun $btns.print $btns.dismiss] 602 grid {*}$buttons -padx 4 -pady 4 603 grid columnconfigure $btns 0 -weight 1 604 if {[tk windowingsystem] eq "aqua"} { 605 foreach b [lrange $buttons 1 end] {$b configure -takefocus 0} 606 grid configure $btns.sep -pady 0 607 grid configure {*}$buttons -pady {10 12} 608 grid configure [lindex $buttons 1] -padx {16 4} 609 grid configure [lindex $buttons end] -padx {4 18} 610 } 611 grid $t -sticky news 612 grid $btns -sticky ew 613 grid rowconfigure $top 0 -weight 1 614 grid columnconfig $top 0 -weight 1 615 616 bind $top <Return> { 617 if {[winfo class %W] ne "Text"} { .code.btns.dismiss invoke } 618 } 619 bind $top <Escape> [bind $top <Return>] 620 } else { 621 wm deiconify $top 622 raise $top 623 } 624 wm title $top [mc "Demo code: %s" [file join $tk_demoDirectory $file]] 625 wm iconname $top $file 626 set id [open [file join $tk_demoDirectory $file]] 627 fconfigure $id -encoding utf-8 -eofchar "\032 {}" 628 $top.f.text delete 1.0 end 629 $top.f.text insert 1.0 [read $id] 630 $top.f.text mark set insert 1.0 631 close $id 632 } 633 634 # printCode -- 635 # Prints the source code currently displayed in the See Code dialog. Much 636 # thanks to Arjen Markus for this. 637 # 638 # Arguments: 639 # w - Name of text widget containing code to print 640 # file - Name of the original file (implicitly for title) 641 642 proc printCode {w file} { 643 set code [$w get 1.0 end-1c] 644 645 set dir "." 646 if {[info exists ::env(HOME)]} { 647 set dir "$::env(HOME)" 648 } 649 if {[info exists ::env(TMP)]} { 650 set dir $::env(TMP) 651 } 652 if {[info exists ::env(TEMP)]} { 653 set dir $::env(TEMP) 654 } 655 656 set filename [file join $dir "tkdemo-$file"] 657 set outfile [open $filename "w"] 658 puts $outfile $code 659 close $outfile 660 661 switch -- $::tcl_platform(platform) { 662 unix { 663 if {[catch {exec lp -c $filename} msg]} { 664 tk_messageBox -title "Print spooling failure" \ 665 -message "Print spooling probably failed: $msg" 666 } 667 } 668 windows { 669 if {[catch {PrintTextWin32 $filename} msg]} { 670 tk_messageBox -title "Print spooling failure" \ 671 -message "Print spooling probably failed: $msg" 672 } 673 } 674 default { 675 tk_messageBox -title "Operation not Implemented" \ 676 -message "Wow! Unknown platform: $::tcl_platform(platform)" 677 } 678 } 679 680 # 681 # Be careful to throw away the temporary file in a gentle manner ... 682 # 683 if {[file exists $filename]} { 684 catch {file delete $filename} 685 } 686 } 687 688 # PrintTextWin32 -- 689 # Print a file under Windows using all the "intelligence" necessary 690 # 691 # Arguments: 692 # filename - Name of the file 693 # 694 # Note: 695 # Taken from the Wiki page by Keith Vetter, "Printing text files under 696 # Windows". 697 # Note: 698 # Do not execute the command in the background: that way we can dispose of the 699 # file smoothly. 700 # 701 proc PrintTextWin32 {filename} { 702 package require registry 703 set app [auto_execok notepad.exe] 704 set pcmd "$app /p %1" 705 catch { 706 set app [registry get {HKEY_CLASSES_ROOT\.txt} {}] 707 set pcmd [registry get \ 708 {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}] 709 } 710 711 regsub -all {%1} $pcmd $filename pcmd 712 puts $pcmd 713 714 regsub -all {\\} $pcmd {\\\\} pcmd 715 set command "[auto_execok start] /min $pcmd" 716 eval exec $command 717 } 718 719 # tkAboutDialog -- 720 # 721 # Pops up a message box with an "about" message 722 # 723 proc tkAboutDialog {} { 724 tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \ 725 -message [mc "Tk widget demonstration application"] -detail \ 726 "[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}] 727 [mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}] 728 [mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}] 729 [mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]" 730 } 731 732 # Local Variables: 733 # mode: tcl 734 # End: