summaryrefslogtreecommitdiffstats
path: root/library/demos/widget
diff options
context:
space:
mode:
Diffstat (limited to 'library/demos/widget')
-rw-r--r--library/demos/widget780
1 files changed, 559 insertions, 221 deletions
diff --git a/library/demos/widget b/library/demos/widget
index d4ec511..d58f086 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -3,99 +3,180 @@
exec wish "$0" ${1+"$@"}
# widget --
-# This script demonstrates the various widgets provided by Tk,
-# along with many of the features of the Tk toolkit. This file
-# only contains code to generate the main window for the
-# application, which invokes individual demonstrations. The
-# code for the actual demonstrations is contained in separate
-# ".tcl" files is this directory, which are sourced by this script
-# as needed.
+# This script demonstrates the various widgets provided by Tk, along with many
+# of the features of the Tk toolkit. This file only contains code to generate
+# the main window for the application, which invokes individual
+# demonstrations. The code for the actual demonstrations is contained in
+# separate ".tcl" files is this directory, which are sourced by this script as
+# needed.
+
+package require Tcl 8.5
+package require Tk 8.5
+package require msgcat
+package require Ttk
eval destroy [winfo child .]
-wm title . "Widget Demonstration"
+set tk_demoDirectory [file join [pwd] [file dirname [info script]]]
+::msgcat::mcload $tk_demoDirectory
+namespace import ::msgcat::mc
+wm title . [mc "Widget Demonstration"]
if {[tk windowingsystem] eq "x11"} {
- # This won't work everywhere, but there's no other way in core Tk
- # at the moment to display a coloured icon.
+ # This won't work everywhere, but there's no other way in core Tk at the
+ # moment to display a coloured icon.
image create photo TclPowered \
-file [file join $tk_library images logo64.gif]
wm iconwindow . [toplevel ._iconWindow]
pack [label ._iconWindow.i -image TclPowered]
- wm iconname . "tkWidgetDemo"
+ wm iconname . [mc "tkWidgetDemo"]
}
-array set widgetFont {
- main {Helvetica 12}
- bold {Helvetica 12 bold}
- title {Helvetica 18 bold}
- status {Helvetica 10}
- vars {Helvetica 14}
+if {"defaultFont" ni [font names]} {
+ # TIP #145 defines some standard named fonts
+ if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} {
+ # FIX ME: the following technique of cloning the font to copy it works
+ # fine but means that if the system font is changed by Tk
+ # cannot update the copied font. font alias might be useful
+ # here -- or fix the app to use TkDefaultFont etc.
+ font create mainFont {*}[font configure TkDefaultFont]
+ font create fixedFont {*}[font configure TkFixedFont]
+ font create boldFont {*}[font configure TkDefaultFont] -weight bold
+ font create titleFont {*}[font configure TkDefaultFont] -weight bold
+ font create statusFont {*}[font configure TkDefaultFont]
+ font create varsFont {*}[font configure TkDefaultFont]
+ if {[tk windowingsystem] eq "aqua"} {
+ font configure titleFont -size 17
+ }
+ } else {
+ font create mainFont -family Helvetica -size 12
+ font create fixedFont -family Courier -size 10
+ font create boldFont -family Helvetica -size 12 -weight bold
+ font create titleFont -family Helvetica -size 18 -weight bold
+ font create statusFont -family Helvetica -size 10
+ font create varsFont -family Helvetica -size 14
+ }
}
set widgetDemo 1
-set font $widgetFont(main)
+set font mainFont
+
+image create photo ::img::refresh -format GIF -data {
+ R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp
+ xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR
+ 2tICU0gXBQA7
+}
+
+image create photo ::img::view -format GIF -data {
+ R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA
+ AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27
+ yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7
+}
+
+image create photo ::img::delete -format GIF -data {
+ R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy
+ PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw==
+}
+
+image create photo ::img::print -format GIF -data {
+ R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA
+ AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ
+ fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g
+ ryhH5pgnEQA7
+}
+
+# Note that this is run through the message catalog! This is because this is
+# actually an image of a word.
+image create photo ::img::new -format GIF -data [mc {
+ R0lGODlhHgAOALMPALMAANyIiOu7u8dEROaqqvru7sxVVeGZmbgREfXd3b0iItZ3
+ d8IzM9FmZvDMzP///yH5BAEAAA8ALAAAAAAeAA4AAASa8MlJq7046827WVOCHEkw
+ nANhUgJlEBIABJIwL3K+4IcUALCHjfbItYZDSgJgkBiYPmBMAUAkkLPKs/BAyLgM
+ wAQwOAAY2ByCaw4QAFQSoDEePJ6DmU1xInYZTw5nOEFFdgVUelkVDTIMd3AKFGQ1
+ MgI2AwEmQW8APZ0gdRONAks5nhIFVVxdAAkUAS2pAVwFl7ITB4UqHb0XEQA7
+}]
#----------------------------------------------------------------
-# The code below create the main window, consisting of a menu bar
-# and a text widget that explains how to use the program, plus lists
-# all of the demos as hypertext items.
+# The code below create the main window, consisting of a menu bar and a text
+# widget that explains how to use the program, plus lists all of the demos as
+# hypertext items.
#----------------------------------------------------------------
menu .menuBar -tearoff 0
-if {[tk windowingsystem] ne "classic" && [tk windowingsystem] ne "aqua"} {
- .menuBar add cascade -menu .menuBar.file -label "File" -underline 0
+if {[tk windowingsystem] ne "aqua"} {
+ # This is a tk-internal procedure to make i18n easier
+ ::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \
+ -menu .menuBar.file
menu .menuBar.file -tearoff 0
- .menuBar.file add command -label "About..." -command "tkAboutDialog" \
- -underline 0 -accelerator "<F1>"
+ ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
+ -command {tkAboutDialog} -accelerator [mc "<F1>"]
+ bind . <F1> {tkAboutDialog}
.menuBar.file add sep
- .menuBar.file add command -label "Quit" -command "exit" -underline 0 \
- -accelerator "Meta-Q"
- bind . <F1> tkAboutDialog
+ if {[string match win* [tk windowingsystem]]} {
+ # Windows doesn't usually have a Meta key
+ ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
+ -command {exit} -accelerator [mc "Ctrl+Q"]
+ bind . <[mc "Control-q"]> {exit}
+ } else {
+ ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
+ -command {exit} -accelerator [mc "Meta-Q"]
+ bind . <[mc "Meta-q"]> {exit}
+ }
}
. configure -menu .menuBar
-frame .statusBar
-label .statusBar.lab -text " " -relief sunken -bd 1 \
- -font $widgetFont(status) -anchor w
-label .statusBar.foo -width 8 -relief sunken -bd 1 \
- -font $widgetFont(status) -anchor w
+ttk::frame .statusBar
+ttk::label .statusBar.lab -text " " -anchor w
+if {[tk windowingsystem] eq "aqua"} {
+ ttk::separator .statusBar.sep
+ pack .statusBar.sep -side top -expand yes -fill x -pady 0
+}
pack .statusBar.lab -side left -padx 2 -expand yes -fill both
-pack .statusBar.foo -side left -padx 2
+if {[tk windowingsystem] ne "aqua"} {
+ ttk::sizegrip .statusBar.foo
+ pack .statusBar.foo -side left -padx 2
+}
pack .statusBar -side bottom -fill x -pady 2
set textheight 30
catch {
set textheight [expr {
- ([winfo screenheight .] - 200) /
- [font metrics $widgetFont(main) -displayof . -linespace]
+ ([winfo screenheight .] * 0.7) /
+ [font metrics mainFont -displayof . -linespace]
}]
}
-frame .textFrame
-scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
- -takefocus 1
+ttk::frame .textFrame
+scrollbar .s -orient vertical -command {.t yview} -takefocus 1
pack .s -in .textFrame -side right -fill y
-text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \
- -font $widgetFont(main) -setgrid 1 -highlightthickness 0 \
- -padx 4 -pady 2 -takefocus 0
+text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \
+ -font mainFont -setgrid 1 -highlightthickness 0 \
+ -padx 4 -pady 2 -takefocus 0
pack .t -in .textFrame -expand y -fill both -padx 1
-pack .textFrame -expand yes -fill both
+pack .textFrame -expand yes -fill both
+if {[tk windowingsystem] eq "aqua"} {
+ pack configure .statusBar.lab -padx {10 18} -pady {4 6}
+ pack configure .statusBar -pady 0
+ .t configure -padx 10 -pady 0
+}
-# Create a bunch of tags to use in the text widget, such as those for
-# section titles and demo descriptions. Also define the bindings for
-# tags.
+# Create a bunch of tags to use in the text widget, such as those for section
+# titles and demo descriptions. Also define the bindings for tags.
-.t tag configure title -font $widgetFont(title)
-.t tag configure bold -font $widgetFont(bold)
+.t tag configure title -font titleFont
+.t tag configure subtitle -font titleFont
+.t tag configure bold -font boldFont
+if {[tk windowingsystem] eq "aqua"} {
+ .t tag configure title -spacing1 8
+ .t tag configure subtitle -spacing3 3
+}
-# We put some "space" characters to the left and right of each demo description
-# so that the descriptions are highlighted only when the mouse cursor
-# is right over them (but not when the cursor is to their left or right)
+# We put some "space" characters to the left and right of each demo
+# description so that the descriptions are highlighted only when the mouse
+# cursor is right over them (but not when the cursor is to their left or
+# right).
#
.t tag configure demospace -lmargin1 1c -lmargin2 1c
-
if {[winfo depth .] == 1} {
.t tag configure demo -lmargin1 1c -lmargin2 1c \
-underline 1
@@ -116,17 +197,17 @@ set lastLine ""
.t tag bind demo <Enter> {
set lastLine [.t index {@%x,%y linestart}]
.t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
- .t config -cursor hand2
+ .t config -cursor [::ttk::cursor link]
showStatus [.t index {@%x,%y}]
}
.t tag bind demo <Leave> {
.t tag remove hot 1.0 end
- .t config -cursor xterm
+ .t config -cursor [::ttk::cursor text]
.statusBar.lab config -text ""
}
.t tag bind demo <Motion> {
set newLine [.t index {@%x,%y linestart}]
- if {[string compare $newLine $lastLine] != 0} {
+ if {$newLine ne $lastLine} {
.t tag remove hot 1.0 end
set lastLine $newLine
@@ -138,97 +219,239 @@ set lastLine ""
}
showStatus [.t index {@%x,%y}]
}
-
+
+##############################################################################
# Create the text for the text widget.
-proc addDemoSection {title demos} {
- .t insert end "\n" {} $title title " \n " demospace
- set num 0
- foreach {name description} $demos {
- .t insert end "[incr num]. $description." [list demo demo-$name]
- .t insert end " \n " demospace
+# addFormattedText --
+#
+# Add formatted text (but not hypertext) to the text widget after first
+# passing it through the message catalog to allow for localization.
+# Lines starting with @@ are formatting directives (insert title, insert
+# demo hyperlink, begin newline, or change style) and all other lines
+# are literal strings to be inserted. Substitutions are performed,
+# allowing processing pieces through the message catalog. Blank lines
+# are ignored.
+#
+proc addFormattedText {formattedText} {
+ set style normal
+ set isNL 1
+ set demoCount 0
+ set new 0
+ foreach line [split $formattedText \n] {
+ set line [string trim $line]
+ if {$line eq ""} {
+ continue
+ }
+ if {[string match @@* $line]} {
+ set data [string range $line 2 end]
+ set key [lindex $data 0]
+ set values [lrange $data 1 end]
+ switch -exact -- $key {
+ title {
+ .t insert end [mc $values]\n title \n normal
+ }
+ newline {
+ .t insert end \n $style
+ set isNL 1
+ }
+ subtitle {
+ .t insert end "\n" {} [mc $values] subtitle \
+ " \n " demospace
+ set demoCount 0
+ }
+ demo {
+ set description [lassign $values name]
+ .t insert end "[incr demoCount]. [mc $description]" \
+ [list demo demo-$name]
+ if {$new} {
+ .t image create end -image ::img::new -padx 5
+ set new 0
+ }
+ .t insert end " \n " demospace
+ }
+ new {
+ set new 1
+ }
+ default {
+ set style $key
+ }
+ }
+ continue
+ }
+ if {!$isNL} {
+ .t insert end " " $style
+ }
+ set isNL 0
+ .t insert end [mc $line] $style
}
}
-.t insert end "Tk Widget Demonstrations\n" title
-.t insert end "\nThis application provides a front end for several short\
- scripts that demonstrate what you can do with Tk widgets. Each of\
- the numbered lines below describes a demonstration; you can click\
- on it to invoke the demonstration. Once the demonstration window\
- appears, you can click the " {} "See Code" bold " button to see the\
- Tcl/Tk code that created the demonstration. If you wish, you can\
- edit the code and click the " {} "Rerun Demo" bold " button in the\
- code window to reinvoke the demonstration with the modified code.\n"
-
-addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" {
- label "Labels (text and bitmaps)"
- unicodeout "Labels and UNICODE text"
- button "Buttons"
- check "Check-buttons (select any of a group)"
- radio "Radio-buttons (select one of a group)"
- puzzle "A 15-puzzle game made out of buttons"
- icon "Iconic buttons that use bitmaps"
- image1 "Two labels displaying images"
- image2 "A simple user interface for viewing images"
- labelframe "Labelled frames"
-}
-addDemoSection "Listboxes" {
- states "The 50 states"
- colors "Colors: change the color scheme for the application"
- sayings "A collection of famous and infamous sayings"
-}
-addDemoSection "Entries and Spin-boxes" {
- entry1 "Entries without scrollbars"
- entry2 "Entries with scrollbars"
- entry3 "Validated entries and password fields"
- spin "Spin-boxes"
- form "Simple Rolodex-like form"
-}
-addDemoSection "Text" {
- text "Basic editable text"
- style "Text display styles"
- bind "Hypertext (tag bindings)"
- twind "A text widget with embedded windows"
- search "A search tool built with a text widget"
-}
-addDemoSection "Canvases" {
- items "The canvas item types"
- plot "A simple 2-D plot"
- ctext "Text items in canvases"
- arrow "An editor for arrowheads on canvas lines"
- ruler "A ruler with adjustable tab stops"
- floor "A building floor plan"
- cscroll "A simple scrollable canvas"
-}
-addDemoSection "Scales" {
- hscale "Horizontal scale"
- vscale "Vertical scale"
-}
-addDemoSection "Paned Windows" {
- paned1 "Horizontal paned window"
- paned2 "Vertical paned window"
-}
-addDemoSection "Menus" {
- menu "Menus and cascades (sub-menus)"
- menubu "Menu-buttons"
-}
-addDemoSection "Common Dialogs" {
- msgbox "Message boxes"
- filebox "File selection dialog"
- clrpick "Color picker"
-}
-addDemoSection "Miscellaneous" {
- bitmap "The built-in bitmaps"
- dialog1 "A dialog box with a local grab"
- dialog2 "A dialog box with a global grab"
+addFormattedText {
+ @@title Tk Widget Demonstrations
+
+ This application provides a front end for several short scripts
+ that demonstrate what you can do with Tk widgets. Each of the
+ numbered lines below describes a demonstration; you can click on
+ it to invoke the demonstration. Once the demonstration window
+ appears, you can click the
+ @@bold
+ See Code
+ @@normal
+ button to see the Tcl/Tk code that created the demonstration. If
+ you wish, you can edit the code and click the
+ @@bold
+ Rerun Demo
+ @@normal
+ button in the code window to reinvoke the demonstration with the
+ modified code.
+ @@newline
+
+ @@subtitle Labels, buttons, checkbuttons, and radiobuttons
+ @@demo label Labels (text and bitmaps)
+ @@demo unicodeout Labels and UNICODE text
+ @@demo button Buttons
+ @@demo check Check-buttons (select any of a group)
+ @@demo radio Radio-buttons (select one of a group)
+ @@demo puzzle A 15-puzzle game made out of buttons
+ @@demo icon Iconic buttons that use bitmaps
+ @@demo image1 Two labels displaying images
+ @@demo image2 A simple user interface for viewing images
+ @@demo labelframe Labelled frames
+ @@new
+ @@demo ttkbut The simple Themed Tk widgets
+
+ @@subtitle Listboxes and Trees
+ @@demo states The 50 states
+ @@demo colors Colors: change the color scheme for the application
+ @@demo sayings A collection of famous and infamous sayings
+ @@new
+ @@demo mclist A multi-column list of countries
+ @@new
+ @@demo tree A directory browser tree
+
+ @@subtitle Entries, Spin-boxes and Combo-boxes
+ @@demo entry1 Entries without scrollbars
+ @@demo entry2 Entries with scrollbars
+ @@demo entry3 Validated entries and password fields
+ @@demo spin Spin-boxes
+ @@new
+ @@demo combo Combo-boxes
+ @@demo form Simple Rolodex-like form
+
+ @@subtitle Text
+ @@demo text Basic editable text
+ @@demo style Text display styles
+ @@demo bind Hypertext (tag bindings)
+ @@demo twind A text widget with embedded windows and other features
+ @@demo search A search tool built with a text widget
+ @@new
+ @@demo textpeer Peering text widgets
+
+ @@subtitle Canvases
+ @@demo items The canvas item types
+ @@demo plot A simple 2-D plot
+ @@demo ctext Text items in canvases
+ @@demo arrow An editor for arrowheads on canvas lines
+ @@demo ruler A ruler with adjustable tab stops
+ @@demo floor A building floor plan
+ @@demo cscroll A simple scrollable canvas
+ @@new
+ @@demo knightstour A Knight's tour of the chess board
+
+ @@subtitle Scales and Progress Bars
+ @@demo hscale Horizontal scale
+ @@demo vscale Vertical scale
+ @@new
+ @@demo ttkscale Themed scale linked to a label with traces
+ @@new
+ @@demo ttkprogress Progress bar
+
+ @@subtitle Paned Windows and Notebooks
+ @@demo paned1 Horizontal paned window
+ @@demo paned2 Vertical paned window
+ @@new
+ @@demo ttkpane Themed nested panes
+ @@new
+ @@demo ttknote Notebook widget
+
+ @@subtitle Menus and Toolbars
+ @@demo menu Menus and cascades (sub-menus)
+ @@demo menubu Menu-buttons
+ @@new
+ @@demo ttkmenu Themed menu buttons
+ @@new
+ @@demo toolbar Themed toolbar
+
+ @@subtitle Common Dialogs
+ @@demo msgbox Message boxes
+ @@demo filebox File selection dialog
+ @@demo clrpick Color picker
+
+ @@subtitle Animation
+ @@new
+ @@demo anilabel Animated labels
+ @@new
+ @@demo aniwave Animated wave
+ @@new
+ @@demo pendulum Pendulum simulation
+ @@new
+ @@demo goldberg A celebration of Rube Goldberg
+
+ @@subtitle Miscellaneous
+ @@demo bitmap The built-in bitmaps
+ @@demo dialog1 A dialog box with a local grab
+ @@demo dialog2 A dialog box with a global grab
}
+
+##############################################################################
.t configure -state disabled
focus .s
+# addSeeDismiss --
+# Add "See Code" and "Dismiss" button frame, with optional "See Vars"
+#
+# Arguments:
+# w - The name of the frame to use.
+
+proc addSeeDismiss {w show {vars {}} {extra {}}} {
+ ## See Code / Dismiss buttons
+ ttk::frame $w
+ ttk::separator $w.sep
+ #ttk::frame $w.sep -height 2 -relief sunken
+ grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2
+ ttk::button $w.dismiss -text [mc "Dismiss"] \
+ -image ::img::delete -compound left \
+ -command [list destroy [winfo toplevel $w]]
+ ttk::button $w.code -text [mc "See Code"] \
+ -image ::img::view -compound left \
+ -command [list showCode $show]
+ set buttons [list x $w.code $w.dismiss]
+ if {[llength $vars]} {
+ ttk::button $w.vars -text [mc "See Variables"] \
+ -image ::img::view -compound left \
+ -command [concat [list showVars $w.dialog] $vars]
+ set buttons [linsert $buttons 1 $w.vars]
+ }
+ if {$extra ne ""} {
+ set buttons [linsert $buttons 1 [uplevel 1 $extra]]
+ }
+ grid {*}$buttons -padx 4 -pady 4
+ grid columnconfigure $w 0 -weight 1
+ if {[tk windowingsystem] eq "aqua"} {
+ foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
+ grid configure $w.sep -pady 0
+ grid configure {*}$buttons -pady {10 12}
+ grid configure [lindex $buttons 1] -padx {16 4}
+ grid configure [lindex $buttons end] -padx {4 18}
+ }
+ return $w
+}
+
# positionWindow --
-# This procedure is invoked by most of the demos to position a
-# new demo window.
+# This procedure is invoked by most of the demos to position a new demo
+# window.
#
# Arguments:
# w - The name of the window to position.
@@ -238,59 +461,66 @@ proc positionWindow w {
}
# showVars --
-# Displays the values of one or more variables in a window, and
-# updates the display whenever any of the variables changes.
+# Displays the values of one or more variables in a window, and updates the
+# display whenever any of the variables changes.
#
# Arguments:
# w - Name of new window to create for display.
# args - Any number of names of variables.
proc showVars {w args} {
- global widgetFont
catch {destroy $w}
toplevel $w
- wm title $w "Variable values"
- label $w.title -text "Variable values:" -width 20 -anchor center \
- -font $widgetFont(vars)
- pack $w.title -side top -fill x
- set len 1
- foreach i $args {
- if {[string length $i] > $len} {
- set len [string length $i]
- }
+ if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
+ wm title $w [mc "Variable values"]
+
+ set b [ttk::frame $w.frame]
+ grid $b -sticky news
+ set f [ttk::labelframe $b.title -text [mc "Variable values:"]]
+ foreach var $args {
+ ttk::label $f.n$var -text "$var:" -anchor w
+ ttk::label $f.v$var -textvariable $var -anchor w
+ grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w
}
- foreach i $args {
- frame $w.$i
- label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
- label $w.$i.value -textvar $i -anchor w
- pack $w.$i.name -side left
- pack $w.$i.value -side left -expand 1 -fill x
- pack $w.$i -side top -anchor w -fill x
+ ttk::button $b.ok -text [mc "OK"] \
+ -command [list destroy $w] -default active
+ bind $w <Return> [list $b.ok invoke]
+ bind $w <Escape> [list $b.ok invoke]
+
+ grid $f -sticky news -padx 4
+ grid $b.ok -sticky e -padx 4 -pady {6 4}
+ if {[tk windowingsystem] eq "aqua"} {
+ $b.ok configure -takefocus 0
+ grid configure $b.ok -pady {10 12} -padx {16 18}
+ grid configure $f -padx 10 -pady {10 0}
}
- button $w.ok -text OK -command "destroy $w" -default active
- bind $w <Return> "tkButtonInvoke $w.ok"
- pack $w.ok -side bottom -pady 2
+ grid columnconfig $f 1 -weight 1
+ grid rowconfigure $f 100 -weight 1
+ grid columnconfig $b 0 -weight 1
+ grid rowconfigure $b 0 -weight 1
+ grid columnconfig $w 0 -weight 1
+ grid rowconfigure $w 0 -weight 1
}
# invoke --
-# This procedure is called when the user clicks on a demo description.
-# It is responsible for invoking the demonstration.
+# This procedure is called when the user clicks on a demo description. It is
+# responsible for invoking the demonstration.
#
# Arguments:
# index - The index of the character that the user clicked on.
proc invoke index {
- global tk_library
+ global tk_demoDirectory
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
if {$i < 0} {
return
}
set cursor [.t cget -cursor]
- .t configure -cursor watch
+ .t configure -cursor [::ttk::cursor busy]
update
set demo [string range [lindex $tags $i] 5 end]
- uplevel [list source [file join $tk_library demos $demo.tcl]]
+ uplevel 1 [list source [file join $tk_demoDirectory $demo.tcl]]
update
.t configure -cursor $cursor
@@ -299,97 +529,205 @@ proc invoke index {
# showStatus --
#
-# Show the name of the demo program in the status bar. This procedure
-# is called when the user moves the cursor over a demo description.
+# Show the name of the demo program in the status bar. This procedure is
+# called when the user moves the cursor over a demo description.
#
proc showStatus index {
- global tk_library
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
set cursor [.t cget -cursor]
if {$i < 0} {
.statusBar.lab config -text " "
- set newcursor xterm
+ set newcursor [::ttk::cursor text]
} else {
set demo [string range [lindex $tags $i] 5 end]
- .statusBar.lab config -text "Run the \"$demo\" sample program"
- set newcursor hand2
+ .statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo]
+ set newcursor [::ttk::cursor link]
}
- if [string compare $cursor $newcursor] {
+ if {$cursor ne $newcursor} {
.t config -cursor $newcursor
}
}
+# evalShowCode --
+#
+# Arguments:
+# w - Name of text widget containing code to eval
+
+proc evalShowCode {w} {
+ set code [$w get 1.0 end-1c]
+ uplevel #0 $code
+}
# showCode --
-# This procedure creates a toplevel window that displays the code for
-# a demonstration and allows it to be edited and reinvoked.
+# This procedure creates a toplevel window that displays the code for a
+# demonstration and allows it to be edited and reinvoked.
#
# Arguments:
-# w - The name of the demonstration's window, which can be
-# used to derive the name of the file containing its code.
+# w - The name of the demonstration's window, which can be used to
+# derive the name of the file containing its code.
proc showCode w {
- global tk_library
+ global tk_demoDirectory
set file [string range $w 1 end].tcl
- if ![winfo exists .code] {
- toplevel .code
- frame .code.buttons
- pack .code.buttons -side bottom -fill x
- button .code.buttons.dismiss -text Dismiss \
- -default active -command "destroy .code"
- button .code.buttons.rerun -text "Rerun Demo" -command {
- eval [.code.text get 1.0 end]
+ set top .code
+ if {![winfo exists $top]} {
+ toplevel $top
+ if {[tk windowingsystem] eq "x11"} {wm attributes $top -type dialog}
+
+ set t [frame $top.f]
+ set text [text $t.text -font fixedFont -height 24 -wrap word \
+ -xscrollcommand [list $t.xscroll set] \
+ -yscrollcommand [list $t.yscroll set] \
+ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3]
+ scrollbar $t.xscroll -command [list $t.text xview] -orient horizontal
+ scrollbar $t.yscroll -command [list $t.text yview] -orient vertical
+
+ grid $t.text $t.yscroll -sticky news
+ #grid $t.xscroll
+ grid rowconfigure $t 0 -weight 1
+ grid columnconfig $t 0 -weight 1
+
+ set btns [ttk::frame $top.btns]
+ ttk::separator $btns.sep
+ grid $btns.sep -columnspan 4 -row 0 -sticky ew -pady 2
+ ttk::button $btns.dismiss -text [mc "Dismiss"] \
+ -default active -command [list destroy $top] \
+ -image ::img::delete -compound left
+ ttk::button $btns.print -text [mc "Print Code"] \
+ -command [list printCode $text $file] \
+ -image ::img::print -compound left
+ ttk::button $btns.rerun -text [mc "Rerun Demo"] \
+ -command [list evalShowCode $text] \
+ -image ::img::refresh -compound left
+ set buttons [list x $btns.rerun $btns.print $btns.dismiss]
+ grid {*}$buttons -padx 4 -pady 4
+ grid columnconfigure $btns 0 -weight 1
+ if {[tk windowingsystem] eq "aqua"} {
+ foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
+ grid configure $btns.sep -pady 0
+ grid configure {*}$buttons -pady {10 12}
+ grid configure [lindex $buttons 1] -padx {16 4}
+ grid configure [lindex $buttons end] -padx {4 18}
}
- pack .code.buttons.dismiss .code.buttons.rerun -side left \
- -expand 1 -pady 2
- frame .code.frame
- pack .code.frame -expand yes -fill both -padx 1 -pady 1
- text .code.text -height 40 -wrap word\
- -xscrollcommand ".code.xscroll set" \
- -yscrollcommand ".code.yscroll set" \
- -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
- scrollbar .code.xscroll -command ".code.text xview" \
- -highlightthickness 0 -orient horizontal
- scrollbar .code.yscroll -command ".code.text yview" \
- -highlightthickness 0 -orient vertical
-
- grid .code.text -in .code.frame -padx 1 -pady 1 \
- -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
- grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
- -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
-# grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
-# -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
- grid rowconfig .code.frame 0 -weight 1 -minsize 0
- grid columnconfig .code.frame 0 -weight 1 -minsize 0
+ grid $t -sticky news
+ grid $btns -sticky ew
+ grid rowconfigure $top 0 -weight 1
+ grid columnconfig $top 0 -weight 1
+
+ bind $top <Return> {
+ if {[winfo class %W] ne "Text"} { .code.btns.dismiss invoke }
+ }
+ bind $top <Escape> [bind $top <Return>]
} else {
- wm deiconify .code
- raise .code
+ wm deiconify $top
+ raise $top
}
- wm title .code "Demo code: [file join $tk_library demos $file]"
- wm iconname .code $file
- set id [open [file join $tk_library demos $file]]
- .code.text delete 1.0 end
- .code.text insert 1.0 [read $id]
- .code.text mark set insert 1.0
+ wm title $top [mc "Demo code: %s" [file join $tk_demoDirectory $file]]
+ wm iconname $top $file
+ set id [open [file join $tk_demoDirectory $file]]
+ $top.f.text delete 1.0 end
+ $top.f.text insert 1.0 [read $id]
+ $top.f.text mark set insert 1.0
close $id
}
-# tkAboutDialog --
+# printCode --
+# Prints the source code currently displayed in the See Code dialog. Much
+# thanks to Arjen Markus for this.
#
-# Pops up a message box with an "about" message
-#
-proc tkAboutDialog {} {
- tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
-"Tk widget demonstration
+# Arguments:
+# w - Name of text widget containing code to print
+# file - Name of the original file (implicitly for title)
+
+proc printCode {w file} {
+ set code [$w get 1.0 end-1c]
+
+ set dir "."
+ if {[info exists ::env(HOME)]} {
+ set dir "$::env(HOME)"
+ }
+ if {[info exists ::env(TMP)]} {
+ set dir $::env(TMP)
+ }
+ if {[info exists ::env(TEMP)]} {
+ set dir $::env(TEMP)
+ }
-Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ set filename [file join $dir "tkdemo-$file"]
+ set outfile [open $filename "w"]
+ puts $outfile $code
+ close $outfile
+
+ switch -- $::tcl_platform(platform) {
+ unix {
+ if {[catch {exec lp -c $filename} msg]} {
+ tk_messageBox -title "Print spooling failure" \
+ -message "Print spooling probably failed: $msg"
+ }
+ }
+ windows {
+ if {[catch {PrintTextWin32 $filename} msg]} {
+ tk_messageBox -title "Print spooling failure" \
+ -message "Print spooling probably failed: $msg"
+ }
+ }
+ default {
+ tk_messageBox -title "Operation not Implemented" \
+ -message "Wow! Unknown platform: $::tcl_platform(platform)"
+ }
+ }
-Copyright (c) 1997-2000 Ajuba Solutions, Inc.
+ #
+ # Be careful to throw away the temporary file in a gentle manner ...
+ #
+ if {[file exists $filename]} {
+ catch {file delete $filename}
+ }
+}
-Copyright (c) 2001-2002 Donal K. Fellows
+# PrintTextWin32 --
+# Print a file under Windows using all the "intelligence" necessary
+#
+# Arguments:
+# filename - Name of the file
+#
+# Note:
+# Taken from the Wiki page by Keith Vetter, "Printing text files under
+# Windows".
+# Note:
+# Do not execute the command in the background: that way we can dispose of the
+# file smoothly.
+#
+proc PrintTextWin32 {filename} {
+ package require registry
+ set app [auto_execok notepad.exe]
+ set pcmd "$app /p %1"
+ catch {
+ set app [registry get {HKEY_CLASSES_ROOT\.txt} {}]
+ set pcmd [registry get \
+ {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}]
+ }
+
+ regsub -all {%1} $pcmd $filename pcmd
+ puts $pcmd
-Copyright (c) 2002-2007 Daniel A. Steffen"
+ regsub -all {\\} $pcmd {\\\\} pcmd
+ set command "[auto_execok start] /min $pcmd"
+ eval exec $command
+}
+
+# tkAboutDialog --
+#
+# Pops up a message box with an "about" message
+#
+proc tkAboutDialog {} {
+ tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
+ -message [mc "Tk widget demonstration application"] -detail \
+"[mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}]
+[mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}]
+[mc {Copyright (c) %s} {2001-2007 Donal K. Fellows}]
+[mc {Copyright (c) %s} {2002-2007 Daniel A. Steffen}]"
}
# Local Variables:
generated by cgit v0.12 at 2024-11-08 09:30:26 (GMT)