Index: openacs-4/packages/acs-lang/tcl/acs-lang-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/acs-lang-init.tcl,v
diff -u -N -r1.2 -r1.3
--- openacs-4/packages/acs-lang/tcl/acs-lang-init.tcl 11 Nov 2002 09:36:31 -0000 1.2
+++ openacs-4/packages/acs-lang/tcl/acs-lang-init.tcl 12 Nov 2002 15:33:15 -0000 1.3
@@ -11,8 +11,4 @@
# Instead, it can be done by a thread after the server has started multithreading.
ad_schedule_proc -once t 5 lang::catalog::import_from_all_files
-# Cache the message catalog from the database
-global message_cache_loaded_p
-if { ![info exists message_cache_loaded_p] } {
- lang::message::cache
-}
+lang::message::cache
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.11 -r1.12
--- openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 12 Nov 2002 08:34:50 -0000 1.11
+++ openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 12 Nov 2002 15:33:15 -0000 1.12
@@ -27,7 +27,8 @@
Inserts the message key into the database if it
doesn't already exists. Inserts the message itself
in the given locale into the database if it doesn't
- exist and updates it if it does.
+ exist and updates it if it does. Also updates the
+ cache with the message.
@author Jeff Davis (davis@arsdigita.com)
@author Bruno Mattarollo (bruno.mattarollo@ams.greenpeace.org)
@@ -53,9 +54,6 @@
db_dml insert_message_key {}
}
- # First we check if the given key already exists
- # or if this is different than what we have saved.
-
# Check if the $lang parameter is a language or a locale
if { [string length $locale] == 2 } {
# It seems to be a language (iso codes are 2 characters)
@@ -64,10 +62,25 @@
# let's get the default locale for that language
set locale [util_memoize [list ad_locale_locale_from_lang $locale]]
}
+
+ if { $key_exists_p } {
+ # The message key exists so we are assuming the en_US version
+ # of the message has already been registered, also it looks like
+ # the message contains variables - check that any suc variables are
+ # unchanged from the existing en_US message
+
+ # Get the current en_US message from the cache
+ set existing_en_us_message [nsv_get lang_message_en_US $key]
+
+ set missing_vars_list [get_missing_embedded_vars $existing_en_us_message $message]
+ if { [llength $missing_vars_list] != 0 } {
+ error "The following variables are in the en_US message for key $message_key but not in the new message \"$message\" in locale $locale : $missing_vars_list"
+ }
+ }
# Check the cache
if { [nsv_exists lang_message_$locale $key] } {
-
+ # Update existing message
set old_message [nsv_get lang_message_$locale $key]
if { ![string equal $message $old_message] } {
@@ -84,6 +97,7 @@
nsv_set lang_message_$locale $key $message
}
} else {
+ # Insert new message
ns_log Debug "lang::message::register - Inserting into database message: $locale $key"
db_transaction {
# As above, avoiding the bug#2011927 from Oracle.
@@ -101,6 +115,48 @@
}
}
+ ad_proc -private get_missing_embedded_vars {
+ existing_message
+ new_message
+ } {
+ Returns a list of variables that are in an existing message and should
+ also be in a new message with the same key but a different locale.
+ The set of embedded variables in the messages for a certain key
+ should be identical across locales.
+
+ @param existing_message The existing message with vars that should
+ also be in the new message
+ @param new_message The new message that we are checking for
+ consistency.
+
+ @return The list of variables in the existing en_US message
+ that are missing in the new message.
+
+ @author Peter Marklund (peter@collaboraid.biz)
+ @creation-date 12 November 2002
+ } {
+ # Loop over the vars in the en_US message
+ set missing_variable_list [list]
+ set remaining_message $existing_message
+ while { [regexp [embedded_vars_regexp] $remaining_message match before_percent \
+ percent_match \
+ remaining_message] } {
+ if { [string equal $percent_match "%%"] } {
+ # A quoted percentage sign - ignore
+ continue
+ } else {
+ # A variable - check that it is in the new message
+ if { ![regexp "(?:^|\[^%]\)${percent_match}" $new_message match] } {
+ # The variable is missing
+ set variable_name [string range $percent_match 1 end-1]
+ lappend missing_variable_list $variable_name
+ }
+ }
+ }
+
+ return $missing_variable_list
+ }
+
ad_proc -private format {
localized_message
{value_array_list {}}
@@ -129,7 +185,7 @@
set value_array_keys [array names value_array]
set remaining_message $localized_message
set formated_message ""
- while { [regexp {^(.*?)(%%|%[a-zA-Z_]+%)(.*)$} $remaining_message match before_percent percent_match remaining_message] } {
+ while { [regexp [embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } {
append formated_message $before_percent
@@ -169,6 +225,16 @@
return $formated_message
}
+ ad_proc -private embedded_vars_regexp {} {
+ The regexp pattern used to loop over variables embedded in
+ message catalog texts.
+
+ @author Peter Marklund (peter@collaboraid.biz)
+ @creation-date 12 November 2002
+ } {
+ return {^(.*?)(%%|%[a-zA-Z_\.]+%)(.*)$}
+ }
+
ad_proc -public lookup {
locale
key
@@ -217,14 +283,6 @@
@return A localized piece of text.
} {
- # If the cache hasn't been loaded - do so now
- # Peter: should we go to the database on first hit and cache the messages as they are used
- # instead of loading the whole cache up-front?
- global message_cache_loaded_p
- if { ![info exists message_cache_loaded_p] } {
- lang::message::cache
- }
-
if { [empty_string_p $locale] } {
# No locale provided
@@ -246,6 +304,20 @@
set locale [util_memoize [list ad_locale_locale_from_lang $locale]]
}
+ if { [lang::util::translator_mode_p] } {
+ # Translator mode - set uo translate_url
+
+ set key_split [split $key "."]
+ set package_key_part [lindex $key_split 0]
+ set message_key_part [lindex $key_split 1]
+ set return_url [ad_conn url]
+ if { [ns_getform] != "" } {
+ append return_url "?[export_entire_form_as_url_vars]"
+ }
+
+ set translate_url /acs-lang/admin/edit-localized-message?[export_vars { { message_key $message_key_part } { locales $locale } { package_key $package_key_part } return_url }]
+ }
+
if { [nsv_exists lang_message_$locale $key] } {
# Message exists in the given locale
@@ -254,6 +326,11 @@
if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $return_value] != -1) } {
set return_value [lang::message::format $return_value $substitution_list [expr $upvar_level + 1]]
}
+
+ if { [lang::util::translator_mode_p] } {
+ # Translator mode - return a translation link
+ append return_value "o"
+ }
} else {
# There is no entry in the message catalog for the given locale
@@ -272,16 +349,16 @@
} else {
# Translator mode - return a translation link
- set key_split [split $key "."]
- set package_key_part [lindex $key_split 0]
- set message_key_part [lindex $key_split 1]
-
- set return_url [ad_conn url]
- if { [ns_getform] != "" } {
- append return_url "?[export_entire_form_as_url_vars]"
+ set us_text [nsv_get lang_message_en_US $key]
+ # Do any variable substitutions (interpolation of variables)
+ if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $us_text] != -1) } {
+ set us_text [lang::message::format $us_text $substitution_list [expr $upvar_level + 1]]
}
-
- set return_value " $message_key_part - TRANSLATE "
+
+
+ set return_value "$us_text*"
+ # set return_value " $message_key_part - TRANSLATE "
+
}
} {
Index: openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl,v
diff -u -N -r1.16 -r1.17
--- openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 12 Nov 2002 08:34:50 -0000 1.16
+++ openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 12 Nov 2002 15:33:15 -0000 1.17
@@ -350,6 +350,8 @@
@param locale Name of a locale, as language_COUNTRY using ISO 639 and ISO 3166
@return IANA MIME character set name
} {
+ # LARS:
+ # This should probably be cached
return [db_string charset_for_locale {}]
}
@@ -491,7 +493,7 @@
&& ![string is space $text_wo_variables]
&& [string length $text] > 1
&& [string match -nocase {*[A-Z]*} $text]
- && ![regexp {(?:\s* \s*)+} $text_wo_variables match]
+ && ![regexp {^(?:\s* \s*)+$} $text_wo_variables match]
&& ![regexp {^\s*#[a-zA-Z\._-]+#\s*$} $text_wo_variables match]
} {
# Peter: texts with a hash or curly brace used to be excluded, my thinking
@@ -500,7 +502,6 @@
#&& ![string match {*\#*} $text]
#&& ![string match {*\{*} $text]
#&& ![string match {*\}*} $text]
-
regexp {^(\s*)(.*?)(\s*)$} $text match lead text lag
set text_w_percentages [convert_adp_variables_to_percentage_signs $text]
@@ -627,9 +628,9 @@
} {
ad_set_client_property acs-lang translator_mode_p $translator_mode_p
}
+}
-}
#####
#
Index: openacs-4/packages/acs-lang/tcl/locale-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/locale-procs.tcl,v
diff -u -N -r1.6 -r1.7
--- openacs-4/packages/acs-lang/tcl/locale-procs.tcl 7 Nov 2002 18:01:11 -0000 1.6
+++ openacs-4/packages/acs-lang/tcl/locale-procs.tcl 12 Nov 2002 15:33:15 -0000 1.7
@@ -269,7 +269,17 @@
} {
return [string range [locale -package_id $package_id -site_wide=$site_wide_p] 0 1]
}
+
+ ad_proc -public charset {
+ } {
+ Returns the MIME charset name corresponding to the current connection's locale.
+ @author Lars Pind (lars@pinds.com)
+ @param locale Name of a locale, as language_COUNTRY using ISO 639 and ISO 3166
+ @return IANA MIME character set name
+ } {
+ return [lang::util::charset_for_locale [lang::conn::locale]]
+ }
}
Index: openacs-4/packages/acs-lang/tcl/test/acs-lang-test.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/test/Attic/acs-lang-test.tcl,v
diff -u -N -r1.2 -r1.3
--- openacs-4/packages/acs-lang/tcl/test/acs-lang-test.tcl 28 Oct 2002 12:32:47 -0000 1.2
+++ openacs-4/packages/acs-lang/tcl/test/acs-lang-test.tcl 12 Nov 2002 15:33:16 -0000 1.3
@@ -203,3 +203,18 @@
aa_true "the frog should jump across the fence" [string equal $subst_message \
$expected_message]
}
+
+aa_register_case message__get_missing_embedded_vars {
+ Tests the lang::message::get_missing_embedded_vars proc
+
+ @author Peter Marklund (peter@collaboraid.biz)
+ @creation-date 12 November 2002
+} {
+ set en_us_message "this is a message with some %vars% and some more %variables%"
+ set new_message "this message contains no vars"
+
+ set missing_vars_list [lang::message::get_missing_embedded_vars $en_us_message $new_message]
+
+ aa_true "check the missing vars" [expr [string equal [lindex $missing_vars_list 0] "vars"] && \
+ [string equal [lindex $missing_vars_list 1] "variables"]]
+}