groups.tcl

Linux下的MSN聊天程序源码

#	Group Administration
#	by: D�imo Emilio Grimaldo Tu�n
# $Id: groups.tcl 6854 2006-06-15 09:31:30Z vivia $
#=======================================================================
# TODO LIST
#  - Keep track of transactions pending completion
#  - Investigate what happens when a group is deleted, does the
#    server send a new list? obviously the upper groups get
#    a reassigned number (???). Remember that the entries in
#    the address book (::abook) contains the group IDs received
#    in the Forward List.
#	* group id is left unused until a new group is added.

namespace eval ::groups {
	namespace export Init Enable Disable Set Rename Delete Add \
		RenameCB DeleteCB AddCB \
		GetList ToggleStatus UpdateCount IsExpanded \
		menuCmdMove menuCmdCopy

	if { $initialize_amsn == 1 } {
	
		#
		# P R I V A T E
		#
		variable parent "";
		variable entryid -1;
		variable groupname "";	# Temporary variable for TCL crappiness
		variable bShowing;		# (array) Y=shown/expanded N=hidden/collapsed
		variable uMemberCnt;		# (array) member count for that group
		variable uMemberCnt_online;	# (array) member count for that group
		
		global pgc
	}

	#
	proc menuCmdDelete {gid {pars ""}} {
		::groups::Delete $gid dlgMsg
	}

	proc menuCmdRename {gid} {
		::groups::dlgRenameThis $gid
	}


	proc menuCmdCopy {newgid {paramlist ""}} {
		set passport [lindex $paramlist 0]
		set name [::abook::getNick $passport]
		::MSN::copyUser $passport $newgid $name
	}


	proc menuCmdMove {newgid currgid {paramlist ""}} {
		set passport [lindex $paramlist 0]
		set name [::abook::getNick $passport]
		::MSN::moveUser $passport $currgid $newgid $name
		#status_log "Moving user $passport from $currgid to $newgid\n" white
	}

	#<dlgMsg>
	proc dlgMsg {msg} {
		::amsn::errorMsg $msg
	}
   
	#<dlgAddGroup> Dialog to add a group
	proc dlgAddGroup {} {

		global pgc

		set w .dlgag

		if {[winfo exists $w]} {
			set pgc 0
			return
		}
	
		set bgcol2 #ABC8D2
	
		toplevel $w -highlightcolor $bgcol2
		wm title $w "[trans groupadd]"

		frame $w.groupname -bd 1 
		label $w.groupname.lbl -text "[trans group]" -font sboldf
		entry $w.groupname.ent -width 20 -bg #FFFFFF -font splainf
		pack $w.groupname.lbl $w.groupname.ent -side left

		frame $w.groupcontact -bd 1
		label $w.groupcontact.lbl -text "[trans groupcontacts]" -font sboldf
		pack $w.groupcontact.lbl

		pack $w.groupname -side top -pady 3 -padx 5
		pack $w.groupcontact -side top -pady 3 -padx 5

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

		set contactlist [list]

		#Create a list with the contacts
		foreach contact [::abook::getAllContacts] {
			if { [lsearch [::abook::getLists $contact] "FL"] != -1 } {
				set contactname [::abook::getDisplayNick $contact]
				lappend contactlist [list $contactname $contact]
			}
		}

		set contactlist [lsort -dictionary -index 0 $contactlist]

		foreach contact $contactlist {
			set name [lindex $contact 0]
			set passport [lindex $contact 1]
			set passport2 [split $passport "@ ."]
   		        set passport3 [join $passport2 "_"]
			checkbutton $gpcontactsframe.w$passport3 -onvalue 1 -offvalue 0 -text " $name" -anchor w -variable [::config::getVar tempcontact_$passport3]
			pack configure $gpcontactsframe.w$passport3 -side top -fill x
		}

		frame $w.b 
		button $w.b.ok -text "[trans ok]"   \
			-command {
				::groups::Add "[.dlgag.groupname.ent get]" dlgMsg;
				destroy .dlgag
			}
		button $w.b.cancel -text "[trans cancel]"   \
			-command {
				set pgc 0;
				foreach contact [::abook::getAllContacts] {
					if { [lsearch [::abook::getLists $contact] "FL"] != -1 } {
						set passport2 [split $contact "@ ."]
					    set passport3 [join $passport2 "_"]
						::config::unsetKey tempcontact_$passport3
					}
				}
				destroy .dlgag
			}
		pack $w.b.ok .dlgag.b.cancel -side right -padx 5

		pack $w.groupcontacts -side top -pady 3 -padx 5
		pack $w.b -side top -anchor e -pady 3


		bind $w.groupname.ent <Return> { 
			::groups::Add "[.dlgag.groupname.ent get]" dlgMsg; 
			destroy $w
		}

		bind $w <<Escape>> {
			set pgc 0
			foreach contact [::abook::getAllContacts] {
				if { [lsearch [::abook::getLists $contact] "FL"] != -1 } {
					set passport2 [split $contact "@ ."]
				    set passport3 [join $passport2 "_"]
					::config::unsetKey tempcontact_$passport3
				}
			}
			destroy .dlgag;
		}

		moveinscreen $w 30
	}

	# Used to perform the group renaming without special dialogues
	proc ThisOkPressed { gid } {
		if [winfo exists .dlgthis] {
			set gname [GetName $gid]
			::groups::Rename $gname [.dlgthis.data.ent get] dlgMsg
			destroy .dlgthis
		}
	}
   
	# New simplified renaming dialog
	proc dlgRenameThis {gid} {
		global pgc
		
		if {[winfo exists .dlgthis]} {
			set pgc 0
			destroy .dlgthis
		}
		set bgcol2 #ABC8D2
	
		toplevel .dlgthis -highlightcolor $bgcol2
		wm title .dlgthis "[trans grouprename]"
		frame .dlgthis.data -bd 1 
		label .dlgthis.data.lbl -text "[trans groupnewname]:" -font sboldf
		entry .dlgthis.data.ent -width 20 -bg #FFFFFF -font splainf
		.dlgthis.data.ent insert end [GetName $gid]
		bind .dlgthis.data.ent <Return> "::groups::ThisOkPressed $gid"
		pack .dlgthis.data.lbl .dlgthis.data.ent -side left
		
		frame .dlgthis.buttons 
		button .dlgthis.buttons.ok -text "[trans ok]" -command "::groups::ThisOkPressed $gid" 
		button .dlgthis.buttons.cancel -text "[trans cancel]" \
			-command "set pgc 0; destroy .dlgthis" 
		pack .dlgthis.buttons.ok .dlgthis.buttons.cancel -side left -pady 5
			
		pack .dlgthis.data .dlgthis.buttons -side top
		moveinscreen .dlgthis 30
	
	}
   
	# New group menu, for contact list only, no for management in toolbar
	# it avoids complex group selection when renaming or deleting groups
	proc GroupMenu {gid cx cy} {
		if [winfo exists .group_handler] {
			destroy .group_handler
		}
		# The submenu of standard group actions
		menu .group_handler -tearoff 0 -type normal
		.group_handler add command -label "[trans groupadd]..." -command ::groups::dlgAddGroup
		if {$gid != "online" & $gid != "offline"} {
			.group_handler add separator
			.group_handler add command -label "[trans delete]" -command "::groups::Delete $gid dlgMsg"
			.group_handler add command -label "[trans rename]..." -command "::groups::dlgRenameThis $gid"
			.group_handler add separator
			.group_handler add command -label "[trans block]" -command "::groups::blockgroup $gid"
			.group_handler add command -label "[trans unblock]" -command "::groups::unblockgroup $gid"
		}
		tk_popup .group_handler $cx $cy
	}


	#Block all the contacts into a group	
	proc blockgroup {gid} {
		#Ask confirmation for block all the users in the group
		set answer [::amsn::messageBox "[trans confirm]" yesno question [trans block]]
		#If yes
		if { $answer == "yes"} {
			#Get all the contacts
			set timer 0
			foreach user_login [::abook::getAllContacts] {
				#If the contact is not already blocked
				if { [lsearch [::abook::getLists $user_login] BL] == -1} {
					#Get the group for each contact
					foreach gp [::abook::getContactData $user_login group] {
						#If the group is the same at specified, block the user
						if {$gp == $gid} {
							set name [::abook::getNick ${user_login}]
							after $timer [list ::MSN::blockUser ${user_login} [urlencode $name]]
							set timer [expr {$timer + 250}]
						}
					}
				}
			}
		}
	}
	#Unblock all the contacts into a group
	proc unblockgroup {gid} {
		#For each user in all contacts
		set timer 0
		foreach user_login [::abook::getAllContacts] {
			#If the contact is blocked
			if { [lsearch [::abook::getLists $user_login] BL] != -1} {
				#Get the group for each contact
				foreach gp [::abook::getContactData $user_login group] {
					#Compare if the group of the user is the same that the group requested to be blocked
					if {$gp == $gid} {
						#If yes, unblock the user
						set name [::abook::getNick ${user_login}]
						after $timer [list ::MSN::unblockUser ${user_login} [urlencode $name]]
						set timer [expr {$timer + 250}]
					}
				}
			}
		}
	}
	

	# Used to display the list of groups that are candidates for
	# deletion in the Delete Group... & Rename Group menus
	proc updateMenu {type path {cb ""} {pars ""}} {
		if {$type == "menu"} {
			$path delete 0 end
		}
		# The Unique Group ID (MSN) is sent with the RemoveGroup message.
		# The first group's ID is zero (0) (MSN)
		set glist [lrange [::groups::GetList] 1 end]

		#SORT THE GROUP-IDS BY GROUP-NAME
		set thelistnames [list]
		foreach gid $glist {
			set thename [::groups::GetName $gid]
			lappend thelistnames [list "$thename" $gid]
		}
		set sortlist [lsort -dictionary -index 0 $thelistnames ]
		set glist [list]
		foreach gdata $sortlist {
			lappend glist [lindex $gdata 1]
		}              


		set gcnt [llength $glist]
		
		for {set i 0} {$i < $gcnt} {incr i} {
			set gid   [lindex $glist $i]	;# Group ID
			set gname [::groups::GetName $gid]	;# Group Name (unencoded)
			
			if {$type == "menu"} {
				$path add command -label $gname -command "$cb $gid $pars"
			} else {
				if {$i == 0} {
#				set mpath [tk_optionMenu $path ::groups::groupname $gname]
				} else {
#				$mpath add radiobutton -label $gname -variable ::groups::groupname
				}
			}
			# To obtain the label of the i'th menu entry
			# set ithLabel [$path entrycget $i -label]
		}
	}

	#
	# P R O T E C T E D
	#
	# ----------------- Callbacks -------------------
	proc RenameCB {pdu} {  # REG 25 12066 15 New%20Name 0
		#variable groups
		array set groups [::abook::getContactData contactlist groups]
	
		if { [::config::getKey protocol] == 11 } {
			set trid [lindex $pdu 1]
			set gid  [lindex $pdu 2]
			set gname [urldecode [lindex $pdu 3]]
		} else {
			set trid [lindex $pdu 1]
			set lmod [lindex $pdu 2]
			set gid  [lindex $pdu 3]
			set gname [urldecode [lindex $pdu 4]]
		}
	
		set groups($gid) $gname
	
		::abook::setContactData contactlist groups [array get groups]
		# Update the Delete Group... menu
		::groups::updateMenu menu .group_list_delete ::groups::menuCmdDelete
		::groups::updateMenu menu .group_list_rename ::groups::menuCmdRename
		::Event::fireEvent groupRenamed groups $gid $gname
	}

	proc DeleteCB {pdu} {	# RMG 24 12065 15
		variable bShowing
		variable uMemberCnt
		variable uMemberCnt_online
		array set groups [abook::getContactData contactlist groups]
		
		if { [::config::getKey protocol] == 11 } {
			set trid [lindex $pdu 1]
			set gid  [lindex $pdu 2]
		} else {
			set trid [lindex $pdu 1]
			set lmod [lindex $pdu 2]
			set gid  [lindex $pdu 3]
		}
	
		# Update our local information
		unset groups($gid)
		unset uMemberCnt($gid)
		unset uMemberCnt_online($gid)
		unset bShowing($gid)
	
		# TODO: We are out of sync, maybe we should request
		# a new list
		abook::setContactData contactlist groups [array get groups]
		# Update the Delete Group... menu
		::groups::updateMenu menu .group_list_delete ::groups::menuCmdDelete
		::groups::updateMenu menu .group_list_rename ::groups::menuCmdRename
		::Event::fireEvent groupRemoved groups $gid
	}

	proc AddCB {pdu} {	# ADG 23 12064 New%20Group 15 =?�-CC
		#variable groups
		variable uMemberCnt
		variable uMemberCnt_online
		variable bShowing
		array set groups [abook::getContactData contactlist groups]

		if { [::config::getKey protocol] == 11 } {
			set trid [lindex $pdu 1]
			set gname [urldecode [lindex $pdu 2]]
			set gid  [lindex $pdu 3]
		} else {
			set trid [lindex $pdu 1]
			set lmod [lindex $pdu 2]
			set gname [urldecode [lindex $pdu 3]]
			set gid  [lindex $pdu 4]
		}
	
		set groups($gid) $gname
		set uMemberCnt($gid) 0
		set uMemberCnt_online($gid) 0
		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)]

		abook::setContactData contactlist groups [array get groups]	
		::groups::updateMenu menu .group_list_delete ::groups::menuCmdDelete
		::groups::updateMenu menu .group_list_rename ::groups::menuCmdRename
		::Event::fireEvent groupAdded groups $gid
	}
   
	proc ToggleStatus {gid} {
		variable bShowing
	
		if {![info exists bShowing($gid)]} {
			return 0
		}
	
		if { $bShowing($gid) == 1 } {
			set bShowing($gid) 0
		} else {
			set bShowing($gid) 1
		}
		
		::config::setKey expanded_group_$gid [set bShowing($gid)]
	
		return [set bShowing($gid)]
	}
   
	proc UpdateCount {gid rel_qty {online ""}} {
		variable uMemberCnt
		variable uMemberCnt_online
		variable bShowing
	
		if {![info exists bShowing($gid)]} {
			return -1
		}
		if {![info exists uMemberCnt($gid)]} {
			set uMemberCnt($gid) 0
		}
		
		if {($rel_qty == 0) || ($rel_qty == "clear")} {
			set uMemberCnt($gid) 0
			set uMemberCnt_online($gid) 0
		} elseif {("$online" == "online")} {