summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/console.tcl251
-rw-r--r--library/demos/en.msg94
-rw-r--r--library/demos/widget159
-rw-r--r--library/msgs/de.msg24
-rw-r--r--library/msgs/en.msg24
-rw-r--r--library/tk.tcl20
6 files changed, 406 insertions, 166 deletions
diff --git a/library/console.tcl b/library/console.tcl
index 93f4f30..0ad6959 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,7 +4,7 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# RCS: @(#) $Id: console.tcl,v 1.22 2003/02/21 03:34:29 das Exp $
+# RCS: @(#) $Id: console.tcl,v 1.23 2003/05/19 14:44:03 dkf Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
@@ -23,7 +23,7 @@ namespace eval ::tk::console {
variable showMatches 1 ; # show multiple expand matches
variable inPlugin [info exists embed_args]
- variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used
+ variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used
if {$inPlugin} {
@@ -49,57 +49,58 @@ proc ::tk::ConsoleInit {} {
wm withdraw .
}
- if {[string equal $tcl_platform(platform) "macintosh"]
- || [string equal [tk windowingsystem] "aqua"]} {
+ if {$tcl_platform(platform) eq "macintosh"
+ || [tk windowingsystem] eq "aqua"} {
set mod "Cmd"
} else {
set mod "Ctrl"
}
- if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
- .menubar add cascade -label File -menu .menubar.file -underline 0
- .menubar add cascade -label Edit -menu .menubar.edit -underline 0
+ if {[catch {menu .menubar} err]} {
+ bgerror "INIT: $err"
+ }
+ AmpMenuArgs .menubar add cascade -label [mc &File] -menu .menubar.file
+ AmpMenuArgs .menubar add cascade -label [mc &Edit] -menu .menubar.edit
menu .menubar.file -tearoff 0
- .menubar.file add command -label [mc "Source..."] \
- -underline 0 -command tk::ConsoleSource
- .menubar.file add command -label [mc "Hide Console"] \
- -underline 0 -command {wm withdraw .}
- .menubar.file add command -label [mc "Clear Console"] \
- -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
- if {[string equal $tcl_platform(platform) "macintosh"]
- || [string equal [tk windowingsystem] "aqua"]} {
- .menubar.file add command -label [mc "Quit"] \
- -command exit -accel Cmd-Q
+ AmpMenuArgs .menubar.file add command -label [mc "&Source..."] \
+ -command {tk::ConsoleSource}
+ AmpMenuArgs .menubar.file add command -label [mc "&Hide Console"] \
+ -command {wm withdraw .}
+ AmpMenuArgs .menubar.file add command -label [mc "&Clear Console"] \
+ -command {.console delete 1.0 "promptEnd linestart"}
+ if {$tcl_platform(platform) eq "macintosh" || \
+ [tk windowingsystem] eq "aqua"} {
+ AmpMenuArgs .menubar.file add command \
+ -label [mc &Quit] -command {exit} -accel "Cmd-Q"
} else {
- .menubar.file add command -label [mc "Exit"] \
- -underline 1 -command exit
+ AmpMenuArgs .menubar.file add command -label [mc E&xit] -command {exit}
}
menu .menubar.edit -tearoff 0
- .menubar.edit add command -label [mc "Cut"] -underline 2 \
- -command { event generate .console <<Cut>> } -accel "$mod+X"
- .menubar.edit add command -label [mc "Copy"] -underline 0 \
- -command { event generate .console <<Copy>> } -accel "$mod+C"
- .menubar.edit add command -label [mc "Paste"] -underline 1 \
- -command { event generate .console <<Paste>> } -accel "$mod+V"
+ AmpMenuArgs .menubar.edit add command -label [mc Cu&t] -accel "$mod+X"\
+ -command {event generate .console <<Cut>>}
+ AmpMenuArgs .menubar.edit add command -label [mc &Copy] -accel "$mod+C"\
+ -command {event generate .console <<Copy>>}
+ AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\
+ -command {event generate .console <<Paste>>}
if {[string compare $tcl_platform(platform) "windows"]} {
- .menubar.edit add command -label [mc "Clear"] -underline 2 \
- -command { event generate .console <<Clear>> }
+ AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \
+ -command {event generate .console <<Clear>>}
} else {
- .menubar.edit add command -label [mc "Delete"] -underline 0 \
- -command { event generate .console <<Clear>> } -accel "Del"
-
- .menubar add cascade -label Help -menu .menubar.help -underline 0
+ AmpMenuArgs .menubar.edit add command -label [mc &Delete] \
+ -command {event generate .console <<Clear>>} -accel "Del"
+
+ AmpMenuArgs .menubar add cascade -label [mc &Help] -menu .menubar.help
menu .menubar.help -tearoff 0
- .menubar.help add command -label [mc "About..."] \
- -underline 0 -command tk::ConsoleAbout
+ AmpMenuArgs .menubar.help add command -label [mc &About...] \
+ -command tk::ConsoleAbout
}
. configure -menu .menubar
- set con [text .console -yscrollcommand [list .sb set] -setgrid true]
+ set con [text .console -yscrollcommand [list .sb set] -setgrid true]
scrollbar .sb -command [list $con yview]
pack .sb -side right -fill both
pack $con -fill both -expand 1 -side left
@@ -111,7 +112,7 @@ proc ::tk::ConsoleInit {} {
$con configure -font systemfixed
}
"unix" {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[tk windowingsystem] eq "aqua"} {
$con configure -font {Monaco 9 normal} -highlightthickness 0
}
}
@@ -180,13 +181,13 @@ proc ::tk::ConsoleInvoke {args} {
incr pos
}
}
- if {[string equal $cmd ""]} {
+ if {$cmd eq ""} {
ConsolePrompt
} elseif {[info complete $cmd]} {
.console mark set output end
.console tag delete input
set result [consoleinterp record $cmd]
- if {[string compare $result ""]} {
+ if {$result ne ""} {
puts $result
}
ConsoleHistory reset
@@ -235,7 +236,7 @@ proc ::tk::ConsoleHistory {cmd} {
} else {
set cmd "history event $HistNum"
}
- if {[string compare $cmd ""]} {
+ if {$cmd ne ""} {
catch {consoleinterp eval $cmd} cmd
}
.console delete promptEnd end
@@ -257,7 +258,7 @@ proc ::tk::ConsoleHistory {cmd} {
proc ::tk::ConsolePrompt {{partial normal}} {
set w .console
- if {[string equal $partial "normal"]} {
+ if {$partial eq "normal"} {
set temp [$w index "end - 1 char"]
$w mark set output end
if {[consoleinterp eval "info exists tcl_prompt1"]} {
@@ -295,7 +296,9 @@ proc ::tk::ConsoleBind {w} {
bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
## Get all Text bindings into Console
- foreach ev [bind Text] { bind Console $ev [bind Text $ev] }
+ foreach ev [bind Text] {
+ bind Console $ev [bind Text $ev]
+ }
## We really didn't want the newline insertion...
bind Console <Control-Key-o> {}
## ...or any Control-v binding (would block <<Paste>>)
@@ -341,16 +344,24 @@ proc ::tk::ConsoleBind {w} {
}
bind Console <<Console_Expand>> {
- if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
+ if {[%W compare insert > promptEnd]} {
+ ::tk::console::Expand %W
+ }
}
bind Console <<Console_ExpandFile>> {
- if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
+ if {[%W compare insert > promptEnd]} {
+ ::tk::console::Expand %W path
+ }
}
bind Console <<Console_ExpandProc>> {
- if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
+ if {[%W compare insert > promptEnd]} {
+ ::tk::console::Expand %W proc
+ }
}
bind Console <<Console_ExpandVar>> {
- if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
+ if {[%W compare insert > promptEnd]} {
+ ::tk::console::Expand %W var
+ }
}
bind Console <<Console_Eval>> {
%W mark set insert {end - 1c}
@@ -359,7 +370,7 @@ proc ::tk::ConsoleBind {w} {
break
}
bind Console <Delete> {
- if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+ if {{} ne [%W tag nextrange sel 1.0 end] \
&& [%W compare sel.first >= promptEnd]} {
%W delete sel.first sel.last
} elseif {[%W compare insert >= promptEnd]} {
@@ -368,7 +379,7 @@ proc ::tk::ConsoleBind {w} {
}
}
bind Console <BackSpace> {
- if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+ if {{} ne [%W tag nextrange sel 1.0 end] \
&& [%W compare sel.first >= promptEnd]} {
%W delete sel.first sel.last
} elseif {[%W compare insert != 1.0] && \
@@ -392,11 +403,15 @@ proc ::tk::ConsoleBind {w} {
}
bind Console <Control-e> [bind Console <End>]
bind Console <Control-d> {
- if {[%W compare insert < promptEnd]} break
+ if {[%W compare insert < promptEnd]} {
+ break
+ }
%W delete insert
}
bind Console <<Console_KillLine>> {
- if {[%W compare insert < promptEnd]} break
+ if {[%W compare insert < promptEnd]} {
+ break
+ }
if {[%W compare insert == {insert lineend}]} {
%W delete insert
} else {
@@ -450,17 +465,19 @@ proc ::tk::ConsoleBind {w} {
}
bind Console <F9> {
eval destroy [winfo child .]
- if {[string equal $tcl_platform(platform) "macintosh"]} {
- if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
+ if {$tcl_platform(platform) eq "macintosh"} {
+ if {[catch {source [file join $tk_library console.tcl]}]} {
+ source -rsrc console
+ }
} else {
source [file join $tk_library console.tcl]
}
}
- if {[string equal $::tcl_platform(platform) "macintosh"]
- || [string equal [tk windowingsystem] "aqua"]} {
- bind Console <Command-q> {
- exit
- }
+ if {$::tcl_platform(platform) eq "macintosh" \
+ || [tk windowingsystem] eq "aqua"} {
+ bind Console <Command-q> {
+ exit
+ }
}
bind Console <<Cut>> {
# Same as the copy event
@@ -493,22 +510,22 @@ proc ::tk::ConsoleBind {w} {
## Bindings for doing special things based on certain keys
##
bind PostConsole <Key-parenright> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchPair %W \( \) promptEnd
}
}
bind PostConsole <Key-bracketright> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchPair %W \[ \] promptEnd
}
}
bind PostConsole <Key-braceright> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchPair %W \{ \} promptEnd
}
}
bind PostConsole <Key-quotedbl> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchQuote %W promptEnd
}
}
@@ -532,11 +549,11 @@ proc ::tk::ConsoleBind {w} {
# s - The string to insert (usually just a single character)
proc ::tk::ConsoleInsert {w s} {
- if {[string equal $s ""]} {
+ if {$s eq ""} {
return
}
catch {
- if {[$w compare sel.first <= insert]
+ if {[$w compare sel.first <= insert] \
&& [$w compare sel.last >= insert]} {
$w tag remove sel sel.first promptEnd
$w delete sel.first sel.last
@@ -602,10 +619,16 @@ Tk $::tk_patchLevel"
# w - console text widget
proc ::tk::console::TagProc w {
- if {!$::tk::console::magicKeys} { return }
+ if {!$::tk::console::magicKeys} {
+ return
+ }
set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
- if {$i == ""} {set i promptEnd} else {append i +2c}
+ if {$i == ""} {
+ set i promptEnd
+ } else {
+ append i +2c
+ }
regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
if {[llength [EvalAttached [list info commands $c]]]} {
$w tag add proc $i "insert-1c wordend"
@@ -637,31 +660,42 @@ proc ::tk::console::TagProc w {
# Calls: ::tk::console::Blink
proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
- if {!$::tk::console::magicKeys} { return }
- if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
+ if {!$::tk::console::magicKeys} {
+ return
+ }
+ if {{} ne [set ix [$w search -back $c1 insert $lim]]} {
while {
[string match {\\} [$w get $ix-1c]] &&
- [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
+ [set ix [$w search -back $c1 $ix-1c $lim]] ne {}
} {}
set i1 insert-1c
- while {[string compare {} $ix]} {
+ while {$ix ne {}} {
set i0 $ix
set j 0
- while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
+ while {[set i0 [$w search $c2 $i0 $i1]] ne {}} {
append i0 +1c
- if {[string match {\\} [$w get $i0-2c]]} continue
+ if {[string match {\\} [$w get $i0-2c]]} {
+ continue
+ }
incr j
}
- if {!$j} break
+ if {!$j} {
+ break
+ }
set i1 $ix
- while {$j && [string compare {} \
- [set ix [$w search -back $c1 $ix $lim]]]} {
- if {[string match {\\} [$w get $ix-1c]]} continue
+ while {$j && [set ix [$w search -back $c1 $ix $lim]] ne {}} {
+ if {[string match {\\} [$w get $ix-1c]]} {
+ continue
+ }
incr j -1
}
}
- if {[string match {} $ix]} { set ix [$w index $lim] }
- } else { set ix [$w index $lim] }
+ if {[string match {} $ix]} {
+ set ix [$w index $lim]
+ }
+ } else {
+ set ix [$w index $lim]
+ }
if {$::tk::console::blinkRange} {
Blink $w $ix [$w index insert]
} else {
@@ -681,12 +715,18 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
# Calls: ::tk::console::Blink
proc ::tk::console::MatchQuote {w {lim 1.0}} {
- if {!$::tk::console::magicKeys} { return }
+ if {!$::tk::console::magicKeys} {
+ return
+ }
set i insert-1c
set j 0
- while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
- if {[string match {\\} [$w get $i-1c]]} continue
- if {!$j} {set i0 $i}
+ while {[set i [$w search -back \" $i $lim]] ne {}} {
+ if {[string match {\\} [$w get $i-1c]]} {
+ continue
+ }
+ if {!$j} {
+ set i0 $i
+ }
incr j
}
if {$j&1} {
@@ -754,17 +794,31 @@ proc ::tk::console::ConstrainBuffer {w size} {
proc ::tk::console::Expand {w {type ""}} {
set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
- if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
- if {[$w compare $tmp >= insert]} { return }
+ if {$tmp == ""} {
+ set tmp promptEnd
+ } else {
+ append tmp +2c
+ }
+ if {[$w compare $tmp >= insert]} {
+ return
+ }
set str [$w get $tmp insert]
switch -glob $type {
- path* { set res [ExpandPathname $str] }
- proc* { set res [ExpandProcname $str] }
- var* { set res [ExpandVariable $str] }
+ path* {
+ set res [ExpandPathname $str]
+ }
+ proc* {
+ set res [ExpandProcname $str]
+ }
+ var* {
+ set res [ExpandVariable $str]
+ }
default {
set res {}
foreach t {Pathname Procname Variable} {
- if {![catch {Expand$t $str} res] && ($res != "")} { break }
+ if {![catch {Expand$t $str} res] && ($res != "")} {
+ break
+ }
}
}
}
@@ -773,11 +827,12 @@ proc ::tk::console::Expand {w {type ""}} {
set repl [lindex $res 0]
$w delete $tmp insert
$w insert $tmp $repl {input stdin}
- if {($len > 1) && $::tk::console::showMatches \
- && [string equal $repl $str]} {
+ if {($len > 1) && ($::tk::console::showMatches) && ($repl eq $str)} {
puts stdout [lsort [lreplace $res 0 0]]
}
- } else { bell }
+ } else {
+ bell
+ }
return [incr len -1]
}
@@ -802,7 +857,9 @@ proc ::tk::console::ExpandPathname str {
set dir [file tail $str]
## Check to see if it was known to be a directory and keep the trailing
## slash if so (file tail cuts it off)
- if {[string match */ $str]} { append dir / }
+ if {[string match */ $str]} {
+ append dir /
+ }
if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
set match {}
} else {
@@ -829,7 +886,9 @@ proc ::tk::console::ExpandPathname str {
} else {
## This may look goofy, but it handles spaces in path names
eval append match $m
- if {[file isdir $match]} {append match /}
+ if {[file isdir $match]} {
+ append match /
+ }
if {[string match ?*/* $str]} {
set match [file dirname $str]/$match
} elseif {[string match /* $str]} {
@@ -894,9 +953,13 @@ proc ::tk::console::ExpandVariable str {
set match [EvalAttached [list array names $ary $str*]]
if {[llength $match] > 1} {
set vars $ary\([ExpandBestMatch $match $str]
- foreach var $match {lappend vars $ary\($var\)}
+ foreach var $match {
+ lappend vars $ary\($var\)
+ }
return $vars
- } else {set match $ary\($match\)}
+ } else {
+ set match $ary\($match\)
+ }
## Space transformation avoided for array names.
} else {
set match [EvalAttached [list info vars $str*]]
@@ -925,8 +988,8 @@ proc ::tk::console::ExpandVariable str {
proc ::tk::console::ExpandBestMatch {l {e {}}} {
set ec [lindex $l 0]
if {[llength $l]>1} {
- set e [string length $e]; incr e -1
- set ei [string length $ec]; incr ei -1
+ set e [expr {[string length $e] - 1}]
+ set ei [expr {[string length $ec] - 1}]
foreach l $l {
while {$ei>=$e && [string first $ec $l]} {
set ec [string range $ec 0 [incr ei -1]]
diff --git a/library/demos/en.msg b/library/demos/en.msg
new file mode 100644
index 0000000..fc7f1a7
--- /dev/null
+++ b/library/demos/en.msg
@@ -0,0 +1,94 @@
+::msgcat::mcset en "Widget Demonstration"
+::msgcat::mcset en "tkWidgetDemo"
+::msgcat::mcset en "&File"
+::msgcat::mcset en "About..."
+::msgcat::mcset en "&About..."
+::msgcat::mcset en "<F1>"
+::msgcat::mcset en "&Quit"
+::msgcat::mcset en "Meta-Q"
+::msgcat::mcset en "Variable values"
+::msgcat::mcset en "Variable values:"
+::msgcat::mcset en "OK"
+::msgcat::mcset en "Run the \"%s\" sample program"
+::msgcat::mcset en "Dismiss"
+::msgcat::mcset en "Rerun Demo"
+::msgcat::mcset en "Demo code: %s"
+::msgcat::mcset en "About Widget Demo"
+::msgcat::mcset en "Tk widget demonstration application"
+::msgcat::mcset en "Copyright (c) %s" "Copyright \u00a9 %s"
+::msgcat::mcset en "
+ @@title
+ Tk Widget Demonstrations
+ @@newline
+ @@normal
+ @@newline
+
+ 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
+"
+::msgcat::mcset en "Labels, buttons, checkbuttons, and radiobuttons"
+::msgcat::mcset en "Labels (text and bitmaps)"
+::msgcat::mcset en "Labels and UNICODE text"
+::msgcat::mcset en "Buttons"
+::msgcat::mcset en "Check-buttons (select any of a group)"
+::msgcat::mcset en "Radio-buttons (select one of a group)"
+::msgcat::mcset en "A 15-puzzle game made out of buttons"
+::msgcat::mcset en "Iconic buttons that use bitmaps"
+::msgcat::mcset en "Two labels displaying images"
+::msgcat::mcset en "A simple user interface for viewing images"
+::msgcat::mcset en "Labelled frames"
+::msgcat::mcset en "Listboxes"
+::msgcat::mcset en "The 50 states"
+::msgcat::mcset en "Colors: change the color scheme for the application"
+::msgcat::mcset en "A collection of famous and infamous sayings"
+::msgcat::mcset en "Entries and Spin-boxes"
+::msgcat::mcset en "Entries without scrollbars"
+::msgcat::mcset en "Entries with scrollbars"
+::msgcat::mcset en "Validated entries and password fields"
+::msgcat::mcset en "Spin-boxes"
+::msgcat::mcset en "Simple Rolodex-like form"
+::msgcat::mcset en "Text"
+::msgcat::mcset en "Basic editable text"
+::msgcat::mcset en "Text display styles"
+::msgcat::mcset en "Hypertext (tag bindings)"
+::msgcat::mcset en "A text widget with embedded windows"
+::msgcat::mcset en "A search tool built with a text widget"
+::msgcat::mcset en "Canvases"
+::msgcat::mcset en "The canvas item types"
+::msgcat::mcset en "A simple 2-D plot"
+::msgcat::mcset en "Text items in canvases"
+::msgcat::mcset en "An editor for arrowheads on canvas lines"
+::msgcat::mcset en "A ruler with adjustable tab stops"
+::msgcat::mcset en "A building floor plan"
+::msgcat::mcset en "A simple scrollable canvas"
+::msgcat::mcset en "Scales"
+::msgcat::mcset en "Horizontal scale"
+::msgcat::mcset en "Vertical scale"
+::msgcat::mcset en "Paned Windows"
+::msgcat::mcset en "Horizontal paned window"
+::msgcat::mcset en "Vertical paned window"
+::msgcat::mcset en "Menus"
+::msgcat::mcset en "Menus and cascades (sub-menus)"
+::msgcat::mcset en "Menu-buttons"
+::msgcat::mcset en "Common Dialogs"
+::msgcat::mcset en "Message boxes"
+::msgcat::mcset en "File selection dialog"
+::msgcat::mcset en "Color picker"
+::msgcat::mcset en "Miscellaneous"
+::msgcat::mcset en "The built-in bitmaps"
+::msgcat::mcset en "A dialog box with a local grab"
+::msgcat::mcset en "A dialog box with a global grab"
diff --git a/library/demos/widget b/library/demos/widget
index 33c7843..e0fde72 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,10 +11,13 @@ exec wish "$0" "$@"
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
-# RCS: @(#) $Id: widget,v 1.9 2003/02/19 16:13:15 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.10 2003/05/19 14:44:04 dkf Exp $
eval destroy [winfo child .]
-wm title . "Widget Demonstration"
+package require msgcat
+::msgcat::mcload [file join $tk_library demos]
+namespace import ::msgcat::mc
+wm title . [mc "Widget Demonstration"]
if {$tcl_platform(platform) eq "unix"} {
# This won't work everywhere, but there's no other way in core Tk
# at the moment to display a coloured icon.
@@ -22,7 +25,7 @@ if {$tcl_platform(platform) eq "unix"} {
-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 {
@@ -43,24 +46,26 @@ set font $widgetFont(main)
#----------------------------------------------------------------
menu .menuBar -tearoff 0
-.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
+# 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
# On the Mac use the specia .apple menu for the about item
-if {[string equal [tk windowingsystem] "classic"]} {
+if {[tk windowingsystem] eq "classic"} {
.menuBar add cascade -menu .menuBar.apple
menu .menuBar.apple -tearoff 0
- .menuBar.apple add command -label "About..." -command "aboutBox"
+ .menuBar.apple add command -label [mc "About..."] -command {aboutBox}
} else {
- .menuBar.file add command -label "About..." -command "aboutBox" \
- -underline 0 -accelerator "<F1>"
+ ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
+ -command {aboutBox} -accelerator [mc "<F1>"]
.menuBar.file add sep
}
-.menuBar.file add command -label "Quit" -command "exit" -underline 0 \
- -accelerator "Meta-Q"
+::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
+ -command {exit} -accelerator [mc "Meta-Q"]
. configure -menu .menuBar
-bind . <F1> aboutBox
+bind . <F1> {aboutBox}
+bind . <Meta-q> {exit}
frame .statusBar
label .statusBar.lab -text " " -relief sunken -bd 1 \
@@ -125,7 +130,7 @@ set lastLine ""
}
.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
@@ -140,25 +145,78 @@ set lastLine ""
# Create the text for the text widget.
+# 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
+# (begin newline, or change style) and all other lines are literal
+# strings to be inserted. Blank lines are ignored.
+#
+proc addFormattedText {formattedText} {
+ set style normal
+ set isNL 1
+ foreach line [split [mc $formattedText] \n] {
+ set line [string trim $line]
+ if {$line eq ""} {
+ continue
+ }
+ if {$line eq "@@newline"} {
+ .t insert end \n $style
+ set isNL 1
+ continue
+ }
+ if {[string match @@* $line]} {
+ set style [string range $line 1 end]
+ continue
+ }
+ if {!$isNL} {
+ .t insert end " " $style
+ }
+ set isNL 0
+ .t insert end $line $style
+ }
+}
+
+# addDemoSection --
+#
+# Add a new section of demos with a title and a (stride-2) list of
+# demo files and their descriptions. Titles and descriptions are
+# passed through the message catalog to allow for localization.
+#
proc addDemoSection {title demos} {
- .t insert end "\n" {} $title title " \n " demospace
+ .t insert end "\n" {} [mc $title] title " \n " demospace
set num 0
foreach {name description} $demos {
- .t insert end "[incr num]. $description." [list demo demo-$name]
+ .t insert end "[incr num]. [mc $description]." [list demo demo-$name]
.t insert end " \n " demospace
}
}
-.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"
-
+addFormattedText {
+ @@title
+ Tk Widget Demonstrations
+ @@newline
+ @@normal
+ @@newline
+
+ 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
+}
addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" {
label "Labels (text and bitmaps)"
unicodeout "Labels and UNICODE text"
@@ -248,8 +306,8 @@ 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 \
+ wm title $w [mc "Variable values"]
+ label $w.title -text [mc "Variable values:"] -width 20 -anchor center \
-font $widgetFont(vars)
pack $w.title -side top -fill x
set len 1
@@ -266,8 +324,9 @@ proc showVars {w args} {
pack $w.$i.value -side left -expand 1 -fill x
pack $w.$i -side top -anchor w -fill x
}
- button $w.ok -text OK -command "destroy $w" -default active
- bind $w <Return> "tkButtonInvoke $w.ok"
+ button $w.ok -text [mc "OK"] -command [list destroy $w] -default active
+ bind $w <Return> [list tkButtonInvoke $w.ok]
+ bind $w <Escape> [list tkButtonInvoke $w.ok]
pack $w.ok -side bottom -pady 2
}
@@ -311,10 +370,10 @@ proc showStatus index {
set newcursor xterm
} else {
set demo [string range [lindex $tags $i] 5 end]
- .statusBar.lab config -text "Run the \"$demo\" sample program"
+ .statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo]
set newcursor hand2
}
- if [string compare $cursor $newcursor] {
+ if {$cursor ne $newcursor} {
.t config -cursor $newcursor
}
}
@@ -331,27 +390,27 @@ proc showStatus index {
proc showCode w {
global tk_library
set file [string range $w 1 end].tcl
- if ![winfo exists .code] {
+ 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 {
+ button .code.buttons.dismiss -text [mc "Dismiss"] \
+ -default active -command {destroy .code}
+ button .code.buttons.rerun -text [mc "Rerun Demo"] -command {
eval [.code.text get 1.0 end]
}
pack .code.buttons.dismiss .code.buttons.rerun -side left \
- -expand 1 -pady 2
+ -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
+ 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
@@ -365,7 +424,7 @@ proc showCode w {
wm deiconify .code
raise .code
}
- wm title .code "Demo code: [file join $tk_library demos $file]"
+ wm title .code [mc "Demo code: %s" [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
@@ -379,14 +438,12 @@ proc showCode w {
# Pops up a message box with an "about" message
#
proc aboutBox {} {
- tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
-"Tk widget demonstration
-
-Copyright (c) 1996-1997 Sun Microsystems, Inc.
-
-Copyright (c) 1997-2000 Ajuba Solutions, Inc.
+ tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
+ -message "[mc {Tk widget demonstration application}]
-Copyright (c) 2001-2002 Donal K. Fellows"
+[mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}]
+[mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}]
+[mc {Copyright (c) %s} {2001-2003 Donal K. Fellows}]"
}
# Local Variables:
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index c5ae689..cfcf1cd 100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
@@ -1,23 +1,26 @@
namespace eval ::tk {
::msgcat::mcset de "&Abort" "&Abbruch"
- ::msgcat::mcset de "About..." "\u00dcber..."
+ ::msgcat::mcset de "&About..." "&\u00dcber..."
::msgcat::mcset de "All Files" "Alle Dateien"
::msgcat::mcset de "Application Error" "Applikationsfehler"
::msgcat::mcset de "&Blue" "&Blau"
::msgcat::mcset de "&Cancel" "&Abbruch"
::msgcat::mcset de "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kann nicht in das Verzeichnis \"%1\$s\" wechseln.\nKeine Rechte vorhanden."
::msgcat::mcset de "Choose Directory" "W\u00e4hle Verzeichnis"
- ::msgcat::mcset de "Clear" "R\u00fccksetzen"
+ ::msgcat::mcset de "&Clear" "&R\u00fccksetzen"
+ ::msgcat::mcset de "&Clear Console" "&Konsole l\u00f6schen"
::msgcat::mcset de "Color" "Farbe"
::msgcat::mcset de "Console" "Konsole"
- ::msgcat::mcset de "Copy" "Kopieren"
- ::msgcat::mcset de "Cut" "Ausschneiden"
- ::msgcat::mcset de "Delete" "L\u00f6schen"
+ ::msgcat::mcset de "&Copy" "&Kopieren"
+ ::msgcat::mcset de "Cu&t" "Aus&schneiden"
+ ::msgcat::mcset de "&Delete" "&L\u00f6schen"
::msgcat::mcset de "Details >>"
::msgcat::mcset de "Directory \"%1\$s\" does not exist." "Das Verzeichnis \"%1\$s\" existiert nicht."
::msgcat::mcset de "&Directory:" "&Verzeichnis:"
+ ::msgcat::mcset de "&Edit" "&Bearbieten"
::msgcat::mcset de "Error: %1\$s" "Fehler: %1\$s"
- ::msgcat::mcset de "Exit" "Ende"
+ ::msgcat::mcset de "E&xit" "&Ende"
+ ::msgcat::mcset de "&File" "&Datei"
::msgcat::mcset de "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Die Datei \"%1\$s\" ist bereits vorhanden.\nWollen sie diese Datei \u00fcberschreiben ?"
::msgcat::mcset de "File \"%1\$s\" already exists.\n\n" "Die Datei \"%1\$s\" ist bereits vorhanden.\n\n"
::msgcat::mcset de "File \"%1\$s\" does not exist." "Die Datei \"%1\$s\" existiert nicht."
@@ -28,8 +31,9 @@ namespace eval ::tk {
::msgcat::mcset de "&Filter"
::msgcat::mcset de "Fil&ter:"
::msgcat::mcset de "&Green" "&Gr\u00fcn"
+ ::msgcat::mcset de "&Help" "&Hilfe"
::msgcat::mcset de "Hi" "Hallo"
- ::msgcat::mcset de "Hide Console" "Konsole unsichtbar machen"
+ ::msgcat::mcset de "&Hide Console" "&Konsole unsichtbar machen"
::msgcat::mcset de "&Ignore" "&Ignorieren"
::msgcat::mcset de "Invalid file name \"%1\$s\"." "Ung\u00fcltiger Dateiname \"%1\$s\"."
::msgcat::mcset de "Log Files" "Protokolldatei"
@@ -39,8 +43,8 @@ namespace eval ::tk {
::msgcat::mcset de "Open" "\u00d6ffnen"
::msgcat::mcset de "&Open" "\u00d6&ffnen"
::msgcat::mcset de "Open Multiple Files"
- ::msgcat::mcset de "Paste" "Einf\u00fcgen"
- ::msgcat::mcset de "Quit" "Beenden"
+ ::msgcat::mcset de "P&aste" "E&inf\u00fcgen"
+ ::msgcat::mcset de "&Quit" "&Beenden"
::msgcat::mcset de "&Red" "&Rot"
::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?"
::msgcat::mcset de "&Retry" "&Wiederholen"
@@ -51,7 +55,7 @@ namespace eval ::tk {
::msgcat::mcset de "Select a file to source" "Auszuf\u00fchrende Datei ausw\u00e4hlen"
::msgcat::mcset de "&Selection:" "Auswah&l:"
::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen"
- ::msgcat::mcset de "Source..." "Ausf\u00fchren..."
+ ::msgcat::mcset de "&Source..." "&Ausf\u00fchren..."
::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte"
::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows"
::msgcat::mcset de "Text Files" "Textdateien"
diff --git a/library/msgs/en.msg b/library/msgs/en.msg
index 7242f91..7434d71 100644
--- a/library/msgs/en.msg
+++ b/library/msgs/en.msg
@@ -1,23 +1,26 @@
namespace eval ::tk {
::msgcat::mcset en "&Abort"
- ::msgcat::mcset en "About..."
+ ::msgcat::mcset en "&About..."
::msgcat::mcset en "All Files"
::msgcat::mcset en "Application Error"
::msgcat::mcset en "&Blue"
::msgcat::mcset en "&Cancel"
::msgcat::mcset en "Cannot change to the directory \"%1\$s\".\nPermission denied."
::msgcat::mcset en "Choose Directory"
- ::msgcat::mcset en "Clear"
+ ::msgcat::mcset en "Cl&ear"
+ ::msgcat::mcset en "&Clear Console"
::msgcat::mcset en "Color"
::msgcat::mcset en "Console"
- ::msgcat::mcset en "Copy"
- ::msgcat::mcset en "Cut"
- ::msgcat::mcset en "Delete"
+ ::msgcat::mcset en "&Copy"
+ ::msgcat::mcset en "Cu&t"
+ ::msgcat::mcset en "&Delete"
::msgcat::mcset en "Details >>"
::msgcat::mcset en "Directory \"%1\$s\" does not exist."
::msgcat::mcset en "&Directory:"
+ ::msgcat::mcset en "&Edit"
::msgcat::mcset en "Error: %1\$s"
- ::msgcat::mcset en "Exit"
+ ::msgcat::mcset en "E&xit"
+ ::msgcat::mcset en "&File"
::msgcat::mcset en "File \"%1\$s\" already exists.\nDo you want to overwrite it?"
::msgcat::mcset en "File \"%1\$s\" already exists.\n\n"
::msgcat::mcset en "File \"%1\$s\" does not exist."
@@ -28,8 +31,9 @@ namespace eval ::tk {
::msgcat::mcset en "&Filter"
::msgcat::mcset en "Fil&ter:"
::msgcat::mcset en "&Green"
+ ::msgcat::mcset en "&Help"
::msgcat::mcset en "Hi"
- ::msgcat::mcset en "Hide Console"
+ ::msgcat::mcset en "&Hide Console"
::msgcat::mcset en "&Ignore"
::msgcat::mcset en "Invalid file name \"%1\$s\"."
::msgcat::mcset en "Log Files"
@@ -39,8 +43,8 @@ namespace eval ::tk {
::msgcat::mcset en "Open"
::msgcat::mcset en "&Open"
::msgcat::mcset en "Open Multiple Files"
- ::msgcat::mcset en "Paste"
- ::msgcat::mcset en "Quit"
+ ::msgcat::mcset en "P&aste"
+ ::msgcat::mcset en "&Quit"
::msgcat::mcset en "&Red"
::msgcat::mcset en "Replace existing file?"
::msgcat::mcset en "&Retry"
@@ -51,7 +55,7 @@ namespace eval ::tk {
::msgcat::mcset en "Select a file to source"
::msgcat::mcset en "&Selection:"
::msgcat::mcset en "Skip Messages"
- ::msgcat::mcset en "Source..."
+ ::msgcat::mcset en "&Source..."
::msgcat::mcset en "Tcl Scripts"
::msgcat::mcset en "Tcl for Windows"
::msgcat::mcset en "Text Files"
diff --git a/library/tk.tcl b/library/tk.tcl
index 716cd46..cb22ed6 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.47 2003/03/04 23:50:42 dgp Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.48 2003/05/19 14:44:03 dkf Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -516,6 +516,24 @@ proc ::tk::AmpWidget {class path args} {
return $path
}
+# ::tk::AmpMenuArgs --
+# Processes arguments for a menu entry, turning -label option into
+# -label and -underline options, returned by ::tk::UnderlineAmpersand.
+#
+proc ::tk::AmpMenuArgs {widget add type args} {
+ set resultArgs [list $widget add $type]
+ foreach {opt val} $args {
+ if {[string equal $opt {-label}]} {
+ foreach {newlabel under} [::tk::UnderlineAmpersand $val] {
+ lappend resultArgs -label $newlabel -underline $under
+ }
+ } else {
+ lappend resultArgs $opt $val
+ }
+ }
+ eval $resultArgs
+}
+
# ::tk::FindAltKeyTarget --
# search recursively through the hierarchy of visible widgets
# to find button or label which has $char as underlined character
generated by cgit v0.12 at 2024-11-03 13:36:43 (GMT)