Index: openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl,v diff -u -N -r1.62 -r1.63 --- openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 17 Jul 2018 11:42:26 -0000 1.62 +++ openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 17 Jul 2018 13:32:18 -0000 1.63 @@ -1,5 +1,5 @@ #/packages/acs-lang/tcl/lang-message-procs.tcl -ad_library { +ad_library { Routines for displaying web pages in multiple languages

@@ -17,17 +17,17 @@ namespace eval lang::message {} -ad_proc -public lang::message::check { +ad_proc -public lang::message::check { locale package_key message_key message -} { +} {

Check a message for semantic and sanity correctness (usually called just before a message is registered). Throws an error when one of the checks fails.

-} { +} { # Qualify the locale variable value with a country code if it is # just a language if { [string length $locale] == 2 } { @@ -36,7 +36,7 @@ # invoked by users. # let's get the default locale for that language set locale [lang::util::default_locale_from_lang $locale] - } + } # Create a globally (across packages) unique key for the cache set key "${package_key}.${message_key}" @@ -52,47 +52,47 @@ if { [llength $missing_vars] > 0 } { set msg "Message key '$key' in locale '$locale' has these embedded variables not present in the en_US locale:\ - [join $missing_vars ","]." + [join $missing_vars ","]." ad_log error $msg error $msg } } - + # If a localization key from acs-lang... if {[regexp {^acs-lang\.localization-(.*)$} $key match lc_key]} { - # - # ...number separators for decimal and thousands must be - # checked to ensure they are not equal, otherwise the - # localized number parsing will fail. - # - if {$lc_key in {decimal_point thousands_sep mon_thousands_sep}} { - # - # Fetch values in case there were already loaded. - # - foreach k {decimal_point thousands_sep mon_thousands_sep} { - set $k [expr {[lang::message::message_exists_p $locale acs-lang.localization-$k] ? - [lc_get -locale $locale $k] : ""}] - } - # - # Overwrite the fetched value with the provided one. - # - set $lc_key $message + # + # ...number separators for decimal and thousands must be + # checked to ensure they are not equal, otherwise the + # localized number parsing will fail. + # + if {$lc_key in {decimal_point thousands_sep mon_thousands_sep}} { + # + # Fetch values in case there were already loaded. + # + foreach k {decimal_point thousands_sep mon_thousands_sep} { + set $k [expr {[lang::message::message_exists_p $locale acs-lang.localization-$k] ? + [lc_get -locale $locale $k] : ""}] + } + # + # Overwrite the fetched value with the provided one. + # + set $lc_key $message - # - # We require, that the decimal_point was either provided - # or loaded before to be able to compare it with the - # thousands points. - # - if {$decimal_point ne "" && - [string first $decimal_point "$thousands_sep$mon_thousands_sep"] > -1} { - error "locale $locale, key: $key: Message keys for thousands and decimal separators must be different." - } - } + # + # We require, that the decimal_point was either provided + # or loaded before to be able to compare it with the + # thousands points. + # + if {$decimal_point ne "" && + [string first $decimal_point "$thousands_sep$mon_thousands_sep"] > -1} { + error "locale $locale, key: $key: Message keys for thousands and decimal separators must be different." + } + } } } -ad_proc -public lang::message::register { +ad_proc -public lang::message::register { {-update_sync:boolean} {-upgrade_status "no_upgrade"} {-conflict:boolean} @@ -101,7 +101,7 @@ package_key message_key message -} { +} {

Registers a message for a given locale and package. Inserts the message key into the database if it @@ -117,9 +117,9 @@ @author Christian Hvid @see _mr - + @param locale Locale or language of the message. If a language is supplied, - the default locale for the language is looked up. + the default locale for the language is looked up. @param package_key The package key of the package that the message belongs to. @@ -132,17 +132,17 @@ a message should only be not null when we know that message in catalog file and db are identical (in sync). This message is then used as a merge base for message catalog upgrades. For more info, - see the lang::catalog::upgrade proc. + see the lang::catalog::upgrade proc. - @param upgrade_status Set the upgrade status of the new message to "added", "updated", "deleted". + @param upgrade_status Set the upgrade status of the new message to "added", "updated", "deleted". Defaults to "no_upgrade". - - @param conflict Set this switch if the upgrade represents a conflict between + + @param conflict Set this switch if the upgrade represents a conflict between changes made in the database and in catalog files. @see lang::message::lookup @see _ -} { +} { # Qualify the locale variable value with a country code if it is # just a language if { [string length $locale] == 2 } { @@ -151,7 +151,7 @@ # invoked by users. # let's get the default locale for that language set locale [lang::util::default_locale_from_lang $locale] - } + } # Create a globally (across packages) unique key for the cache set key "${package_key}.${message_key}" @@ -173,17 +173,17 @@ error $error_message } } - + # Call semantic and sanity checks on the key before registering. lang::message::check $locale $package_key $message_key $message - + # Build up an array of columns to set array set cols [list] if { $update_sync_p } { set cols(sync_time) [db_map sync_time] } else { set cols(sync_time) "null" - } + } if { [string trim $message] eq "" } { set cols(message) "null" } else { @@ -195,7 +195,7 @@ set cols(conflict_p) :conflict_db_p # Different logic for update and insert - if { [nsv_exists lang_message_$locale $key] } { + if { [nsv_exists lang_message_$locale $key] } { # Update existing message if the message has changed # For use in audit log call @@ -218,7 +218,7 @@ } db_transaction { - + # Update audit log lang::audit::changed_message \ $old_message \ @@ -230,16 +230,16 @@ $old_message_array(sync_time) \ $old_message_array(conflict_p) \ $old_message_array(upgrade_status) - - # Trying to avoid hitting Oracle bug#2011927 + + # Trying to avoid hitting Oracle bug#2011927 if { [string trim $message] eq "" } { db_dml lang_message_update {} - } else { + } else { set cols(message) [db_map message] db_dml lang_message_update {} -clobs [list $message] } } - } else { + } else { # Insert new message set cols(package_key) :package_key @@ -249,17 +249,17 @@ # We wrap this in a catch, so that it still works in the bootstrap-installer where ad_conn user_id will fail. # LARS NOTE: Why not make ad_conn user_id return 0 in the bootstrap-installer? catch { - set creation_user [ad_conn user_id] + set creation_user [ad_conn user_id] set cols(creation_user) :creation_user } - + set col_clauses [list] set val_clauses [list] foreach col [array names cols] { lappend col_clauses $col lappend val_clauses $cols($col) } - + # avoiding bug#2011927 from Oracle. if { [string trim $message] eq "" } { db_dml lang_message_insert_null_msg {} @@ -272,7 +272,7 @@ nsv_set lang_message_$locale $key $message } -ad_proc -public lang::message::delete { +ad_proc -public lang::message::delete { -package_key:required -message_key:required -locale:required @@ -312,9 +312,9 @@ where lma2.package_key = lma1.package_key and lma2.message_key = lma1.message_key and lma2.locale = lma1.locale - ) + ) }] - + lang::message::register \ $locale \ $package_key \ @@ -326,7 +326,7 @@ -package_key:required -message_key:required -locale:required - -element:required + -element:required } { Get value of a single attribute of a message. @@ -345,18 +345,18 @@ return $message_array($element) } -ad_proc -public lang::message::get { +ad_proc -public lang::message::get { -package_key:required -message_key:required -locale:required -array:required } { Get all properties of a message in a particular locale. - - @param array Name of an array in the caller's namespace into + + @param array Name of an array in the caller's namespace into which you want the message properties delivered. - @return The array will contain the following entries: + @return The array will contain the following entries: message_key, package_key, locale, @@ -395,15 +395,15 @@ } -column_array row } -ad_proc -public lang::message::unregister { +ad_proc -public lang::message::unregister { package_key message_key } { Unregisters a message key, i.e. deletes it along with all its messages from the database and deleted entries in the cache. This proc is useful when installing a package. - To delete an individual message, as opposed to the entire key, + To delete an individual message, as opposed to the entire key, use lang::message::delete. @see lang::message::delete @@ -444,7 +444,7 @@ @param edit_array_list An array list holding names of columns and the values to set them to. Valid keys in this array list are any column names in the - lang_messages table. + lang_messages table. @param update_sync If this switch is provided the sync_time of the message will be updated to current time. If not @@ -482,7 +482,7 @@ $old_message_array(deleted_p) \ $old_message_array(sync_time) \ $old_message_array(conflict_p) \ - $old_message_array(upgrade_status) + $old_message_array(upgrade_status) # If we are deleting an en_US message we need to mark the message deleted in all locales if {$locale eq "en_US"} { @@ -515,7 +515,7 @@ } if { [llength $set_clauses] > 0 } { - + set sql " update lang_messages set [join $set_clauses ", "] @@ -533,7 +533,7 @@ } { Return the number of messages with conflicts (conflict_p=t) resulting from catalog imports. - + @param package_key Restrict count to package with this key @param locale Restrict count to messages of this locale @@ -584,7 +584,7 @@ message } { Returns a list of embedded substitution variables on the form %varname% in a message. - This is useful if you want to check that the variables used in a translated message also + This is useful if you want to check that the variables used in a translated message also appear in the en_US message. If not, there's likely to be a typo. @param message A message with embedded %varname% notation @@ -620,19 +620,19 @@ with array_key (what's between the percentage sings). If value_array_list is not provided then attempt to fetch variable values the number of levels up given by upvar_level (defaults to 3 because this proc is typically invoked from the underscore - lookup proc). + lookup proc). Here is an example: set localized_message "The %animal% jumped across the %barrier%. About 50% of the time, he stumbled, or maybe it was %%20 %times%." set value_list { animal "frog" barrier "fence" } ns_log notice formatted=[format $localized_message $value_list] - + The output from the example is: The frog jumped across the fence. About 50% of the time, he stumbled, or maybe it was %20 %times%. -} { +} { array set value_array $value_array_list set value_array_keys [array names value_array] set remaining_message $localized_message @@ -649,10 +649,10 @@ if { [llength $value_array_list] > 0 } { # A substitution list is provided, the key should be in there - + if {$variable_string ni $value_array_keys} { ns_log Warning "lang::message::format: The value_array_list \"$value_array_list\" does not contain the variable name $variable_string found in the message: $localized_message" - + # There is no value available to do the substitution with # so don't substitute at all append formatted_message $percent_match @@ -677,7 +677,7 @@ } } else { ns_log warning "Message contains a variable named '$variable_name' which doesn't exist in the caller's environment: message $localized_message" - append formatted_message "MISSING: variable '$variable_name' is not available" + append formatted_message "MISSING: variable '$variable_name' is not available" } } } @@ -690,7 +690,7 @@ } ad_proc -private lang::message::embedded_vars_regexp {} { - The regexp pattern used to loop over variables embedded in + The regexp pattern used to loop over variables embedded in message catalog texts. @author Peter Marklund (peter@collaboraid.biz) @@ -707,7 +707,7 @@ # Make sure messages are in the cache lang::message::cache - return [nsv_exists lang_message_$locale $key] + return [nsv_exists lang_message_$locale $key] } ad_proc -public lang::message::lookup { @@ -723,32 +723,32 @@ Returns a translated string for the given locale and message key. If the user is a translator, inserts tags to link to the translator interface. This allows a translator to work from the context of a web page. - - Messages will have %name% replaced with variables either from substitution_list, + + Messages will have %name% replaced with variables either from substitution_list, if present, or from the caller's namespace (or upvar_level's namespace). Set upvar_level to 0 and substitution_list empty to prevent substitution from happening - Note that this proc does not use named parameters, because named parameters are + Note that this proc does not use named parameters, because named parameters are relatively slow, and this is going to get called a whole lot on each request. @param locale Locale (e.g., "en_US") or language (e.g., "en") string. If locale is the empty string ad_conn locale will be used if we are in an HTTP connection, otherwise the system locale (SiteWideLocale) will be used. - @param key Unique identifier for this message. Will be the same - identifier for each locale. All keys belong to a certain - package and should be prefixed with the package key of that package - on the format package_key.message_key (the dot is reserved for separating + @param key Unique identifier for this message. Will be the same + identifier for each locale. All keys belong to a certain + package and should be prefixed with the package key of that package + on the format package_key.message_key (the dot is reserved for separating the package key, the rest of the key should contain only alpha-numeric - characters and underscores). If the key does not belong to + characters and underscores). If the key does not belong to any particular package it should not contain a dot. A lookup is always attempted with the exact key given to this proc. @param default Text to return if there is no message in the message catalog for the given locale. This argument is optional. If this argument is not provided or is the empty string then the text returned will - be TRANSLATION MISSING - $key. + be TRANSLATION MISSING - $key. @param substitution_list A list of values to substitute into the message. This argument should only be given for certain messages that contain place holders (on the syntax @@ -760,8 +760,8 @@ @param upvar_level If there are embedded variables and no substitution list provided, this parameter specifies how many levels up to fetch the values of the variables in the message. The default is 1. - - @param translator_mode_p Set to 0 if you do not want this call to honor translator mode. + + @param translator_mode_p Set to 0 if you do not want this call to honor translator mode. Useful if you're not using this message in the page itself, but e.g. for localization data or for the list of messages on the page. @@ -771,18 +771,18 @@ @see _ @see lang::message::register - + @return A localized piece of text. -} { +} { # Make sure messages are in the cache lang::message::cache # Make sure that a default of "" is transformed into Translation Missing # As per discussion on IRC on 2008-03-06 if { $default eq ""} { - set default "TRANSLATION MISSING" + set default "TRANSLATION MISSING" } - + if { $locale eq "" } { # No locale provided @@ -801,9 +801,9 @@ } else { set locale $default_locale } - } + } - # We remember the passed-in locale, because we want the translator mode to show which + # We remember the passed-in locale, because we want the translator mode to show which # messages have been translated, and which have not. set org_locale $locale @@ -832,18 +832,18 @@ if { [message_exists_p $locale $key] } { set message [nsv_get lang_message_$locale $key] } else { - if {"TRANSLATION MISSING" ne $default} { - set message $default - } else { + if {"TRANSLATION MISSING" ne $default} { + set message $default + } else { ad_log Error "lang::message::lookup: Key '$key' does not exist in en_US" set message "MESSAGE KEY MISSING: '$key'" - } - } + } + } } } } } - + # Do any variable substitutions (interpolation of variables) # Set upvar_level to 0 and substitution_list empty to prevent substitution from happening if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $message] != -1) } { @@ -853,15 +853,15 @@ if { [lang::util::translator_mode_p] } { # Translator mode - record the message lookup lang::util::record_message_lookup $key - + if { $translator_mode_p } { global message_key_num if { ![info exists message_key_num] } { set message_key_num 1 } else { incr message_key_num } - + # encode the key in the page set message "$message\x02(\x01$key\x01)\x02" } @@ -870,17 +870,17 @@ return $message } -ad_proc -private lang::message::translate { +ad_proc -private lang::message::translate { msg locale } { Translates an English string into a different language using Babelfish. Warning - october 2002: This is broken. - + @author Henry Minsky (hqm@mit.edu) - + @param msg String to translate @param lang Abbreviation for lang in which to translate string @return Translated string @@ -898,7 +898,7 @@ } else { error "Babelfish translation error" } -} +} ad_proc -private lang::message::cache { @@ -910,23 +910,23 @@ # if we segregage instead by package. Check for problems with ns_info locks. # LARS TODO: Use a mutex - if { ![nsv_exists lang_message_cache executed_p] } { + if { ![nsv_exists lang_message_cache executed_p] } { nsv_set lang_message_cache executed_p 1 if { $package_key eq "" } { set package_where_clause "" } else { set package_where_clause "where package_key = :package_key" } - - set i 0 + + set i 0 db_foreach select_locale_keys {} { nsv_set lang_message_$locale "${package_key}.${message_key}" $message incr i } - + db_release_unused_handles - + ns_log Notice "lang::message::cache - Initialized message cache with $i rows from database" } } @@ -945,14 +945,14 @@ Inserts the message into the table lang_messages if it does not exist and updates if it does. - For backward compatibility - it assumes that the key + For backward compatibility - it assumes that the key is the concatenation of message and package key like this: package_key.message_key @author Jeff Davis (davis@xarg.net) - + @param locale Abbreviation for language of the message or the locale. @param key Unique identifier for this message. Will be the same identifier for each language @@ -968,13 +968,13 @@ key {substitution_list {}} } { - Short hand proc that invokes the lang::message::lookup proc. + Short hand proc that invokes the lang::message::lookup proc. Returns a localized text from the message catalog with the locale ad_conn locale if invoked within a request, or the system locale otherwise.

- Example: + Example:

     set the_url [export_vars -base "[ad_conn package_url]view" { item_id }]
     set body [_ my-package.lt_To_view_this_item [list item_url $the_url]]
@@ -985,15 +985,15 @@
     @param key        Unique identifier for this message. Will be the same identifier
                       for each locale. The key is on the format package_key.message_key
 
-    @param substitution_list 
-                      A list of values to substitute into the message on the form { name value name value ... }. 
+    @param substitution_list
+                      A list of values to substitute into the message on the form { name value name value ... }.
                       This argument should only be given for certain messages that contain place holders (on the syntax
                       %1:pretty_name%, %2:another_pretty_name% etc) for embedding variable values.
                       If the message contains variables that should be interpolated and this argument
                       is not provided then upvar will be used to fetch the variable values.
 
     @return           A localized message
-    
+
     @author Jeff Davis (davis@xarg.net)
     @author Peter Marklund (peter@collaboraid.biz)
     @author Christian Hvid (chvid@collaboraid.biz)