guicontactlist.tcl

Linux下的MSN聊天程序源码

		# First let's get our groups
		set groupList [getGroupList]

		# Now our contacts
		set userList [::MSN::sortedContactList]

		# Create new list of lists with [email groupitsin]
		set userGroupList [list]

		foreach user $userList {
			lappend userGroupList [list $user [getGroupId $user]]
		}
		
		# Go through each group, and insert the contacts in a new list
		# that will represent our GUI view
		foreach group $groupList {
			set grId [lindex $group 0]
			
			# if group is empty and remove empty groups is set (or this is
			# Individuals group) then skip this group
			if { ($grId == 0 || ([::config::getKey removeempty] && $grId != "offline" \
				&& $grId != "mobile")) && [getGroupCount $group] == 0} {
				continue
			}

			# First we append the group
			lappend contactList $group

			if { [::groups::IsExpanded [lindex $group 0]] != 1 && $kind == "normal"} {
				continue
			}
			
			# We check for each contact
			set idx 0
			foreach user $userGroupList {
				set hisgroupslist [lindex $user 1]
				# If this contact matches this group, let's add him
				if { [lsearch $hisgroupslist [lindex $group 0]] != -1 } {
					lappend contactList [list "C" [lindex $user 0]]
					# If he only belongs to this group, remove him from initial list
					if { [llength $hisgroupslist] == 1 } {
						lreplace $userGroupList $idx $idx
					}
				}
				incr idx
			}
		}

		return $contactList
	}

	##################################################
	# Get the group count
	# Depend if user in status/group/hybrid mode
	proc getGroupCount {element} {
		set mode [::config::getKey orderbygroup]
		if { $mode == 0} {
			# Status mode
			set groupcount $::groups::uMemberCnt([lindex $element 0])
		}  elseif { $mode == 1} {
			# Group mode
			set groupcount $::groups::uMemberCnt_online([lindex $element 0])/$::groups::uMemberCnt([lindex $element 0])
		} elseif { $mode == 2} {
			# Hybrid mode
			if {[lindex $element 0] == "offline" || [lindex $element 0] == "mobile"} {
				set groupcount $::groups::uMemberCnt([lindex $element 0])
			} else {
				set groupcount $::groups::uMemberCnt_online([lindex $element 0])	
			}
		}
		return $groupcount
	}


	# Function that returns a list of the groups, depending on the selected view mode (Status, Group, Hybrid)
	#
	# List looks something like this :
	# We have a list of these lists :
	# [group_state gid group_name [listofmembers]]
	# listofmembers is like this :
	# [email redraw_flag]
	proc getGroupList {} {
		set mode [::config::getKey orderbygroup]
		
		# Online/Offline mode
		if { $mode == 0 } {
			if {[::config::getKey showMobileGroup] == 1} {
				set groupList [list [list "online" [trans online]] \
					[list "mobile" [trans mobile]] \
					[list "offline" [trans offline]]]
			} else {
				set groupList [list [list "online" [trans online]] \
					[list "offline" [trans offline]]]
			}

		# Group/Hybrid mode
		} elseif { $mode == 1 || $mode == 2} {
			set groupList [list]
			# We get the array of groups from abook
			array set groups [::abook::getContactData contactlist groups]
			# Convert to list
			set g_entries [array get groups]
			set items [llength $g_entries]

			for {set idx 0} {$idx < $items} {incr idx 1} {
				set gid [lindex $g_entries $idx]
				incr idx 1
				# Jump over the individuals group as it should not be
				# sorted alphabetically and allways be first
				if {$gid == 0} {
					continue
				} else {
					set name [lindex $g_entries $idx]
					lappend groupList [list $gid $name]
				}
			}

			# Sort the list alphabetically
			if {[::config::getKey ordergroupsbynormal]} {
				set groupList [lsort -dictionary -index 1 $groupList]
			} else {
				set groupList [lsort -decreasing -dictionary -index 1 $groupList]
			}

			# Now we have to add the "individuals" group, translated and as first

			# TODO: Maybe someone should do this a better way, but I had problems
			#	 with the 'linsert' command
			set groupList "\{0 \{[trans nogroup]\}\} $groupList"
		}
		
		# Hybrid Mode, we add mobile and offline group
		if { $mode == 2 } {
			if {[::config::getKey showMobileGroup] == 1} {
				lappend groupList [list "mobile" [trans mobile]]
			}
			lappend groupList [list "offline" [trans offline]]
		}
		
		return $groupList
	}


	################################################################
	# Function that returns the appropriate GroupID(s) for the user
	# this GroupID depends on the group view mode selected
	proc getGroupId { email } {
		set mode [::config::getKey orderbygroup]
		set status [::abook::getVolatileData $email state FLN]
		
		# Online/Offline mode
		if { $mode == 0 } {
			if { $status == "FLN" } {
				if { [::abook::getContactData $email msn_mobile] == "1" \
					&& [::config::getKey showMobileGroup] == 1} {
					return "mobile"
				} else {
					return "offline"
				}
			} else {
				return "online"
			}

		# Group mode
		} elseif { $mode == 1} {
			return [::abook::getGroups $email]
		}
		
		# Hybrid Mode, we add offline group
		if { $mode == 2 } {
			if { $status == "FLN" } {
				if { [::abook::getContactData $email msn_mobile] == "1" && [::config::getKey showMobileGroup] == 1} {
					return "mobile"
				} else {
					return "offline"
				}
			} else {
				return [::abook::getGroups $email]
			}
		}
	}

	###############################################	
	# Here we create the balloon message
	# and we add the binding to the canvas item.
	proc getBalloonMessage {email element} {
		# Get variables
		set not_in_reverse [expr {[lsearch [::abook::getLists $email] RL] == -1}]
		set state_code [::abook::getVolatileData $email state FLN]

		# If user is not in list, add it to the balloon
		if { $not_in_reverse } {
			set balloon_message2 "\n[trans notinlist]"
		} else {
			set balloon_message2 ""
		}

		# If order in status mode, show the group of the contact in the balloon
		if { [::config::getKey orderbygroup] == 0 } {
			set groupname [::abook::getGroupsname $email]
			set balloon_message3 "\n[trans group] : $groupname"
		} else {
			set balloon_message3 ""
		}

		# If the status is offline, get the last time he was online
		if { $state_code == "FLN" } {
			set balloon_message4 "\n[trans lastseen] : [::abook::dateconvert \
				"[::abook::getContactData $email last_seen]"]"
		} else {
			set balloon_message4 ""
		}

		# Define the final balloon message
		set balloon_message "[string map {"%" "%%"} [::abook::getNick $email]]\n\
			$email\n[trans status] : [trans [::MSN::stateToDescription $state_code]] \
			$balloon_message2 $balloon_message3 $balloon_message4\n[trans lastmsgedme] \
			: [::abook::dateconvert "[::abook::getContactData $email last_msgedme]"]"
		return $balloon_message	
	}


	proc truncateText { text maxwidth } {
		set shortened ""
		set stringlength [string length $text]

		# Store stringlength
		for {set x 0} {$x < $stringlength} {incr x} {
			set nextchar [string range $text $x $x]
			set nextstring "$shortened$nextchar"
			if {[font measure splainf $nextstring] > $maxwidth} {
				break
			}
			set shortened "$nextstring"
		}
		return $shortened
	}


	#######################################################
	# Procedure that draws horizontal lines from this list
	# of [list xcoord xcoord linelength] lists
	proc underlineList { canvas lines nicktag} {
		set poslist [$canvas coords $nicktag]
		set xpos [lindex $poslist 0]
		set ypos [lindex $poslist 1]
		# status_log "poslist: $lines"
		global OnTheMove

		# if {!$OnTheMove} {
			foreach line $lines {
				$canvas create line [expr [lindex $line 0] + $xpos] \
					[expr [lindex $line 1] + $ypos] [expr [lindex $line 0] \
					+ [lindex $line 2] + $xpos] [expr [lindex $line 1] + $ypos] \
					-fill [lindex $line 3] -tags [list uline_$nicktag $nicktag uline]
			}
		# }
		$canvas lower uline_$nicktag $nicktag
	}


	#######################################################
	# Procedure which scrolls the canvas up/down
	proc scrollCL {canvas direction} {
		set canvaslength [lindex [$canvas cget -scrollregion] 3]

		if {[winfo height $canvas] <= $canvaslength} {
			if {$direction == "down" || $direction == "-1"} {
				$canvas yview scroll 1 units
			} else {
				$canvas yview scroll -1 units
			}
		
			# Here we have to move the background-image. This should
			# be done as a command given to scrolledwindow, so it also
			# works when dragging the scrollbar
			moveBGimage $canvas

			# $canvas coords backgroundimage 0 [expr int([expr \
			#	[lindex [$canvas yview] 0] * $canvaslength])]
		}
	}


	proc createNicknameArray {} {
		global nicknameArray
		array set nicknameArray {}

		set userList [::MSN::sortedContactList]

		foreach user $userList {
			set usernick "[::abook::getDisplayNick $user]"
			set nicknameArray("$user") "[::smiley::parseMessageToList $usernick 1]"
		}

		# TODO: Review this event, maybe it would fit better in other place
		set evpar(array) nicknameArray
		::plugins::PostEvent NickArrayCreated evpar
	}


	#####################################
	#    Contact dragging procedures    #
	#####################################
	proc contactPress {tag canvas} {
		global OldX
		global OldY
		global OnTheMove

		# Store old coordinates
		set OldX [winfo pointerx .]
		set OldY [winfo pointery .]
		set OnTheMove 1

		$canvas delete uline_$tag
	}


	proc contactMove {tag canvas} {
		global OldX
		global OldY

		# Change coordinates 
		set NewX [winfo pointerx .]
		set NewY [winfo pointery .]
		set ChangeX [expr $OldX - $NewX]
		set ChangeY [expr $OldY - $NewY]

		$canvas move $tag [expr $ChangeX * -1] [expr $ChangeY * -1]

		set OldX [winfo pointerx .]
		set OldY [winfo pointery .]

		# TODO: * Make the canvas scroll if we hover the vertical edges of the canvas
		# 	* Make the dragged contact stay under the cursor
		# 	* Make it keep scrolling as long as we are in the area also if we don't move (extra proc)

		set canvaslength [lindex [$canvas cget -scrollregion] 3]

		# if {[lindex [$canvas coords $email] 1] >= [expr [winfo height $canvas] - 20] } {
		# 	after 300 
		# 	::guiContactList::scrollCL down $canvaslength
		# }
		# !!! Won't work this way
		$canvas delete uline_$tag
		
	}


	proc contactReleased {tag canvas} {
		global OldX
		global OldY
		global OnTheMove

		# TODO: copying instead of moving when CTRL is pressed
		# 	first get the info out of the tag

		status_log "tag is: $tag"

		set email [::guiContactList::getEmailFromTag $tag]
		status_log "email is: $email"

		set grId [::guiContactList::getGrIdFromTag $tag]
		status_log "grId is: $grId"
		# Kill the balloon if it came up, otherwise it just stays there
		set Bulle(first) 0; kill_balloon

		# Check with Xcoord if we're still on the canvas
		set iconXCoord [lindex [$canvas coords $tag] 0]

		# TODO: If we drag off the list; now it's only on the left, make 
		# 	it also "if bigger then viewable area of canvas
		if {$iconXCoord < 0} { 
			# TODO: Where we should trigger an event that can be used
			# 	by plugins for example, the contact tray plugin
			# 	could create trays like this

			status_log "guiContactList: contact dragged off the CL"

			# Trigger event

			::guiContactList::drawList $canvas
		} else {
			# First see what's the coordinates of the icon
			set iconYCoord [lindex [$canvas coords $tag] 1]

			# Now we have to find the group whose ycoord is the first
			# less then this coord

			# Beginsituation: group to move to is group where we began
			set oldgrId $grId
			set newgrId $oldgrId

			set groupList [getGroupList]

			# Cycle to the list of groups and select the group where
			# the user drags to
			foreach group $groupList {
				# Get the group ID
				set grId [lindex $group 0]

				# Only go for groups that are actually drawn on the list
				if { [$canvas coords gid_$grId] != ""} {
					# Get the coordinates of the group
					set grYCoord [lindex [$canvas coords gid_$grId] 1]
	
					# This +5 is to make dragging a contact on a group's name
					# or 5 pixels above the group's name possible
					if {$grYCoord <= [expr $iconYCoord + 5]} {
						set newgrId $grId
					}
				}
			}
	
			# Remove the contact from the canvas as it's gonna be redrawn on the right place	
			$canvas delete $tag

			# If user wants to move from/to a place that's not possible, just leave the
			# contact in the current group (other words: "don't do anything")

			if { [string is integer $newgrId] && $newgrId != $oldgrId && [string is integer $oldgrId] } {
				# Move the contact
				status_log "Gonna move $email from $oldgrId to $newgrId"
				::groups::menuCmdMove $newgrId $oldgrId $email
				status_log "$email is now in [getGroupId $email]"
				# TODO: This redrawing should be deleted once the right events are
				# 	set as the event will know when a group is changed and we
				# 	don't want to redraw twice!
				after 1000 ::guiContactList::drawList $canvas
			} else {
				status_log "Can't move $email from \"$oldgrId\" to \"$newgrId\"!"
				::guiContactList::drawList $canvas
			}
		}

		set OnTheMove 0

		# Remove those vars as they're not in use anymore
		unset OldX
		unset OldY
	}


	proc getEmailFromTag { tag } {
		set pos [string last _ $tag]
		set email [string range $tag 0 [expr $pos -1]]
		return $email
	}


	proc getGrIdFromTag { tag } {
		set pos [string last _ $tag]
		set grId [string range $tag [expr $pos + 1] end]
		return $grId
	}
}