summaryrefslogtreecommitdiffstats
path: root/library/msgcat/msgcat.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/msgcat/msgcat.tcl')
-rw-r--r--library/msgcat/msgcat.tcl116
1 files changed, 72 insertions, 44 deletions
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 7e663cf..231eaa1 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -10,10 +10,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require Tcl 8.2
+package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.3.4
+package provide msgcat 1.4.3
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
@@ -26,13 +26,14 @@ namespace eval msgcat {
variable Loclist {}
# Records the mapping between source strings and translated strings. The
- # array key is of the form "<locale>,<namespace>,<src>" and the value is
+ # dict key is of the form "<locale> <namespace> <src>", where locale and
+ # namespace should be themselves dict values and the value is
# the translated string.
- array set Msgs {}
+ variable Msgs [dict create]
# Map of language codes used in Windows registry to those of ISO-639
- if { [string equal $::tcl_platform(platform) windows] } {
- array set WinRegToISO639 {
+ if { $::tcl_platform(platform) eq "windows" } {
+ variable WinRegToISO639 [dict create {*}{
01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
@@ -157,7 +158,7 @@ namespace eval msgcat {
77 so 0477 so_SO
78 sit 0478 sit_CN
79 pap 0479 pap_AN
- }
+ }]
}
}
@@ -174,7 +175,7 @@ namespace eval msgcat {
# args Args to pass to the format command
#
# Results:
-# Returns the translatd string. Propagates errors thrown by the
+# Returns the translated string. Propagates errors thrown by the
# format command.
proc msgcat::mc {src args} {
@@ -189,20 +190,19 @@ proc msgcat::mc {src args} {
while {$ns != ""} {
foreach loc $Loclist {
- if {[info exists Msgs($loc,$ns,$src)]} {
+ if {[dict exists $Msgs $loc $ns $src]} {
if {[llength $args] == 0} {
- return $Msgs($loc,$ns,$src)
+ return [dict get $Msgs $loc $ns $src]
} else {
- return [uplevel 1 \
- [linsert $args 0 ::format $Msgs($loc,$ns,$src)]]
+ return [format [dict get $Msgs $loc $ns $src] {*}$args]
}
}
}
set ns [namespace parent $ns]
}
# we have not found the translation
- return [uplevel 1 \
- [linsert $args 0 [::namespace origin mcunknown] $Locale $src]]
+ return [uplevel 1 [list [namespace origin mcunknown] \
+ $Locale $src {*}$args]]
}
# msgcat::mclocale --
@@ -223,7 +223,8 @@ proc msgcat::mclocale {args} {
set len [llength $args]
if {$len > 1} {
- error {wrong # args: should be "mclocale ?newLocale?"}
+ return -code error "wrong # args: should be\
+ \"[lindex [info level 0] 0] ?newLocale?\""
}
if {$len == 1} {
@@ -236,9 +237,13 @@ proc msgcat::mclocale {args} {
set Loclist {}
set word ""
foreach part [split $Locale _] {
- set word [string trimleft "${word}_${part}" _]
- set Loclist [linsert $Loclist 0 $word]
+ set word [string trim "${word}_${part}" _]
+ if {$word ne [lindex $Loclist 0]} {
+ set Loclist [linsert $Loclist 0 $word]
+ }
}
+ lappend Loclist {}
+ set Locale [lindex $Loclist 0]
}
return $Locale
}
@@ -273,13 +278,13 @@ proc msgcat::mcpreferences {} {
proc msgcat::mcload {langdir} {
set x 0
foreach p [mcpreferences] {
+ if { $p eq {} } {
+ set p ROOT
+ }
set langfile [file join $langdir $p.msg]
if {[file exists $langfile]} {
incr x
- set fid [open $langfile "r"]
- fconfigure $fid -encoding utf-8
- uplevel 1 [read $fid]
- close $fid
+ uplevel 1 [list ::source -encoding utf-8 $langfile]
}
}
return $x
@@ -301,12 +306,21 @@ proc msgcat::mcload {langdir} {
proc msgcat::mcset {locale src {dest ""}} {
variable Msgs
if {[llength [info level 0]] == 3} { ;# dest not specified
- set dest $src
+ set dest $src
}
set ns [uplevel 1 [list ::namespace current]]
-
- set Msgs([string tolower $locale],$ns,$src) $dest
+
+ set locale [string tolower $locale]
+
+ # create nested dictionaries if they do not exist
+ if {![dict exists $Msgs $locale]} {
+ dict set Msgs $locale [dict create]
+ }
+ if {![dict exists $Msgs $locale $ns]} {
+ dict set Msgs $locale $ns [dict create]
+ }
+ dict set Msgs $locale $ns $src $dest
return $dest
}
@@ -326,16 +340,24 @@ proc msgcat::mcmset {locale pairs } {
set length [llength $pairs]
if {$length % 2} {
- error {bad translation list: should be "mcmset locale {src dest ...}"}
+ return -code error "bad translation list:\
+ should be \"[lindex [info level 0] 0] locale {src dest ...}\""
}
set locale [string tolower $locale]
set ns [uplevel 1 [list ::namespace current]]
-
+
+ # create nested dictionaries if they do not exist
+ if {![dict exists $Msgs $locale]} {
+ dict set Msgs $locale [dict create]
+ }
+ if {![dict exists $Msgs $locale $ns]} {
+ dict set Msgs $locale $ns [dict create]
+ }
foreach {src dest} $pairs {
- set Msgs($locale,$ns,$src) $dest
+ dict set Msgs $locale $ns $src $dest
}
-
+
return $length
}
@@ -358,7 +380,7 @@ proc msgcat::mcmset {locale pairs } {
proc msgcat::mcunknown {locale src args} {
if {[llength $args]} {
- return [uplevel 1 [linsert $args 0 ::format $src]]
+ return [format $src {*}$args]
} else {
return $src
}
@@ -366,7 +388,7 @@ proc msgcat::mcunknown {locale src args} {
# msgcat::mcmax --
#
-# Calculates the maximun length of the translated strings of the given
+# Calculates the maximum length of the translated strings of the given
# list.
#
# Arguments:
@@ -381,7 +403,7 @@ proc msgcat::mcmax {args} {
set translated [uplevel 1 [list [namespace origin mc] $string]]
set len [string length $translated]
if {$len>$max} {
- set max $len
+ set max $len
}
}
return $max
@@ -418,13 +440,16 @@ proc msgcat::ConvertLocale {value} {
# Initialize the default locale
proc msgcat::Init {} {
+ global env tcl_platform
+
#
# set default locale, try to get from environment
#
foreach varName {LC_ALL LC_MESSAGES LANG} {
- if {[info exists ::env($varName)]
- && ![string equal "" $::env($varName)]} {
- if {![catch {mclocale [ConvertLocale $::env($varName)]}]} {
+ if {[info exists env($varName)] && ("" ne $env($varName))} {
+ if {![catch {
+ mclocale [ConvertLocale $env($varName)]
+ }]} {
return
}
}
@@ -432,11 +457,10 @@ proc msgcat::Init {} {
#
# On Darwin, fallback to current CFLocale identifier if available.
#
- if {[string equal $::tcl_platform(os) Darwin]
- && [string equal $::tcl_platform(platform) unix]
- && [info exists ::tcl::mac::locale]
- && ![string equal $::tcl::mac::locale ""]} {
- if {![catch {mclocale [ConvertLocale $::tcl::mac::locale]}]} {
+ if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} {
+ if {![catch {
+ mclocale [ConvertLocale $::tcl::mac::locale]
+ }]} {
return
}
}
@@ -444,7 +468,7 @@ proc msgcat::Init {} {
# The rest of this routine is special processing for Windows;
# all other platforms, get out now.
#
- if { ![string equal $::tcl_platform(platform) windows] } {
+ if {$tcl_platform(platform) ne "windows"} {
mclocale C
return
}
@@ -453,9 +477,11 @@ proc msgcat::Init {} {
# or fall back on locale of "C".
#
set key {HKEY_CURRENT_USER\Control Panel\International}
- if {[catch {package require registry}] \
- || [catch {registry get $key "locale"} locale]} {
- mclocale C
+ if {[catch {
+ package require registry
+ set locale [registry get $key "locale"]
+ }]} {
+ mclocale C
return
}
#
@@ -470,7 +496,9 @@ proc msgcat::Init {} {
variable WinRegToISO639
set locale [string tolower $locale]
while {[string length $locale]} {
- if {![catch {mclocale [ConvertLocale $WinRegToISO639($locale)]}]} {
+ if {![catch {
+ mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]]
+ }]} {
return
}
set locale [string range $locale 1 end]
generated by cgit v0.12 at 2024-11-22 04:31:08 (GMT)