contactlist.tcl

来自「Linux下的MSN聊天程序源码」· TCL 代码 · 共 984 行 · 第 1/3 页

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