summaryrefslogtreecommitdiffstats
path: root/library/msgcat
diff options
context:
space:
mode:
Diffstat (limited to 'library/msgcat')
-rw-r--r--library/msgcat/msgcat.tcl191
-rw-r--r--library/msgcat/pkgIndex.tcl2
2 files changed, 112 insertions, 81 deletions
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 7299004..01b4477 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -10,25 +10,41 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: msgcat.tcl,v 1.13 2002/04/20 00:35:19 dgp Exp $
+# RCS: @(#) $Id: msgcat.tcl,v 1.14 2002/06/17 05:37:39 dgp Exp $
package require Tcl 8.2
-package provide msgcat 1.2.3
+package provide msgcat 1.3
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
mcunknown
# Records the current locale as passed to mclocale
- variable locale ""
+ variable Locale ""
# Records the list of locales to search
- variable loclist {}
+ 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
# the translated string.
- array set msgs {}
+ array set Msgs {}
+
+ # Map of language codes used in Windows registry to those of ISO-639
+ array set WinRegToISO639 {
+ 0409 en_US 0809 en_UK 43c gd 83c ga 01 ar 02 bg 03 ca 04 zh 05
+ cs 06 da 07 de 08 el 0a es 0b fi 0c fr 0d he 0e hu 0f is 10 it
+ 11 ja 12 ko 13 da 14 no 15 pl 16 pt 17 rm 18 ro 19 ru 1a hr
+ 1b sk 1c sq 1d sv 1e th 1f tr 20 ur 21 id 22 uk 23 be 24 sl
+ 25 et 26 lv 27 lt 28 tg 29 fa 2a vi 2b hy 2c az 2d eu 2e wen
+ 2f mk 30 bnt 31 ts 33 ven 34 xh 35 zu 36 af 37 ka 38 fo 39 hi
+ 3a mt 3b se 3d yi 3e ms 3f kk 40 ky 41 sw 42 tk 43 uz 44 tt
+ 45 bn 46 pa 47 gu 48 or 49 ta 4a te 4b kn 4c ml 4d as 4e mr
+ 4f sa 50 mn 51 bo 52 cy 53 km 54 lo 55 my 56 gl 57 kok 58 mni
+ 59 sd 5a syr 5b si 5c chr 5d iu 5e am 5f ber 60 ks 61 ne 62 fy
+ 63 ps 64 tl 65 div 66 bin 67 ful 68 ha 69 nic 6a yo 70 ibo
+ 71 kau 72 om 73 ti 74 gn 75 cpe 76 la 77 so 78 sit 79 pap
+ }
}
# msgcat::mc --
@@ -51,20 +67,20 @@ proc msgcat::mc {src args} {
# Check for the src in each namespace starting from the local and
# ending in the global.
- variable msgs
- variable loclist
- variable locale
+ variable Msgs
+ variable Loclist
+ variable Locale
set ns [uplevel 1 [list ::namespace current]]
while {$ns != ""} {
- foreach loc $loclist {
- if {[info exists msgs($loc,$ns,$src)]} {
+ foreach loc $Loclist {
+ if {[info exists Msgs($loc,$ns,$src)]} {
if {[llength $args] == 0} {
- return $msgs($loc,$ns,$src)
+ return $Msgs($loc,$ns,$src)
} else {
return [uplevel 1 \
- [linsert $args 0 ::format $msgs($loc,$ns,$src)]]
+ [linsert $args 0 ::format $Msgs($loc,$ns,$src)]]
}
}
}
@@ -72,7 +88,7 @@ proc msgcat::mc {src args} {
}
# we have not found the translation
return [uplevel 1 \
- [linsert $args 0 [::namespace origin mcunknown] $locale $src]]
+ [linsert $args 0 [::namespace origin mcunknown] $Locale $src]]
}
# msgcat::mclocale --
@@ -88,8 +104,8 @@ proc msgcat::mc {src args} {
# Returns the current locale.
proc msgcat::mclocale {args} {
- variable loclist
- variable locale
+ variable Loclist
+ variable Locale
set len [llength $args]
if {$len > 1} {
@@ -97,15 +113,15 @@ proc msgcat::mclocale {args} {
}
if {$len == 1} {
- set locale [string tolower [lindex $args 0]]
- set loclist {}
+ set Locale [string tolower [lindex $args 0]]
+ set Loclist {}
set word ""
- foreach part [split $locale _] {
+ foreach part [split $Locale _] {
set word [string trimleft "${word}_${part}" _]
- set loclist [linsert $loclist 0 $word]
+ set Loclist [linsert $Loclist 0 $word]
}
}
- return $locale
+ return $Locale
}
# msgcat::mcpreferences --
@@ -120,8 +136,8 @@ proc msgcat::mclocale {args} {
# Returns an ordered list of the locales preferred by the user.
proc msgcat::mcpreferences {} {
- variable loclist
- return $loclist
+ variable Loclist
+ return $Loclist
}
# msgcat::mcload --
@@ -164,14 +180,14 @@ proc msgcat::mcload {langdir} {
# Returns the new locale.
proc msgcat::mcset {locale src {dest ""}} {
- variable msgs
+ variable Msgs
if {[string equal $dest ""]} {
set dest $src
}
set ns [uplevel 1 [list ::namespace current]]
- set msgs([string tolower $locale],$ns,$src) $dest
+ set Msgs([string tolower $locale],$ns,$src) $dest
return $dest
}
@@ -187,7 +203,7 @@ proc msgcat::mcset {locale src {dest ""}} {
# Returns the number of pairs processed
proc msgcat::mcmset {locale pairs } {
- variable msgs
+ variable Msgs
set length [llength $pairs]
if {$length % 2} {
@@ -198,7 +214,7 @@ proc msgcat::mcmset {locale pairs } {
set ns [uplevel 1 [list ::namespace current]]
foreach {src dest} $pairs {
- set msgs($locale,$ns,$src) $dest
+ set Msgs($locale,$ns,$src) $dest
}
return $length
@@ -252,61 +268,76 @@ proc msgcat::mcmax {args} {
return $max
}
-# Initialize the default locale
+# Convert the locale values stored in environment variables to a form
+# suitable for passing to [mclocale]
+proc msgcat::ConvertLocale {value} {
+ # Assume $value is of form: $language[_$territory][.$codeset][@modifier]
+ # Convert to form: $language[_$territory][_$modifier]
+ #
+ # Comment out expanded RE version -- bugs alleged
+ #regexp -expanded {
+ # ^ # Match all the way to the beginning
+ # ([^_.@]*) # Match "lanugage"; ends with _, ., or @
+ # (_([^.@]*))? # Match (optional) "territory"; starts with _
+ # ([.]([^@]*))? # Match (optional) "codeset"; starts with .
+ # (@(.*))? # Match (optional) "modifier"; starts with @
+ # $ # Match all the way to the end
+ #} $value -> language _ territory _ codeset _ modifier
+ regexp {^([^_.@]*)(_([^.@]*))?([.]([^@]*))?(@(.*))?$} $value \
+ -> language _ territory _ codeset _ modifier
+ set ret $language
+ if {[string length $territory]} {
+ append ret _$territory
+ }
+ if {[string length $modifier]} {
+ append ret _$modifier
+ }
+ return $ret
+}
-namespace eval msgcat {
+# Initialize the default locale
+proc msgcat::Init {} {
+ #
# set default locale, try to get from environment
- if {[info exists ::env(LANG)]} {
- mclocale $::env(LANG)
- } else {
- if { $tcl_platform(platform) == "windows" } {
- # try to set locale depending on registry settings
- #
- set key {HKEY_CURRENT_USER\Control Panel\International}
- if {[catch {package require registry}] || \
- [catch {registry get $key "locale"} locale]} {
- mclocale "C"
- } else {
-
- #
- # Clean up registry value for translating LCID value
- # by using only the last 2 digits, since first
- # 2 digits appear to be the country... For example
- # 0409 - English - United States
- # 0809 - English - United Kingdom
- #
- set locale [string trimleft $locale "0"]
- set locale [string range $locale end-1 end]
- set locale [string tolower $locale]
- switch -- $locale {
- 01 { mclocale "ar" }
- 02 { mclocale "bg" }
- 03 { mclocale "ca" }
- 04 { mclocale "zh" }
- 05 { mclocale "cs" }
- 06 { mclocale "da" }
- 07 { mclocale "de" }
- 08 { mclocale "el" }
- 09 { mclocale "en" }
- 0a { mclocale "es" }
- 0b { mclocale "fi" }
- 0c { mclocale "fr" }
- 0d { mclocale "he" }
- 0e { mclocale "hu" }
- 0f { mclocale "is" }
- 10 { mclocale "it" }
- 11 { mclocale "ja" }
- 12 { mclocale "ko" }
- 13 { mclocale "da" }
- 14 { mclocale "no" }
- 15 { mclocale "pl" }
- 16 { mclocale "pt" }
-
- default { mclocale "C" }
- }
- }
- } else {
- mclocale "C"
- }
+ #
+ foreach varName {LC_ALL LC_MESSAGES LANG} {
+ if {[info exists ::env($varName)]
+ && ![string equal "" $::env($varName)]} {
+ mclocale [ConvertLocale $::env($varName)]
+ return
+ }
+ }
+ #
+ # On Windows, try to set locale depending on registry settings,
+ # or fall back on locale of "C". Other platforms will return
+ # when they fail to load the registry package.
+ #
+ set key {HKEY_CURRENT_USER\Control Panel\International}
+ if {[catch {package require registry}] \
+ || [catch {registry get $key "locale"} locale]} {
+ mclocale "C"
+ return
+ }
+ #
+ # Keep trying to match against smaller and smaller suffixes
+ # of the registry value, since the latter hexadigits appear
+ # to determine general language and earlier hexadigits determine
+ # more precise information, such as territory. For example,
+ # 0409 - English - United States
+ # 0809 - English - United Kingdom
+ # Add more translations to the WinRegToISO639 array above.
+ #
+ variable WinRegToISO639
+ set locale [string tolower $locale]
+ while {[string length $locale]} {
+ if {![catch {mclocale $WinRegToISO639($locale)}]} {
+ return
+ }
+ set locale [string range $locale 1 end]
}
+ #
+ # No translation known. Fall back on "C" locale
+ #
+ mclocale C
}
+msgcat::Init
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index cc1af0c..9d16a19 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
-package ifneeded msgcat 1.2.3 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.3 [list source [file join $dir msgcat.tcl]]