1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
# msgcat.tcl --
#
# This file defines various procedures which implement a
# message catalog facility for Tcl programs. It should be
# loaded with the command "package require msgcat".
#
# Copyright (c) 1998 by Scriptics Corporation.
# Copyright (c) 1998 by Mark Harrison.
#
# 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.1 2000/10/16 22:02:08 kriston Exp $
package provide msgcat 1.1
namespace eval msgcat {
namespace export mc mcset mclocale mcpreferences mcunknown
# Records the current locale as passed to mclocale
variable locale ""
# Records the list of locales to search
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 {}
}
# msgcat::mc --
#
# Find the translation for the given string based on the current
# locale setting. Check the local namespace first, then look in each
# parent namespace until the source is found. If additional args are
# specified, use the format command to work them into the traslated
# string.
#
# Arguments:
# src The string to translate.
# args Args to pass to the format command
#
# Results:
# Returns the translatd string. Propagates errors thrown by the
# format command.
proc msgcat::mc {src args} {
# Check for the src in each namespace starting from the local and
# ending in the global.
set ns [uplevel {namespace current}]
while {$ns != ""} {
foreach loc $::msgcat::loclist {
if {[info exists ::msgcat::msgs($loc,$ns,$src)]} {
if {[llength $args] == 0} {
return $::msgcat::msgs($loc,$ns,$src)
} else {
return [eval \
[list format $::msgcat::msgs($loc,$ns,$src)] \
$args]
}
}
}
set ns [namespace parent $ns]
}
# we have not found the translation
return [uplevel 1 [list [namespace origin mcunknown] \
$::msgcat::locale $src] $args]
}
# msgcat::mclocale --
#
# Query or set the current locale.
#
# Arguments:
# newLocale (Optional) The new locale string. Locale strings
# should be composed of one or more sublocale parts
# separated by underscores (e.g. en_US).
#
# Results:
# Returns the current locale.
proc msgcat::mclocale {args} {
set len [llength $args]
if {$len > 1} {
error {wrong # args: should be "mclocale ?newLocale?"}
}
set args [string tolower $args]
if {$len == 1} {
set ::msgcat::locale $args
set ::msgcat::loclist {}
set word ""
foreach part [split $args _] {
set word [string trimleft "${word}_${part}" _]
set ::msgcat::loclist [linsert $::msgcat::loclist 0 $word]
}
}
return $::msgcat::locale
}
# msgcat::mcpreferences --
#
# Fetch the list of locales used to look up strings, ordered from
# most preferred to least preferred.
#
# Arguments:
# None.
#
# Results:
# Returns an ordered list of the locales preferred by the user.
proc msgcat::mcpreferences {} {
return $::msgcat::loclist
}
# msgcat::mcload --
#
# Attempt to load message catalogs for each locale in the
# preference list from the specified directory.
#
# Arguments:
# langdir The directory to search.
#
# Results:
# Returns the number of message catalogs that were loaded.
proc msgcat::mcload {langdir} {
set x 0
foreach p [::msgcat::mcpreferences] {
set langfile [file join $langdir $p.msg]
if {[file exists $langfile]} {
incr x
uplevel [list source $langfile]
}
}
return $x
}
# msgcat::mcset --
#
# Set the translation for a given string in a specified locale.
#
# Arguments:
# locale The locale to use.
# src The source string.
# dest (Optional) The translated string. If omitted,
# the source string is used.
#
# Results:
# Returns the new locale.
proc msgcat::mcset {locale src {dest ""}} {
if {[string equal $dest ""]} {
set dest $src
}
set ns [uplevel {namespace current}]
set ::msgcat::msgs([string tolower $locale],$ns,$src) $dest
return $dest
}
# msgcat::mcunknown --
#
# This routine is called by msgcat::mc if a translation cannot
# be found for a string. This routine is intended to be replaced
# by an application specific routine for error reporting
# purposes. The default behavior is to return the source string.
# If additional args are specified, the format command will be used
# to work them into the traslated string.
#
# Arguments:
# locale The current locale.
# src The string to be translated.
# args Args to pass to the format command
#
# Results:
# Returns the translated value.
proc msgcat::mcunknown {locale src args} {
if {[llength $args]} {
return [eval [list format $src] $args]
} else {
return $src
}
}
# Initialize the default locale
namespace eval msgcat {
# set default locale, try to get from environment
if {[info exists ::env(LANG)]} {
mclocale $::env(LANG)
} else {
mclocale "C"
}
}
|
