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 &nbsp;
            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 {&nbsp;} $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