lang.tcl

Linux下的MSN聊天程序源码

if { $initialize_amsn == 1 } {
	global lang_list langenc langlong
	set lang_list [list]
	set langenc "iso8859-1"
	set langlong "English"
}

proc scan_languages { } {

	global lang_list
	set lang_list [list]

	::lang::LoadVersions	 

	foreach langcode $::lang::Lang {
		set name [::lang::ReadLang $langcode name]
		set encoding [::lang::ReadLang $langcode encoding]
		lappend lang_list "{$langcode} {$name} {$encoding}"
	}

}


proc detect_language { {default "en"} } {
	global env
	
	if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
		if { [catch { set system_language [string tolower [corefoundation::getLocaleIdentifier]]}]} {
			set system_language en
		} else {
			set system_language [string tolower [corefoundation::getLocaleIdentifier]]
		}
	} elseif { ![info exists env(LANG)] } {
		status_log "No LANG environment variable. Using $default\n"
		return $default
	} else {
		set system_language [string tolower $env(LANG)]
	}
	
	
	set idx [string first "@" $system_language]
	status_log "System language is $system_language\n"
	#Remove @euro thing or similar
	if { $idx != -1 } {
		incr idx -1
		set system_language [string range $system_language 0 $idx]
		status_log "Removed @ thing. Now system language is $system_language\n"
	}
	
	set language [language_in_list $system_language]
	if { $language != 0 } {
		status_log "Matching language $language!\n"
		return $language
	}
	
	set idx [string first "_" $system_language]
	#Remove _variant thing, like BR in pt_BR
	if { $idx != -1 } {
		incr idx -1
		set system_language [string range $system_language 0 $idx]
		status_log "Removed _ variant. Now system language is $system_language\n"
	}
	
	set language [language_in_list $system_language]
	if { $language != 0 } {
		status_log "Matching language $language!\n"
		return $language
	}
	status_log "NO matching language. Defaulting to $default\n"	
	return $default
}

proc language_in_list { lang_name } {
	global lang_list
	
	if {![info exists lang_list]} {
		scan_languages
	}
	
	foreach lang_desc $lang_list {
		set lang_short [string tolower [lindex $lang_desc 0]]
		if {[string compare $lang_short $lang_name] == 0 } {
			status_log "Language \"$lang_name\" is in available languages, using it\n" blue
			return [lindex $lang_desc 0]
		}
		
	}
	
	return 0
}

proc trans {msg args} {
	global lang

	set plugin [::plugins::calledFrom]

	for {set i 1} {$i <= [llength $args]} {incr i} {
		set $i [lindex $args [expr {$i-1}]]
	}

	if {[ catch {
		if { ($plugin != -1) && ([array names ::${plugin}::lang $msg] == "$msg") } {
			return [subst -nocommands [set ::${plugin}::lang($msg)]]
		} elseif { [string length $lang($msg)] > 0 } {
			return [subst -nocommands $lang($msg)]
		} else {
			if {[llength $args]>0} {
				return "$msg $args"
			} else {
				return "$msg"
			}
		}
	} res] == 1} {
		status_log "Catch in proc trans ($msg $args): $res" red
		if {[llength $args]>0} {
			return "$msg $args"
		} else {
			return "$msg"
		}
	} else {
		return $res
	}
}


#Lectura del idioma
proc load_lang { {langcode "en"} {plugindir ""} } {
	global lang lang_list langenc langlong

	if {[string equal $plugindir ""]} { set plugindir "lang" }
	if { [catch {set file_id [open "[file join $plugindir lang$langcode]" r]}] } {
		return 0
	}

	#check if this is called from a plugin
	set plugin [::plugins::calledFrom]
	if {$plugin != -1} {
		status_log "load_lang called from a plugin"
		variable ::${plugin}::lang
	}
	set current_enc ""

	foreach langdata $lang_list {
		if { [lindex $langdata 0] == $langcode } {

			set current_enc  [lindex $langdata 2]
			if { $plugin == -1 } {
				set langenc [lindex $langdata 2]
				set langlong [lindex $langdata 1]
			} 

			
		}
	}

	fconfigure $file_id -encoding $current_enc

	gets $file_id tmp_data
	if {$tmp_data != "amsn_lang_version 2"} {	;# config version not supported!
		return 1
	}

	while {[gets $file_id tmp_data] != "-1"} {
		#If line is a comment, skip
		if {[string range $tmp_data 0 0] == "#"} {
			continue
		}
		set pos [string first " " $tmp_data]

		#Remove comments at end of line
		set posend [string first "#" $tmp_data]
		if { $posend == -1 } {
			set posend [expr {[string length $tmp_data]-1}]
		} else {
			incr posend -1
			while {[string range $tmp_data $posend $posend] == " "} {
			incr posend -1
			}
		}
		set l_msg [string range $tmp_data 0 [expr {$pos -1}]]
		set l_trans [string range $tmp_data [expr {$pos +1}] $posend]
		if { ![info exists lang($l_msg)] && ![string match "*lang*" $plugindir] } {
			set lang($l_msg) $l_trans
		} elseif { [string match "*lang*" $plugindir] } {
			set lang($l_msg) $l_trans
		}
	}
	close $file_id
	return 0
}


namespace eval ::lang {


	#///////////////////////////////////////////////////////////////////////
	proc show_languagechoose {} {

		global HOME2

		set languages [list]

		::lang::LoadOnlineVersions

		foreach langcode $::lang::Lang {
			set name [::lang::ReadLang $langcode name]
			lappend languages [list "$name" "$langcode"]
		}
		
		set languages [lsort -index 0 -dictionary $languages] 

		set wname ".langchoose"

		if {[winfo exists $wname]} {
			raise $wname
			return
		}

		toplevel $wname
		wm title $wname "[trans language]"
		wm geometry $wname 300x350
		wm protocol $wname WM_DELETE_WINDOW "::lang::language_manager_close"

		frame $wname.notebook -borderwidth 3

		set nb $wname.notebook
		NoteBook $nb.nn
		$nb.nn insert end language -text [trans language]
		$nb.nn insert end manager -text [trans language_manager]


		#  .__________.
		# _| Language |____

		set frm [$nb.nn getframe language]

		frame $frm.list -class Amsn -borderwidth 0
		frame $frm.buttons -class Amsn

		listbox $frm.list.items -yscrollcommand "$frm.list.ys set" -font splainf \
				-background white -relief flat -highlightthickness 0 -width 60
		scrollbar $frm.list.ys -command "$frm.list.items yview" -highlightthickness 0 \
				-borderwidth 1 -elementborderwidth 1 

		button $frm.buttons.ok -text "[trans ok]" -command [list ::lang::show_languagechoose_Ok $languages]
		button $frm.buttons.cancel -text "[trans cancel]" -command "::lang::language_manager_close"


		pack $frm.list.ys -side right -fill y
		pack $frm.list.items -side left -expand true -fill both
		pack $frm.list -side top -expand true -fill both -padx 4 -pady 4

		pack $frm.buttons.ok -padx 5 -side right
		pack $frm.buttons.cancel -padx 5 -side right
		pack $frm.buttons -side bottom -fill both -pady 3

		foreach item $languages {
			$frm.list.items insert end [lindex $item 0]
		}


		bind $frm.list.items <Double-Button-1> [list ::lang::show_languagechoose_Ok $languages]
		bind $frm <Return> [list ::lang::show_languagechoose_Ok languages]


		catch {
			raise $frm
			focus $frm.buttons.ok
		}

		pack $frm -fill both -expand true

		$nb.nn compute_size


		#  ._________.
		# _| Manager |____
		set frm [$nb.nn getframe manager]

		if { $::lang::LoadOk == 1 && [file writable [file join $HOME2 langlist.xml]]} {		

		# Create a list box where we will put the lang
		frame $frm.selection -class Amsn -borderwidth 0
		listbox $frm.selection.box -yscrollcommand "$frm.selection.ys set" -font splainf -background white -relief flat -highlightthickness 0
		scrollbar $frm.selection.ys -command "$frm.selection.box yview" -highlightthickness 0 -borderwidth 1 -elementborderwidth 2
		pack $frm.selection.ys -side right -fill y
		pack $frm.selection.box -side left -expand true -fill both

		# Add the lang into the previous list
		set languages2 [list]
		foreach langcode $::lang::OnlineLang {
			set name [::lang::ReadOnlineLang $langcode name]
			lappend languages2 [list "$name" "$langcode"]
		}
		set languages2 [lsort -index 0 -dictionary $languages2]
		
		set ::lang::OnlineLang [list]
		
		foreach lang $languages2 {
			set langcode [lindex $lang 1]
			set ::lang::OnlineLang [lappend ::lang::OnlineLang $langcode]
		}		
		
		foreach item $languages2 {
			set langname [lindex $item 0]
			set langcode [lindex $item 1]
			$frm.selection.box insert end "$langname"
			# Choose the background according to the fact lang is available or not
			if { [lsearch $::lang::Lang $langcode] != -1 } {
				$frm.selection.box itemconfigure end -background #DDF3FE
			} else {
				$frm.selection.box itemconfigure end -background #FFFFFF
			}
		}


		# When a language is selected, execute language_manager_selected
		bind $frm.selection.box <<ListboxSelect>> "::lang::language_manager_selected"

		frame $frm.txt
		label $frm.txt.text -text " "
		pack configure $frm.txt.text

		frame $frm.command1
		
		button $frm.command1.deleteall -text "[trans deleteall]" -command "::lang::language_manager_deleteall"
		pack configure $frm.command1.deleteall -side left -padx 5
		
		button $frm.command1.load -text "[trans download]" -command "::lang::language_manager_load" -state disabled
		pack configure $frm.command1.load -side right -padx 5
		
		frame $frm.command2

		button $frm.command2.close -text "[trans close]" -command "::lang::language_manager_close"
		pack configure $frm.command2.close -side right -padx 5

		pack configure $frm.selection -side top -expand true -fill both -padx 4 -pady 4
		pack configure $frm.txt -side top -fill x
		pack configure $frm.command1 -side top -fill x -padx 10
		pack configure $frm.command2 -side top -fill x -padx 10


		} else {

		frame $frm.txt
		label $frm.txt.text -text "[trans cantloadonlineversion]" -foreground red -wraplength 200
		pack configure $frm.txt.text

		frame $frm.command
		button $frm.command.close -text "[trans close]" -command "::lang::language_manager_close"
		pack configure $frm.command.close -side right -padx 5

		pack configure $frm.txt -side top -fill x
		pack configure $frm.command -side bottom -fill x -padx 10

		}

		pack $frm -fill both -expand true



		$nb.nn compute_size

		$nb.nn raise language
		$nb.nn compute_size
		pack $nb.nn -fill both -expand true
		pack $wname.notebook -fill both -expand true


		bind $wname <<Escape>> [list destroy $wname]
		moveinscreen $wname 30


	}


	#///////////////////////////////////////////////////////////////////////
	proc language_manager_close { } {

		catch {::lang::SaveVersions}
		destroy .langchoose

	}

	#///////////////////////////////////////////////////////////////////////
	proc show_languagechoose_Ok { itemlist } {
		set sel [.langchoose.notebook.nn.flanguage.list.items curselection]
		if { $sel == "" } { return }
		destroy .langchoose	
		::lang::set_language [lindex [lindex $itemlist $sel] 1]
	}


	#///////////////////////////////////////////////////////////////////////
	proc language_manager_selected { } {

		set dir [get_language_dir]
		if { $dir == 0 } {
			return
		}

		set w ".langchoose.notebook.nn.fmanager"

		# Get the selected item
		set selection [$w.selection.box curselection]
		set langcode [lindex $::lang::OnlineLang $selection]
		set lang "lang$langcode"

		# If the lang selected is the current lang
		if { $langcode == [::config::getGlobalKey language]} {
			$w.command1.load configure -state disabled -text "[trans delete]"
			$w.txt.text configure -text "[trans currentlanguage]" -foreground red		
		# If the file is not available
		} elseif {[lsearch $::lang::Lang $langcode] == -1 } {
			$w.command1.load configure -state normal -text "[trans download]" -command "[list ::lang::downloadlanguage "$langcode" $selection]"
			$w.txt.text configure -text ""
		# If the file is protected
		} elseif { ![file writable "$dir/$lang"] | $langcode == "en" } {
			$w.command1.load configure -state disabled -text "[trans delete]"
			$w.txt.text configure -text "[trans filenotwritable]" -foreground red
		# If the file is available
		} elseif {[lsearch $::lang::Lang $langcode] != -1 } {
			$w.command1.load configure -state normal -text "[trans delete]" -command "[list ::lang::deletelanguage "$langcode" $selection]"
			$w.txt.text configure -text ""
		}


		.langchoose.notebook.nn.flanguage.list.items delete 0 end

		set languages [list]


		foreach langcode $::lang::Lang {
			set name [::lang::ReadLang $langcode name]
			lappend languages [list "$name" "$langcode"]
		}


		foreach item $languages {
			.langchoose.notebook.nn.flanguage.list.items insert end [lindex $item 0]
		}


	}
	
	
	#///////////////////////////////////////////////////////////////////////
	proc language_manager_deleteall { } {
		
		global lang_list
		
		set dir [::lang::get_language_dir]
		
		set k 0
		
		foreach lang $lang_list {
			set langcode [lindex $lang 0]
			# If the lang selected is the current lang, the file is protected, or it is English, don't delete the lang
			if { $langcode != [::config::getGlobalKey language] && [file writable "$dir/lang$langcode"] && $langcode != "en" } {
				::lang::deletelanguage "$langcode" "$k"
			}
			incr k
		}
			
	}


	#///////////////////////////////////////////////////////////////////////
	proc set_language { langname } {
		global gui_language

		load_lang $langname
		msg_box [trans mustrestart]

		#Reload english to overwrite any missing sentences
		load_lang en
		#Reload the current GUI language
		load_lang $gui_language

		::config::setGlobalKey language $langname
		::config::saveGlobal

		return
	}


	#///////////////////////////////////////////////////////////////////////
	# Get the encoding of a language
	proc get_lang_encoding { langcode } {