mingw/lib/tk8.5/demos/widget

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