groups.tcl

Linux下的MSN聊天程序源码

			incr uMemberCnt($gid) $rel_qty
			incr uMemberCnt_online($gid) $rel_qty
		} else {
			incr uMemberCnt($gid) $rel_qty
		}
		return $uMemberCnt($gid)
	}

	proc IsExpanded {gid} {
		variable bShowing
		if {![info exists bShowing($gid)]} {
			set bShowing($gid) 1	
			if { [::config::getKey expanded_group_$gid]!="" } {
				set bShowing($gid) [::config::getKey expanded_group_$gid]
			}
			::config::setKey expanded_group_$gid [set bShowing($gid)]
		}
	
		return $bShowing($gid)
	}

	#
	# P U B L I C
	#
	#<Init> Initialize the non-mutable part of the menus and the
	#	   core of the group administration. At this point we do not
	#	   have any information about the groups (we are not connected)
	proc Init {p} {
		variable parent
		variable entryid
	
		# The submenu with the list of defined groups (to be filled)
		menu .group_list_delete -tearoff 0 -type normal
		menu .group_list_rename -tearoff 0 -type normal
	
		# The submenu of standard group actions
#		menu .group_menu -tearoff 0 -type normal
#		.group_menu add command -label "[trans groupadd]..." \
#			-command ::groups::dlgAddGroup
#		.group_menu add cascade -label "[trans grouprename]" \
#			-menu .group_list_rename
#		.group_menu add cascade -label "[trans groupdelete]" \
#			-menu .group_list_delete
#
	
		# Attach the Group Administration entry to the parent menu
#		$p add cascade -label "[trans admingroups]" -state disabled \
#			-menu .group_menu
	
#		set parent $p		;# parent menu where we attach
		# We need the next to dynamically enable/disable the menu widget
#		set entryid [$p index "[trans admingroups]"]
	
	
	}

	proc Reset {} {
	
		#variable groups
		variable bShowing
		variable uMemberCnt
	
	
		# These are the default groups. Used when not sorting the
		# display by user-defined groups
		set uMemberCnt(online)	0
		set uMemberCnt(offline) 0
		set uMemberCnt(blocked) 0
		set bShowing(online)	1
		set bShowing(offline)	1
		set bShowing(blocked)   1
	
		foreach groupid {online offline blocked} {
			if { [::config::getKey expanded_group_$groupid]!="" } {
				set bShowing($groupid) [::config::getKey expanded_group_$groupid]
			}
		}

		::abook::setContactData contactlist groups ""
		::abook::unsetConsistent
		#Clear list of groups
		#set g_entries [array names groups]
		#foreach gr $g_entries {
		#   unset groups($gr)
		#}
	
	}

	# Must only Enable it when the list of groups is already available!
	# That's because from here we rebuild the group submenu (list)
	proc Enable {} {
		variable parent
		variable entryid
	
		::groups::updateMenu menu .group_list_delete ::groups::menuCmdDelete
		::groups::updateMenu menu .group_list_rename ::groups::menuCmdRename
		# The entryid of the parent is 0
#		$parent entryconfigure $entryid -state normal
#		$parent entryconfigure 6 -state normal
		#status_log "Groups: menu enabled\n" blue
	}

	# Call this one when going offline (disconnecting)
	proc Disable {} {
		variable parent 
		variable entryid
	
#		$parent entryconfigure $entryid -state disabled
#		$parent entryconfigure 6 -state disabled

	}

	# Gets called whenever we receive a List Group (LSG) packet,
	# this happens in the early stages of the connection.
	# MSN Packet: LSG <x> <trid> <cnt> <total> <gid> <name> 0
	proc Set { nr name } {	# There is a new group in the list
		#variable groups
		variable uMemberCnt
		variable uMemberCnt_online
		variable bShowing
		array set groups [abook::getContactData contactlist groups]
		
		set name [urldecode $name]
		set groups($nr) $name
		set uMemberCnt($nr) 0
		set uMemberCnt_online($nr) 0
		set bShowing($nr)   1
		
		if { [::config::getKey expanded_group_$nr]!="" } {
			set bShowing($nr) [::config::getKey expanded_group_$nr]
		}
		::config::setKey expanded_group_$nr [set bShowing($nr)]

		abook::setContactData contactlist groups [array get groups]       
		
		#status_log "Groups: added group $nr ($name)\n" blue
	}

	# Get a group's name (decoded) given its ID (0..n)
	proc GetName {nr} {
		if { $nr == 0 } {
			#Special group "Individuals"
			return [trans nogroup]
		}
		array set groups [abook::getContactData contactlist groups]
		
		if {![info exists groups($nr)]} {
			return ""
		}
		return $groups($nr)
	}

	# Does a reverse lookup from group name to find it's id.
	# Returns: -1 on error (not found), otherwise 0..n
	proc GetId {gname} {
		#variable groups
		array set groups [abook::getContactData contactlist groups]
		# Groups are stored here in decoded state. When sent to
		# the server we must urlencode them!
		set gname [string trim $gname]
		foreach group [array names groups] {
			if {$groups($group) == $gname} {
				return $group
			}
		}
		return -1
	}

	proc Exists {gname} {
		#variable groups
		array set groups [abook::getContactData contactlist groups]
	
		set gname [string trim $gname]
		foreach group [array names groups] {
			if {$groups($group) == $gname} {
				return 1
			}
		}
		return 0
	}

	proc Rename { old new {ghandler ""}} {
		global pgc
		
		set old [string trim $old]
		set new [string trim $new]
	
		if {$old == $new || $old == ""} { return 0 }
	
		if {![::groups::Exists $old]} {
		if {$ghandler != ""} {
			set retval [eval "$ghandler \"$old : [trans groupunknown]\""]
		}
		set pgc 0
		return 0
		}
	
		if {[::groups::Exists $new]} {
		if {$ghandler != ""} {
			set retval [eval "$ghandler \"$new : [trans groupexists]\""]
		}
		set pgc 0
		return 0
		}
	
		set currentGid [::groups::GetId $old]
		if {$currentGid == -1} {
		if {$ghandler != ""} {
			set retval [eval "$ghandler \"[trans groupmissing]: $old\""]
		}
		set pgc 0
		return 0
		}
	
		#TODO Keep track of transaction number
		set new [urlencode $new]
		::MSN::WriteSB ns "REG" "$currentGid $new 0"
		# RenameCB() should be called when we receive the REG
		# packet from the server

		# If an "add contact" window is open, actualise the group list
		if { [winfo exists .addcontact] == 1 } {
			after 500 cmsn_draw_grouplist
		}

		return 1
	}

	proc Add { gname {ghandler ""}} {
		global pgc
		
		if {[::groups::Exists $gname]} {
			if {$ghandler != ""} {
				set retval [eval "$ghandler \"[trans groupexists]!\""]
			}
			set pgc 0
			return 0
		}
	
		set gname2 [urlencode $gname]
		::MSN::WriteSB ns "ADG" "$gname2 0"
		# MSN sends back "ADG %T %M $gname gid junkdata"
		# AddCB() should be called when we receive the ADG
		# packet from the server

		after 2000 ::groups::AddContactsToGroup $gname

		# If an "add contact" window is open, actualise the group list
		if { [winfo exists .addcontact] == 1 } {
			after 500 cmsn_draw_grouplist
		}
		return 1
	}


	proc AddContactsToGroup { gname } {

		set timer 250
		set gid [::groups::GetId $gname]
		foreach contact [::abook::getAllContacts] {
			if { [lsearch [::abook::getLists $contact] "FL"] != -1 } {
				set passport2 [split $contact "@ ."]
			    set passport3 [join $passport2 "_"]
				if { [::config::getKey tempcontact_$passport3] == 1 } {
					
					set timer [expr {$timer + 250}]
					after $timer ::MSN::copyUser $contact $gid
				}
				::config::unsetKey tempcontact_$passport3
			}
		}

	}

        
	proc Delete { gid {ghandler ""}} {
		global pgc
		
		set gname [::groups::GetName $gid]
		if {![::groups::Exists $gname]} {
		if {$ghandler != ""} {
		set retval [eval "$ghandler \"[trans groupunknown]!\""]
		}
		set pgc 0
		return 0
		}
	
		# Cannot and must not delete a group until it is empty
		if {$::groups::uMemberCnt($gid) != 0} {
		if {$ghandler != ""} {
		set retval [eval "$ghandler \"[trans groupnotempty]!\""]
		}
		set pgc 0
		return 0
		}
		
		::MSN::WriteSB ns "RMG" $gid
		# MSN sends back "RMG %T %M $gid"
		# DeleteCB() should be called when we receive the RMG
		# packet from the server

		# If an "add contact" window is open, actualise the group list
		if { [winfo exists .addcontact] == 1 } {
			after 500 cmsn_draw_grouplist
		}

		return 1
	}

	proc GetList {{opt ""}} {
		#variable groups
		array set groups [abook::getContactData contactlist groups]

		set g_list [list]
		set g_entries [array get groups]
		set items [llength $g_entries]
		for {set idx 0} {$idx < $items} {incr idx 1} {
			set var_pk [lindex $g_entries $idx]
			incr idx 1
			set var_value [lindex $g_entries $idx]
			if {$opt != "-names"} {
				lappend g_list $var_pk	;# Return the key only
			} else {
				lappend g_list $var_value;# Return the value only
			}
		}
		set g_list [lsort -increasing $g_list]
		return $g_list
	    }

	#Tests if a contact belong to a group or not
	proc Belongtogp {email gid} {

		if {[lsearch [::abook::getGroups $email] $gid] == -1} {
			return "0"
		} else {
			return "1"
		} 
	}

	proc Groupmanager { email w } {
		# The Unique Group ID (MSN) is sent with the RemoveGroup message.
		# The first group's ID is zero (0) (MSN)
		set gidlist [lrange [::groups::GetList] 1 end]

		set thelistnames [list]

		#Create a list with the names of the groups the contact belong to
		foreach gid $gidlist {
			set thename [::groups::GetName $gid]
			lappend thelistnames [list "$thename" $gid]
		}

		#Sort the list by names (sortlist is a list of lists with name and gid of a group)
		set sortlist [lsort -dictionary -index 0 $thelistnames]
		set sortlist2 [list]

		frame $w.box

		foreach group $sortlist {
			set name [lindex $group 0]
			set gid [lindex $group 1]
			lappend glist $name
			lappend sortlist2 $gid
			checkbutton $w.box.w$gid -onvalue 1 -offvalue 0 -text " $name" -variable [::config::getVar tempgroup_[::md5::md5 $email]($gid)] -anchor w
			pack configure $w.box.w$gid -side top -fill x
			::config::setKey tempgroup_[::md5::md5 $email]($gid) [Belongtogp $email $gid]
		}
		
		pack configure $w.box -side top -fill x
	}

	proc GroupmanagerOk { email } {
		# The Unique Group ID (MSN) is sent with the RemoveGroup message.
		# The first group's ID is zero (0) (MSN)
		set gidlist [lrange [::groups::GetList] 1 end]

		set gidlistyes [list]
		set gidlistno [list]

		#Check which groups the contact belong to (gidlistyes) and which he doesn't (gidlistno)
		foreach gid $gidlist {
			set state [::config::getKey tempgroup_[::md5::md5 $email]($gid)]
			if {$state == 1} {
				lappend gidlistyes $gid
			} elseif {$state == 0} {
				lappend gidlistno $gid
			}
			::config::unsetKey tempgroup_[::md5::md5 $email]($gid)
		}

		#If the contact doesn't belong to any groups, put it in the "Nogroup" group
		if {$gidlistyes == ""} {
			lappend gidlistyes 0
			set gidlistno [lrange $gidlistno 1 end]
		}

		set timer 0

		#First add the contact to the new groups
		foreach gid $gidlistyes {
			if {[lsearch [::abook::getGroups $email] $gid] == -1} {
				after $timer ::MSN::copyUser $email $gid
				set timer [expr {$timer + 1000}]
			}
		}

		#Then remove their from the former groups
		foreach gid $gidlistno {
			if {[lsearch [::abook::getGroups $email] $gid] != -1} {
				after $timer ::MSN::deleteUser $email $gid
				set timer [expr {$timer + 1000}]
			}
		}

		destroy .gpmanage_[::md5::md5 $email]
	}


	proc GroupmanagerClose { email } {

		# The Unique Group ID (MSN) is sent with the RemoveGroup message.
		# The first group's ID is zero (0) (MSN)
		set gidlist [lrange [::groups::GetList] 1 end]

		foreach gid $gidlist {
			::config::unsetKey tempgroup_[::md5::md5 $email]($gid)
		}

		destroy .gpmanage_[::md5::md5 $email]
	}


}