automsg.tcl

Linux下的MSN聊天程序源码

#///////////////////////////////////////////////////////////////////////////////
# Procedures concerning new personalised States with Auto Messaging features
# 27/12/2003 - Major rewrite by Alberto D韆z: Now the system has options to store
#		the states in states.xml or keep it temporal. Also created a cascading
#		menu-system to manage states. Removed non-xml status file.
#		Added options to switch or not to created state, option to have custom
#		nicknames for each status. We don't need backwards compatibility in 
#		custom status system because previous versions don't store them 

#a custom state is stored in the array StatesList
#each state as an idx (an integer) is saved as argument in
#StatesList($idx) which is a list of the following elements : (in order)
# - the name of this state
# - the custom nick
# - the number describing the status (0 for Online ....)
# - the number of lines of the automessage
# - the automessage itself
# - the personal message (aka psm)

#///////////////////////////////////////////////////////////////////////////////
# LoadStateList ()
# Loads the list of states from the file in the HOME dir
proc LoadStateList {} {
	global HOME

	StateList clear
	if { [file exists [file join ${HOME} "states.xml"]] } {
		if { [catch {

			set file_id [sxml::init [file join ${HOME} "states.xml"]]
			sxml::register_routine $file_id "states:newstate" "new_state"
			sxml::parse $file_id
			sxml::end $file_id
		} res] } {
			::amsn::errorMsg "[trans corruptstates [file join ${HOME} "states.xml.old"]]"
			file copy [file join ${HOME} "states.xml"] [file join ${HOME} "states.xml.old"]
		}
	}
}

#///////////////////////////////////////////////////////////////////////////////
# SaveStateList ()
# Saves the list of states to the file in the HOME dir
proc SaveStateList {} {
	global HOME tcl_platform 
	if {$tcl_platform(platform) == "unix"} {
		set file_id [open "[file join ${HOME} states.xml]" w 00600]
	} else {
		set file_id [open "[file join ${HOME} states.xml]" w]
	}
	fconfigure $file_id -encoding utf-8
	puts $file_id "<?xml version=\"1.0\"?>\n\n<states>"
	set idx 0
	while { $idx <= [expr {[StateList size] - 1}] } {
		set tmp [StateList get $idx]
		set name [::sxml::xmlreplace [lindex $tmp 0]]
		set nick [::sxml::xmlreplace [lindex $tmp 1]]
		set state [::sxml::xmlreplace [lindex $tmp 2]]
		set msg [::sxml::xmlreplace [lindex $tmp 4]]
		set psm [::sxml::xmlreplace [lindex $tmp 5]]
		puts $file_id "   <newstate>\n      <name>$name</name>\n      <nick>$nick</nick>"
		puts $file_id "      <state>$state</state>\n      <message>$msg</message>\n      <psm>$psm</psm>\n   </newstate>\n"
		incr idx 1
	}
	puts $file_id "</states>"
	close $file_id
}


#///////////////////////////////////////////////////////////////////////////////
# StateList (action argument)
# Controls information for list of states
# action can be :
#	add : add a new state to the list (have to give a list with 6 elements)
#	promote : makes state given by argument (is an index) the last used (for aging)
#	get : Returns the state given by argument (is an index), returns 0 if dosen't exist
#	unset : Removes state given by argument (is an index)
#       size : Returns size
#	show : Dumps list to stdout, for debugging purposes only
#	clear : Clears the list
proc StateList { action { argument "" } {argument2 ""} } {
	variable StatesList
	switch $action {
		add {
			set StatesList([array size StatesList]) $argument
			}

		edit {
			set StatesList(${argument2}) $argument
			}

		promote {
			set temp $StatesList($argument)
			for {set idx $argument} {$idx > 0} {incr idx -1} {
				set StatesList($idx) $StatesList([expr {$idx - 1}])
			}
			set StatesList(0) $temp
			unset temp
			}

		get {
			return $StatesList($argument)
			}

		unset {
			for {set idx $argument} {$idx < [expr {[array size StatesList] - 1}]} {incr idx} {
				set StatesList($idx) $StatesList([expr {$idx + 1}])
			}
			unset StatesList([expr {[array size StatesList] - 1}])
			}

		size {
			return [array size StatesList]
			}

		show {
			for {set idx 0} {$idx < [array size StatesList]} {incr idx} {
				status_log "$idx : $StatesList($idx)\n"
			}
			}
		clear {
			if { [info exists StatesList] } {
				unset StatesList
			}
			}
	}
}

#///////////////////////////////////////////////////////////////////////////////
# AddStatesToList (path)
proc AddStatesToList { path } {
	for {set idx 0} {$idx < [StateList size] } { incr idx } {
		$path list insert end "** [lindex [StateList get $idx] 0] **"
	}
}
#///////////////////////////////////////////////////////////////////////////////
# CreateStatesMenu (path)
# Creates the menu that will be added under the default states
# path points to the path of the menu where to add
proc CreateStatesMenu { path } {
	global automessage iconmenu
	# Delete old menu to create new one
	if { [$path index end] != 7 } {
		$path delete 8 end
	}
	if { [winfo exists $path.editstates] && [winfo exists $path.deletestates] } {
		$path.editstates delete 0 end
		$path.deletestates delete 0 end
	} else {
		menu $path.editstates -tearoff 0 -type normal
		menu $path.deletestates -tearoff 0 -type normal
	}
#	if { [::config::getKey docking] && [winfo exists $iconmenu] && [$iconmenu index end] != 16} {
#		$iconmenu delete 17 end
#	}
    
	# Create new menu
	if { [StateList size] >= 3 } {
		set limit 3
	} else {
		set limit [StateList size]
	}

	for {set idx 0} {$idx <= [expr {$limit - 1}] } { incr idx 1 } {
		$path.deletestates add command -label "[lindex [StateList get $idx] 0]" -command "DeleteState $idx $path"
		$path.editstates add command -label "[lindex [StateList get $idx] 0]" -command "EditNewState 2 $idx"
		$path add command -label "[lindex [StateList get $idx] 0]" -command "ChCustomState $idx"
#		if { [::config::getKey docking]  && [winfo exists $iconmenu] } {
#			$iconmenu add command -label "   [lindex [StateList get $idx] 0]" -command "ChCustomState $idx" -state disabled
#		}
	}

	# Add cascade menu if there are more than 3 personal states
	if { [StateList size] > 3 } {
		if { ![winfo exists $path.otherstates] } {
			menu $path.otherstates -tearoff 0 -type normal
		} else {
			$path.otherstates delete 0 end
		}
#		if { [::config::getKey docking] && [winfo exists $iconmenu] && ![winfo exists $iconmenu.otherstates] } {
#			menu $iconmenu.otherstates -tearoff 0 -type normal
#		} elseif { [::config::getKey docking] && [winfo exists $iconmenu.otherstates] } {
#			$iconmenu.otherstates delete 0 end
#		}
		for {} { $idx <= [expr {[StateList size] - 1}] } { incr idx } {
			$path.deletestates add command -label "[lindex [StateList get $idx] 0]" -command "DeleteState $idx $path"
			$path.editstates add command -label "[lindex [StateList get $idx] 0]" -command "EditNewState 2 $idx"
			$path.otherstates add command -label "[lindex [StateList get $idx] 0]" -command "ChCustomState $idx"
#			if { [::config::getKey docking] && [winfo exists $iconmenu] } {
#				$iconmenu.otherstates add command -label "[lindex [StateList get $idx] 0]" -command "ChCustomState $idx"
#			}
		}
#		if { [::config::getKey docking] && [winfo exists $iconmenu.otherstates] } {
#			$iconmenu add cascade -label "   [trans morepersonal]" -menu $iconmenu.otherstates -state disabled
#			$iconmenu add separator
#			$iconmenu add command -label "[trans close]" -command "exit"
#		}
		$path add cascade -label "[trans morepersonal]" -menu $path.otherstates
	}


	$path add separator
	$path add command -label "[trans newstate]" -command "EditNewState 0"
	if { [StateList size] != 0 } {
		$path add cascade -label "[trans editcustomstate]" -menu $path.editstates
		$path add cascade -label "[trans deletecustomstate]" -menu $path.deletestates
	}
	#		if { [::config::getKey docking] && [winfo exists $iconmenu] } {
	#			$iconmenu add separator
	#			$iconmenu add command -label "[trans close]" -command "exit"
	#		}
	
	$path add separator
	$path add command -label "[trans changenick]..." -command cmsn_change_name
	
	$path add command -label "[trans changedisplaypic]..." -command pictureBrowser 
	
	$path add command -label "[trans editmyprofile]..." -command "::hotmail::hotmail_profile"
	
	$path add command -label "[trans cfgalarmall]..." -command "::alarms::configDialog all"
	#	statusicon_proc [MSN::myStatusIs]
		
	if { [::config::getKey use_dock] && [winfo exists $iconmenu.imstatus] && $path != "$iconmenu.imstatus" } {
		CreateStatesMenu $iconmenu.imstatus
	}
	if { [::config::getKey use_dock] && [winfo exists $iconmenu.imstatus] && $path == "$iconmenu.imstatus" } {
		$path delete [expr {[$path index end] - 3}] end
	}
}
	

#///////////////////////////////////////////////////////////////////////////////
# ChCustomState ( idx )
# Sets a new personal state with automessages
# idx indicates the index of the personal state in the StateList, 
# otherwise it indicates a normal state change (AWY, BSY, etc)
proc ChCustomState { idx } {
	global HOME automessage automsgsent original_nick original_psm
	set automessage "-1"
	set redraw 0
	if { [string is digit $idx] == 1 } {
		if { [lindex [StateList get $idx] 2] != "" } {
			if {![info exists original_nick] && [::config::getKey storename]} {
				set original_nick [::abook::getPersonal MFN]
			}
			if {![info exists original_psm] && [::config::getKey storename]} {
				set original_psm [::abook::getPersonal PSM]
			}
			#set new_state [lindex [lindex $list_states [lindex [StateList get $idx] 2]] 0]
			set new_state [::MSN::numberToState [lindex [StateList get $idx] 2]]
			if { $new_state == [::MSN::myStatusIs] } {
				set redraw 1
			}
			set automessage [StateList get $idx]
			set newname "[lindex [StateList get $idx] 1]"
			set newpsm "[lindex [StateList get $idx] 5]"
			status_log [StateList get $idx]
			if { $newname != "" } {
				catch {
					set nickcache [open [file join ${HOME} "nick.cache"] w]
					fconfigure $nickcache -encoding utf-8
					puts $nickcache $original_nick
					puts $nickcache $newname
					puts $nickcache [::abook::getPersonal login]
					close $nickcache
				}
				
				set newname [string map { "\\" "\\\\" "\$" "\\\$" } $newname]
				set newname [string map { "\\\$nick" "\${original_nick}" } $newname]
				set newname [subst -nocommands $newname]
				::MSN::changeName [::config::getKey login] $newname
				StateList promote $idx
			}
			if { $newpsm != "" } {
                                catch {
                                        set psmcache [open [file join ${HOME} "psm.cache"] w]
                                        fconfigure $psmcache -encoding utf-8
                                        puts $psmcache $original_psm
                                        puts $psmcache $newpsm
                                        puts $psmcache [::abook::getPersonal PSM]
                                        close $psmcache
                                }

                                set newpsm [string map { "\\" "\\\\" "\$" "\\\$" } $newpsm]
                                set newpsm [string map { "\\\$psm" "\${original_psm}" } $newpsm]
                                set newpsm [subst -nocommands $newpsm]
                                ::MSN::changePSM $newpsm
                        }
		}
	} else {
		set automessage "-1"
		if { $idx == [::MSN::myStatusIs]} {
			set redraw 1
		}
		if {[::config::getKey storename]} {
			if { [info exists original_nick] } {
				::MSN::changeName [::config::getKey login] $original_nick
				unset original_nick
				catch { file delete [file join ${HOME} "nick.cache"] }
			}
                        if { [info exists original_psm] } {
                                ::MSN::changePSM $original_psm
                                unset original_psm
                                catch { file delete [file join ${HOME} "psm.cache"] } 
                        }

		}
		set new_state $idx
	}

	if { [info exists new_state] } {
		::MSN::changeStatus $new_state

		#PostEvent 'ChangeMyState' when the user changes his/her state
		set evPar(automessage) automessage
		set evPar(idx) new_state