lang::util::replace_adp_text_with_message_tags (public)
lang::util::replace_adp_text_with_message_tags file_name mode [ keys ]
Defined in packages/acs-lang/tcl/lang-util-procs.tcl
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: - 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.
- Parameters:
- file_name - The name of the adp file to do replacements in.
mode - Either report or write.
keys (optional) - 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.
- Returns:
- 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.
- Authors:
- Christian Hvid
- Peter Marklund
- Jeff Davis
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- util__replace_adp_text_with_message_tags
Source code: set state text set out {} set report [list] set garbage [list] set n 0 # open file and read its content set fp [open $file_name "r"] set s [read $fp] close $fp #ns_write "input== s=[string range $s 0 600]\n" set x {} while {$s ne "" && $n < 1000} { if { $state eq "text" } { # clip non tag stuff 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 set translatable_remainder $text set adp_var_patterns [list [template::adp_array_variable_regexp] [template::adp_array_variable_regexp_noquote] [template::adp_variable_regexp] [template::adp_variable_regexp_noquote]] foreach adp_var_pattern $adp_var_patterns { regsub -all $adp_var_pattern $translatable_remainder "" translatable_remainder } regsub -all {#[a-zA-Z0-9\._-]+#} $translatable_remainder "" translatable_remainder regsub -all { } $translatable_remainder "" translatable_remainder # Only consider the text translatable if the remainder contains # at least one letter if { [string match -nocase {*[A-Z]*} $translatable_remainder] } { regexp {^(\s*)(.*?)(\s*)$} $text match lead text lag if { $mode eq "report" } { # create a key for the text set key [suggest_key $text] lappend report [list $key "<code>[string range [remove_gt_lt $out$lead] end-20 end]<b><span style=\"background:yellow\">$text</span></b>[string range [remove_gt_lt $lag$s] 0 20]</code>" ] } else { # Write mode if { [llength $keys] != 0} { # Use keys supplied if { [lindex $keys $n] ne "" } { # 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] } if { $write_key ne "" } { # Write tag to file lappend report [list ${write_key} "<code>[string range [remove_gt_lt $out$lead] end-20 end]<b><span style=\"background:yellow\">$text</span></b>[string range [remove_gt_lt $lag$s] 0 20]</code>" ] append out "$lead<\#${write_key} $text\#>$lag" } else { # Leave the text untouched lappend garbage "<code>[string range [remove_gt_lt $out$lead] end-20 end]<b><span style=\"background:yellow\">$text </span></b>[string range [remove_gt_lt $lag$s] 0 20]</code>" append out "$lead$text$lag" } } 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 "<code>$short_text</code>" } } set state tag } elseif { $state eq "tag"} { if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} { set s {} } append out $tag set state text } } if { $mode eq "write" } { if { $n > 0 } { # 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 } } return [list $report $garbage]XQL Not present: PostgreSQL, Oracle Generic XQL file: packages/acs-lang/tcl/lang-util-procs.xql