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 -r1.19 -r1.20
--- openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 27 Jan 2003 21:19:56 -0000 1.19
+++ openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 18 Aug 2003 08:04:26 -0000 1.20
@@ -17,617 +17,634 @@
@cvs-id $Id$
}
-namespace eval lang::util {
+namespace eval lang::util {}
- ad_proc -public lang_sort {
- field
- {locale {}}
- } {
- Each locale can have a different alphabetical sort order. You can test
- this proc with the following data:
-
- insert into lang_testsort values ('lama');
- insert into lang_testsort values ('lhasa');
- insert into lang_testsort values ('llama');
- insert into lang_testsort values ('lzim');
-
-
- @author Jeff Davis (davis@arsdigita.com)
-
- @param field Name of Oracle column
- @param locale Locale for sorting.
- If locale is unspecified just return the column name
- @return Language aware version of field for Oracle ORDER BY clause.
-
- } {
- # Use west european for english since I think that will fold
- # cedilla etc into reasonable values...
- set lang(en) "XWest_european"
- set lang(de) "XGerman_din"
- set lang(fr) "XFrench"
- set lang(es) "XSpanish"
-
- if { [empty_string_p $locale] || ![info exists lang($locale)] } {
- return $field
- } else {
- return "NLSSORT($field,'NLS_SORT = $lang($locale)')"
- }
- }
+ad_proc -public lang::util::lang_sort {
+ field
+ {locale {}}
+} {
+ Each locale can have a different alphabetical sort order. You can test
+ this proc with the following data:
+
+ insert into lang_testsort values ('lama');
+ insert into lang_testsort values ('lhasa');
+ insert into lang_testsort values ('llama');
+ insert into lang_testsort values ('lzim');
+
- ad_proc -private get_hash_indices { multilingual_string } {
- Returns a list of two element lists containing
- the start and end indices of a #message_key# match in the multilingual string.
- This proc is used by the localize proc.
+ @author Jeff Davis (davis@arsdigita.com)
+
+ @param field Name of Oracle column
+ @param locale Locale for sorting.
+ If locale is unspecified just return the column name
+ @return Language aware version of field for Oracle ORDER BY clause.
+
+} {
+ # Use west european for english since I think that will fold
+ # cedilla etc into reasonable values...
+ set lang(en) "XWest_european"
+ set lang(de) "XGerman_din"
+ set lang(fr) "XFrench"
+ set lang(es) "XSpanish"
- @author Peter marklund (peter@collaboraid.biz)
- } {
- set regexp_pattern {(?:^|[^\\])(\#[-a-zA-Z0-9_:\.]+\#)}
- return [get_regexp_indices $multilingual_string $regexp_pattern]
+ if { [empty_string_p $locale] || ![info exists lang($locale)] } {
+ return $field
+ } else {
+ return "NLSSORT($field,'NLS_SORT = $lang($locale)')"
}
+}
- ad_proc message_tag_regexp {} {
- The regexp expression used by proc get_temporary_tags_indices and elsewhere
- to extract temporary message catalog tags (<#...#>) from adp and tcl files.
- The first sub match of the expression is the whole tag, the second sub match
- is the message key, and the third sub match is the message text in en_US locale.
+ad_proc -private lang::util::get_hash_indices { multilingual_string } {
+ Returns a list of two element lists containing
+ the start and end indices of a #message_key# match in the multilingual string.
+ This proc is used by the localize proc.
- @author Peter marklund (peter@collaboraid.biz)
- } {
- return {(<#\s*?([-a-zA-Z0-9_:\.]+)\s+(.+?)#>)}
- }
+ @author Peter marklund (peter@collaboraid.biz)
+} {
+ set regexp_pattern {(?:^|[^\\])(\#[-a-zA-Z0-9_:\.]+\#)}
+ return [get_regexp_indices $multilingual_string $regexp_pattern]
+}
- ad_proc get_temporary_tags_indices { adp_file_string } {
- Given the contents of an adp file return the indices of the
- start and end chars of embedded message keys on the syntax:
-
- <#package_key.message_key Some en_US text#>
-
- @author Peter marklund (peter@collaboraid.biz)
- } {
- return [lang::util::get_regexp_indices $adp_file_string [message_tag_regexp]]
- }
-
- ad_proc -private get_regexp_indices { multilingual_string regexp_pattern } {
- Returns a list of two element lists containing
- the start and end indices of what is captured by the first parenthesis in the
- given regexp pattern in the multilingual string. The
- regexp pattern must follow the syntax of the expression argument to the TCL regexp command.
- It must also contain exactly one capturing parenthesis for the pieces of text that indices
- are to be returned for.
+ad_proc lang::util::message_tag_regexp {} {
+ The regexp expression used by proc get_temporary_tags_indices and elsewhere
+ to extract temporary message catalog tags (<#...#>) from adp and tcl files.
+ The first sub match of the expression is the whole tag, the second sub match
+ is the message key, and the third sub match is the message text in en_US locale.
- @see get_hash_indices
+ @author Peter marklund (peter@collaboraid.biz)
+} {
+ return {(<#\s*?([-a-zA-Z0-9_:\.]+)\s+(.+?)#>)}
+}
+
+ad_proc lang::util::get_temporary_tags_indices { adp_file_string } {
+ Given the contents of an adp file return the indices of the
+ start and end chars of embedded message keys on the syntax:
+
+ <#package_key.message_key Some en_US text#>
+
+ @author Peter marklund (peter@collaboraid.biz)
+} {
+ return [lang::util::get_regexp_indices $adp_file_string [message_tag_regexp]]
+}
- @author Peter marklund (peter@collaboraid.biz)
- } {
-
- set multilingual_string_offset "0"
- set offset_string $multilingual_string
- set indices_list [list]
+ad_proc -private lang::util::get_regexp_indices { multilingual_string regexp_pattern } {
+ Returns a list of two element lists containing
+ the start and end indices of what is captured by the first parenthesis in the
+ given regexp pattern in the multilingual string. The
+ regexp pattern must follow the syntax of the expression argument to the TCL regexp command.
+ It must also contain exactly one capturing parenthesis for the pieces of text that indices
+ are to be returned for.
- while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } {
-
- set start_idx [lindex $key_match_idx 0]
- set end_idx [lindex $key_match_idx 1]
+ @see get_hash_indices
- lappend indices_list [list [expr $multilingual_string_offset + $start_idx] \
- [expr $multilingual_string_offset + $end_idx]]
-
- set new_offset [expr $end_idx + 1]
- set multilingual_string_offset [expr $multilingual_string_offset + $new_offset]
- set offset_string [string range $offset_string $new_offset end]
- }
+ @author Peter marklund (peter@collaboraid.biz)
+} {
+
+ set multilingual_string_offset "0"
+ set offset_string $multilingual_string
+ set indices_list [list]
+
+ while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } {
- return $indices_list
- }
+ set start_idx [lindex $key_match_idx 0]
+ set end_idx [lindex $key_match_idx 1]
- ad_proc replace_temporary_tags_with_lookups {
- {-catalog_file_path ""}
- file_list
- } {
- Modify the given adp or tcl files by replacing occurencies of
+ lappend indices_list [list [expr $multilingual_string_offset + $start_idx] \
+ [expr $multilingual_string_offset + $end_idx]]
+
+ set new_offset [expr $end_idx + 1]
+ set multilingual_string_offset [expr $multilingual_string_offset + $new_offset]
+ set offset_string [string range $offset_string $new_offset end]
+ }
- <#package_key.message_key Some text#>
-
- with message lookups (i.e. #package_key.message_key# for adp files
- and [_ "package_key.message_key"] for tcl files) and create entries in the
- catalog file for each of these keys. If the short hand form <#_ Some en_US text#>
- is used then the key will be autogenerated based on the text.
- Returns the number of replacements done. This procedure only
- reads from and writes to the catalog file specified (the en_US catalog
- file per default) of the package that the files belong to, the database
- is not accessed in any way.
+ return $indices_list
+}
- @param catalog_file_path The fully qualified path of the catalog file.
- If not provided the catalog file for the en_US locale will be
- used, i.e. $package_root/catalog/$package_key.en_US.ISO-8859-1.xml.
- @param file_list A list of paths to adp or tcl files to do replacements in. The
- paths should be relative to [acs_root_dir]. All files must
- belong to the same package.
-
- @author Peter marklund (peter@collaboraid.biz)
- } {
- # Return if there are no files to process
- if { [llength $file_list] == 0 } {
- ns_log Warning "lang::util::replace_temporary_tags_with_lookups - \
- Invoked with no files to process, returning"
- return
- }
+ad_proc lang::util::replace_temporary_tags_with_lookups {
+ {-catalog_file_path ""}
+ file_list
+} {
+ Modify the given adp or tcl files by replacing occurencies of
- # Read messages from any existing catalog file
- # Get the package the files belong to
- set first_file [lindex $file_list 0]
- if { ![regexp {/?packages/([^/]+)/} $first_file match package_key] } {
- error "lang::util::replace_temporary_tags_with_lookups - Could not extract package_key from file $first_file"
+ <#package_key.message_key Some text#>
+
+ with message lookups (i.e. #package_key.message_key# for adp files
+ and [_ "package_key.message_key"] for tcl files) and create entries in the
+ catalog file for each of these keys. If the short hand form <#_ Some en_US text#>
+ is used then the key will be autogenerated based on the text.
+ Returns the number of replacements done. This procedure only
+ reads from and writes to the catalog file specified (the en_US catalog
+ file per default) of the package that the files belong to, the database
+ is not accessed in any way.
+
+ @param catalog_file_path The fully qualified path of the catalog file.
+ If not provided the catalog file for the en_US locale will be
+ used, i.e. $package_root/catalog/$package_key.en_US.ISO-8859-1.xml.
+ @param file_list A list of paths to adp or tcl files to do replacements in. The
+ paths should be relative to [acs_root_dir]. All files must
+ belong to the same package.
+
+ @author Peter marklund (peter@collaboraid.biz)
+} {
+ # Return if there are no files to process
+ if { [llength $file_list] == 0 } {
+ ns_log Warning "lang::util::replace_temporary_tags_with_lookups - \
+ Invoked with no files to process, returning"
+ return
+ }
+
+ # Read messages from any existing catalog file
+ # Get the package the files belong to
+ set first_file [lindex $file_list 0]
+ if { ![regexp {/?packages/([^/]+)/} $first_file match package_key] } {
+ error "lang::util::replace_temporary_tags_with_lookups - Could not extract package_key from file $first_file"
+ }
+ set catalog_dir "[acs_root_dir]/packages/$package_key/catalog"
+ if { [empty_string_p $catalog_file_path] } {
+ set catalog_file_path "$catalog_dir/$package_key.en_US.ISO-8859-1.xml"
+ }
+ if { [file exists $catalog_file_path] } {
+ set catalog_file_contents [lang::catalog::read_file $catalog_file_path]
+ array set catalog_array [lang::catalog::parse $catalog_file_contents]
+ array set messages_array [lindex [array get catalog_array messages] 1]
+ } else {
+ array set messages_array {}
+ }
+
+ # Keep track of how many message tags we have replaced (will be returned by this proc)
+ set number_of_replacements "0"
+
+ # Loop over and process each file
+ foreach file $file_list {
+ ns_log Notice "lang::util::replace_temporary_tags_with_lookups - processing file $file"
+
+ set full_file_path "[acs_root_dir]/$file"
+ regexp {\.([^.]+)$} $file match file_ending
+
+ # Attempt a backup of the file first. Do not overwrite an old backup file.
+ if { [catch "file -- copy $full_file_path \"${full_file_path}.orig\"" errmsg] } {
+ ns_log Warning [list lang::util::replace_temporary_tags_with_lookups - The file $full_file_path \
+ could not be backed up before message key extraction since backup file \
+ ${full_file_path}.orig already exists]
}
- set catalog_dir "[acs_root_dir]/packages/$package_key/catalog"
- if { [empty_string_p $catalog_file_path] } {
- set catalog_file_path "$catalog_dir/$package_key.en_US.ISO-8859-1.xml"
- }
- if { [file exists $catalog_file_path] } {
- set catalog_file_contents [lang::catalog::read_file $catalog_file_path]
- array set catalog_array [lang::catalog::parse $catalog_file_contents]
- array set messages_array [lindex [array get catalog_array messages] 1]
- } else {
- array set messages_array {}
- }
-
- # Keep track of how many message tags we have replaced (will be returned by this proc)
- set number_of_replacements "0"
-
- # Loop over and process each file
- foreach file $file_list {
- ns_log Notice "lang::util::replace_temporary_tags_with_lookups - processing file $file"
- set full_file_path "[acs_root_dir]/$file"
- regexp {\.([^.]+)$} $file match file_ending
-
- # Attempt a backup of the file first. Do not overwrite an old backup file.
- if { [catch "file -- copy $full_file_path \"${full_file_path}.orig\"" errmsg] } {
- ns_log Warning [list lang::util::replace_temporary_tags_with_lookups - The file $full_file_path \
- could not be backed up before message key extraction since backup file \
- ${full_file_path}.orig already exists]
- }
-
- # Read the contents of the file
- set file_contents [template::util::read_file $full_file_path]
+ # Read the contents of the file
+ set file_contents [template::util::read_file $full_file_path]
- set modified_file_contents $file_contents
-
- # Loop over each message tag in the file
- # Get the indices of the first and last char of the <#...#> text snippets
- set message_key_indices [lang::util::get_temporary_tags_indices $file_contents]
- foreach index_pair $message_key_indices {
-
- incr number_of_replacements
-
- set tag_start_idx [lindex $index_pair 0]
- set tag_end_idx [lindex $index_pair 1]
- set message_tag "[string range $file_contents $tag_start_idx $tag_end_idx]"
-
- # Extract the message key and the text from the message tag
- # The regexp on the message tag string should never fail as the message tag
- # was extracted with a known regexp
- if { ![regexp [message_tag_regexp] $message_tag full_match \
- message_tag message_key new_text] } {
+ set modified_file_contents $file_contents
- ns_log Error [list lang::util::replace_temporary_tags_with_lookups - could not extract message key \
- and text from the message tag $message_tag in file $file. This means there is a \
- mismatch with the regexp that extracted the message key.]
- continue
- }
+ # Loop over each message tag in the file
+ # Get the indices of the first and last char of the <#...#> text snippets
+ set message_key_indices [lang::util::get_temporary_tags_indices $file_contents]
+ foreach index_pair $message_key_indices {
- # if the message key is the _ symbol (an underscore) then automatically generate a key
- # based on the message text
- if { [string equal $message_key "_"] } {
- set message_key [suggest_key $new_text]
- }
+ incr number_of_replacements
- # If this is an adp file - replace adp variable syntax with percentage variables
- if { [string equal $file_ending "adp"] } {
- set new_text [convert_adp_variables_to_percentage_signs $new_text]
- }
+ set tag_start_idx [lindex $index_pair 0]
+ set tag_end_idx [lindex $index_pair 1]
+ set message_tag "[string range $file_contents $tag_start_idx $tag_end_idx]"
+
+ # Extract the message key and the text from the message tag
+ # The regexp on the message tag string should never fail as the message tag
+ # was extracted with a known regexp
+ if { ![regexp [message_tag_regexp] $message_tag full_match \
+ message_tag message_key new_text] } {
- # Check if the key already exists, if it does and texts differ - make key unique
- set key_comp_counter "0"
- set unique_key $message_key
- while { 1 } {
- set existing_text [lindex [array get messages_array $unique_key] 1]
+ ns_log Error [list lang::util::replace_temporary_tags_with_lookups - could not extract message key \
+ and text from the message tag $message_tag in file $file. This means there is a \
+ mismatch with the regexp that extracted the message key.]
+ continue
+ }
- if { ![empty_string_p $existing_text] } {
- # The key already exists
+ # if the message key is the _ symbol (an underscore) then automatically generate a key
+ # based on the message text
+ if { [string equal $message_key "_"] } {
+ set message_key [suggest_key $new_text]
+ }
- if { [string equal $existing_text $new_text] } {
- # New and old texts are identical - don't add the key
- ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - \
- message key $unique_key already exists in catalog \
- file with same value, will not add]
+ # If this is an adp file - replace adp variable syntax with percentage variables
+ if { [string equal $file_ending "adp"] } {
+ set new_text [convert_adp_variables_to_percentage_signs $new_text]
+ }
- # We are done
- break
- } else {
- # New and old texts differ, try to make the key unique and check again
- set unique_key "${message_key}_[expr ${key_comp_counter} + 1]"
- }
- } else {
- # The key is new - save it in the array for addition
+ # Check if the key already exists, if it does and texts differ - make key unique
+ set key_comp_counter "0"
+ set unique_key $message_key
+ while { 1 } {
+ set existing_text [lindex [array get messages_array $unique_key] 1]
- if { ![string equal $message_key $unique_key] } {
- # The message key had to be changed to be made unique
- ns_log Warning [list The message key $message_key was changed to $unique_key \
- to be made unique. If the value was mistyped and should have been \
- the same as previously then you must manually remove the entry for \
- $unique_key from the catalog file and change the key in \
- the file $file fom $unique_key to $message_key]
- } else {
- ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - Will be adding \
- new key $unique_key to catalog file for package $package_key]
- }
+ if { ![empty_string_p $existing_text] } {
+ # The key already exists
- set messages_array($unique_key) $new_text
+ if { [string equal $existing_text $new_text] } {
+ # New and old texts are identical - don't add the key
+ ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - \
+ message key $unique_key already exists in catalog \
+ file with same value, will not add]
# We are done
break
+ } else {
+ # New and old texts differ, try to make the key unique and check again
+ set unique_key "${message_key}_[expr ${key_comp_counter} + 1]"
}
-
- incr key_comp_counter
+ } else {
+ # The key is new - save it in the array for addition
+
+ if { ![string equal $message_key $unique_key] } {
+ # The message key had to be changed to be made unique
+ ns_log Warning [list The message key $message_key was changed to $unique_key \
+ to be made unique. If the value was mistyped and should have been \
+ the same as previously then you must manually remove the entry for \
+ $unique_key from the catalog file and change the key in \
+ the file $file fom $unique_key to $message_key]
+ } else {
+ ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - Will be adding \
+ new key $unique_key to catalog file for package $package_key]
+ }
+
+ set messages_array($unique_key) $new_text
+
+ # We are done
+ break
}
+
+ incr key_comp_counter
+ }
- # Replace the message tag with a message key lookup in the file
- switch -regexp -- $file_ending {
- {^(adp|sql)$} {
- regsub [message_tag_regexp] \
- $modified_file_contents \
- "#${package_key}.${unique_key}#" \
- modified_file_contents
- }
- {^tcl$} {
- regsub [message_tag_regexp] \
- $modified_file_contents \
- "\[_ ${package_key}.${unique_key}\]" \
- modified_file_contents
- }
- {.*} {
- error "Unknown ending $file_ending of file $file, aborting"
- }
+ # Replace the message tag with a message key lookup in the file
+ switch -regexp -- $file_ending {
+ {^(adp|sql)$} {
+ regsub [message_tag_regexp] \
+ $modified_file_contents \
+ "#${package_key}.${unique_key}#" \
+ modified_file_contents
+ }
+ {^tcl$} {
+ regsub [message_tag_regexp] \
+ $modified_file_contents \
+ "\[_ ${package_key}.${unique_key}\]" \
+ modified_file_contents
}
+ {.*} {
+ error "Unknown ending $file_ending of file $file, aborting"
+ }
}
-
- # Update the file with the replaced message keys
- set file_id [open "${full_file_path}" w]
- puts -nonewline $file_id $modified_file_contents
- close $file_id
}
- if { $number_of_replacements > 0 } {
- # Use the messages array to generate a new catalog file
- lang::catalog::export_messages_to_file $catalog_file_path [array get messages_array]
+ # Update the file with the replaced message keys
+ set file_id [open "${full_file_path}" w]
+ puts -nonewline $file_id $modified_file_contents
+ close $file_id
+ }
- # Register the messages in the database so that the new messages are immediately reflected
- # in the system
- foreach {message_key message_text} [array get messages_array] {
- lang::message::register en_US $package_key $message_key $message_text
- }
+ if { $number_of_replacements > 0 } {
+ # Use the messages array to generate a new catalog file
+ lang::catalog::export_messages_to_file $catalog_file_path [array get messages_array]
+
+ # Register the messages in the database so that the new messages are immediately reflected
+ # in the system
+ foreach {message_key message_text} [array get messages_array] {
+ lang::message::register en_US $package_key $message_key $message_text
}
-
- return $number_of_replacements
- }
+ }
- ad_proc -public localize {
- string_with_hashes
- } {
- Takes a string with embedded message keys on the format #message_key_name#
- and returns the same string but with the message keys (and their surrounding hash
- marks) replaced with the corresponding value in the message catalog. Message lookup
- is done with the locale of the request. If message lookup fails for a certain key
- then a translation missing message will be used instead.
+ return $number_of_replacements
+}
+
+ad_proc -public lang::util::localize {
+ string_with_hashes
+} {
+ Takes a string with embedded message keys on the format #message_key_name#
+ and returns the same string but with the message keys (and their surrounding hash
+ marks) replaced with the corresponding value in the message catalog. Message lookup
+ is done with the locale of the request. If message lookup fails for a certain key
+ then a translation missing message will be used instead.
+
+ @author Peter marklund (peter@collaboraid.biz)
+} {
+ set indices_list [get_hash_indices $string_with_hashes]
- @author Peter marklund (peter@collaboraid.biz)
- } {
- set indices_list [get_hash_indices $string_with_hashes]
+ set subst_string $string_with_hashes
+ foreach item_idx $indices_list {
+ # The replacement string starts and ends with a hash mark
+ set replacement_string [string range $string_with_hashes [lindex $item_idx 0] \
+ [lindex $item_idx 1]]
+ set message_key [string range $replacement_string 1 [expr [string length $replacement_string] - 2]]
- set subst_string $string_with_hashes
- foreach item_idx $indices_list {
- # The replacement string starts and ends with a hash mark
- set replacement_string [string range $string_with_hashes [lindex $item_idx 0] \
- [lindex $item_idx 1]]
- set message_key [string range $replacement_string 1 [expr [string length $replacement_string] - 2]]
-
- # Attempt a message lookup
- set message_value [_ $message_key]
-
- # Replace the string
- # LARS: We don't use regsub here, because regsub interprets certain characters
- # in the replacement string specially.
- set subst_string [string range $string_with_hashes 0 [expr [lindex $item_idx 0]-1]]
- append subst_string $message_value
- append subst_string [string range $string_with_hashes [expr [lindex $item_idx 1]+1] end]
- }
+ # Attempt a message lookup
+ set message_value [_ $message_key]
- return $subst_string
- }
+ # Replace the string
+ # LARS: We don't use regsub here, because regsub interprets certain characters
+ # in the replacement string specially.
+ set subst_string [string range $string_with_hashes 0 [expr [lindex $item_idx 0]-1]]
+ append subst_string $message_value
+ append subst_string [string range $string_with_hashes [expr [lindex $item_idx 1]+1] end]
+ }
+
+ return $subst_string
+}
- ad_proc -public charset_for_locale {
- locale
- } {
- Returns the MIME charset name corresponding to a locale.
+ad_proc -public lang::util::charset_for_locale {
+ locale
+} {
+ Returns the MIME charset name corresponding to a locale.
+
+ @author Henry Minsky (hqm@mit.edu)
+ @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 {}]
+}
+
+ad_proc -private lang::util::default_locale_from_lang_not_cached {
+ language
+} {
+ Returns the default locale for a language. Not cached.
- @author Henry Minsky (hqm@mit.edu)
- @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 {}]
- }
+ @author Henry Minsky (hqm@mit.edu)
+ @param language Name of a country, using ISO-3166 two letter code
+ @return Default locale
- ad_proc -public default_locale_from_lang {
- language
- } {
- Returns the default locale for a language
-
- @author Henry Minsky (hqm@mit.edu)
- @param language Name of a country, using ISO-3166 two letter code
- @return Default locale
- } {
- return [db_string default_locale_from_lang {}]
- }
+ @see lang::util::default_locale_from_lang
+} {
+ # LARS:
+ # Note that this query does not use bind variables, because these cause the query to not
+ # match any rows in Oracle when the language key is less than 3 characters,
+ # because the column is a char(3), not a varchar2(3).
+ return [db_string default_locale_from_lang {}]
+}
- ad_proc -public nls_language_from_language {
- language
- } {
- Returns the nls_language name for a language
+ad_proc -public lang::util::default_locale_from_lang {
+ language
+} {
+ Returns the default locale for a language
+
+ @author Henry Minsky (hqm@mit.edu)
+ @param language Name of a country, using ISO-3166 two letter code
+ @return Default locale
+} {
+ return [util_memoize [list lang::util::default_locale_from_lang_not_cached $language]]
+}
- @author Henry Minsky (hqm@mit.edu)
- @param language Name of a country, using ISO-3166 two letter code
- @return The nls_language name of the language.
- } {
- return [db_string nls_language_from_language {}]
- }
+ad_proc -public lang::util::nls_language_from_language {
+ language
+} {
+ Returns the nls_language name for a language
+ @author Henry Minsky (hqm@mit.edu)
+ @param language Name of a country, using ISO-3166 two letter code
+ @return The nls_language name of the language.
+} {
+ return [db_string nls_language_from_language {}]
+}
- ad_proc -private remove_gt_lt {
- s
- } {
- Removes < > and replaces them with < >
- } {
- regsub -all "<" $s {\<} s
- regsub -all ">" $s {\>} s
- return $s
- }
- ad_proc -private suggest_key {
- text
- } {
- Suggest a key for given text.
- } {
- regsub -all " " $text "_" key
-
- # Do not allow . in the key as dot is used as a separator to qualify a key
- # with the package key. The prepending with package key is done at a later
- # stage
- regsub -all {[^-a-zA-Z0-9_]} $key "" key
-
- # is this key too long?
-
- if { [string length $key] > 20 } {
- set key "lt_[string range $key 0 20]"
- }
- return $key
+ad_proc -private lang::util::remove_gt_lt {
+ s
+} {
+ Removes < > and replaces them with < >
+} {
+ regsub -all "<" $s {\<} s
+ regsub -all ">" $s {\>} s
+ return $s
+}
+
+ad_proc -private lang::util::suggest_key {
+ text
+} {
+ Suggest a key for given text.
+} {
+ regsub -all " " $text "_" key
+
+ # Do not allow . in the key as dot is used as a separator to qualify a key
+ # with the package key. The prepending with package key is done at a later
+ # stage
+ regsub -all {[^-a-zA-Z0-9_]} $key "" key
+
+ # is this key too long?
+
+ if { [string length $key] > 20 } {
+ set key "lt_[string range $key 0 20]"
}
+ return $key
+}
- ad_proc -private convert_adp_variables_to_percentage_signs { text } {
- Convert ADP variables to percentage_signs - the notation used to
- interpolate variable values into acs-lang messages.
+ad_proc -private lang::util::convert_adp_variables_to_percentage_signs { text } {
+ Convert ADP variables to percentage_signs - the notation used to
+ interpolate variable values into acs-lang messages.
- @author Peter Marklund
- } {
- # substitute array variable references
- # loop to handle the case of adjacent variable references, like @a@@b@
- while {[regsub -all [template::adp_array_variable_regexp] $text {\1%\2.\3%} text]} {}
+ @author Peter Marklund
+} {
+ # substitute array variable references
+ # loop to handle the case of adjacent variable references, like @a@@b@
+ while {[regsub -all [template::adp_array_variable_regexp] $text {\1%\2.\3%} text]} {}
- # substitute simple variable references
- while {[regsub -all [template::adp_variable_regexp] $text {\1%\2%} text]} {}
+ # substitute simple variable references
+ while {[regsub -all [template::adp_variable_regexp] $text {\1%\2%} text]} {}
- return $text
- }
+ return $text
+}
- ad_proc -public replace_adp_text_with_message_tags {
- file_name
- mode
- {keys {}}
-
- } {
- Prepares an .adp-file for localization by inserting temporary hash-tags
- around text strings that looks like unlocalized plain text. Needless to say
- this is a little shaky so not all plain text is caught and the script may insert
- hash-tags around stuff that should not be localized. It is conservative though.
+ad_proc -public lang::util::replace_adp_text_with_message_tags {
+ file_name
+ mode
+ {keys {}}
+
+} {
+ Prepares an .adp-file for localization by inserting temporary hash-tags
+ around text strings that looks like unlocalized plain text. Needless to say
+ this is a little shaky so not all plain text is caught and the script may insert
+ hash-tags around stuff that should not be localized. It is conservative though.
- There are two modes the script can be run in:
+ There are two modes the script can be run in:
- - report : do *not* write changes to the file but return a report with suggested changes.
+ - report : do *not* write changes to the file but return a report with suggested changes.
- - write : write changes in the file - it expects a list of keys and will insert them
- in the order implied by the report - a report is also returned.
+ - write : write changes in the file - it expects a list of keys and will insert them
+ in the order implied by the report - a report is also returned.
- @param file_name The name of the adp file to do replacements in.
- @param mode Either report or write.
- @param keys A list of keys to use for the texts that may be provided in write mode. If
- the keys are not provided then autogenerated keys will be used.
- If a supplied key is the empty string this indicates that the corresponding
- text should be left untouched.
+ @param file_name The name of the adp file to do replacements in.
+ @param mode Either report or write.
+ @param keys A list of keys to use for the texts that may be provided in write mode. If
+ the keys are not provided then autogenerated keys will be used.
+ If a supplied key is the empty string this indicates that the corresponding
+ text should be left untouched.
- @return The report is list of two lists: The first being a list of pairs (key, text with context)
- and the second is a list of suspious looking garbage. In report mode the keys are suggested
- keys and in write mode the keys are the keys supplied in the keys parameter.
+ @return The report is list of two lists: The first being a list of pairs (key, text with context)
+ and the second is a list of suspious looking garbage. In report mode the keys are suggested
+ keys and in write mode the keys are the keys supplied in the keys parameter.
- @author Christian Hvid
- @author Peter Marklund
- @author Jeff Davis
+ @author Christian Hvid
+ @author Peter Marklund
+ @author Jeff Davis
- } {
- set state text
- set out {}
+} {
+ set state text
+ set out {}
- set report [list]
- set garbage [list]
+ set report [list]
+ set garbage [list]
- set n 0
-
- # open file and read its content
+ set n 0
- set fp [open $file_name "r"]
- set s [read $fp]
- close $fp
+ # open file and read its content
- #ns_write "input== s=[string range $s 0 600]\n"
- set x {}
- while {![empty_string_p $s] && $n < 1000} {
- if { $state == "text" } {
-
- # clip non tag stuff
- if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} {
- set text $s
- set s {}
- }
+ set fp [open $file_name "r"]
+ set s [read $fp]
+ close $fp
- # Remove parts from the text that we know are not translatable
- # such as adp variables, message key lookups, and
- regsub -all {@[a-zA-Z0-9_\.]+@} $text "" translatable_remainder
- regsub -all {#[a-zA-Z0-9\._-]+#} $translatable_remainder "" translatable_remainder
- regsub -all { } $translatable_remainder "" translatable_remainder
+ #ns_write "input== s=[string range $s 0 600]\n"
+ set x {}
+ while {![empty_string_p $s] && $n < 1000} {
+ if { $state == "text" } {
- # Only consider the text translatable if the remainder contains
- # at least one letter
- if { [string match -nocase {*[A-Z]*} $translatable_remainder] } {
+ # clip non tag stuff
+ if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} {
+ set text $s
+ set s {}
+ }
- regexp {^(\s*)(.*?)(\s*)$} $text match lead text lag
+ # Remove parts from the text that we know are not translatable
+ # such as adp variables, message key lookups, and
+ regsub -all {@[a-zA-Z0-9_\.]+@} $text "" translatable_remainder
+ regsub -all {#[a-zA-Z0-9\._-]+#} $translatable_remainder "" translatable_remainder
+ regsub -all { } $translatable_remainder "" translatable_remainder
- if { $mode == "report" } {
- # create a key for the text
-
- set key [suggest_key $text]
+ # Only consider the text translatable if the remainder contains
+ # at least one letter
+ if { [string match -nocase {*[A-Z]*} $translatable_remainder] } {
- lappend report [list $key "[string range [remove_gt_lt $out$lead] end-20 end]$text[string range [remove_gt_lt $lag$s] 0 20]" ]
- } else {
- # Write mode
- if { [llength $keys] != 0} {
- # Use keys supplied
- if { [lindex $keys $n] != "" } {
- # Use supplied key
- set write_key [lindex $keys $n]
- } else {
- # The supplied key for this index is empty so leave the text untouched
- set write_key ""
- }
- } else {
- # No keys supplied - autogenerate a key
- set write_key [suggest_key $text]
- }
+ regexp {^(\s*)(.*?)(\s*)$} $text match lead text lag
- if { ![empty_string_p $write_key] } {
- # Write tag to file
- lappend report [list ${write_key} "[string range [remove_gt_lt $out$lead] end-20 end]$text[string range [remove_gt_lt $lag$s] 0 20]" ]
+ if { $mode == "report" } {
+ # create a key for the text
+
+ set key [suggest_key $text]
- append out "$lead<\#${write_key} $text\#>$lag"
+ lappend report [list $key "[string range [remove_gt_lt $out$lead] end-20 end]$text[string range [remove_gt_lt $lag$s] 0 20]" ]
+ } else {
+ # Write mode
+ if { [llength $keys] != 0} {
+ # Use keys supplied
+ if { [lindex $keys $n] != "" } {
+ # Use supplied key
+ set write_key [lindex $keys $n]
} else {
- # Leave the text untouched
- lappend garbage "[string range [remove_gt_lt $out$lead] end-20 end]$text [string range [remove_gt_lt $lag$s] 0 20]"
- append out "$lead$text$lag"
- }
+ # The supplied key for this index is empty so leave the text untouched
+ set write_key ""
+ }
+ } else {
+ # No keys supplied - autogenerate a key
+ set write_key [suggest_key $text]
}
- incr n
-
- } else {
- # this was not something we should localize
-
- append out $text
-
- # but this maybe something that should be localized by hand
-
- if { ![string match {*\#*} $text] && ![string is space $text] && [string match -nocase {*[A-Z]*} $text] && ![regexp {^\s*@[^@]+@\s*$} $text] } {
-
- # log a comment on it and make a short version of the text that is easier to read
-
- regsub -all "\n" $text "" short_text
-
- set short_text [string range $short_text 0 40]
-
- lappend garbage "$short_text"
+ if { ![empty_string_p $write_key] } {
+ # Write tag to file
+ lappend report [list ${write_key} "[string range [remove_gt_lt $out$lead] end-20 end]$text[string range [remove_gt_lt $lag$s] 0 20]" ]
- }
-
+ append out "$lead<\#${write_key} $text\#>$lag"
+ } else {
+ # Leave the text untouched
+ lappend garbage "[string range [remove_gt_lt $out$lead] end-20 end]$text [string range [remove_gt_lt $lag$s] 0 20]"
+ append out "$lead$text$lag"
+ }
}
- set state tag
-
- } elseif { $state == "tag"} {
- if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
- set s {}
- }
- append out $tag
- set state text
-
- }
- }
- if { $mode == "write" } {
- if { $n > 0 } {
- # backup original file - fail silently if backup already exists
+ incr n
- if { [catch {file copy -- $file_name $file_name.orig}] } { }
-
- set fp [open $file_name "w"]
- puts $fp $out
- close $fp
+ } else {
+ # this was not something we should localize
+
+ append out $text
+
+ # but this maybe something that should be localized by hand
+
+ if { ![string match {*\#*} $text] && ![string is space $text] && [string match -nocase {*[A-Z]*} $text] && ![regexp {^\s*@[^@]+@\s*$} $text] } {
+
+ # log a comment on it and make a short version of the text that is easier to read
+
+ regsub -all "\n" $text "" short_text
+
+ set short_text [string range $short_text 0 40]
+
+ lappend garbage "$short_text"
+
+ }
+
}
- }
+ set state tag
- return [list $report $garbage]
+ } elseif { $state == "tag"} {
+ if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
+ set s {}
+ }
+ append out $tag
+ set state text
+
+ }
}
- ad_proc -public translator_mode_p {} {
- Whether translator mode is enabled for this session or
- not. Translator mode will cause all non-translated messages to appear as a
- link to a page where the message can be translated, instead of the default
- "not translated" message.
-
- @author Lars Pind (lars@collaboraid.biz)
- @creation-date October 24, 2002
+ if { $mode == "write" } {
+ if { $n > 0 } {
+ # backup original file - fail silently if backup already exists
- @return 1 if translator mode is enabled, 0 otherwise. Returns 0 if there is
- no HTTP connection.
-
- @see lang::util::translator_mode_set
- } {
- global ad_conn
- if { [info exists ad_conn] } {
- # THere is an HTTP connection - return the client property
- return [ad_get_client_property -default 0 acs-lang translator_mode_p]
- } else {
- # No HTTP connection
- return 0
+ if { [catch {file copy -- $file_name $file_name.orig}] } { }
+
+ set fp [open $file_name "w"]
+ puts $fp $out
+ close $fp
}
}
+
+ return [list $report $garbage]
+}
+
+ad_proc -public lang::util::translator_mode_p {} {
+ Whether translator mode is enabled for this session or
+ not. Translator mode will cause all non-translated messages to appear as a
+ link to a page where the message can be translated, instead of the default
+ "not translated" message.
- ad_proc -public translator_mode_set {
- translator_mode_p
- } {
- Sets whether translator mode is enabled for this session or
- not.
-
- @author Lars Pind (lars@collaboraid.biz)
- @creation-date October 24, 2002
+ @author Lars Pind (lars@collaboraid.biz)
+ @creation-date October 24, 2002
- @param translator_mode_p 1 if you want translator mode to be enabled, 0 otherwise.
+ @return 1 if translator mode is enabled, 0 otherwise. Returns 0 if there is
+ no HTTP connection.
- @see lang::util::translator_mode_p
- } {
- ad_set_client_property acs-lang translator_mode_p $translator_mode_p
+ @see lang::util::translator_mode_set
+} {
+ global ad_conn
+ if { [info exists ad_conn] } {
+ # THere is an HTTP connection - return the client property
+ return [ad_get_client_property -default 0 acs-lang translator_mode_p]
+ } else {
+ # No HTTP connection
+ return 0
}
}
+
+ad_proc -public lang::util::translator_mode_set {
+ translator_mode_p
+} {
+ Sets whether translator mode is enabled for this session or
+ not.
+ @author Lars Pind (lars@collaboraid.biz)
+ @creation-date October 24, 2002
+ @param translator_mode_p 1 if you want translator mode to be enabled, 0 otherwise.
+ @see lang::util::translator_mode_p
+} {
+ ad_set_client_property acs-lang translator_mode_p $translator_mode_p
+}
+
+
+
#####
#
# Compatibility procs