home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 April / PCWorld_2001-04_cd.bin / Software / TemaCD / webclean / !!!python!!! / BeOpen-Python-2.0.exe / MSGCAT.TCL < prev    next >
Encoding:
Text File  |  2000-08-08  |  4.9 KB  |  202 lines
  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. }
  202.