mingw/lib/tk8.5/demos/widget

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