TKE  3.6
Advanced code editor for programmers
lang Namespace Reference

Functions

 gather_msgcat
 
 fetch_lang lang
 
 update_xlates
 
 write_en
 
 write_lang lang
 
 create_ui
 
 edit_end_command tbl row col value
 
 populate_ui auto lang
 
 show_hide_xlate row
 
 show_hide_xlates
 
 perform_translation row lang
 
 perform_translations lang
 
 perform_retranslation row lang
 
 perform_retranslations lang
 
 perform_untranslations lang
 
 update_langs auto langs
 

Function Documentation

§ create_ui()

lang::create_ui

Definition at line 232 of file lang.tcl.

232  proc create_ui {} {
233 
234  variable widgets
235 
236  wm geometry . 800x600
237 
238  # Force the window to exit if the close button is clicked
239  wm protocol . WM_DELETE_WINDOW {
240  exit
241  }
242 
243  ttk::frame .tf
244  set widgets(tbl) [tablelist::tablelist .tf.tl -columns {0 {} 0 String 0 Translation 0 Re-translation 0 {}} \
245  -editselectedonly 1 -selectmode extended -exportselection 0 -stretch all \
246  -editendcommand "lang::edit_end_command" \
247  -yscrollcommand ".tf.vb set"]
248  ttk::scrollbar .tf.vb -orient vertical -command ".tf.tl yview"
249 
250  foreach {key value} [array get ::tablelistopts] {
251  .tf.tl configure -$key $value
252  }
253 
254  .tf.tl columnconfigure 0 -name num -editable 0 -resizable 0 -stretchable 0 -showlinenumbers 1
255  .tf.tl columnconfigure 1 -name str -editable 0 -stretchable 1 -maxwidth -400
256  .tf.tl columnconfigure 2 -name xlate -editable 1 -stretchable 1 -maxwidth -400
257  .tf.tl columnconfigure 3 -name rexlate -editable 0 -stretchable 1 -maxwidth -400
258  .tf.tl columnconfigure 4 -name src -editable 0 -hide 1
259 
260  grid rowconfigure .tf 0 -weight 1
261  grid columnconfigure .tf 0 -weight 1
262  grid .tf.tl -row 0 -column 0 -sticky news
263  grid .tf.vb -row 0 -column 1 -sticky ns
264 
265  ttk::frame .bf
266  set widgets(xlate) [ttk::button .bf.xlate -text "Add Translations"]
267  set widgets(rexlate) [ttk::button .bf.rexlate -text "Reverse translate"]
268  set widgets(unxlate) [ttk::button .bf.unxlate -text "Use English"]
269  set widgets(hide) [ttk::checkbutton .bf.hide -text "Hide translated" -variable lang::hide_xlates \
270  -command "lang::show_hide_xlates"]
271  set widgets(update) [ttk::button .bf.upd -text "Update" -width 6 -command "set ::update_lang 1; set ::update_done 1"]
272  ttk::button .bf.cancel -text "Cancel" -width 6 -command "set ::update_done 1"
273 
274  pack .bf.xlate -side left -padx 2 -pady 2
275  pack .bf.rexlate -side left -padx 2 -pady 2
276  pack .bf.unxlate -side left -padx 2 -pady 2
277  pack .bf.hide -side left -padx 2 -pady 2
278  pack .bf.cancel -side right -padx 2 -pady 2
279  pack .bf.upd -side right -padx 2 -pady 2
280 
281  pack .tf -fill both -expand yes
282  pack .bf -fill x
283 
284  }

§ edit_end_command()

lang::edit_end_command   tbl row col value  

Definition at line 288 of file lang.tcl.

288  proc edit_end_command {tbl row col value} {
289 
290  # Handle the show/hide status of the row
291  if {$value ne ""} {
292  after idle [list lang::show_hide_xlate $row]
293  }
294 
295  return $value
296 
297  }

§ fetch_lang()

lang::fetch_lang   lang  

Definition at line 106 of file lang.tcl.

106  proc fetch_lang {lang} {
107 
108  variable xlates
109 
110  # Clear the xlates array
111  array unset xlates
112 
113  if {![catch "open [file join $::tke_dir data msgs $lang.msg] r" rc]} {
114 
115  # Read the file contents and close the file
116  set contents [read $rc]
117  close $rc
118 
119  # Parse the file
120  foreach line [split $contents \n] {
121  set line [string trim $line]
122  if {[regexp {^#\s+(\S+)} $line -> fn]} {
123  set fname $fn
124  } elseif {[regexp {msgcat::mcmset} $line]} {
125  set mcmset 1
126  set xlate [list]
127  } elseif {$mcmset} {
128  if {[string index $line 0] eq "\}"} {
129  foreach {me other} $xlate {
130  set xlates($me) [list $fname $other]
131  }
132  set mcmset 0
133  } elseif {$line ne ""} {
134  lappend xlate [string range $line 1 end-1]
135  }
136  }
137  }
138 
139  }
140 
141  # Update the xlates array
143 
144  }

§ gather_msgcat()

lang::gather_msgcat

Definition at line 59 of file lang.tcl.

59  proc gather_msgcat {} {
60 
61  variable phrases
62  variable notes
63 
64  foreach src [glob -directory [file join $::tke_dir lib] *.tcl] {
65 
66  if {![catch "open $src r" rc]} {
67 
68  # Read the contents of the file and close the file
69  set contents [read $rc]
70  close $rc
71 
72  # Look for a note that we will append to the filename in the generated files
73  if {[regexp {msgcat::note\s+([^\n]+)} $contents -> note]} {
74  set notes($src) $note
75  }
76 
77  # Store all of the found msgcat::mc calls in the phrases array
78  set start 0
79  while {[regexp -indices -start $start {msgcat::mc\s+\"([^\"]+)\"} $contents -> phrase_index]} {
80  if {[string index $contents [lindex $phrase_index 1]] eq "\\"} {
81  puts "ERROR: Found a translatable string that contains an embedded doublequote character"
82  puts " File: $src, line: [llength [split [string range $contents 0 [lindex $phrase_index 1]] \n]]"
83  exit 1
84  }
85  set phrase [string range $contents {*}$phrase_index]
86  if {[info exists phrases($phrase)]} {
87  if {[lindex $phrases($phrase) 0] ne $src} {
88  set phrases($phrase) [list General [expr [lindex $phrases($phrase) 1] + 1]]
89  } else {
90  set phrases($phrase) [list $src [expr [lindex $phrases($phrase) 1] + 1]]
91  }
92  } else {
93  set phrases($phrase) [list $src 1]
94  }
95  set start [lindex $phrase_index 1]
96  }
97 
98  }
99 
100  }
101 
102  }

§ perform_retranslation()

lang::perform_retranslation   row lang  

Definition at line 473 of file lang.tcl.

473  proc perform_retranslation {row lang} {
474 
475  variable widgets
476 
477  # Prepare the search string for URL usage
478  set str2xlate [$widgets(tbl) cellcget $row,xlate -text]
479  set str [http::formatQuery q $str2xlate]
480  set str "https://mymemory.translated.net/api/get?$str&langpair=$lang|en&de=phase1geo@gmail.com"
481 
482  # Perform http request
483  set token [http::geturl $str -strict 0]
484 
485  # Get the data returned from the request
486  if {[http::status $token] eq "ok"} {
487  set data [http::data $token]
488  if {[regexp {translatedText\":\"([^\"]+)\"} $data -> ttext]} {
489  if {[string compare -length 17 "MYMEMORY WARNING:" $ttext] == 0} {
490  http::cleanup $token
491  return -code error "Row: $row, $ttext"
492  }
493  if {([string first "??" $ttext] != -1)} {
494  set xlated $str2xlate
495  } else {
496  set xlated [subst [string map {{[} {\[} {]} {\]}} $ttext]]
497  }
498  $widgets(tbl) cellconfigure $row,rexlate -text [string trim $xlated]
499  if {[string map {{ } {}} [string tolower $xlated]] ne [string map {{ } {}} [string tolower [$widgets(tbl) cellcget $row,str -text]]]} {
500  $widgets(tbl) cellconfigure $row,rexlate -background red -foreground white
501  }
502  $widgets(tbl) see $row
503  }
504  }
505 
506  # Cleanup request
507  http::cleanup $token
508 
509  }

§ perform_retranslations()

lang::perform_retranslations   lang  

Definition at line 513 of file lang.tcl.

513  proc perform_retranslations {lang} {
514 
515  variable widgets
516 
517  # Disable the "Add Translations" button from being clicked again
518  $widgets(xlate) configure -state disabled
519  $widgets(rexlate) configure -state disabled
520  $widgets(unxlate) configure -state disabled
521  $widgets(update) configure -state disabled
522 
523  # Get any selected rows
524  set selected [$widgets(tbl) curselection]
525 
526  if {[catch {
527  if {[llength $selected] > 0} {
528  foreach row $selected {
529  perform_retranslation $row $lang
530  }
531  } else {
532  for {set i 0} {$i < [$widgets(tbl) size]} {incr i} {
533  set str [$widgets(tbl) cellcget $i,str -text]
534  set rexlate [$widgets(tbl) cellcget $i,rexlate -text]
535  if {($rexlate eq "") || ([string first "??" $rexlate] != -1)} {
536  perform_retranslation $i $lang
537  }
538  }
539  }
540  } rc]} {
541  tk_messageBox -parent . -default ok -message "Re-translation error" -detail $rc -type ok
542  }
543 
544  # Enable the 'Add Translations' button
545  $widgets(xlate) configure -state normal
546  $widgets(rexlate) configure -state normal
547  $widgets(unxlate) configure -state normal
548  $widgets(update) configure -state normal
549 
550  }

§ perform_translation()

lang::perform_translation   row lang  

Definition at line 393 of file lang.tcl.

393  proc perform_translation {row lang} {
394 
395  variable widgets
396 
397  # Prepare the search string for URL usage
398  set str2xlate [$widgets(tbl) cellcget $row,str -text]
399  set str [http::formatQuery q $str2xlate]
400  set str "https://mymemory.translated.net/api/get?$str&langpair=en|$lang&de=phase1geo@gmail.com"
401 
402  # Perform http request
403  set token [http::geturl $str -strict 0]
404 
405  # Get the data returned from the request
406  if {[http::status $token] eq "ok"} {
407  set data [http::data $token]
408  if {[regexp {translatedText\":\"([^\"]+)\"} $data -> ttext]} {
409  if {[string compare -length 17 "MYMEMORY WARNING:" $ttext] == 0} {
410  http::cleanup $token
411  return -code error "Row: $row, $ttext"
412  }
413  if {([string first "??" $ttext] != -1)} {
414  set xlated $str2xlate
415  } else {
416  set xlated [subst [string map {{[} {\[} {]} {\]}} $ttext]]
417  }
418  $widgets(tbl) cellconfigure $row,xlate -text [string trim $xlated]
419  $widgets(tbl) see $row
420  show_hide_xlate $row
421  }
422  }
423 
424  # Cleanup request
425  http::cleanup $token
426 
427  }

§ perform_translations()

lang::perform_translations   lang  

Definition at line 431 of file lang.tcl.

431  proc perform_translations {lang} {
432 
433  variable widgets
434 
435  # Disable the "Add Translations" button from being clicked again
436  $widgets(xlate) configure -state disabled
437  $widgets(rexlate) configure -state disabled
438  $widgets(unxlate) configure -state disabled
439  $widgets(update) configure -state disabled
440 
441  # Get any selected rows
442  set selected [$widgets(tbl) curselection]
443 
444  if {[catch {
445  if {[llength $selected] > 0} {
446  foreach row $selected {
447  perform_translation $row $lang
448  }
449  } else {
450  for {set i 0} {$i < [$widgets(tbl) size]} {incr i} {
451  set str [$widgets(tbl) cellcget $i,str -text]
452  set xlate [$widgets(tbl) cellcget $i,xlate -text]
453  if {($xlate eq "") || ([string first "??" $xlate] != -1)} {
454  perform_translation $i $lang
455  }
456  }
457  }
458  } rc]} {
459  tk_messageBox -parent . -default ok -message "Translation error" -detail $rc -type ok
460  }
461 
462  # Enable the 'Add Translations' button
463  $widgets(xlate) configure -state normal
464  $widgets(rexlate) configure -state normal
465  $widgets(unxlate) configure -state normal
466  $widgets(update) configure -state normal
467 
468  }

§ perform_untranslations()

lang::perform_untranslations   lang  

Definition at line 554 of file lang.tcl.

554  proc perform_untranslations {lang} {
555 
556  variable widgets
557 
558  foreach row [$widgets(tbl) curselection] {
559  $widgets(tbl) cellconfigure $row,xlate -text [$widgets(tbl) cellcget $row,str -text]
560  $widgets(tbl) cellconfigure $row,rexlate -text "" -background "" -foreground ""
561  }
562 
563  }

§ populate_ui()

lang::populate_ui   auto lang  

Definition at line 301 of file lang.tcl.

301  proc populate_ui {auto lang} {
302 
303  variable widgets
304  variable xlates
305 
306  wm title . "Translations for $lang"
307  wm geometry . 1000x800
308 
309  # Clear the table
310  $widgets(tbl) delete 0 end
311 
312  # Populate the table
313  set xlate_list [list]
314  foreach xlate [lsort [array names xlates]] {
315  lappend xlate_list [list "" $xlate [lindex $xlates($xlate) 1] [list] [lindex $xlates($xlate) 0]]
316  }
317  $widgets(tbl) insertlist end $xlate_list
318 
319  # Ready the UI for translation
320  set ::update_lang 0
321  set ::update_done 0
322 
323  # Setup the translations button
324  $widgets(xlate) configure -command "lang::perform_translations $lang"
325  $widgets(rexlate) configure -command "lang::perform_retranslations $lang"
326  $widgets(unxlate) configure -command "lang::perform_untranslations $lang"
327 
328  if {$auto} {
329 
330  # Specify that we want to hide the translated rows
331  set lang::hide_xlates 1
332 
333  # Only show the lines that need to be translated
335 
336  # Perform the translation
338 
339  # Specify that the language was updated (if we were not cancellled)
340  if {!$::update_done} {
341  set ::update_lang 1
342  }
343 
344  } else {
345 
346  # Wait for the user to Update or Cancel the window
347  vwait ::update_done
348 
349  # Make sure any edited cells are in the not edit mode
350  $widgets(tbl) finishediting
351 
352  }
353 
354  # If we need to write the language file, do so now
355  if {$::update_lang} {
356  write_lang $lang
357  }
358 
359  return $::update_lang
360 
361  }

§ show_hide_xlate()

lang::show_hide_xlate   row  

Definition at line 365 of file lang.tcl.

365  proc show_hide_xlate {row} {
366 
367  variable widgets
368  variable hide_xlates
369 
370  if {[$widgets(tbl) cellcget $row,xlate -text] ne ""} {
371  $widgets(tbl) rowconfigure $row -hide $hide_xlates
372  $widgets(tbl) selection clear $row
373  }
374 
375  }

§ show_hide_xlates()

lang::show_hide_xlates

Definition at line 379 of file lang.tcl.

379  proc show_hide_xlates {} {
380 
381  variable widgets
382  variable hide_xlates
383 
384  for {set i 0} {$i < [$widgets(tbl) size]} {incr i} {
385  show_hide_xlate $i
386  }
387 
388  }

§ update_langs()

lang::update_langs   auto langs  

Definition at line 567 of file lang.tcl.

567  proc update_langs {auto langs} {
568 
569  variable xlates
570 
571  # Read the current msgcat information from the source files
573 
574  # For each language, perform the update
575  foreach lang $langs {
576 
577  if {$lang eq "en"} {
578 
579  write_en
580 
581  } else {
582 
583  # Read in the language, if it exists
584  fetch_lang $lang
585 
586  # Update the UI with the current language information
587  if {[populate_ui $auto $lang] == 0} {
588  break
589  }
590 
591  }
592 
593  }
594 
595  # When we are done, exit
596  exit
597 
598  }

§ update_xlates()

lang::update_xlates

Definition at line 150 of file lang.tcl.

150  proc update_xlates {} {
151 
152  variable phrases
153  variable xlates
154 
155  array set others [array get xlates]
156  array unset xlates
157 
158  foreach str [array names phrases] {
159  if {[info exists others($str)]} {
160  set xlates($str) [list [lindex $phrases($str) 0] [lindex $others($str) 1]]
161  } else {
162  set xlates($str) [list [lindex $phrases($str) 0] ""]
163  }
164  }
165 
166  }

§ write_en()

lang::write_en

Definition at line 170 of file lang.tcl.

170  proc write_en {} {
171 
172  variable phrases
173 
174  if {![catch "open [file join $::tke_dir data msgs en.msg] w" rc]} {
175 
176  puts $rc "msgcat::mcmset en \{\n"
177  foreach phrase [array names phrases] {
178  puts $rc " \"$phrase\""
179  puts $rc " \"$phrase\"\n"
180  }
181  puts $rc "\}\n"
182 
183  close $rc
184 
185  }
186 
187  }

§ write_lang()

lang::write_lang   lang  

Definition at line 192 of file lang.tcl.

192  proc write_lang {lang} {
193 
194  variable widgets
195  variable notes
196 
197  if {![catch "open [file join $::tke_dir data msgs $lang.msg] w" rc]} {
198 
199  # Organize the strings by file
200  for {set i 0} {$i < [$widgets(tbl) size]} {incr i} {
201  if {[set xlate [$widgets(tbl) cellcget $i,xlate -text]] ne ""} {
202  lappend srcs([$widgets(tbl) cellcget $i,src -text]) [list [$widgets(tbl) cellcget $i,str -text] $xlate]
203  }
204  }
205 
206  # Output to the file by source file
207  foreach src [lsort [array names srcs]] {
208 
209  # Figure out the note to attach
210  set note [expr {[info exists notes($src)] ? " ($notes($src))" : ""}]
211 
212  puts $rc "# [file tail $src]$note"
213  puts $rc "msgcat::mcmset $lang \{\n"
214 
215  foreach xlate $srcs($src) {
216  puts $rc " \"[lindex $xlate 0]\""
217  puts $rc " \"[lindex $xlate 1]\"\n"
218  }
219 
220  puts $rc "\}\n"
221 
222  }
223 
224  close $rc
225 
226  }
227 
228  }