tcl/library/msgcat1.0/msgcat.tcl

   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$
  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