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.52 -r1.53 --- openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 25 Apr 2018 19:23:25 -0000 1.52 +++ openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 8 May 2018 22:37:18 -0000 1.53 @@ -20,42 +20,42 @@ namespace eval lang::util {} ad_proc -public lang::util::lang_sort { - field + 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');  
+    insert into lang_testsort values ('lzim');
@author Jeff Davis (davis@xarg.net) @param field Name of Oracle column - @param locale Locale for sorting. + @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 + # 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" - + set lang(fr) "XFrench" + set lang(es) "XSpanish" + if { $locale eq "" || ![info exists lang($locale)] } { return $field - } else { + } else { return "NLSSORT($field,'NLS_SORT = $lang($locale)')" } } ad_proc -private lang::util::get_hash_indices { multilingual_string } { - Returns a list of two element lists containing + 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. @@ -88,15 +88,15 @@ 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#> + <#package_key.message_key Some en_US text#> - @author Peter marklund (peter@collaboraid.biz) + @author Peter marklund (peter@collaboraid.biz) } { return [lang::util::get_regexp_indices $adp_file_string [message_tag_regexp]] } - + ad_proc -private lang::util::get_regexp_indices { multilingual_string regexp_pattern } { - Returns a list of two element lists containing + 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. @@ -112,33 +112,32 @@ set offset_string $multilingual_string set indices_list {} - 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] + while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } { + lassign $key_match_idx start_idx end_idx + 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] } - + return $indices_list -} +} -ad_proc lang::util::replace_temporary_tags_with_lookups { - file_list +ad_proc lang::util::replace_temporary_tags_with_lookups { + file_list } { Modify the given ADP or Tcl files by replacing occurencies of message keys 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 + 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 file_list A list of paths to adp or Tcl files to do replacements in. The @@ -154,21 +153,21 @@ } # Get package_key - set first_file [lindex $file_list 0] + 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" } # Always create new keys in en_US set locale "en_US" - + # Read messages from any existing catalog file set catalog_file_path [lang::catalog::get_catalog_file_path \ -package_key $package_key \ -locale $locale] 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 catalog_array [lang::catalog::parse $catalog_file_contents] array set messages_array $catalog_array(messages) } else { array set messages_array {} @@ -178,7 +177,7 @@ set number_of_replacements "0" # Loop over and process each file - foreach file $file_list { + foreach file $file_list { ns_log debug "lang::util::replace_temporary_tags_with_lookups: processing file $file" set full_file_path "$::acs::rootdir/$file" @@ -201,10 +200,9 @@ incr number_of_replacements - set tag_start_idx [lindex $index_pair 0] - set tag_end_idx [lindex $index_pair 1] + lassign $index_pair tag_start_idx tag_end_idx 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 @@ -235,7 +233,7 @@ if { [info exists messages_array($unique_key)] } { # The key already exists - + if {$messages_array($unique_key) eq $new_text} { # New and old texts are identical - don't add the key ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - \ @@ -262,14 +260,14 @@ } 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 } @@ -280,7 +278,7 @@ $modified_file_contents \ "#${package_key}.${unique_key}#" \ modified_file_contents - } + } {^tcl$} { regsub [message_tag_regexp] \ $modified_file_contents \ @@ -311,7 +309,7 @@ } return $number_of_replacements -} +} ad_proc -public lang::util::localize { string_with_hashes @@ -330,12 +328,12 @@ return $string_with_hashes } - if {$locale eq ""} { - set locale [ad_conn locale] - } + if {$locale eq ""} { + set locale [ad_conn locale] + } set indices_list [get_hash_indices $string_with_hashes] - + set subst_string "" set start_idx 0 foreach item_idx $indices_list { @@ -346,23 +344,23 @@ # Attempt a message lookup set message_value [lang::message::lookup $locale $message_key "" "" 2] - + # Replace the string # LARS: We don't use regsub here, because regsub interprets certain characters # in the replacement string specially. append subst_string [string range $string_with_hashes $start_idx [lindex $item_idx 0]-1] append subst_string $message_value set start_idx [expr {[lindex $item_idx 1] + 1}] - } + } append subst_string [string range $string_with_hashes $start_idx end] - + return $subst_string } -ad_proc -public lang::util::charset_for_locale { - locale +ad_proc -public lang::util::charset_for_locale { + locale } { Returns the MIME charset name corresponding to a locale. @@ -376,25 +374,25 @@ set $key [db_string -cache_key ad_lang_mime_charset_$locale charset_for_locale {}] } -ad_proc -private lang::util::default_locale_from_lang_not_cached { +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 language Name of a language, using a two or three letter ISO code @return Default locale - + @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, + # 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 {} -default ""] } -ad_proc -public lang::util::default_locale_from_lang { +ad_proc -public lang::util::default_locale_from_lang { language } { Returns an enabled default locale for a language. If a language @@ -408,8 +406,8 @@ return [util_memoize [list lang::util::default_locale_from_lang_not_cached $language]] } -ad_proc -public lang::util::nls_language_from_language { - language +ad_proc -public lang::util::nls_language_from_language { + language } { Returns the nls_language name for a language @@ -437,14 +435,14 @@ 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]" } @@ -466,7 +464,7 @@ while {[regsub -all [template::adp_variable_regexp] $text {\1%\2%} text]} {} while {[regsub -all [template::adp_variable_regexp_noquote] $text {\1%\2;noquote%} text]} {} - return $text + return $text } ad_proc -private lang::util::convert_percentage_signs_to_adp_variables { text } { @@ -492,11 +490,11 @@ return $text } -ad_proc -public lang::util::replace_adp_text_with_message_tags { +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 @@ -526,7 +524,7 @@ @author Jeff Davis } { - set state text + set state text set out {} set report {} @@ -542,14 +540,14 @@ #ns_write "input== s=[string range $s 0 600]\n" set x {} - while {$s ne "" && $n < 1000} { - if { $state eq "text" } { + while {$s ne "" && $n < 1000} { + if { $state eq "text" } { # clip non tag stuff - if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} { + if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} { set text $s set s {} - } + } # Remove parts from the text that we know are not translatable # such as adp variables, message key lookups, and   @@ -572,14 +570,14 @@ if { $mode eq "report" } { # create a key for the text - + set key [suggest_key $text] 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 { + } else { # Write mode if { [llength $keys] != 0} { - # Use keys supplied + # Use keys supplied if { [lindex $keys $n] ne "" } { # Use supplied key set write_key [lindex $keys $n] @@ -589,7 +587,7 @@ } } else { # No keys supplied - autogenerate a key - set write_key [suggest_key $text] + set write_key [suggest_key $text] } if { $write_key ne "" } { @@ -601,12 +599,12 @@ # 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" - } + } } incr n - } else { + } else { # this was not something we should localize append out $text @@ -620,18 +618,18 @@ regsub -all "\n" $text "" short_text set short_text [string range $short_text 0 40] - + lappend garbage "$short_text" } } - set state tag + set state tag - } elseif { $state eq "tag"} { - if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} { + } elseif { $state eq "tag"} { + if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} { set s {} - } + } append out $tag set state text @@ -643,7 +641,7 @@ # backup original file - fail silently if backup already exists if { [catch {file copy -- $file_name $file_name.orig}] } { } - + set fp [open $file_name "w"] puts $fp $out close $fp @@ -655,10 +653,10 @@ 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 + 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 @@ -790,14 +788,14 @@ } else { set message_key "${prefix}_[lang::util::suggest_key $text]" } - } - + } + # Register the language keys lang::message::register en_US $package_key $message_key $text if {$locale ne ""} { lang::message::register $locale $package_key $message_key $text } - + return "#${package_key}.${message_key}#" } else { return "$text" @@ -850,7 +848,7 @@ return $edit_url } -ad_proc -public lang::util::iso6392_from_language { +ad_proc -public lang::util::iso6392_from_language { -language:required } { @@ -871,14 +869,14 @@ } elseif { $lang_len eq 3 } { # input is iso-639-2 language code # we check in the table in case the language code is wrong - + set iso6392_code [db_string get_iso2_code_from_iso2 {} -default ""] } return $iso6392_code } -ad_proc -public lang::util::iso6392_from_locale { +ad_proc -public lang::util::iso6392_from_locale { -locale:required } { @@ -894,7 +892,7 @@ return [lang::util::iso6392_from_language -language $language] } -ad_proc -public lang::util::language_label { +ad_proc -public lang::util::language_label { -language:required } { @@ -915,7 +913,7 @@ } elseif { $lang_len eq 3 } { # input is iso-639-2 language code # we check in the table in case the language code is wrong - + set lang_label [db_string get_label_from_iso2 {} -default ""] }