gui.tcl

Linux下的MSN聊天程序源码

	proc FTWin {cookie filename user {chatid 0}} {
		status_log "Creating receive progress window\n"

		if { [string range $filename [expr {[string length $filename] - 11}] [string length $filename]] == ".incomplete" } {
			set filename [filenoext $filename]
		}

		# Set appropriate Cancel command
		if { [::MSNP2P::SessionList get $cookie] == 0 } {
			set cancelcmd "::MSNFT::cancelFT $cookie"
		} else {
			set cancelcmd "::MSN6FT::CancelFT $chatid $cookie"
		}

		set w .ft$cookie
		toplevel $w
		wm group $w .
		wm geometry $w 360x170

		#frame $w.f -class amsnChatFrame -background [::skin::getKey chatwindowbg] -borderwidth 0 -relief flat
		#set w $ww.f

		label $w.user -text "[trans user]: $user" -font splainf
		pack $w.user -side top -anchor w
		label $w.file -text "[trans filename]: $filename" -font splainf
		pack $w.file -side top -anchor w

		pack [::dkfprogress::Progress $w.prbar] -fill x -expand 0 -padx 5 -pady 5 -side top

		label $w.progress -text "" -font splainf
		label $w.time -text "" -font splainf
		pack $w.progress $w.time -side top

		checkbutton $w.ftautoclose -text "[trans ftautoclose]" -onvalue 1 -offvalue 0 -variable [::config::getVar ftautoclose]
		pack $w.ftautoclose -side top
		#Specify the path to the file
		set filepath [file join [::config::getKey receiveddir] $filename]
		set filedir [file dirname $filepath]

		#Open directory and Open picture button
		button $w.close -text "[trans cancel]" -command $cancelcmd
		button $w.open -text "[trans opendir]" -state normal -command "launch_filemanager \"$filedir\""
		button $w.openfile -text "[trans openfile]" -state disable -command "open_file {$filepath}"
		pack $w.close $w.open $w.openfile -side right -pady 5 -padx 10

		if { [::MSNFT::getTransferType $cookie] == "received" } {
			wm title $w "$filename - [trans receivefile]"
		} else {
			wm title $w "$filename - [trans sendfile]"
		}

		wm title $w "$filename - [trans filetransfer]"
		bind $w <<Escape>> $cancelcmd
		wm protocol $w WM_DELETE_WINDOW $cancelcmd
		moveinscreen $w 30


		::dkfprogress::SetProgress $w.prbar 0
	}


	#Updates filetransfer progress window/Bar
	#fileTransferProgress mode cookie filename bytes filesize
	# mode: a=Accepting invitation
	#       c=Connecting
	#       w=Waiting for connection
	#       e=Connect error
	#       i=Identifying/negotiating
	#       l=Connection lost
	#       ca=Cancel
	#       s=Sending
	#       r=Receiving
	#       fr=finish receiving
	#       fs=finish sending
	# cookie: ID for the filetransfer
	# bytes: bytes sent/received (-1 if cancelling)
	# filesize: total bytes in the file
	# chatid used for MSNP9 through server transfers
	#####
	proc FTProgress {mode cookie filename {bytes 0} {filesize 1000} {chatid 0}} {
	# -1 in bytes to transfer cancelled
	# bytes >= filesize for connection finished

		variable firsttimes    ;# Array. Times in ms when the FT started.
		variable ratetimer

		if { [info exists ratetimer($cookie)] } {
			after cancel $ratetimer($cookie)
		}

		set w .ft$cookie

		if { ([winfo exists $w] == 0) && ($mode != "ca")} {
			#set filename2 [::MSNFT::getFilename $cookie]
			if { $filename == "" } {
				FTWin $cookie [::MSNFT::getFilename $cookie] [::MSNFT::getUsername $cookie] $chatid
			} else {
				FTWin $cookie $filename $bytes $chatid
			}
		}

		if {[winfo exists $w] == 0} {
			return -1
		}

		switch $mode {
			a {
				$w.progress configure -text "[trans ftaccepting]..."
				set bytes 0
				set filesize 1000
			}
			c {
				$w.progress configure -text "[trans ftconnecting $bytes $filesize]..."
				set bytes 0
				set filesize 1000
			}
			w {
				$w.progress configure -text "[trans listeningon $bytes]..."
				set bytes 0
				set filesize 1000
			}
			e {
				$w.progress configure -text "[trans ftconnecterror]"
				$w.close configure -text "[trans close]" -command "destroy $w"
				wm protocol $w WM_DELETE_WINDOW "destroy $w"
			}
			i {
				#$w.progress configure -text "[trans ftconnecting]"
			}
			l {
				$w.progress configure -text "[trans ftconnectionlost]"
				$w.close configure -text "[trans close]" -command "destroy $w"
				wm protocol $w WM_DELETE_WINDOW "destroy $w"
				bind $w <<Escape>> "destroy $w"
			}
			r -
			s {
				#Calculate how many seconds has transmission lasted
				if {![info exists firsttimes] || ![info exists firsttimes($cookie)]} {
					set firsttimes($cookie) [clock seconds]
					set difftime 0
				} else {
					set difftime  [expr {[clock seconds] - $firsttimes($cookie)}]
				}


				if { $difftime == 0 || $bytes == 0} {
					set rate "???"
					set timeleft "-"
				} else {
					#Calculate rate and time
					set rate [format "%.1f" [expr {(1.0*$bytes / $difftime) / 1024.0 } ]]
					set secleft [expr {int(((1.0*($filesize - $bytes)) / $bytes) * $difftime)} ]
					set t1 [expr {$secleft % 60 }] ;#Seconds
					set secleft [expr {int($secleft / 60)}]
					set t2 [expr {$secleft % 60 }] ;#Minutes
					set secleft [expr {int($secleft / 60)}]
					set t3 $secleft ;#Hours
					set timeleft [format "%02i:%02i:%02i" $t3 $t2 $t1]
				}

				if {$mode == "r"} {
					$w.progress configure -text \
						"[trans receivedbytes [::amsn::sizeconvert $bytes] [::amsn::sizeconvert $filesize]] ($rate KB/s)"
				} elseif {$mode == "s"} {
					$w.progress configure -text \
						"[trans sentbytes [::amsn::sizeconvert $bytes] [::amsn::sizeconvert $filesize]] ($rate KB/s)"
				}
				$w.time configure -text "[trans timeremaining] :  $timeleft"

				set ratetimer($cookie) [after 1000 [list ::amsn::FTProgress $mode $cookie $filename $bytes $filesize $chatid]]
			}
			ca {
				$w.progress configure -text "[trans filetransfercancelled]"
				$w.close configure -text "[trans close]" -command "destroy $w"
				wm protocol $w WM_DELETE_WINDOW "destroy $w"
				bind $w <<Escape>> "destroy $w"
			}
			fs -
			fr {
				::dkfprogress::SetProgress $w.prbar 100
				$w.progress configure -text "[trans filetransfercomplete]"
				$w.close configure -text "[trans close]" -command "destroy $w"
				$w.openfile configure -state normal
				wm protocol $w WM_DELETE_WINDOW "destroy $w"
				bind $w <<Escape>> "destroy $w"
				set bytes 1024
				set filesize 1024
			}
		}

		switch $mode {
			e -
			l -
			ca -
			fs -
			fr {
				# Whenever a file transfer is terminated in a way or in another,
				# remove the counters for this cookie.
				if {[info exists firsttimes($cookie)]} { unset firsttimes($cookie) }
				if {[info exists ratetimer($cookie)]} { unset ratetimer($cookie) }
			}
		}

		#set bytes2 [expr {int($bytes/1024)}]
		#set filesize2 [expr {int($filesize/1024)}]
		if { $filesize != 0 } {
			#set percent [expr {int(($bytes2*100)/$filesize2)}]
			#::dkfprogress::SetProgress $w.prbar $percent
			::dkfprogress::SetProgress $w.prbar $bytes $filesize
		}

		# Close the window if the filetransfer is finished
		if {($mode == "fr" | $mode == "fs") & [::config::getKey ftautoclose]} {
			destroy $w
		}

	}

 	#Converts filesize in KBytes or MBytes
 	proc sizeconvert {filesize} {
 		#Converts in KBytes
 		set filesizeK [expr {int($filesize/1024)}]
 		#Converts in MBytes
 		set filesizeM [expr {int($filesize/1048576)}]
 		#If the sizefile is bigger than 1Mo
 		if {$filesizeM != 0} {
 			set filesizeM2 [expr {int((($filesize/1048576.) - $filesizeM)*100)}]
 			if {$filesizeM2 < 10} {
 				set filesizeM2 "0$filesizeM2"
 			}
 			set filesizeM "$filesizeM,$filesizeM2"
 			return "${filesizeM}M"
 		#Elseif the filesize is bigger than 1Ko
 		} elseif {$filesizeK != 0} {
 			return "${filesizeK}K"
 		} else {
 			return "$filesize"
 		}
 	}

	#///////////////////////////////////////////////////////////////////////////////
	# PUBLIC messageFrom(chatid,user,msg,type,[fontformat])
	# Called by the protocol layer when a message 'msg' arrives from the chat
	# 'chatid'.'user' is the login of the message sender, and 'user' can be "msg" to
	# send special messages not prefixed by "XXX says:". 'type' can be a style tag as
	# defined in the ::ChatWindow::Open proc, or just "user". If the type is "user",
	# the 'fontformat' parameter will be used as font format.
	# The procedure will open a window if it does not exists, add a notifyWindow and
	# play a sound if it's necessary
	proc messageFrom { chatid user nick message type {p4c 0} } {
		global remote_auth

		set fonttype [$message getHeader X-MMS-IM-Format]

		set begin [expr {[string first "FN=" $fonttype]+3}]
		set end   [expr {[string first ";" $fonttype $begin]-1}]
		set fontfamily "[urldecode [string range $fonttype $begin $end]]"

		set begin [expr {[string first "EF=" $fonttype]+3}]
		set end   [expr {[string first ";" $fonttype $begin]-1}]
		set fontstyle "[urldecode [string range $fonttype $begin $end]]"

		set begin [expr {[string first "CO=" $fonttype]+3}]
		set end   [expr {[string first ";" $fonttype $begin]-1}]
		set fontcolor "000000[urldecode [string range $fonttype $begin $end]]"
		set fontcolor "[string range $fontcolor end-1 end][string range $fontcolor end-3 end-2][string range $fontcolor end-5 end-4]"

		set style [list]
		if {[string first "B" $fontstyle] >= 0} {
			lappend style "bold"
		}
		if {[string first "I" $fontstyle] >= 0} {
			lappend style "italic"
		}
		if {[string first "U" $fontstyle] >= 0} {
			lappend style "underline"
		}
		if {[string first "S" $fontstyle] >= 0} {
			lappend style "overstrike"
		}
		if { [::config::getKey disableuserfonts] } {	 
			# If user wants incoming and outgoing messages to have the same font\
			set fontfamily [lindex [::config::getKey mychatfont] 0]	 
			set style [lindex [::config::getKey mychatfont] 1]	 
			#set fontcolor [lindex [::config::getKey mychatfont] 2]	 
		} elseif { [::config::getKey theirchatfont] != "" && $user != [::config::getKey login] } {
			# If user wants to specify a font for incoming messages (to override that user's font)
			foreach { fontfamily style fontcolor } [::config::getKey theirchatfont] {}
			#set fontfamily [lindex  0]	 
			#set style [lindex [::config::getKey theirchatfont] 1]
			#set fontcolor [lindex [::config::getKey theirchatfont 2]
		}

		#if customfnick exists replace the nick with customfnick
		set customfnick [::abook::getContactData $user customfnick]

		if { $customfnick != "" } {
			set nick [::abook::getNick $user]
			set customnick [::abook::getContactData $user customnick]
			set psm [::abook::getpsmmedia $user]
			set nick [::abook::parseCustomNick $customfnick $nick $user $customnick $psm]
		}
		
		set msg [$message getBody]

		set maxw [expr {[::skin::getKey notifwidth]-20}]
		incr maxw [expr {0-[font measure splainf "[trans says [list]]:"]}]
		set nickt [trunc $nick $maxw splainf]

		#if { ([::config::getKey notifymsg] == 1) && ([string first ${win_name} [focus]] != 0)} {
		#	notifyAdd "[trans says $nickt]:\n$msg" "::amsn::chatUser $chatid"
		#}
		set tmsg "[trans says $nickt]:\n$msg"

		set win_name [::ChatWindow::MakeFor $chatid $tmsg $user]


		if { $remote_auth == 1 } {
			if { "$user" != "$chatid" } {

				write_remote "To $chatid : $msg" msgsent

			} else {

				write_remote "From $chatid : $msg" msgrcv
			}
		}

		PutMessage $chatid $user $nick $msg $type [list $fontfamily $style $fontcolor] $p4c

#		set evPar [list $user [::abook::getDisplayNick $user] $msg]


	}
	#///////////////////////////////////////////////////////////////////////////////

	#///////////////////////////////////////////////////////////////////////////////
	# PUBLIC ShowInk(chatid,user,image,type,p4c)
	# Called by the protocol layer when an ink 'image' arrives from the chat
	# 'chatid'.'user' is the login of the message sender, and 'user' can be "msg" to
	# send special messages not prefixed by "XXX says:". 'type' can be a style tag as
	# defined in the ::ChatWindow::Open proc, or just "user". If the type is "user",
	# the 'fontformat' parameter will be used as font format.
	# The procedure will open a window if it does not exists, add a notifyWindow and
	# play a sound if it's necessary
	proc ShowInk { chatid user nick image type {p4c 0} } {
		global remote_auth

		#if customfnick exists replace the nick with customfnick
		set customfnick [::abook::getContactData $user customfnick]

		if { $customfnick != "" } {
			set nick [::abook::getNick $user]
			set customnick [::abook::getContactData $user customnick]
			set psm [::abook::getpsmmedia $user]
			set nick [::abook::parseCustomNick $customfnick $nick $user $customnick $psm]
		}
		
		set maxw [expr {[::skin::getKey notifwidth]-20}]
		incr maxw [expr {0-[font measure splainf "[trans says [list]]:"]}]
		set nickt [trunc $nick $maxw splainf]

		set tmsg "[trans gotink $user]"

		set win_name [::ChatWindow::MakeFor $chatid $tmsg $user]

		PutMessageWrapped $chatid $user $nickt "" $type "" $p4c
		
		set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]


		[::ChatWindow::GetOutText ${win_name}] configure -state normal
		[::ChatWindow::GetOutText ${win_name}] image create end -image $image

		if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }


		[::ChatWindow::GetOutText ${win_name}] configure -state disabled

	}
	#///////////////////////////////////////////////////////////////////////////////