contactlist.tcl

Linux下的MSN聊天程序源码

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 } {
		
	}