contactlist.tcl

Linux下的MSN聊天程序源码

		if { [$self ContactInGroup $id $groupid] } {
			# Change the text of the canvas item
			$list itemconfigure $nickid($groupid.$id) -text $newnick
			# Store the new nick in array
			set nick($groupid.$id) $newnick
		}
	}

	method ChangeContactPSM { groupid id newpsm } {
		if { [$self ContactInGroup $id $groupid] } {
			# Change the text of the canvas item
			$list itemconfigure $psmid($groupid.$id) -text $newpsm
			# Store the new psm in array
			set psm($groupid.$id) $newpsm
		}
	}

	method ChangeContactMusic { groupid id newmusic } {
		if { [$self ContactInGroup $id $groupid] } {
			# Change the text of the canvas item
			$list itemconfigure $musicid($groupid.$id) -text $newmusic
			# Store the new music in array
			set music($groupid.$id) $newmusic
		}
	}

	method ChangeContactState { groupid id newstate } {
		if { [$self ContactInGroup $id $groupid] } {
			# Change the text of the canvas item
			$list itemconfigure $stateid($groupid.$id) -text $newstate
			$list itemconfigure $statusiconid($groupid.$id) -image [$self StatusCodeToImage $newstate]
			# Store the new state in array
			set state($groupid.$id) $newstate
		}
	}

	method ChangeContactPic { groupid id } {
		if { [$self ContactInGroup $id $groupid] } {
			# Change the image of the canvas item
			image delete [$list itemcget $buddyid($groupid.$id)]
			set img [image create photo [TmpImgName]]
			$img copy [::skin::getDisplayPicture $id]
			::picture::ResizeWithRatio $img 32 32
			$list itemconfigure $buddyid($groupid.$id) -image $img
		}
	}

	method DeleteContact { groupid id } {
		if { [$self ContactInGroup $id $groupid] } {
			# Remove the contact from the contentmanager
			contentmanager delete $cl $groupid $id
			# Delete it's canvas items
			foreach tag "$buddyid($groupid.$id) $nickid($groupid.$id) $psmid($groupid.$id) $stateid($groupid.$id)" {
				$list delete $tag
			}
			# Sort the list
			$self sort list
		}
	}

	method BlockContact { groupid id } {
		
	}

	method UnBlockContact { groupid id } {
		
	}

	method CopyContact { groupid id groupid2 } {
		if { ![$self ContactInGroup $id $groupid] } {
			return {}
		}
		status_log "CopyContact $nick($groupid.$id)"
		$self AddContact $groupid2 $id $nick($groupid.$id) $psm($groupid.$id) $music($groupid.$id) $state($groupid.$id)
	}

	method toggle { groupid } {
		# Toggle the group in contentmanager
		contentmanager toggle $cl $groupid
		# Do something, depending on whether we are showing or hiding the group
		if { [string equal [contentmanager cget $cl $groupid -state] "normal"] } {
			# Showing...
			if { [string first $groupid. $selected] != -1 } {
				# If the currently selected contact is in this group, re-show the selectbg (it will have been hidden when the group was)
				$list itemconfigure $selectbgid -state normal
			}
			# Change the toggle icon to the contract icon
			$list itemconfigure $toggleid($groupid) -image [::skin::loadPixmap contractimg]
		} else {
			# Hiding...
			if { [string first $groupid. $selected] != -1 } {
				# If the currently selected contact is in this group, hide the selectbg
				$list itemconfigure $selectbgid -state hidden
			}
			# Change the toggle icon to the expand icon
			$list itemconfigure $toggleid($groupid) -image [::skin::loadPixmap expandimg]
		}
		# Sort the group recursively then sort the contactlist at level 0.
		# (It's faster to recursively sort the group then sort the cl at level 0 than just recursively sort cl)
		contentmanager sort $cl $groupid -level r
		$self sort list 0
	}

	method SelectContact { args } {
		# Get the group id
		set groupid [lindex $args 0]

		# Have we been called with "none"?
		if { [string equal $groupid "none"] } {
			# Yes, set selected to none, hide the selectbg and return
			set selected none
			$list itemconfigure $selectbgid -state hidden
			return {}
		}

		# Get the contact's id
		set id [lindex $args 1]
		# Was any contact selected before?
		if { [string equal $selected "none"] } {
			# No, so we need to calculate the width of the selectbg
			set selected $groupid.$id
			$selectbg configure -width [$self CalculateSelectWidth]
		}
		# Set selected to this contact
		set selected $groupid.$id
		# Get coords of contact
		set xy [contentmanager getcoords $cl $groupid $id]
		set x [lindex $xy 0]
		set y [lindex $xy 1]
		# Raise selectbg to just above the group background in stacking order
		$list raise $selectbgid $groupbgid($groupid)
		# Place the selectbg
		$list coords $selectbgid $x $y
		# Show it if it isn't already shown
		$list itemconfigure $selectbgid -state normal
		# Set it to the height of the contact
		$selectbg configure -height [contentmanager cget $cl $groupid $id -height]
	}

	method sort { component {level r} } {
		after cancel $afterid(sort.$component)
		set afterid(sort.$component) [after 1 "$self Sort $component $level"]
	}

	method Sort { component {level r} } {
		switch $component {
			top {
				contentmanager sort $me -level $level
				# Position displaypic bg and overlay
				set xy [$top coords $mypicid]
				eval $top coords $mypicbgid $xy
				eval $top coords $mypicoverlayid $xy
				$top raise $mypicoverlayid
			}
			list {
				contentmanager sort $cl -level $level
				# Position selectbg
				if { ![string equal $selected "none"] } {
					set xy [eval contentmanager getcoords $cl $selected]
					set x [lindex $xy 0]
					set y [lindex $xy 1]
					$list coords $selectbgid $x $y
					if { ![string equal $selected "none"] } {
						$selectbg configure -height [eval contentmanager cget $cl $selected -height]
					}
				}

				# Resize group backgrounds
				foreach groupid $groups {
					#eval $list coords $groupbgid($groupid) [contentmanager getcoords $cl $groupid]
					$self SetGroupBgHeight $groupid [contentmanager cget $cl $groupid -height]
				}
				# Set canvas's scrollregion
				$list configure -scrollregion "0 0 0 [contentmanager cget $cl -height]"
			}
		}
	}

	method Config { component width height } {
		after cancel $afterid(config.$component)
		set afterid(config.$component) [after 1 "$self Configure $component $width $height"]
	}

	method Configure { component width height } {
		# Config'ing top or list?
		switch $component {
			top {
				$topbg configure -width $width -height $height
			}
			list {
				$listbg configure -width $width -height $height
				$selectbg configure -width [$self CalculateSelectWidth]
				# Resize group backgrounds
				foreach groupid $groups {
					$self SetGroupBgWidth $groupid [expr {$width - (2 * $options(-ipadx)) - (2 * $options(-grouppadx))}]
				}
				set listwidth $width
				set listheight $height
			}
		}

		# Truncate text items (nicks etc)
		after cancel $afterid(trunc_me)
		set afterid(trunc_me) [after 1 "$self TruncateMyNick $width"]
		after cancel $afterid(trunc_contacts)
		set afterid(trunc_contacts) [after 1 "$self TruncateContactsNicks $width"]
	}

	method Yview { args } {
		eval $list yview $args
		$list coords $listbgid 0 [$list canvasy 0]
	}

	method CalculateSelectWidth { } {
		set winw [winfo width $list]
		if { ![string equal $selected "none"] } {
			set width [expr { $winw - ( 2 * $options(-grouppadx)) - (2 * $options(-groupipadx)) - (2 * $options(-buddypadx))}]
		} else {
			set width 0
		}
		return $width
	}

	method SetGroupBgWidth { groupid width } {
		$groupbg($groupid) configure -width $width
	}

	method SetGroupBgHeight { groupid height } {
		$groupbg($groupid) configure -height $height
	}

	method TruncateMyNick { width } {
		set width [expr {$width - (2 * $options(-topipadx))}]
		$top itemconfigure $mynickid -text [$self CalcTruncatedString $top $mynickfont {Hobbes - All the colours of the rainbow!!!} [expr {$width - [lindex [$top coords $mynickid] 0]}]]
	}

	method TruncateContactsNicks { width } {
		set width [expr {$width - (2 * $options(-ipadx)) - (2 * $options(-grouppadx)) - (2 * $options(-groupipadx)) - (2 * $options(-buddypadx)) - (2 * $options(-buddyipadx))}]
		foreach groupid $groups {
			foreach id [contentmanager children $cl $groupid] {
				if { [string equal $id head] } {
					continue
				}
				set tag $nickid($groupid.$id)
				$list itemconfigure $tag -text [$self CalcTruncatedString $list $nickfont $nick($groupid.$id) [expr {$width - [lindex [$list coords $tag] 0]}]]
			}
		}
	}

	method CalcTruncatedString { w font str width } {
		for { set i 0 } { 1 } { incr i 1 } {
			set strw [font measure $font -displayof $w [string range $str 0 $i]]
			if { $strw >= $width } {
				incr i -3
				set newstr [string range $str 0 $i]...
				break
			} elseif { $i >= [string length $str] } {
				set newstr $str
				break
			}
		}
		return $newstr
	}

	# o------------------------------------------------------------------------------------------------------------------------
	#  Methods to convert state codes to state descriptions and images
	# o------------------------------------------------------------------------------------------------------------------------
	method StatusCodeToText { code } {
		switch $code {
			NLN { return online }
			FLN { return offline }
			AWY { return away }
			BRB { return "be right back" }
			LUN { return "gone to lunch" }
			BSY { return busy }
			PHN { return "on phone" }
			IDL { return "no activity" }

			Offline { return offline }
			default { return {} }
		}
	}

	method StatusCodeToImage { code } {
		switch $code {
			NLN { return [::skin::loadPixmap online] }
			FLN { return [::skin::loadPixmap offline] }
			AWY { return [::skin::loadPixmap away] }
			BRB { return [::skin::loadPixmap away] }
			LUN { return [::skin::loadPixmap away] }
			IDL { return [::skin::loadPixmap away] }
			BSY { return [::skin::loadPixmap busy] }
			PHN { return [::skin::loadPixmap busy] }

			Offline { return [::skin::loadPixmap offline] }
			default { return [::skin::loadPixmap offline] }
		}
	}
}

bind Contactlist <4> {
	[winfo parent %W] Yview scroll -5 units
}
bind Contactlist <5> {
	[winfo parent %W] Yview scroll 5 units
}

bind Contactlist <Configure> {
	[winfo parent %W] Config list %w %h
}

bind ContactlistTop <Configure> {
	[winfo parent %W] Config top %w %h
}

#pack forget .main;source contactlist.tcl;pack [contactlist .cl] -expand true -fill both

proc speedycontacts { } {
	.cl groupAdded grp1
	.cl groupAdded grp2
	.cl groupAdded grp3
	for { set i 0 } { $i < 25 } { incr i 1} {
		.cl contactAdded grp1 $i "test $i" "psm $i" FLN
		.cl contactAdded grp2 $i "test $i" "psm $i" FLN
		.cl contactAdded grp3 $i "test $i" "psm $i" FLN
	}
}