|  | #!/bin/sh | 
|  | # Tcl ignores the next line -*- tcl -*- \ | 
|  | exec tclsh "$0" -- "$@" | 
|  |  | 
|  | # This is a really stupid program, which serves as an alternative to | 
|  | # msgfmt.  It _only_ translates to Tcl mode, does _not_ validate the | 
|  | # input, and does _not_ output any statistics. | 
|  |  | 
|  | proc u2a {s} { | 
|  | set res "" | 
|  | foreach i [split $s ""] { | 
|  | scan $i %c c | 
|  | if {$c<128} { | 
|  | # escape '[', '\', '$' and ']' | 
|  | if {$c == 0x5b || $c == 0x5d || $c == 0x24} { | 
|  | append res "\\" | 
|  | } | 
|  | append res $i | 
|  | } else { | 
|  | append res \\u[format %04.4x $c] | 
|  | } | 
|  | } | 
|  | return $res | 
|  | } | 
|  |  | 
|  | set output_directory "." | 
|  | set lang "dummy" | 
|  | set files [list] | 
|  | set show_statistics 0 | 
|  |  | 
|  | # parse options | 
|  | for {set i 0} {$i < $argc} {incr i} { | 
|  | set arg [lindex $argv $i] | 
|  | if {$arg == "--statistics"} { | 
|  | incr show_statistics | 
|  | continue | 
|  | } | 
|  | if {$arg == "--tcl"} { | 
|  | # we know | 
|  | continue | 
|  | } | 
|  | if {$arg == "-l"} { | 
|  | incr i | 
|  | set lang [lindex $argv $i] | 
|  | continue | 
|  | } | 
|  | if {$arg == "-d"} { | 
|  | incr i | 
|  | set tmp [lindex $argv $i] | 
|  | regsub "\[^/\]$" $tmp "&/" output_directory | 
|  | continue | 
|  | } | 
|  | lappend files $arg | 
|  | } | 
|  |  | 
|  | proc flush_msg {} { | 
|  | global msgid msgstr mode lang out fuzzy | 
|  | global translated_count fuzzy_count not_translated_count | 
|  |  | 
|  | if {![info exists msgid] || $mode == ""} { | 
|  | return | 
|  | } | 
|  | set mode "" | 
|  | if {$fuzzy == 1} { | 
|  | incr fuzzy_count | 
|  | set fuzzy 0 | 
|  | return | 
|  | } | 
|  |  | 
|  | if {$msgid == ""} { | 
|  | set prefix "set ::msgcat::header" | 
|  | } else { | 
|  | if {$msgstr == ""} { | 
|  | incr not_translated_count | 
|  | return | 
|  | } | 
|  | set prefix "::msgcat::mcset $lang \"[u2a $msgid]\"" | 
|  | incr translated_count | 
|  | } | 
|  |  | 
|  | puts $out "$prefix \"[u2a $msgstr]\"" | 
|  | } | 
|  |  | 
|  | set fuzzy 0 | 
|  | set translated_count 0 | 
|  | set fuzzy_count 0 | 
|  | set not_translated_count 0 | 
|  | foreach file $files { | 
|  | regsub "^.*/\(\[^/\]*\)\.po$" $file "$output_directory\\1.msg" outfile | 
|  | set in [open $file "r"] | 
|  | fconfigure $in -encoding utf-8 | 
|  | set out [open $outfile "w"] | 
|  |  | 
|  | set mode "" | 
|  | while {[gets $in line] >= 0} { | 
|  | if {[regexp "^#" $line]} { | 
|  | if {[regexp ", fuzzy" $line]} { | 
|  | set fuzzy 1 | 
|  | } else { | 
|  | flush_msg | 
|  | } | 
|  | continue | 
|  | } elseif {[regexp "^msgid \"(.*)\"$" $line dummy match]} { | 
|  | flush_msg | 
|  | set msgid $match | 
|  | set mode "msgid" | 
|  | } elseif {[regexp "^msgstr \"(.*)\"$" $line dummy match]} { | 
|  | set msgstr $match | 
|  | set mode "msgstr" | 
|  | } elseif {$line == ""} { | 
|  | flush_msg | 
|  | } elseif {[regexp "^\"(.*)\"$" $line dummy match]} { | 
|  | if {$mode == "msgid"} { | 
|  | append msgid $match | 
|  | } elseif {$mode == "msgstr"} { | 
|  | append msgstr $match | 
|  | } else { | 
|  | puts stderr "I do not know what to do: $match" | 
|  | } | 
|  | } else { | 
|  | puts stderr "Cannot handle $line" | 
|  | } | 
|  | } | 
|  | flush_msg | 
|  | close $in | 
|  | close $out | 
|  | } | 
|  |  | 
|  | if {$show_statistics} { | 
|  | set str "" | 
|  |  | 
|  | append str  "$translated_count translated message" | 
|  | if {$translated_count != 1} { | 
|  | append str s | 
|  | } | 
|  |  | 
|  | if {$fuzzy_count > 1} { | 
|  | append str  ", $fuzzy_count fuzzy translation" | 
|  | if {$fuzzy_count != 1} { | 
|  | append str s | 
|  | } | 
|  | } | 
|  | if {$not_translated_count > 0} { | 
|  | append str  ", $not_translated_count untranslated message" | 
|  | if {$not_translated_count != 1} { | 
|  | append str s | 
|  | } | 
|  | } | 
|  |  | 
|  | append str  . | 
|  | puts $str | 
|  | } |