diff options
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | library/console.tcl | 251 | ||||
-rw-r--r-- | library/demos/en.msg | 94 | ||||
-rw-r--r-- | library/demos/widget | 159 | ||||
-rw-r--r-- | library/msgs/de.msg | 24 | ||||
-rw-r--r-- | library/msgs/en.msg | 24 | ||||
-rw-r--r-- | library/tk.tcl | 20 |
7 files changed, 413 insertions, 166 deletions
@@ -1,5 +1,12 @@ 2003-05-19 Donal K. Fellows <fellowsd@cs.man.ac.uk> + * library/demos/en.msg: Base catalog for the widget demo. + * library/demos/widget: Added message-catalog support. + * library/console.tcl: Reworked to use tk::AmpMenuArgs and be more + "in style". + * library/tk.tcl (tk::AmpMenuArgs): New procedure for doing + tk::AmpWidget-like processing for menus. + * generic/tkTextMark.c: Removed complaints about signed vs. * generic/tkTextImage.c: unsigned in arguments to strncmp() by * generic/tkText.c: using Tcl_GetIndexFromObj() more. 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 |