autoupdate.tcl

Linux下的MSN聊天程序源码

		#Create 2 buttons, save and save as
		button $w.bottom.save -command "::autoupdate::amsn_save $url $token $defaultlocation" -text "Save" -default active
		button $w.bottom.saveas -command "::autoupdate::amsn_save_as $url $token $defaultlocation" -text "Save in another directory" -default normal
		pack $w.bottom.save
		pack $w.bottom.saveas -pady 5
		#If user try to close the window, just save in default directory
		bind $w <<Escape>> "::autoupdate::amsn_save $url $token $defaultlocation"
		bind $w <<Destroy>> "::autoupdate::amsn_save $url $token $defaultlocation"
		wm protocol $w WM_DELETE_WINDOW "::autoupdate::amsn_save $url $token $defaultlocation"
	}

	#When user click on save in another directory, he gets a window to choose the directory
	proc amsn_save_as {url token defaultlocation} {
		set location [tk_chooseDirectory -initialdir $defaultlocation]
		if { $location !="" } {
			::autoupdate::amsn_save $url $token $location
		} else {
			return
		}
	}

	#Define default directory on the three platforms 
	#(It's ok For Mac OS X, change it on your platform if you feel it's not good)
	proc get_default_location {} {
		global env
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			set namelocation "Desktop"
			set defaultlocation "[file join $env(HOME) Desktop]"
		} elseif { $::tcl_platform(platform)=="windows" } {
			set namelocation "Received files folder"
			set defaultlocation "[::config::getKey receiveddir]"
		} else { 
			set namelocation "Home folder"
			set defaultlocation "[file join $env(HOME)]"
		}
		lappend location $namelocation
		lappend location $defaultlocation
		return $location
	}

	#When the user cancel the update, we check if he clicked on "Don't ask update again for one week"
	#If yes, save the actual time in seconds in the weekdate
	proc dont_ask_before {} {
		if {$::dont_ask_for_one_week} {
			::config::setKey weekdate "[clock seconds]"
		}
	}

	#///////////////////////////////////////////////////////////////////////
	proc amsn_save { url token location} {
		
		set savedir $location
		set w .downloadwindow
		
		#Save the file
		set lastslash [expr {[string last "/" $url]+1}]
		set fname [string range $url $lastslash end]
		
		if { [catch {
			set file_id [open [file join $savedir $fname] w]
			fconfigure $file_id -translation {binary binary} -encoding binary
			puts -nonewline $file_id [::http::data $token]
			close $file_id
		}]} {
			#Can't save the file at this place
			#Get informations of the default location for this system
			set location [::autoupdate::get_default_location]
			set namelocation [lindex $location 0]
			set defaultlocation [lindex $location 1]
			#Show the button to choose a new file location or use default location
			$w.top.text configure -text "File can't be saved at this place."
			$w.bottom.save configure -command "::autoupdate::amsn_save $url $token $defaultlocation" -text "Save in default location" -default active
			$w.bottom.saveas configure -command "::autoupdate::amsn_save_as $url $token $defaultlocation" -text "Choose new file location" -default normal
			
			bind $w <<Escape>> "::autoupdate::amsn_save $url $token $defaultlocation"
			bind $w <<Destroy>> "::autoupdate::amsn_save $url $token $defaultlocation"
			wm protocol $w WM_DELETE_WINDOW "::autoupdate::amsn_save $url $token $defaultlocation"
		} else {
			#The saving is a sucess, show a button to open directory of the saved file and close button
			$w.top.text configure -text "Done\n Saved $fname in $savedir."
			$w.bottom.save configure -command "launch_filemanager \"$savedir\";destroy $w" -text "Open directory" -default normal
			$w.bottom.saveas configure -command "destroy $w" -text "Close" -default active
			#if { $::tcl_platform(platform)=="unix" } {
			#	button $w.bottom.install -text "Install" -command "amsn_install_linux $savedir $fname"
			#	pack $w.bottom.install
			#}
			#if { $::tcl_platform(platform)=="windows" } {
			#	button $w.bottom.install -text "Install" -command "amsn_install_windows $savedir $fname"
			#	pack $w.bottom.install
			#}
			bind $w <<Escape>> "destroy $w"
			bind $w <<Destroy>> "destroy $w"
			wm protocol $w WM_DELETE_WINDOW "destroy $w"
		}

	}

	#///////////////////////////////////////////////////////////////////////
	package require http

	proc check_web_version { token } {
		global rcversion weburl

		set newer 0

		set tmp_data [ ::http::data $token ]

		if { [::http::status $token] == "ok" && [::http::ncode $token] == 200 } {
			set tmp_data [string map {"\n" "" "\r" ""} $tmp_data]
			set lastver [split $tmp_data "."]
			set yourver [split $rcversion "."]

			for {set x 0} {$x<[llength "$lastver"]} {incr x} {
				if {[lindex $lastver $x] > [lindex $yourver $x]} {
					set newer 1
					break
				} elseif {[lindex $lastver $x] < [lindex $yourver $x]} {
					break
				}
			}

			catch {status_log "check_web_ver: Current= $rcversion New=$tmp_data\n"}
			#Time in second when the user clicked to not have an alert before 3 days
			set weekdate [::config::getKey weekdate]
			#Actual time in seconds
			set actualtime "[clock seconds]"
			#Number of seconds for 7 days
			set three_days "[expr {60*60*24*7}]"
			#If you tant to test just with 60 seconds, add # on the previous line and remove the # on the next one
			#set three_days "60"
			#Compare the difference betwen actualtime and the time when he clicked
			if {$weekdate != ""} {
				set diff_time "[expr {$actualtime-$weekdate}]"
			} else {
				set diff_time "[expr {$three_days + 1 } ]"
			}
			status_log "Three days (in seconds) :$three_days\n" blue
			status_log "Difference time (in seconds): $diff_time\n" blue
			#If new version and more than 7 days since the last alert (if user choosed that feature)
			#Open the update window
			if { $newer == 1 && $diff_time > $three_days} {
				::autoupdate::update_window $tmp_data
			} else {
				status_log "Not yet 3 days or no new version\n" red 
			}


		} else {
			catch {status_log "check_web_ver: status=[::http::status $token] ncode=[::http::ncode $token]\n" blue}

		}
		::http::cleanup $token

		# Auto-update for language files
		if { [::config::getKey activeautoupdate] } {
			set langpluginupdated [::autoupdate::UpdateLangPlugin]
		}

		# Even if langpluginupdated is supposed to exists, prevents a "race" problem
		if { ![info exists langpluginupdated] } {
			return $newer
		} elseif {$newer == 0 && $langpluginupdated == 1} {
			return 1
		} else {
			return $newer
		}
		
	}

	proc check_version {} {
		global weburl


		if { [winfo exists .checking] } {
			raise .checking
			return
		}
		toplevel .checking

		wm title .checking "[trans title]"
		ShowTransient .checking
		canvas .checking.c -width 300 -height 50

		.checking.c create image 25 10 -anchor n -image [::skin::loadPixmap download]
		.checking.c create text 155 20 -font splainf -anchor n \
		    -text "[trans checkingver]..." -justify center -width 250
		pack .checking.c -expand true
		tkwait visibility .checking
		catch {grab .checking}

		update idletasks

		status_log "Getting ${weburl}/amsn_latest\n" blue
		if { [catch {
			set token [::http::geturl ${weburl}/amsn_latest -timeout 10000]
			if {[::autoupdate::check_web_version $token]==0} {
				msg_box "[trans nonewver]"
			}
		} res ]} {
			msg_box "[trans connecterror]: $res"
		}

		destroy .checking

	}

	#///////////////////////////////////////////////////////////////////////
	proc check_version_silent {} {
		global weburl

		catch {
			::http::geturl ${weburl}/amsn_latest -timeout 10000 -command ::autoupdate::check_web_version
		}

	}


	#///////////////////////////////////////////////////////////////////////
	proc UpdateLangPlugin {} {

		set w ".updatelangplugin"
		if { [winfo exists $w] } {
			raise $w
			return 1
		}

		::lang::UpdatedLang
		set updatedplugins [::plugins::UpdatedPlugins]

		if { ($::lang::UpdatedLang == "") && ($updatedplugins == 0) } {
			::autoupdate::UpdateLangPlugin_close
			return 0
		}



		toplevel $w
		wm title $w "[trans update]"
		wm geometry $w 320x400
		wm protocol $w WM_DELETE_WINDOW "::autoupdate::UpdateLangPlugin_close"
		
		bind $w <<Escape>> "::autoupdate::UpdateLangPlugin_close"

		frame $w.text
		label $w.text.img -image [::skin::loadPixmap download]
		label $w.text.txt -text "New updates available for aMSN" -font sboldf
		pack configure $w.text.img -side left
		pack configure $w.text.txt -expand true -side right
		pack $w.text -side top -fill x

		ScrolledWindow $w.list -auto vertical -scrollbar vertical
		ScrollableFrame $w.list.sf -constrainedwidth 1
		$w.list setwidget $w.list.sf
		pack $w.list -anchor n -side top -fill both -expand true
		set frame [$w.list.sf getframe]
		

		#Language label
		if {$::lang::UpdatedLang != ""} {
			label $frame.langtext -text "[trans language]" -font sboldf
			pack configure $frame.langtext -side top -fill x -expand true
		}

		#Checkbox for each language
		foreach langcode $::lang::UpdatedLang {
			set langname [::lang::ReadLang $langcode name]
			checkbutton $frame.lang$langcode -onvalue 1 -offvalue 0 -text " $langname" -variable ::autoupdate::lang($langcode) -anchor w
			pack configure $frame.lang$langcode -side top -fill x -expand true
		}

		#Plugin label
		if {$updatedplugins == 1} {
			label $frame.plugintext -text "[trans pluginselector]" -font sboldf
			pack configure $frame.plugintext -side top -fill x
		}

		#Checkbox for each plugin
		foreach plugin [::plugins::getPlugins] {
			if { [::plugins::getInfo $plugin updated] == 1 } {
				checkbutton $frame.plugin$plugin -onvalue 1 -offvalue 0 -text " $plugin" -variable ::plugins::plugins(${plugin}_updated_selected) -anchor w
				pack configure $frame.plugin$plugin -side top -fill x
			}
		}
		
		# Create a frame that will contain the progress of the update
		frame $w.update
		label $w.update.txt -text ""
		pack configure $w.update.txt -fill x
		pack configure $w.update -side top -fill x

		frame $w.button
		button $w.button.selectall -text "[trans selectall]" -command "::autoupdate::UpdateLangPlugin_selectall"
		button $w.button.unselectall -text "[trans unselectall]" -command "::autoupdate::UpdateLangPlugin_unselectall"
		pack configure $w.button.selectall -side left -padx 3 -pady 3
		pack configure $w.button.unselectall -side left -padx 3 -pady 3

		
		frame $w.button2
		button $w.button2.close -text "[trans close]" -command "::autoupdate::UpdateLangPlugin_close"
		button $w.button2.update -text "[trans update]" -command "::autoupdate::UpdateLangPlugin_update" -default active
		pack configure $w.button2.update -side left -padx 3 -pady 3
		pack configure $w.button2.close -side right -padx 3 -pady 3

		pack configure $w.button2 -side bottom -fill x
		pack configure $w.button -side bottom -fill x
		
		return 1

	}


	#///////////////////////////////////////////////////////////////////////
	proc UpdateLangPlugin_update { } {
	
		set w ".updatelangplugin"
	
		pack forget $w.list
		pack forget $w.button
		pack forget $w.button2.update

		wm geometry $w 300x100

		set langcodes [list]

		if { [info exists ::lang::UpdatedLang] && $::lang::UpdatedLang != "" } {
			foreach langcode $::lang::UpdatedLang {
				if { [::autoupdate::ReadLangSelected $langcode] == 1} {
					set langcodes [lappend langcodes $langcode]
				}
			}
			::lang::UpdateLang $langcodes
		}

		foreach plugin [::plugins::getPlugins] {
			if { [::plugins::getInfo $plugin updated] == 1 && [::plugins::getInfo $plugin updated_selected] == 1 } {
				::plugins::UpdatePlugin $plugin
			}
		}
		
		::autoupdate::UpdateLangPlugin_close

	}


	#///////////////////////////////////////////////////////////////////////
	proc UpdateLangPlugin_close { } {
	
		global HOME2
		
		if { [winfo exists ".updatelangplugin"] } {
			destroy ".updatelangplugin"
		}
	
		foreach plugin [::plugins::getPlugins] {
			file delete [file join $HOME2 $plugin.xml]
		}
		
		unset -nocomplain ::lang::UpdatedLang
		
	}


	#///////////////////////////////////////////////////////////////////////
	proc UpdateLangPlugin_selectall { } {
	
		set frame [.updatelangplugin.list.sf getframe]
	
		foreach langcode $::lang::UpdatedLang {
			set ::autoupdate::lang($langcode) 1
		}

		foreach plugin [::plugins::getPlugins] {
			if { [::plugins::getInfo $plugin updated] == 1 } {
				set ::plugins::plugins(${plugin}_updated_selected) 1
			}
		}
		
	}
		

	#///////////////////////////////////////////////////////////////////////
	proc UpdateLangPlugin_unselectall { } {
	
		set frame [.updatelangplugin.list.sf getframe]
	
		foreach langcode $::lang::UpdatedLang {
			set ::autoupdate::lang($langcode) 0
		}

		foreach plugin [::plugins::getPlugins] {
			if { [::plugins::getInfo $plugin updated] == 1 } {
				set ::plugins::plugins(${plugin}_updated_selected) 0
			}
		}
		
	}


	#///////////////////////////////////////////////////////////////////////
	proc ReadLangSelected { langcode } {

		set lang [array get ::autoupdate::lang]
		set id [expr {[lsearch $lang $langcode] + 1}]
		return [lindex $lang $id]

	}


}