guicontactlist.tcl

Linux下的MSN聊天程序源码

					image create photo boxdownbar_$groupDrawn -height [image height [::skin::loadPixmap down]] \
						-width $width
					boxdownbar_$groupDrawn copy [::skin::loadPixmap downleft] -to 0 0 [image width \
						[::skin::loadPixmap downleft]]  [image height [::skin::loadPixmap downleft]]
					boxdownbar_$groupDrawn copy [::skin::loadPixmap down] -to  [image width \
						[::skin::loadPixmap downleft]] 0 [expr $width -  [image width \
						[::skin::loadPixmap downright]]]  [image height [::skin::loadPixmap down]]
					boxdownbar_$groupDrawn copy [::skin::loadPixmap downright] -to [expr $width - \
						[image width [::skin::loadPixmap downright]]] 0 $width \
						[image height [::skin::loadPixmap downright]]
					$canvas create image $boXpad $bodYend -image boxdownbar_$groupDrawn -anchor nw \
						-tags [list box box_downbar $gid]

					set curPos [list [lindex $curPos 0] [expr [lindex $curPos 1]+ $ypad] ]
				} else {
					set curPos [list [lindex $curPos 0] [lindex $curPos 1] ]
				}

				# Create upbar of the box
				image create photo boxupbar_$groupDrawn -height [image height [::skin::loadPixmap up]] \
					-width $width
				boxupbar_$groupDrawn copy [::skin::loadPixmap upleft] -to 0 0 [image width \
					[::skin::loadPixmap upleft]]  [image height [::skin::loadPixmap upleft]]
				boxupbar_$groupDrawn copy [::skin::loadPixmap up] -to  [image width \
					[::skin::loadPixmap upleft]] 0 [expr $width -  [image width \
					[::skin::loadPixmap upright]]]  [image height [::skin::loadPixmap up]]
				boxupbar_$groupDrawn copy [::skin::loadPixmap upright] -to [expr $width - \
					[image width [::skin::loadPixmap upright]]] 0 $width \
					[image height [::skin::loadPixmap upright]]

				# Draw it
				set topYbegin [expr [lindex $curPos 1] -5]
				$canvas create image $boXpad $topYbegin -image boxupbar_$groupDrawn -anchor nw \
					-tags [list box box_upbar $gid]

				# Save the endypos for next body drawing
				set bodYbegin [expr $topYbegin + [image height [::skin::loadPixmap up]]]
			
				$canvas move $tag [expr [lindex $curPos 0] - [lindex $currentPos 0] + $xpad] \
					[expr [lindex $curPos 1] - [lindex $currentPos 1]]
				set curPos [list [lindex $curPos 0] [expr [lindex $curPos 1] + 20] + $ypad]
				# TODO: * change this '20' (height of the title) to the right value
				# 	as we already drew a group, the next won't be the first anymore
				set DrawingFirstGroup 0

				# END the "else it's a group"
			}
			# END of foreach
		}

		# Now do the body and the end for the last group:
		set bodYend [expr [lindex $curPos 1] - [::skin::getKey buddy_ypad] ]

		# Here we should draw the body
		set height [expr $bodYend - $bodYbegin]

		if {$height > 0} {
			image create photo boxbodysmall_$groupDrawn -height [image height [::skin::loadPixmap left]] \
				-width $width
			boxbodysmall_$groupDrawn copy [::skin::loadPixmap left] -to 0 0 [image width \
				[::skin::loadPixmap left]]  [image height [::skin::loadPixmap left]]
			boxbodysmall_$groupDrawn copy [::skin::loadPixmap body] -to  [image width \
				[::skin::loadPixmap left]] 0 [expr $width -  [image width \
				[::skin::loadPixmap right]]]  [image height [::skin::loadPixmap body]]
			boxbodysmall_$groupDrawn copy [::skin::loadPixmap right] -to [expr $width - \
				[image width [::skin::loadPixmap right]]] 0 $width  [image height \
				[::skin::loadPixmap right]]
			image create photo boxbody_$groupDrawn -height $height -width $width
			boxbody_$groupDrawn copy boxbodysmall_$groupDrawn -to 0 0 $width $height
			image delete boxbodysmall_$groupDrawn
				
			# Draw it
			$canvas create image $boXpad $bodYbegin -image boxbody_$groupDrawn -anchor nw \
				-tags [list box box_body $gid]
		} else {
			set bodYend $bodYbegin
		}

		# Create endbar of the box
		image create photo boxdownbar_$groupDrawn -height [image height [::skin::loadPixmap down]] \
			-width $width
		boxdownbar_$groupDrawn copy [::skin::loadPixmap downleft] -to 0 0 [image width \
			[::skin::loadPixmap downleft]]  [image height [::skin::loadPixmap downleft]]
		boxdownbar_$groupDrawn copy [::skin::loadPixmap down] -to  [image width \
			[::skin::loadPixmap downleft]] 0 [expr $width -  [image width \
			[::skin::loadPixmap downright]]]  [image height [::skin::loadPixmap down]]
		boxdownbar_$groupDrawn copy [::skin::loadPixmap downright] -to [expr $width - \
			[image width [::skin::loadPixmap downright]]] 0 $width \
			[image height [::skin::loadPixmap downright]]
		$canvas create image $boXpad $bodYend -image boxdownbar_$groupDrawn -anchor nw \
			-tags [list box box_downbar $gid]
			# Get the group-boxes behind the groups and contacts
		$canvas lower box items
			# Set height of canvas
		set canvaslength [expr [lindex $curPos 1] + 20]
		$canvas configure -scrollregion [list 0 0 2000 $canvaslength]
			# Make sure after redrawing the bgimage is on the right place
		$canvas coords backgroundimage 0 [expr int([expr [lindex [$canvas yview] 0] * $canvaslength])]
	}


	#/////////////////////////////////////////////////////////////////////////
	# Function that draws a group 
	#/////////////////////////////////////////////////////////////////////////
	proc drawGroup { canvas element} {
		# Set the group id, our ids are integers and tags can't be so add gid_ to start
		set gid gid_[lindex $element 0]

		# $canvas addtag items withtag $gid

		# Delete the group before redrawing
		$canvas delete $gid

		set xpos 0
		set ypos 0
		
		# Let's setup the right image (expanded or contracted)
		if { [::groups::IsExpanded [lindex $element 0]] } {
			# Set padding between image and text
			set xpad [::skin::getKey contract_xpad]
			set img [::skin::loadPixmap contract]
			set img_hover [::skin::loadPixmap contract_hover]
			set groupcolor [::skin::getKey groupcolorextend]
		} else {
			# Set padding between image and text
			set xpad [::skin::getKey expand_xpad]
			set img [::skin::loadPixmap expand]
			set img_hover [::skin::loadPixmap expand_hover]
			set groupcolor [::skin::getKey groupcolorcontract]
		}

		set groupnamecountpad 5

		# Get the number of user for this group
		set groupcount [getGroupCount $element]
		
		# Store group name and groupcount as string, for measuring length of underline
		set groupnametext "[lindex $element 1]"
		set groupcounttext "($groupcount)"
		
		# Set the begin-position for the groupnametext
		set textxpos [expr $xpos + [image width $img] + $xpad]

		# First we draw our little group toggle button
		$canvas create image $xpos $ypos -image $img -activeimage $img_hover -anchor nw \
			-tags [list group toggleimg $gid img$gid]

		# Then the group's name
		$canvas create text $textxpos $ypos -text $groupnametext -anchor nw \
			-fill $groupcolor -font sboldf -tags [list group title name_$gid $gid]

		set text2xpos [expr {$textxpos + [font measure sboldf $groupnametext] + \
			$groupnamecountpad}]

		# Then the group's count
		$canvas create text $text2xpos $ypos -text $groupcounttext -anchor nw \
			-fill $groupcolor -font splainf -tags [list group title count_$gid $gid]



		#Setup co-ords for underline on hover
		set yuline [expr {$ypos + [font configure splainf -size] + 1 }]

		set underlinst [list [list $textxpos $yuline [font measure sboldf $groupnametext] \
			$groupcolor] [list $text2xpos $yuline [font measure splainf $groupcounttext] \
			$groupcolor]]

		# Create mouse event bindings

		# First, remove previous bindings
		$canvas bind $gid <Enter> ""
		$canvas bind $gid <Motion> ""
		$canvas bind $gid <Leave> ""
		$canvas bind $gid <<Button1>> ""
		$canvas bind $gid <<Button3>> ""

		$canvas bind $gid <<Button1>> "+::guiContactList::toggleGroup [list $element] $canvas"
		$canvas bind $gid <<Button3>> "+::groups::GroupMenu $gid %X %Y"

		$canvas bind $gid <Enter> "+::guiContactList::underlineList $canvas [list $underlinst] $gid"
		$canvas bind $gid <Leave> "+$canvas delete uline_$gid"

		# Change cursor bindings for contacts
		$canvas bind $gid <Enter> "+$canvas configure -cursor hand2"
		$canvas bind $gid <Leave> "+$canvas configure -cursor left_ptr"
	}


	#/////////////////////////////////////////////////////////////////////////
	# Function that draws a contact 
	#/////////////////////////////////////////////////////////////////////////
	proc drawContact { canvas element groupID} {
		# We are gonna store the height of the nicknames
		global nickheightArray
		global nicknameArray
		global Xbegin

		# Set the place for drawing it (should be invisible)
		set xpos 0
		set ypos 0
		
		set email [lindex $element 1]
		set grId $groupID

		# The tag can't be just $email as users can be in more then one group
		set tag "_$grId"; set tag "$email$tag"

		$canvas delete $tag

		set state_code [::abook::getVolatileData $email state FLN]

		if { [::abook::getContactData $email customcolor] != "" } {
			set nickcolour [::abook::getContactData $email customcolor] 
		} else {
			set nickcolour [::MSN::stateToColor $state_code]
		}

		if { [::MSN::userIsBlocked $email] } {
			set img [::skin::loadPixmap blocked]
		} elseif { [::abook::getContactData $email msn_mobile] == "1" && $state_code == "FLN"} {
			set img [::skin::loadPixmap mobile]
		} else {
			set img [::skin::loadPixmap [::MSN::stateToImage $state_code]]
		}

		# TODO: hovers for the status-icons
		# 	skinsetting to have buddypictures in their place (this is default in MSN7!)
		# 	with a pixmap border and also status-emblem overlay in bottom right corner		

		set parsednick $nicknameArray("$email")
		set nickstatespacing 5
		# TODO: skinsetting for the spacing between nicknames and the status
		set statetext "\([trans [::MSN::stateToDescription $state_code]]\)"

		if {$state_code == "NLN" || $state_code == "FLN"} {
			set nickstatespacing 0
			set statetext ""
		}

		if {$grId == "mobile"} {
			set nickstatespacing 5
			set statetext "\([trans mobile]\)"
		}

		set statecolour grey
		# TODO: skinsetting for state-colour
		set statewidth [font measure splainf $statetext]

		# Draw status-icon
		$canvas create image $xpos $ypos -image $img -anchor nw -tags [list contact icon $tag]

		# TODO: skin setting to draw buddypicture; statusicon should become icon + status overlay
		# 	like:	draw icon or small buddypicture overlay it with the status-emblem

		# Set the beginning coords for the next drawings
		set xnickpos [expr $xpos + [image width $img] + 5]
		set ynickpos [expr $ypos + [image height $img]/2]

		# If you are not on this contact's list, show the notification icon
		if {[expr {[lsearch [::abook::getLists $email] RL] == -1}]} {
			set icon [::skin::loadPixmap notinlist]
			$canvas create image [expr $xnickpos -3] $ynickpos -image \
				[::skin::loadPixmap notinlist] -anchor w -tags \
				[list contact icon $tag]
			set xnickpos [expr $xnickpos + [image width $icon]]
		}

		# Now we're gonna draw the nickname itself
		# Reset the underlining's list
		set underlinst [list]
		set maxwidth [winfo width $canvas]
		set ellips "..."

		# Leave some place for the statustext, the elipsis (...) and the spacing + spacing
		# of border and - the beginningborder
		set maxwidth [expr $maxwidth - $statewidth - [font measure splainf $ellips] - \
			$nickstatespacing - 5 - $Xbegin - [::skin::getKey buddy_xpad]]

		# TODO: An option for a X-padding for buddies .. should be set here and in the organising proc

		# We can draw as long as the line isn't full
		set linefull 0
		set textheight [expr [font configure splainf -size]/2 ]

		# This is the var for the y-change
		set ychange [image height $img]
		set relnickcolour $nickcolour
		set relxnickpos $xnickpos
		set relynickpos $ypos

		foreach unit $parsednick {
			if {[lindex $unit 0] == "text"} {
				# Check if we are still allowed to write text
				if { $linefull } {
					continue
				}

				# Store the text as a string
				set textpart [lindex $unit 1]

				# Check if it's really containing text
				if {$textpart == ""} {
					continue
				}

				# Check if text is not too long and should be truncated, then
				# first truncate it and restore it in $textpart and set the linefull
				if {[expr $relxnickpos + [font measure splainf $textpart]] > $maxwidth} {
					set textpart [::guiContactList::truncateText $textpart \
						[expr $maxwidth - $relxnickpos]]
					set textpart "$textpart$ellips"

					# This line is full, don't draw anything anymore before we start a new line
					set linefull 1
				}

				# Draw the text
				$canvas create text $relxnickpos $ynickpos -text $textpart -anchor w -fill \
					$relnickcolour -font splainf -tags [list contact $tag nicktext]
				set textwidth [font measure splainf $textpart]

				# Append underline coords
				set yunderline [expr $ynickpos + $textheight + 1]
				lappend underlinst [list [expr $relxnickpos - $xpos] [expr $yunderline - $ypos] \
					$textwidth $relnickcolour]

				# Change the coords
				set relxnickpos [expr $relxnickpos + $textwidth]
			} elseif { [lindex $unit 0] == "smiley" } {
				# Check if we are still allowed to draw smileys
				if { $linefull } {
					continue
				}

				set smileyname [lindex $unit 1]

				if { [expr $relxnickpos + [image width $smileyname]] > $maxwidth } {
					# This line is full, don't draw anything anymore before we start a new line
					set linefull 1

					$canvas create text $relxnickpos $ynickpos -text $ellips -anchor w \
						-fill $relnickcolour -font splainf -tags [list contact $tag nicktext]
					set textwidth [font measure splainf $ellips]

					# Append underline coords
					set yunderline [expr $ynickpos + $textheight + 1]
					lappend underlinst [list [expr $relxnickpos - $xpos]  \
						[expr $yunderline - $ypos] $textwidth $relnickcolour]
					continue
				}

				# Draw the smiley
				$canvas create image $relxnickpos $ynickpos -image $smileyname -anchor w \
					-tags [list contact $tag smiley]

				# TODO: smileys should be resized to fit in text-height
				# if {[image height $smileyname] >= $ychange} {
				# 	set ychange [image height $smileyname]
				# }

				# Change the coords
				set relxnickpos [expr $relxnickpos + [image width $smileyname]]
			} elseif {[lindex $unit 0] == "newline"} {
				set relxnickpos $xnickpos
				set ynickpos [expr $ynickpos + [image height $img]]
				set ychange [expr $ychange + [image height $img]]

				# New line, we can draw again !
				set linefull 0
			} elseif {[lindex $unit 0] == "colour"} {
				# A plugin like aMSN Plus! could make the text lists
				# contain an extra variable for colourchanges
				set relnickcolour [lindex $unit 1]
				if {$relnickcolour == "reset"} {
					set relnickcolour $nickcolour
				}
			}
			# END the foreach loop
		}

		if { $statetext != "" } {
			# Set the spacing (if this needs to be underlined, we'll draw the state as
			# "  $statetext" and remove the spacing
			set relxnickpos [expr $relxnickpos + $nickstatespacing]

			$canvas create text $relxnickpos $ynickpos -text "$statetext" -anchor w\
				-fill $statecolour -font splainf -tags [list contact $tag statetext]

			# TODO: Maybe a skin-option to have the spacing underlined

			# Append underline coords
			set yunderline [expr $ynickpos + $textheight + 1]
			lappend underlinst [list [expr $relxnickpos - $xpos] [expr $yunderline - $ypos] \
				$statewidth $statecolour]
		}

		# The bindings:

		# First, remove previous bindings
		$canvas bind $tag <Enter> ""
		$canvas bind $tag <Motion> ""
		$canvas bind $tag <Leave> ""
		
		# Add binding for balloon
		if { [::config::getKey tooltips] == 1 } {
			$canvas bind $tag <Enter> +[list balloon_enter %W %X %Y "[getBalloonMessage \
				$email $element]" [::skin::getDisplayPicture $email]]
			$canvas bind $tag <Motion> +[list balloon_motion %W %X %Y "[getBalloonMessage \
				$email $element]" [::skin::getDisplayPicture $email]]
			$canvas bind $tag <Leave> "+set Bulle(first) 0; kill_balloon"
		}

		# Add binding for click / right click (remembering to get config key for single/dbl
		# click on contacts to open chat)
		if { [::config::getKey sngdblclick] } {
			set singordblclick <Button-1>
		} else {
			set singordblclick <Double-Button-1>
		}

		# Binding for left (double)click
		if { $state_code != "FLN" } {
			$canvas bind $tag $singordblclick "::amsn::chatUser $email"
		} elseif {[::abook::getContactData $email msn_mobile] == "1"} {
			# If the user is offline and support mobile (SMS)
			$canvas bind $tag $singordblclick "::MSNMobile::OpenMobileWindow ${email}"
		} else {
			$canvas bind $tag $singordblclick ""
		}

		# Binding for right click		 
		$canvas bind $tag <<Button3>> "show_umenu $email $grId %X %Y"

		# Bindings for dragging
		$canvas bind $tag <<Button2-Press>> "::guiContactList::contactPress $tag $canvas"
		$canvas bind $tag <<Button2-Motion>> "::guiContactList::contactMove $tag $canvas"
		$canvas bind $tag <<Button2>> "::guiContactList::contactReleased $tag $canvas"

		# Add binding for underline if the skinner use it
		if {[::skin::getKey underline_contact]} {
			$canvas bind $tag <Enter> "+::guiContactList::underlineList $canvas [list $underlinst] $tag"
			$canvas bind $tag <Leave> "+$canvas delete uline"
		}


		# Change cursor bindings for contacts
		$canvas bind $tag <Enter> "+$canvas configure -cursor hand2"
		$canvas bind $tag <Leave> "+$canvas configure -cursor left_ptr"

		# Now store the nickname [and] height in the nickarray
		# set nickheight [expr $ychange + [::skin::getKey buddy_ypad] ]
		set nickheightArray("$email") $ychange
		# status_log "nickheight $email: $nickheight"
	}


	proc getContactList { {kind "normal"} } {
		set contactList [list]