lang.tcl

Linux下的MSN聊天程序源码

		global lang_list

		# Search in the lang_list list the lang we want, and return its encoding
		foreach langdata $lang_list {
			if { [lindex $langdata 0] == $langcode } {
				set langenc [lindex $langdata 2]
				break
			}
		}

		return $langenc

	}

	#///////////////////////////////////////////////////////////////////////
	# Get the name of a language
	proc get_lang_name { langcode } {

		global lang_list

		# Search in the lang_list list the lang we want, and return its encoding
		foreach langdata $lang_list {
			if { [lindex $langdata 0] == $langcode } {
				set langname [lindex $langdata 1]
				break
			}
		}

		return $langname

	}


	#///////////////////////////////////////////////////////////////////////
	# Return the directory of the lang files
	proc get_language_dir { } {

		if { [file isdirectory "[pwd]/lang"] } {
			return "[pwd]/lang"
		} else {
			::amsn::errorMsg "[trans dirdontexist]"
			return "0"
		}

	}


	#///////////////////////////////////////////////////////////////////////
	# Download the lang file
	proc downloadlanguage { langcode { selection "" } } {

		global lang_list weburl HOME2

		set lang "lang$langcode"
		
		set dir [get_language_dir]

		if { $dir == 0 } {
			return
		}

		# Get the information from the online version
		set name [::lang::ReadOnlineLang $langcode name]
		set version [::lang::ReadOnlineLang $langcode version]
		set encoding [::lang::ReadOnlineLang $langcode encoding]

		# Download the content of the file from the web
		if { [catch {
			set token [::http::geturl "http://amsn.sourceforge.net/autoupdater/lang/$lang" -timeout 120000 -binary 1]
			set content [::http::data $token]
			set status [::http::status $token]
		} ] } {
			catch {::http::cleanup $token}
			status_log "Error while uploading lang : $langcode\n" red
			return
		}

		#If an error occured, stop the process
		if { $status != "ok" } {
			::http::cleanup $token
			status_log "Error while uploading lang : $langcode ($status)\n" red
			return
		}

		# Puts the content into the file
		set file "[file join ${dir} $lang]"
		if { ![file writable $file] && [file exists $file] } {
			::http::cleanup $token
			status_log "Error while updating $file : file is protected\n" red
			return
		}

		if { [catch {
			set fid [open $file w]
			fconfigure $fid -encoding binary
			puts -nonewline $fid "$content"
			close $fid
		} ] } {
			status_log "Error while updating $file : file is protected\n" red
			return
		}
		::http::cleanup $token

		# Add the language into the language list
		::lang::AddLang "$langcode" "$name" "$version" "$encoding"

		if { $selection != "" } {
			catch {
				.langchoose.notebook.nn.fmanager.selection.box itemconfigure $selection -background #DDF3FE
				::lang::language_manager_selected
			}
		}
	}


	#///////////////////////////////////////////////////////////////////////
	# Delete a lang file
	proc deletelanguage { langcode {selection ""} } {

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

		file delete "$dir/lang$langcode"

		::lang::RemoveLang $langcode

		if { $selection != "" } {
			catch {
				.langchoose.notebook.nn.fmanager.selection.box itemconfigure $selection -background #FFFFFF
				::lang::language_manager_selected
			}
		}
	}


	#///////////////////////////////////////////////////////////////////////
	# Load the language versions

	proc LoadVersions { } {

		global HOME2

		# Reinitialise all the versions
		if { [info exists ::lang::Lang] } {
			foreach langcode $::lang::Lang {
				::lang::RemoveLang $langcode
			}
		}

		set ::lang::Lang ""

		set check 0

		set filename "[file join $HOME2 langlist.xml]"

		# If langlist.xml doesn't exist, or if langlist was modified after langlist.xml
		if { ![file exists $filename] || [file mtime $filename] < [file mtime "langlist"] } {
			file copy -force "langlist" "$filename"
			set check 1
		}

		set id [::sxml::init $filename]
		sxml::register_routine $id "version:lang" "::lang::XMLLang"
		sxml::parse $id
		sxml::end $id

		if { $check == 1 } {
			::lang::CheckLangList
		}

	}


	#///////////////////////////////////////////////////////////////////////
	proc XMLLang { cstack cdata saved_data cattr saved_attr args } {
		upvar $saved_data sdata

		set langcode $sdata(${cstack}:langcode)
		set name $sdata(${cstack}:name)
		set version $sdata(${cstack}:version)
		set encoding $sdata(${cstack}:encoding)
		::lang::AddLang $langcode $name $version $encoding

		return 0

	}


	#///////////////////////////////////////////////////////////////////////
	# Read the properties a lang (version, name, encoding)

	proc ReadLang { langcode array } {

		set list [array get ::lang::Lang$langcode]
		set index [lsearch $list $array]
		if { $index != -1 } {
			return [lindex $list [expr {$index + 1}]]
		} else {
			return ""
		}

	}

	proc ReadOnlineLang { langcode array } {

		set list [array get ::lang::OnlineLang$langcode]
		set index [lsearch $list $array]
		if { $index != -1 } {
			return [lindex $list [expr {$index + 1}]]
		} else {
			return ""
		}

	}


	#///////////////////////////////////////////////////////////////////////
	# Initialize the langlist.xml file

	proc CheckLangList { } {

		foreach langcode $::lang::Lang {
			if { ![file exists [file join lang lang$langcode]] } {
				::lang::RemoveLang $langcode
			}
		}

		::lang::SaveVersions

	}

	#///////////////////////////////////////////////////////////////////////
	# Check if a lang is loaded

	proc LangExists { langcode } {

		if {[lsearch $::lang::Lang $langcode] != -1 } {
			return 1
		} else {
			return 0
		}

	}


	#///////////////////////////////////////////////////////////////////////
	# Add a new lang

	proc AddLang { langcode name version encoding } {

		array set ::lang::Lang$langcode [list name "$name" version $version encoding $encoding]

		if { ![::lang::LangExists $langcode] } {
			set ::lang::Lang [lappend ::lang::Lang $langcode]
			set ::lang::Lang [lsort $::lang::Lang]
		}

	}


	#///////////////////////////////////////////////////////////////////////
	# Delete a lang from the XML file and delete all the information about it that are in memory

	proc RemoveLang { langcode } {
		
		if { [::lang::LangExists $langcode] } {
			set index [lsearch $::lang::Lang $langcode]
			set ::lang::Lang [lreplace $::lang::Lang $index $index]
		}

		unset -nocomplain ::lang::Lang$langcode

	}

			
	#///////////////////////////////////////////////////////////////////////
	# Save the XML file

	proc SaveVersions {} {

		global HOME2
	
		set file_id [open "[file join $HOME2 langlist.xml]" w]

		fconfigure $file_id -encoding utf-8

		puts $file_id "<?xml version=\"1.0\"?>\n\n<version>"

		foreach langcode $::lang::Lang {
			set name [::lang::ReadLang $langcode name]
			set version [::lang::ReadLang $langcode version]
			set encoding [::lang::ReadLang $langcode encoding]
			puts $file_id "\t<lang>\n\t\t<langcode>$langcode</langcode>\n\t\t<name>$name</name>\n\t\t<version>$version</version>\n\t\t<encoding>$encoding</encoding>\n\t</lang>"
		}

		puts $file_id "</version>"

		close $file_id
	}


	#///////////////////////////////////////////////////////////////////////
	# Load the online version and read the XML file

	proc LoadOnlineVersions { } {

		global HOME2

		if { [catch {

			set ::lang::OnlineLang ""

			set filename "[file join $HOME2 langlistnew.xml]"

			set fid [open $filename w]
			set token [::http::geturl "http://amsn.sourceforge.net/autoupdater/langlist" -timeout 120000 -binary 1]
			set content [::http::data $token]
			fconfigure $fid -encoding binary
			puts -nonewline $fid "$content"
			close $fid
			::http::cleanup $token

			set id [::sxml::init $filename]
			sxml::register_routine $id "version:lang" "::lang::XMLOnlineLang"
			sxml::register_routine $id "version:plugin" "::lang::XMLOnlinePlugin"
			sxml::parse $id
			sxml::end $id

			file delete $filename

		}]} {
			set ::lang::LoadOk 0
		} else {
			set ::lang::LoadOk 1
		}

	}


	#///////////////////////////////////////////////////////////////////////

	proc XMLOnlineLang { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata

		set langcode $sdata(${cstack}:langcode)
		set name $sdata(${cstack}:name)
		set version $sdata(${cstack}:version)
		set encoding $sdata(${cstack}:encoding)
		array set ::lang::OnlineLang$langcode [list name $name version $version encoding $encoding]

		lappend ::lang::OnlineLang $langcode

		return 0
	}



	#///////////////////////////////////////////////////////////////////////
	# This proc is called to check if a new version of lang files exists, and put it into the ::lang::UpdatedLang list

	proc UpdatedLang { } {
	
		set dir [get_language_dir]

		set ::lang::UpdatedLang [list]

		set langcode [::config::getGlobalKey language]
		set lang "lang$langcode"

		if { $langcode == "en" || ([::lang::keyscounter "en"] <= [::lang::keyscounter "$langcode"]) } {
			return
		}

		::lang::LoadVersions
		::lang::LoadOnlineVersions

		if { $::lang::LoadOk == 0 } {
			status_log "Unable to update language\n" red
			return
		}

		
		# Check if the current language is not English,
		# if the number of keys is different in this language and in English
		# and if the file is writable before
		if { [file writable "$dir/$lang"] } {
			set version [::lang::ReadLang $langcode version]
			set onlineversion [::lang::ReadOnlineLang $langcode version]
			set current [split $version "."]
			set new [split $onlineversion "."]
			set newer 0
				
			if { [lindex $new 0] > [lindex $current 0] } {
				set newer 1
			} elseif { [lindex $new 1] > [lindex $current 1] } {
				set newer 1
			}
				
			if { $newer == 1 } {
				lappend ::lang::UpdatedLang $langcode
			}
				
		}

		::lang::SaveVersions
	}


	#///////////////////////////////////////////////////////////////////////
	# This proc is called to update a lang
	
	proc UpdateLang { langcodes } {
		
		set w ".updatelangplugin"
	
		foreach langcode $langcodes {			
			
			set langname [::lang::ReadLang $langcode name]
			if { [winfo exists $w] } {
				$w.update.txt configure -text "[trans updating] $langname..."
			}

			set onlineversion [::lang::ReadOnlineLang $langcode version]
			set name $::lang::OnlineLang"$langcode"(name)
			set encoding $::lang::OnlineLang"$langcode"(encoding)

			::lang::downloadlanguage $langcode
				
			set ::lang::Lang"$langcode"(version) $onlineversion
			set ::lang::Lang"$langcode"(name) $name
			set ::lang::Lang"$langcode"(encoding) $encoding
			
		}
		
		::lang::SaveVersions
	
	}


	#///////////////////////////////////////////////////////////////////////
	# This proc counts the number of keys of a language

	proc keyscounter { langcode } {

		set dir [get_language_dir]
		set lang "lang$langcode"

		set file [open "[file join ${dir} ${lang}]" r]
		set keys [split [read $file] "\n"]
		set keysnumber [llength $keys]

		return $keysnumber

	}

}

#All the stuff necessary to find the preferred language to use on Mac OS X
if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
if {![catch {package require Ffidl 0.6}]} {

namespace eval corefoundation {
    proc api {name argl ret} {::ffidl::callout $name $argl $ret \
	[::ffidl::symbol CoreFoundation.framework/CoreFoundation $name]}
    api CFLocaleCopyCurrent {} pointer
    api CFLocaleGetIdentifier pointer pointer
    api CFStringGetLength pointer sint32
    if { $initialize_amsn == 1  } {
    	::ffidl::typedef CFRange sint32 sint32
    }
    api CFStringGetCharacters {pointer CFRange pointer-var} void
    api CFRelease pointer void

    proc getLocaleIdentifier {} {
	set cfloc [CFLocaleCopyCurrent]
	set cfstr [CFLocaleGetIdentifier $cfloc]
	set len [CFStringGetLength $cfstr]
	set buf [binary format x[expr {2*$len}]]
	set range [binary format [::ffidl::info format CFRange] 0 $len]
	CFStringGetCharacters $cfstr $range buf
	CFRelease $cfloc
	encoding convertfrom unicode $buf
    }
}
}
}