amsn-data 0.98.9-1 / usr / share / amsn / contactlist.tcl

package require contentmanager

snit::widget contactlist {

	typevariable topbgimg
	typevariable mypicbgimg
	typevariable mypicoverlayimg
	typevariable listbgimg
	typevariable groupbgimg
	typevariable selectbgimg
	typevariable expandimg
	typevariable contractimg
	typevariable buddyimg

	typevariable mynickfont
	typevariable mypsmfont
	typevariable mymusicfont
	typevariable mystatefont
	typevariable nickfont
	typevariable psmfont
	typevariable musicfont
	typevariable statefont

	typevariable mynickcol
	typevariable mypsmcol
	typevariable mymusiccol
	typevariable mystatecol
	typevariable nickcol
	typevariable psmcol
	typevariable musiccol
	typevariable statecol

	typeconstructor {
		# Load images
		::skin::setPixmap topbgimg background_top.png
		::skin::setPixmap mypicbgimg mypicbg.png
		::skin::setPixmap mypicoverlayimg mypicoverlay.png
		::skin::setPixmap listbgimg background_list.png
		::skin::setPixmap groupbgimg background_group.png
		::skin::setPixmap selectbgimg background_selected.png
		::skin::setPixmap expandimg expand.png
		::skin::setPixmap contractimg contract.png
		::skin::setPixmap buddyimg buddy.png

		# Set fonts
		set mynickfont [font create -family helvetica -size 12 -weight bold]
		set mypsmfont [font create -family helvetica -size 12 -weight bold]
		set mymusicfont [font create -family helvetica -size 12 -weight bold]
		set mystatefont [font create -family helvetica -size 12 -weight bold]
		set nickfont [font create -family helvetica -size 11 -weight bold]
		set psmfont [font create -family helvetica -size 11 -weight bold -slant italic]
		set musicfont [font create -family helvetica -size 11 -weight bold]
		set statefont [font create -family helvetica -size 11 -weight bold]

		# Set colours
		# Top colours
		set mynickcol darkblue
		set mypsmcol #0000ee
		set mymusiccol purple
		set mystatecol darkgreen
		# List colours
		set nickcol darkblue
		set psmcol #0000ee
		set musiccol purple
		set statecol darkgreen
	}

	hulltype frame

	component top
	component topbg
	component toolbar
	component toolbarbg
	component list
	component listbg
	component listscrollbar
	component selectbg

	option -width -default 0
	option -height -default 0
	option -toppadx -default 5
	option -toppady -default 5
	option -topipadx -default 5
	option -topipady -default 5
	option -listpadx -default 5
	option -listpady -default 5
	option -topborder -default {12 12 12 12}
	option -listborder -default {20 20 20 20}
	option -groupbgborder -default {5 5 5 5}
	option -selectborder -default {5 5 5 5}
	option -ipadx -default 0
	option -ipady -default 0
	option -grouppadx -default 5
	option -grouppady -default 5
	option -groupipadx -default 5
	option -groupipady -default 5
	option -buddypadx -default 2
	option -buddypady -default 2
	option -buddyipadx -default 5
	option -buddyipady -default 5
	option -contractpadx -default 2
	option -contractpady -default 2
	option -expandpadx -default 2
	option -expandpady -default 2

	option -groupmode -default groups -configuremethod SetGroupMode

	variable groups {}

	# Variables to store the dimensions of our list
	variable listwidth
	variable listheight

	# Variables ending in 'id' denote canvas item ids
	variable topbgid
	variable mypicid
	variable mypicbgid
	variable mypicoverlayid
	variable mynickid
	variable mypsmid
	variable mymusicid
	variable mystateid
	variable listbgid
	variable selectbgid
	variable groupbgid
	variable toggleid
	variable headid
	variable buddyid
	variable nickid
	variable psmid
	variable musicid
	variable stateid
	variable statusiconid

	# Arrays to store contacts' info
	variable nick
	variable psm
	variable music
	variable state
	variable tags

	# Array to store name of group backgrounds
	variable groupbg

	# Variable to store selected contact
	variable selected

	variable dragX
	variable dragY
	variable dragXOffset
	variable dragYOffset

	# Array used for speeding up batch processing (using after and after cancel, see sort methid)
	variable afterid

	# Names for top-level contentmanager groups on top canvas and list canvas
	variable me
	variable cl

	constructor { args } {
		bindtags $self "Frame . all"
		# Create canvases
		install top using canvas $self.top -bd 0 -highlightthickness 0 -insertontime 0 -height 100
		install toolbar using canvas $self.toolbar -bd 0 -highlightthickness 0 -insertontime 0
		install list using canvas $self.list -bd 0 -highlightthickness 0 -insertontime 0 -yscrollcommand "$self.listscroll set"
		# Create list scrollbar
		install listscrollbar using scrollbar $self.listscroll -command "$self Yview"

		# Create background images
		# Top (my nick & status etc)
		install topbg using scalable-bg $top.bg -source [::skin::loadPixmap topbgimg] \
			-border $options(-topborder) \
			-resizemethod tile
		# List (where contacts go!)
		install listbg using scalable-bg $list.bg -source [::skin::loadPixmap listbgimg] \
			-border $options(-listborder) \
			-resizemethod tile
		# Select (for showing a contact is selected)
		install selectbg using scalable-bg $list.selectbg -source [::skin::loadPixmap selectbgimg] \
			-border $options(-selectborder) \
			-resizemethod tile
		# Create them on their canvases
		set topbgid [$top create image 0 0 -anchor nw -image [$topbg name]]
		set listbgid [$list create image 0 0 -anchor nw -image [$listbg name]]
		set selectbgid [$list create image 0 0 -anchor nw -image [$selectbg name] -state hidden]

		# Clicking on the list background should deselect the currently selected contact
		$list bind $listbgid <ButtonPress-1> "$self SelectContact none"

		# Pack the canvases and scrollbar
		pack $top -side top -anchor nw -expand false -fill x -padx $options(-toppadx) -pady $options(-toppady)
		pack $list -side left -anchor nw -expand true -fill both -padx $options(-listpadx) -pady $options(-listpady)
		pack $listscrollbar -after $list -expand true -fill y

		# Bind the canvases
		bindtags $top "Canvas ContactlistTop . all"
		bindtags $list "Canvas Contactlist . all"

		# Apply arguments
		$self configurelist $args

		# Create empty canvas id variables/arrays
		array set groupbg {{} {}}
		array set groupbgid {{} {}}
		array set toggleid {{} {}}
		array set headid {{} {}}
		array set buddyid {{} {}}
		array set nickid {{} {}}
		array set psmid {{} {}}
		array set musicid {{} {}}
		array set stateid {{} {}}

		# Arrays to store nicknames, psms, music and states in (for the truncation and other methods to refer to)
		array set nick {{} {}}
		array set psm {{} {}}
		array set music {{} {}}
		array set state {{} {}}
		array set tags {{} {}}

		# Arrays to store initial drag positions for contacts
		array set dragX {{} {}}
		array set dragY {{} {}}

		# Afterid arrays. These are very important for speed! Because we bind to the <Configure> event,
		# we will get a lot of resize actions (especially on scalable-bgs) when the user resizes the window.
		# To stop this slowing us down, we do all resize and sort (and a few other eg truncate) actions with a:
		# after cancel $afterid($Action)
		# set afterid(Action) [after 1 "$doAction"]
		# So that we only do the last action called.
		array set afterid {
			sort.top {}
			sort.list {}
			config.top {}
			config.list {}
			trunc_me {}
			trunc_contacts {}
			groupbg {}
			filter {}
		}

		# No contacts selected yet..
		set selected none

		# Initial dimensions are assumed to be zero
		set listwidth 0
		set listheight 0

		# Create container groups for top and list (these will sort/arrange the stuff inside them)
		set me $self.me
		set cl $self.cl
		contentmanager add group $me -orient horizontal -widget $top
		contentmanager add group $cl -orient vertical -ipadx $options(-ipadx) -ipady $options(-ipady) -widget $list

		$self AddGroup search "Search results"
		$self HideGroup search
		pack [label $self.searchlabel -anchor w -text "Search:"] [entry $self.search -bg white] -after $top -anchor w -expand false -fill x -side top
		bind $self.search <Return> "$self SubmitSearch"

		$self AddGroup nogroup nogroup

		$self AddGroup online Online
		$self AddGroup offline Offline

		# Draw the top stuff (My pic, nick, psm, music, state etc)
		$self DrawMe
		$self registerForEvents

		$self configurelist $args
	}

	method registerForEvents { } {
		::Event::registerEvent groupAdded all $self
		::Event::registerEvent groupDeleted all $self
		::Event::registerEvent groupRenamed all $self
		::Event::registerEvent contactAdded all $self
		::Event::registerEvent contactDeleted all $self
		::Event::registerEvent contactChangeNick all $self
		::Event::registerEvent contactChangePSM all $self
		::Event::registerEvent contactChangeState all $self
	}

	# o------------------------------------------------------------------------------------------------------------------------
	#  Methods to deal with protocol events
	# o------------------------------------------------------------------------------------------------------------------------
	method contactlistLoaded { } {

	}

	method groupAdded { groupid {name {}} } {
		if { [string equal $name {}] } {
			set name $groupid
		}
		$self AddGroup $groupid $name
		#tk_messageBox -message "Successfully added group '$name'" -type ok
	}

	method groupAddFailed { } {
		
	}

	method groupDeleted { groupid } {
		$self DeleteGroup $groupid
	}

	method groupDeleteFailed { } {
		
	}

	method groupRenamed { groupid newname } {
		$self RenameGroup $groupid $newname
	}

	method groupRenameFailed { } {
		
	}

	method contactAdded { groupid id {_nick {}} {_psm {}} {_music {}} {_state {}} } {
		if { [string equal $groupid {}] } {
			set groupid "nogroup"
		}
		$self AddContact $groupid $id $_nick $_psm $_music $_state
		#tk_messageBox -message "Successfully added contact '$id'" -type ok
	}

	method contactAddFailed { id } {
		
	}

	method contactDeleted { groupid id } {
		$self DeleteContact $groupid $id
	}

	method contactDeleteFailed { } {
		
	}

	method contactBlocked { } {
		
	}

	method contactBlockFailed { } {
		
	}

	method contactUnBlocked { } {
		
	}

	method contactUnBlockFailed { } {
		
	}

	method contactCopiedTo { groupid id groupid2 } {
		$self CopyContact $groupid $id $groupid2
	}

	method contactCopyFailed { } {
		
	}

	method contactMovedTo { } {
		
	}

	method contactMoveFailed { } {
		
	}

	method contactChangeNick { id newnick } {
		foreach groupid $groups {
			$self ChangeContactNick $groupid $id $newnick
		}
	}

	method contactChangePSM { id newpsm } {
		foreach groupid $groups {
			$self ChangeContactPSM $groupid $id $newpsm
		}
	}

	method contactChangeMusic { id newmusic } {
		foreach groupid $groups {
			$self ChangeContactMusic $groupid $id $newmusic
		}
	}

	method contactChangeState { id newstate } {
		foreach groupid $groups {
			$self ChangeContactState $groupid $id $newstate
		}
	}

	method contactChangePic { id newpic } {
		foreach groupid $groups {
			$self ChangeContactPic $groupid $id $newpic
		}
	}

	# o------------------------------------------------------------------------------------------------------------------------
	#  Methods to carry out GUI actions
	# o------------------------------------------------------------------------------------------------------------------------
	method ContactInGroup { id groupid } {
		set contacts [contentmanager children $cl $groupid]
		if { [lsearch $contacts $id] != -1 } {
			return 1
		} else {
			return 0
		}
	}

	method DrawMe { } {
		# Create the canvas items
		set mypicbgid [$top create image 0 0 -anchor nw -image [::skin::loadPixmap mypicbgimg]]
		set mypicoverlayid [$top create image 0 0 -anchor nw -image [::skin::loadPixmap mypicoverlayimg]]
		set mypicid [$top create image 0 0 -anchor nw -image displaypicture_not_self]
		set mynickid [$top create text 0 0 -anchor nw -fill $mynickcol -font $mynickfont -text "Hobbes - all the colours of the rainbow!!!"]
		set mypsmid [$top create text 0 0 -anchor nw -fill $mypsmcol -font $mypsmfont -text "http://amsn.sf.net/"]
		set mymusicid [$top create text 0 0 -anchor nw -fill $mymusiccol -font $mymusicfont -text "Kate Bush - Aerial tal"]
		set mystateid [$top create text 0 0 -anchor nw -fill $mystatecol -font $mystatefont -text "Online"]
		# Add them to the layout
		contentmanager add group $me icon -widget $top -padx 5 -pady 5
		contentmanager add element $me icon icon -widget $top -tag $mypicid
		contentmanager add group $me info -widget $top -padx 5 -pady 5
		contentmanager add element $me info nick -widget $top -tag $mynickid
		contentmanager add element $me info psm -widget $top -tag $mypsmid
		contentmanager add element $me info music -widget $top -tag $mymusicid
		contentmanager add element $me info state -widget $top -tag $mystateid
		
		$self sort top
	}

	method SetGroupMode { option value } {
		set options(-groupmode) $value
		if { ![info exists cl] } {
			return $value
		}
		switch $value {
			status {
				foreach groupid $groups {
					if { ![string equal $groupid online] && ![string equal $groupid offline] } {
						$self HideGroup $groupid
					}
				}
				$self ShowGroup online
				$self ShowGroup offline
			}
			groups {
				foreach groupid $groups {
					if {
						![string equal $groupid online] && \
						![string equal $groupid offline] && \
						![string equal $groupid search]
					} {
						$self ShowGroup $groupid
					}
				}
				$self HideGroup online
				$self HideGroup offline
			}
			hybrid {
				foreach groupid $groups {
					if { 
						![string equal $groupid online] && \
						![string equal $groupid search]
					} {
						$self ShowGroup $groupid
					}
				}
				$self HideGroup online
			}
		}
	}

	method AddGroup { groupid name } {
		# Background image
		set groupbg($groupid) [scalable-bg $groupid.bg \
			-source [::skin::loadPixmap groupbgimg] \
			-border $options(-groupbgborder) \
			-resizemethod tile \
			-width [expr {$listwidth - (2 * $options(-ipadx)) - (2 * $options(-grouppadx))}]]
		# Background image canvas item
		set groupbgid($groupid) [$list create image 0 0 -anchor nw -image [$groupbg($groupid) name]]
		# Heading canvas items
		set toggleid($groupid) [$list create image 0 0 -anchor nw -image [::skin::loadPixmap contractimg]]
		
		set headid($groupid) [$list create text 0 0 -anchor nw -text $name]

		# Create groups and elements with contentmanager
		# Main group
		contentmanager add group $cl $groupid -widget $list -padx $options(-grouppadx) -pady $options(-grouppady) -ipadx $options(-groupipadx) -ipady $options(-groupipady)
		contentmanager add attachment $cl $groupid bg -widget $list -tag $groupbgid($groupid) -omnipresent yes
		# Heading group
		contentmanager add group $cl $groupid head -widget $list -orient horizontal -omnipresent yes
		# Heading elements
		contentmanager add element $cl $groupid head toggle -widget $list -tag $toggleid($groupid)
		contentmanager add element $cl $groupid head text -widget $list -tag $headid($groupid)

		# Bind heading
		contentmanager bind $cl $groupid head <ButtonPress-1> "$self toggle $groupid"

		# Store the group id in list
		lappend groups $groupid

		# Sort the cl
		$self sort list
	}

	method RenameGroup { groupid newname } {
		$list itemconfigure $headid($groupid) -text $newname
		$self sort list
	}

	method DeleteGroup { groupid } {
		# Delete group's heading canvas items
		$list delete $toggleid($groupid)
		$list delete $headid($groupid)
		# Find group in list of groups
		set index [lsearch $groups $groupid]
		# Get the groups before and after this group...
		set list1 [lrange $groups 0 [expr {$index - 1}]]
		set list2 [lrange $groups [expr {$index + 1}] end]
		# ...and join them together to make the new list
		set groups [concat $list1 $list2]
		# Remove the group from the contentmanager
		contentmanager delete $cl $groupid
		# Sort the list
		$self sort list
	}

	method HideGroup { groupid } {
		contentmanager hide $cl $groupid -force 1
		$list itemconfigure $groupbgid($groupid) -state hidden
		contentmanager sort $cl $groupid -level r
		$self sort list 0
	}

	method ShowGroup { groupid } {
		contentmanager show $cl $groupid
		contentmanager show $cl $groupid head
		$list itemconfigure $groupbgid($groupid) -state normal
		contentmanager sort $cl $groupid -level r
		$self sort list 0
	}

	method SubmitSearch { } {
		set pattern [$self.search get]
		after cancel $afterid(filter)
		set afterid(filter) [after 100 "$self FilterContacts $pattern"]
	}

	method FilterContacts { {pattern {}} } {
		# Empty search pattern
		if { [string equal $pattern {}] } {
			foreach groupid $groups {
				if { [string first "hidden" [contentmanager cget $cl $groupid -state]] == -1 } {
					$self ShowGroup $groupid
				}
			}
		# Non-empty search pattern
		} else {
			set results [$self SearchContacts $pattern]
			#puts "results $results"
			set matches [lindex $results 0]
			set nonmatches [lindex $results 1]
			foreach { groupid id } $matches {
				$self ShowContact $groupid $id
			}
			foreach { groupid id } $nonmatches {
				$self HideContact $groupid $id
			}
		}
	}

	method SearchContacts { pattern } {
		set matches {}
		set nonmatches {}
		foreach groupid $groups {
			foreach id [contentmanager children $cl $groupid] {
				if { [string equal $id head] } {
					continue
				}
				if {
					[string first $pattern $nick($groupid.$id)] != -1 || \
					[string first $pattern $psm($groupid.$id)] != -1 || \
					[lsearch $tags($groupid.$id) $pattern] != -1
				} {
					lappend matches $groupid $id
				} else {
					lappend nonmatches $groupid $id
				}
			}
		}
		return [list $matches $nonmatches]
	}

	method ShowContact { groupid id } {
		if { [string first "hidden" [contentmanager cget $cl $groupid -state]] != -1 } {
			return
		}
		contentmanager show $cl $groupid $id
		after cancel "contentmanager sort $cl $groupid -level 0"
		after 1 "contentmanager sort $cl $groupid -level 0"
		$self sort list 0
	}

	method HideContact { groupid id } {
		contentmanager hide $cl $groupid $id -force yes
		after cancel "contentmanager sort $cl $groupid -level 0"
		after 1 "contentmanager sort $cl $groupid -level 0"
		$self sort list 0
	}

	method AddContact { groupid id {nicktext {}} {psmtext {}} {musictext {}} {statetext {}} } {
		if { [$self ContactInGroup $id $groupid] } {
			return {}
		}
		# Create canvas items (pic, nick, psm, music, state)
		set img [image create photo [TmpImgName]]
		$img copy [::skin::getDisplayPicture $id]
		::picture::ResizeWithRatio $img 32 32
		set buddyid($groupid.$id) [$list create image 0 0 -anchor nw -image $img]
		set nickid($groupid.$id) [$list create text 0 0 -anchor nw -text $nicktext -font $nickfont -fill $nickcol]
		set psmid($groupid.$id) [$list create text 0 0 -anchor nw -text $psmtext -font $psmfont -fill $psmcol]
		set stateid($groupid.$id) [$list create text 0 0 -anchor nw -text [$self StatusCodeToText $statetext] -font $statefont -fill $statecol]
		set statusiconid($groupid.$id) [$list create image 0 0 -anchor nw -image [$self StatusCodeToImage $statetext]]

		# Store the nick in array
		set nick($groupid.$id) $nicktext
		set psm($groupid.$id) $psmtext
		set music($groupid.$id) $musictext
		set state($groupid.$id) $statetext
		set tags($groupid.$id) $id

		# Create contentmanager objects
		# Main contact group
		contentmanager add group $cl $groupid $id -widget $list -orient horizontal -padx $options(-buddypadx) -pady $options(-buddypady) -ipadx $options(-buddyipadx) -ipady $options(-buddyipadx)
		# Buddy icon group & elements
		contentmanager add group $cl $groupid $id icon -widget $list
		contentmanager add element $cl $groupid $id icon icon -widget $list -tag $buddyid($groupid.$id)
		#contentmanager add element $cl $groupid $id icon status -widget $list -tag $statusiconid($groupid.$id)
		contentmanager add attachment $cl $groupid $id icon status -widget $list -tag $statusiconid($groupid.$id)
		# Information group & elements (nick, psm, etc)
		contentmanager add group $cl $groupid $id info -widget $list
		contentmanager add element $cl $groupid $id info nick -widget $list -tag $nickid($groupid.$id)
		contentmanager add element $cl $groupid $id info psm -widget $list -tag $psmid($groupid.$id)
		contentmanager add element $cl $groupid $id info state -widget $list -tag $stateid($groupid.$id)

		# Bind the contact
		contentmanager bind $cl $groupid $id <ButtonPress-1> "$self SelectContact $groupid $id"

		# Sort the list
		$self sort list
	}

	method ChangeContactNick { groupid id newnick } {
		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
	}
}