guicontactlist.tcl

Linux下的MSN聊天程序源码

# New Contact List :: Based on canvas
#
# This module is still experimental, a lot of work is still needed.
#
# Things to be done (TODO):
#
# * set right mousewheel bindings (windows/mac) using [IsMac] etc procs
# * redraw on skinchange
# * scroll the canvas while dragging if you come near to the border (hard one :|)
# * change cursor while dragging (should we ?)
# * background doesn't move when using the scrollbar 
#        -> needs a FIX in ScrolledWindow code to have a command feeded run when scrolling
# * animated smileys on CL -> I hope this is possible easily with TkCxImage?
# * events when the groupview option is changed to redraw the whole list
# *
# *
# * ... cfr. "TODO:" msgs in code


namespace eval ::guiContactList {
	namespace export drawCL


	#//////////////////////////////////////////////////////////////////////////////
	# guiContactList (action [id] [varlist])
	# Data Structure for Contact List elements, linked list style :
	# 1 - Element Type		(type) Can be GROUP or CONTACT
	# 4 - Next Element		(nextid)
	# 5 - Previous Element		(previousid)
	#
	# action can be :
	#	get : This method returns the wanted info, 0 if non existent
	#	set : This method sets the variables for the given id, takes 2 arguments (variableid newvalue).
	#	insert : Adds new element, if id = -1, adds at end of list, otherwise adds right after element with given id.
	#	unset : This method removes the given id variables
	#	last : Return id of last element
	#	first : Return id of first element
	#	
	proc guiContactList { action { id "" } { varlist "-1" } } {
		variable type
		variable nextId
		variable previousId

		switch $action {
			get {
				if { [info exists type($id)] } {
					switch $varlist {
						type {
							return $type($id)
						}
						nextId {
							return $nextId($id)
						}
						previousId {
							return $previousId($id)
						}
					}
					# found, return values
				} else {
					# id not found, return 0
					return 0
				}
			}

			set {
				# This overwrites previous vars
				switch [lindex $varlist 0] {
					type {
						set type($id) [lindex $varlist 1]
					} 
					nextId {
						set nextId($id) [lindex $varlist 1]
					} 
					previousId {
						set previousId($id) [lindex $varlist 1]
					} 
				}
			}

			insert {
				if { $id == -1 } {
					
				}
			}

			unset {
				# Lets connect previous and next together
				set nextId($previousId($id)) $nextId($id)
				set previousId($nextId($id)) $previousId($id)
				
				# Now remove it's items
				if { [info exists type($id)] } {
					unset type($id)
				} else {
					status_log "Trying to unset type($id) but do not exist\n" red
				}
				if { [info exists nextId($id)] } {
					unset nextId($id)
				} else {
					status_log "Trying to unset nextId($id) but dosent exist\n" red
				}
				if { [info exists previousId($id)] } {
					unset previousId($id)
				} else {
					status_log "Trying to unset previousId($id) but dosent exist\n" red
				}
			}
		}
	}


	#/////////////////////////////////////////////////////////////////////
	# Function that draws a window where it embeds our contactlist canvas 
	#  (in a scrolledwindow) (this proc will nto be used if this gets
	#  embedded in the normal window
	#/////////////////////////////////////////////////////////////////////
	proc createCLWindow {} {
		#define global variables
		global clcanvas
		global tcl_platform
		global nicknameArray

		#here we load images used in this code:
		::skin::setPixmap back back.gif
		::skin::setPixmap upleft box_upleft.gif
		::skin::setPixmap up box_up.gif
		::skin::setPixmap upright box_upright.gif
		::skin::setPixmap left box_left.gif
		::skin::setPixmap body box_body.gif
		::skin::setPixmap right box_right.gif
		::skin::setPixmap downleft box_downleft.gif
		::skin::setPixmap down box_down.gif
		::skin::setPixmap downright box_downright.gif


		#set easy names for the widgets
		set window .contactlist
		set clcontainer .contactlist.sw
		set clcanvas .contactlist.sw.cvs

		#check if the window already exists, ifso, raise it and redraw the CL
		if { [winfo exists $window] } {
			raise $window
			drawList $clcanvas
			return
		}


		#create the window
		toplevel $window
		wm title $window "[trans title] - [::config::getKey login]"
		wm geometry $window 1000x1000

		# Set up the 'ScrolledWindow' container for the canvas
		ScrolledWindow $clcontainer -auto vertical -scrollbar vertical -bg white -bd 0 -ipad 0
		# TODO: * ScrolledWindow should be feeded a command run on scroll (reset the image)
		#	* bgcolor should be skinnable

		# Set beginning big width/height		
		set clbox [list 0 0 2000 1500]

		# Create a blank canvas
		canvas $clcanvas -width [lindex $clbox 2] -height [lindex $clbox 3] -background white
		# TODO: * bgcolor should be skinnable:

		# Embed the canvas in the ScrolledWindow
		$clcontainer setwidget $clcanvas
		# Pack the scrolledwindow in the window
		pack $clcontainer
		# Parse the nicknames for smiley/newline substitution
		createNicknameArray

		$clcanvas create image 0 0 -image [::skin::loadPixmap back] -anchor nw -tag backgroundimage
		after 1 ::guiContactList::drawList $clcanvas

		# Register events
		# TODO: * here we should register all needed events
		::Event::registerEvent contactDataChange all ::guiContactList::contactChanged
		::Event::registerEvent blockedContact all ::guiContactList::contactChanged
		::Event::registerEvent unblockedContact all ::guiContactList::contactChanged
		::Event::registerEvent movedContact all ::guiContactList::contactChanged
		::Event::registerEvent addedUser all ::guiContactList::contactChanged

		# TODO: * create the bindings for scrolling (using procs "IsMac" etc)

		# TODO: scrollbindings: make 'm work for every platform!
		#	scrolledwindow should be feeded a command that moves the background 
		#	so it's also at the right place when the bar is dragged

		# MacOS Classic/OSX and Windows
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			#TODO: fix mac bindings -> Jerome's job ;)

			bind $clcanvas <MouseWheel> {
				%W yview scroll [expr {- (%D)}] units;

				# $canvas coords backgroundimage 0 [expr int([expr [lindex [$canvas yview] 0] * $canvaslength])]
				::guiContactList::moveBGimage $clcanvas
			}
		} elseif {$tcl_platform(platform) == "windows"} {
			# TODO: fix win bindings -> Arieh's job ;)
			# bind $clcanvas <MouseWheel> {
			# 	::guiContactList::scrollCL $clcanvas [expr {- (%D)}]
			# }
			bind [winfo parent [winfo parent $clcanvas]] <MouseWheel> {
				if {%D >= 0} {
					::guiContactList::scrollCL .contactlist.sw.cvs up
				} else {
					::guiContactList::scrollCL .contactlist.sw.cvs down
				}
			}
		} else {
			# We're on X11! (I suppose ;))
			bind $clcanvas <ButtonPress-5> "::guiContactList::scrollCL $clcanvas down"
			bind $clcanvas <ButtonPress-4> "::guiContactList::scrollCL $clcanvas up"
			bind [winfo parent $clcanvas].vscroll <ButtonPress-5> "::guiContactList::scrollCL $clcanvas down"
			bind [winfo parent $clcanvas].vscroll <ButtonPress-4> "::guiContactList::scrollCL $clcanvas up"
		}

		# Let's avoid the bug of window behind the bar menu on MacOS X
		catch {wm geometry .contactlist [::config::getKey wingeometry]}
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			moveinscreen .contactlist 30
		}

		bind $clcanvas <Configure> "::guiContactList::drawList $clcanvas"

		# set the size
		# wm geometry $window 300x600
	}


	#/////////////////////////////////////////////////////////////////////
	# Function that draws everything needed on the canvas
	#/////////////////////////////////////////////////////////////////////
	proc drawList {canvas} {
		global Xbegin
		global Ybegin

		set Xbegin 10
		set Ybegin 10

		::guiContactList::drawGroups $canvas
		::guiContactList::drawContacts $canvas
		::guiContactList::organiseList $canvas
	}


	proc moveBGimage { canvas } {
		set canvaslength [lindex [$canvas cget -scrollregion] 3]
		if {$canvaslength == ""} { set canvaslenght 0}
		$canvas coords backgroundimage 0 [expr int([expr [lindex [$canvas yview] 0] * $canvaslength])]
		$canvas lower backgroundimage
	}


	proc drawGroups { canvas } {
		# Now let's get the actual whole contact list (also not shown users)
		set contactList [getContactList full]

		foreach element $contactList {
			# We check the type, and call the appropriate draw function
			if {[lindex $element 0] != "C" } {
				# Draw the group title
				drawGroup $canvas $element
			}
		}
	}


	proc drawContacts { canvas } {
		set groupID "offline"

		# Now let's get the actual whole contact list (also not shown users)
		set contactList [getContactList full]

		foreach element $contactList {
			# We check the type, and call the appropriate draw function
			if {[lindex $element 0] == "C" } {
				# Draw the group title
				drawContact $canvas $element $groupID
			} else {
				set groupID [lindex $element 0]
			}
		}
	}


	proc contactChanged { eventused email { gidlist ""} } {
		if { [winfo exists .contactlist] } {
			status_log "CONTACTCHANGED: $email"

			if { $email == "contactlist" } {
				return
			}

			if { $email == "myself" } {
				return
			}

			# TAKE A LOOK AT THIS CODE. HIGH PRIORITY
			# Redraw the groups
			# if {$eventused == "contactStateChange" } {
			# 	set gidlist [list [::abook::getGroups $email] offline mobile ]
			# }
			#
			# if {$gidlist != "" && $eventused != "contactNickChange"} {
			# 	foreach group $gidlist {
			# 		set the element list for the changed group
			# 		set groupelement [list $group "[::groups::GetName $group]"]
			#
			# 		if {$group == "offline" || $group == "mobile"} {
			# 			set groupelement [list $group "$group"]
			# 		}
			#
			# 		# Redraw the group
			# 		::guiContactList::drawGroup .contactlist.sw.cvs $groupelement
			# 		status_log "REDRAWN: $groupelement"
			# 	}
			# }
			#
			# As I can't make it work properly, let's redraw all groups for now:

			::guiContactList::drawGroups .contactlist.sw.cvs

			# Redraw the contact
			if {$eventused != "movedContact"} {
				set groupslist [list [getGroupId $email]]

				foreach group $groupslist {
					set contactelement [list "C" $email]
					::guiContactList::drawContact .contactlist.sw.cvs $contactelement $group
					status_log "REDRAWN: $contactelement"
				}
			}

			# Reorganise the list
			::guiContactList::organiseList .contactlist.sw.cvs
		}
	}


	proc toggleGroup { element canvas } {
		::groups::ToggleStatus [lindex $element 0]
		# Redraw group as it's state changed
		::guiContactList::drawGroup $canvas $element 
		::guiContactList::organiseList $canvas
	}


	# Move 'm to the right place
	proc organiseList { canvas } {
		global Xbegin
		global Ybegin
		global nickheightArray

		# First we move all the canvas items
		$canvas addtag items withtag group
		$canvas addtag items withtag contact
		# Make sure we move 'm to an invisible place first
		$canvas move items 100000 100000
		$canvas delete box

		# Now let's get an exact contact list
		set contactList [getContactList]

		# Before drawing we set the "we are draggin, sir" variable on 0
		set OnTheMove 0

		# Let's draw each element of this list
		set curPos [list $Xbegin $Ybegin]

		# TODO: an option for a X-padding for buddies .. should be set here and for teh truncation 
		# 	in the nickdraw proc


		################################
		#  First line for the "boxes"  #
		set DrawingFirstGroup 1
		################################

		foreach element $contactList {
			# We check the type, and call the appropriate draw function, these can be extended	
			# We got a contact
			if { [lindex $element 0] == "C" } {
				# Move it to it's place an set the new curPos
				set email [lindex $element 1]
				set gid $groupDrawn
				set tag "_$gid"; set tag $email$tag
				set currentPos [$canvas coords $tag]
				#status_log "MOVING CONTACT WITH TAG: $tag ;  currentpos: $currentPos  ; curPos: $curPos"

				if { $currentPos == "" } {
					status_log "WARNING: contact NOT moved: $email"
					return
				}

				set xpad [::skin::getKey buddy_xpad]
				set ypad [::skin::getKey buddy_ypad]

				$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] + $nickheightArray("$email") + $ypad] ]
			} else {
				# It must be a group title
				if { [::groups::IsExpanded [lindex $element 0]] } {
					set xpad [::skin::getKey contract_xpad]
					set ypad [::skin::getKey contract_ypad]
				} else {
					set xpad [::skin::getKey expand_xpad]
					set ypad [::skin::getKey expand_ypad]
				}

				# Move it to it's place an set the new curPos
				set gid [lindex $element 0]
				set groupDrawn $gid
				set tag "gid_"; set tag $tag$gid
				set currentPos [$canvas coords $tag]

				if { $currentPos == "" } {
					status_log "WARNING: group NOT moved: $gid"
					return
				}

				set maxwidth [winfo width $canvas]
				set boXpad 10
				set width [expr $maxwidth - ($boXpad*2)]
				if {$width <= 30} {set width 300}

				# If we're not drawing the first group, we should draw the end of the box of the \
				# group before here and change the curPos
				if {!$DrawingFirstGroup} {
					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