summaryrefslogtreecommitdiffstats
path: root/library/tk.tcl
diff options
context:
space:
mode:
authora_kovalenko <a_kovalenko>2002-06-10 00:15:42 (GMT)
committera_kovalenko <a_kovalenko>2002-06-10 00:15:42 (GMT)
commit2d16e519a080ed6d8c55721f49a707e28db9532d (patch)
treee2f9f905ff561612501e85c0d8bf86a1f4531c1c /library/tk.tcl
parent8f7a5e090555d59da1db17e4881ac68aee343859 (diff)
downloadtk-2d16e519a080ed6d8c55721f49a707e28db9532d.zip
tk-2d16e519a080ed6d8c55721f49a707e28db9532d.tar.gz
tk-2d16e519a080ed6d8c55721f49a707e28db9532d.tar.bz2
Added "magic ampersand" approach for translated strings in standard dialogs.
All translations were modified to work with "magic ampersand". Russian translations added.
Diffstat (limited to 'library/tk.tcl')
-rw-r--r--library/tk.tcl112
1 files changed, 111 insertions, 1 deletions
diff --git a/library/tk.tcl b/library/tk.tcl
index 679b786..165b56d 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.40 2002/05/20 13:59:02 dgp Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.41 2002/06/10 00:15:42 a_kovalenko Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -443,3 +443,113 @@ proc ::tk::TabToWindow {w} {
focus $w
}
+# ::tk::UnderlineAmpersand --
+# This procedure takes some text with ampersand and returns
+# text w/o ampersand and position of the ampersand.
+# Double ampersands are converted to single ones.
+# Position returned is -1 when there is no ampersand.
+#
+proc ::tk::UnderlineAmpersand {text} {
+ set idx [string first "&" $text]
+ if {$idx >= 0} {
+ set underline $idx
+ # ignore "&&"
+ while {[string match "&" [string index $text [expr {$idx + 1}]]]} {
+ set base [expr {$idx + 2}]
+ set idx [string first "&" [string range $text $base end]]
+ if {$idx < 0} {
+ break
+ } else {
+ set underline [expr {$underline + $idx + 1}]
+ incr idx $base
+ }
+ }
+ }
+ if {$idx >= 0} {
+ regsub -all -- {&([^&])} $text {\1} text
+ }
+ return [list $text $idx]
+}
+
+# ::tk::SetAmpText --
+# Given widget path and text with "magic ampersands",
+# sets -text and -underline options for the widget
+#
+proc ::tk::SetAmpText {widget text} {
+ foreach {newtext under} [::tk::UnderlineAmpersand $text] {
+ $widget configure -text $newtext -underline $under
+ }
+}
+
+# ::tk::AmpWidget --
+# Creates new widget, turning -text option into -text and
+# -underline options, returned by ::tk::UnderlineAmpersand.
+#
+proc ::tk::AmpWidget {class path args} {
+ set wcmd [list $class $path]
+ foreach {opt val} $args {
+ if {[string equal $opt {-text}]} {
+ foreach {newtext under} [::tk::UnderlineAmpersand $val] {
+ lappend wcmd -text $newtext -underline $under
+ }
+ } else {
+ lappend wcmd $opt $val
+ }
+ }
+ eval $wcmd
+ if {$class=="button"} {
+ bind $path <<AltUnderlined>> [list $path invoke]
+ }
+ return $path
+}
+
+# ::tk::FindAltKeyTarget --
+# search recursively through the hierarchy of visible widgets
+# to find button or label which has $char as underlined character
+#
+proc ::tk::FindAltKeyTarget {path char} {
+ switch [winfo class $path] {
+ Button -
+ Label {
+ if {[string equal -nocase $char \
+ [string index [$path cget -text] \
+ [$path cget -underline]]]} {return $path} else {return {}}
+ }
+ default {
+ foreach child \
+ [concat [grid slaves $path] \
+ [pack slaves $path] \
+ [place slaves $path] ] {
+ if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} {
+ return $target
+ }
+ }
+ }
+ }
+ return {}
+}
+
+# ::tk::AltKeyInDialog --
+# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>>
+# to button or label which has appropriate underlined character
+#
+proc ::tk::AltKeyInDialog {path key} {
+ set target [::tk::FindAltKeyTarget $path $key]
+ if { $target == ""} return
+ event generate $target <<AltUnderlined>>
+}
+
+# ::tk::mcmaxamp --
+# Replacement for mcmax, used for texts with "magic ampersand" in it.
+#
+
+proc ::tk::mcmaxamp {args} {
+ set maxlen 0
+ foreach arg $args {
+ set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]]
+ if {$length>$maxlen} {
+ set maxlen $length
+ }
+ }
+ return $maxlen
+}