From 045414500d7c1640591cb4510f97f0d391e8dae7 Mon Sep 17 00:00:00 2001 From: stanton Date: Fri, 4 Dec 1998 21:58:08 +0000 Subject: * library/msgcat1.0/msgcat.tcl: Changed code to conform to Tcl coding standards. Changed to use file join for portability. --- library/msgcat/msgcat.tcl | 206 +++++++++++++++++++++++++++++-------------- library/msgcat1.0/msgcat.tcl | 206 +++++++++++++++++++++++++++++-------------- 2 files changed, 284 insertions(+), 128 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index cfe1fde..330002d 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -1,92 +1,170 @@ # 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". +# 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. -# -# $Id: msgcat.tcl,v 1.1.2.1 1998/12/04 18:52:40 stanton Exp $ -# +# +# RCS: @(#) $Id: msgcat.tcl,v 1.1.2.2 1998/12/04 21:58:08 stanton Exp $ -#--------------------------------------------------------------- -# message catalog procedures -#--------------------------------------------------------------- +package provide msgcat 1.0 namespace eval msgcat { - set _locale "" - set _loclist {} - - proc mc {src} { - set ns [uplevel {namespace current}] - foreach loc $::msgcat::_loclist { - if {[info exists ::msgcat::_msg($loc,$ns,$src)]} { - return $::msgcat::_msg($loc,$ns,$src) - } - } - # we have not found the translation - return [mcunknown $::msgcat::_locale $src] + namespace export mc mcset mclocale mclocales 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 ",," and the value is + # the translated string. + array set msgs {} + + # set default locale, try to get from environment + if {[info exists ::env(LANG)]} { + mclocale $::env(LANG) + } else { + mclocale "C" } +} - proc mclocale {args} { - set len [llength $args] - if {$len == 0} { - return $::msgcat::_locale - } elseif {$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] - } - } else { - # incorrect argument count - error {called "mclocale" with too many arguments} - } +# msgcat::mc -- +# +# Find the translation for the given string based on the current +# locale setting. +# +# Arguments: +# src The string to translate. +# +# Results: +# Returns the translatd string. + +proc msgcat::mc {src} { + set ns [uplevel {namespace current}] + foreach loc $::msgcat::loclist { + if {[info exists ::msgcat::msgs($loc,$ns,$src)]} { + return $::msgcat::msgs($loc,$ns,$src) + } } + # we have not found the translation + return [mcunknown $::msgcat::locale $src] +} + +# 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 mcpreferences {} { - return $::msgcat::_loclist +proc msgcat::mclocale {args} { + set len [llength $args] + + if {$len > 1} { + error {wrong # args: should be "mclocale ?newLocale?"} } - proc mcload {langdir} { - foreach p [::msgcat::mcpreferences] { - set langfile $langdir/$p.msg - if {[file exists $langfile]} { - uplevel [list source $langfile] - } - } + 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 +} - proc mcset {locale src {dest ""}} { - if {[string compare "" $dest] == 0} { - set dest $src - } +# 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. - set ns [uplevel {namespace current}] +proc msgcat::mcpreferences {} { + return $::msgcat::loclist +} - set ::msgcat::_msg($locale,$ns,$src) $dest - } +# 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: +# None. - proc mcunknown {locale src} { - return $src +proc msgcat::mcload {langdir} { + foreach p [::msgcat::mcpreferences] { + set langfile [file join $langdir $p.msg] + if {[file exists $langfile]} { + uplevel [list source $langfile] + } } + return +} - # set default locale try to get from environment - if {[info exists ::env(LANG)]} { - mclocale $::env(LANG) - } else { - mclocale "C" +# 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: +# None. + +proc msgcat::mcset {locale src {dest ""}} { + if {$dest == ""} { + set dest $src } - namespace export mc mcset mclocale mclocales mcunknown + set ns [uplevel {namespace current}] + + set ::msgcat::msgs($locale,$ns,$src) $dest + return } -package provide msgcat 1.0 +# 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. +# +# Arguments: +# locale The current locale. +# src The string to be translated. +# +# Results: +# Returns the translated value. + +proc msgcat::mcunknown {locale src} { + return $src +} -#eof: msgcat.tcl diff --git a/library/msgcat1.0/msgcat.tcl b/library/msgcat1.0/msgcat.tcl index cfe1fde..330002d 100644 --- a/library/msgcat1.0/msgcat.tcl +++ b/library/msgcat1.0/msgcat.tcl @@ -1,92 +1,170 @@ # 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". +# 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. -# -# $Id: msgcat.tcl,v 1.1.2.1 1998/12/04 18:52:40 stanton Exp $ -# +# +# RCS: @(#) $Id: msgcat.tcl,v 1.1.2.2 1998/12/04 21:58:08 stanton Exp $ -#--------------------------------------------------------------- -# message catalog procedures -#--------------------------------------------------------------- +package provide msgcat 1.0 namespace eval msgcat { - set _locale "" - set _loclist {} - - proc mc {src} { - set ns [uplevel {namespace current}] - foreach loc $::msgcat::_loclist { - if {[info exists ::msgcat::_msg($loc,$ns,$src)]} { - return $::msgcat::_msg($loc,$ns,$src) - } - } - # we have not found the translation - return [mcunknown $::msgcat::_locale $src] + namespace export mc mcset mclocale mclocales 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 ",," and the value is + # the translated string. + array set msgs {} + + # set default locale, try to get from environment + if {[info exists ::env(LANG)]} { + mclocale $::env(LANG) + } else { + mclocale "C" } +} - proc mclocale {args} { - set len [llength $args] - if {$len == 0} { - return $::msgcat::_locale - } elseif {$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] - } - } else { - # incorrect argument count - error {called "mclocale" with too many arguments} - } +# msgcat::mc -- +# +# Find the translation for the given string based on the current +# locale setting. +# +# Arguments: +# src The string to translate. +# +# Results: +# Returns the translatd string. + +proc msgcat::mc {src} { + set ns [uplevel {namespace current}] + foreach loc $::msgcat::loclist { + if {[info exists ::msgcat::msgs($loc,$ns,$src)]} { + return $::msgcat::msgs($loc,$ns,$src) + } } + # we have not found the translation + return [mcunknown $::msgcat::locale $src] +} + +# 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 mcpreferences {} { - return $::msgcat::_loclist +proc msgcat::mclocale {args} { + set len [llength $args] + + if {$len > 1} { + error {wrong # args: should be "mclocale ?newLocale?"} } - proc mcload {langdir} { - foreach p [::msgcat::mcpreferences] { - set langfile $langdir/$p.msg - if {[file exists $langfile]} { - uplevel [list source $langfile] - } - } + 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 +} - proc mcset {locale src {dest ""}} { - if {[string compare "" $dest] == 0} { - set dest $src - } +# 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. - set ns [uplevel {namespace current}] +proc msgcat::mcpreferences {} { + return $::msgcat::loclist +} - set ::msgcat::_msg($locale,$ns,$src) $dest - } +# 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: +# None. - proc mcunknown {locale src} { - return $src +proc msgcat::mcload {langdir} { + foreach p [::msgcat::mcpreferences] { + set langfile [file join $langdir $p.msg] + if {[file exists $langfile]} { + uplevel [list source $langfile] + } } + return +} - # set default locale try to get from environment - if {[info exists ::env(LANG)]} { - mclocale $::env(LANG) - } else { - mclocale "C" +# 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: +# None. + +proc msgcat::mcset {locale src {dest ""}} { + if {$dest == ""} { + set dest $src } - namespace export mc mcset mclocale mclocales mcunknown + set ns [uplevel {namespace current}] + + set ::msgcat::msgs($locale,$ns,$src) $dest + return } -package provide msgcat 1.0 +# 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. +# +# Arguments: +# locale The current locale. +# src The string to be translated. +# +# Results: +# Returns the translated value. + +proc msgcat::mcunknown {locale src} { + return $src +} -#eof: msgcat.tcl -- cgit v0.12