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