gui.tcl

Linux下的MSN聊天程序源码

		}
				
		if { [winfo exists .about] } {
			raise .about
			return
		}

		toplevel .about
		wm title .about "[trans aboutamsn]"

		ShowTransient .about

		wm state .about withdrawn


		#Top frame (Picture and name of developers)
		set developers "Didimo Grimaldo\n Alvaro J. Iradier\n Khalaf Philippe\n Alaoui Youness\n Dave Mifsud\n..."


		label .about.image -image [::skin::loadPixmap msndroid]
		label .about.title -text "aMSN $::version ([::abook::dateconvert $date])" -font bboldf
		label .about.what -text "[trans whatisamsn]\n"
		pack .about.image .about.title .about.what -side top

		#names-frame
		frame .about.names -class Amsn
		label .about.names.t -font splainf -text "[trans broughtby]:\n$developers"
		pack .about.names.t -side top
		pack .about.names -side top


		#Middle frame (About text)
		frame .about.middle
		frame .about.middle.list -class Amsn -borderwidth 0
		text .about.middle.list.text -background white -width 80 -height 10 -wrap word \
			-yscrollcommand ".about.middle.list.ys set" -font splainf
		scrollbar .about.middle.list.ys -command ".about.middle.list.text yview"
		pack .about.middle.list.ys -side right -fill y
		pack .about.middle.list.text -side left -expand true -fill both
		pack .about.middle.list -side top -expand true -fill both -padx 1 -pady 1

		label .about.middle.url -text $weburl -font bplainf -fg blue
		pack .about.middle.url -side top -pady 3

		bind .about.middle.url <Enter> ".about.middle.url configure -font bboldf "
		bind .about.middle.url <Leave> ".about.middle.url configure -font bplainf"

		bind .about.middle.url <Enter> "+.about.middle.url configure -cursor hand2"
#		bind .about.middle.url <Leave> ".about.middle.url configure -cursor left_ptr"

		bind .about.middle.url <Button1-ButtonRelease> "launch_browser $weburl"


		#Bottom frame (Close button)
		frame .about.bottom -class Amsn
		button .about.bottom.close -text "[trans close]" -command "destroy .about"
		bind .about <<Escape>> "destroy .about"
		button .about.bottom.credits -text "[trans credits]..." -command [list ::amsn::showHelpFileWindow CREDITS [trans credits]]

		pack .about.bottom.close -side right
		pack .about.bottom.credits -side left

		pack .about.bottom -side bottom -fill x -pady 3 -padx 5
		pack .about.middle -expand true -fill both -side top

		#Insert the text in .about.middle.list.text
		set id [open $filename r]
		fconfigure $id -encoding $current_enc

		.about.middle.list.text insert 1.0 [read $id]
		close $id

		.about.middle.list.text configure -state disabled

		update idletasks

		wm state .about normal
		set x [expr {([winfo vrootwidth .about] - [winfo width .about]) / 2}]
		set y [expr {([winfo vrootheight .about] - [winfo height .about]) / 2}]
		wm geometry .about +${x}+${y}
		moveinscreen .about 30

		#Should we disable resizable? Since when we make the windows smaller (in y), we lost the "Close button"
		#wm resizable .about 0 0
	}
	#///////////////////////////////////////////////////////////////////////////////


	#///////////////////////////////////////////////////////////////////////////////
	# showHelpFileWindow(file, windowtitle, ?english?)
	proc showHelpFileWindow {file title {english 0}} {
		global langenc

		set langcode [::config::getGlobalKey language]
		set encoding $langenc
			

		if {$english == 1} {
			set langcode "en"
			set encoding "iso8859-1"
		}

		set filename [file join "docs" "${file}$langcode"]
		if {$langcode == "en"} {
			set filename $file
		}


		if {![file exists $filename]} {
			status_log "File $filename NOT exists!!\n\tOpening English one instead." red
			set filename "${file}"
			set langcode "en"
			set encoding "iso8859-1"
			if {![file exists $filename]} {			
				status_log "Couldn't open $filename!" red
				msg_box "[trans transnotexists]"
				return
			}
		}
			
		if {$langcode == "en"} {
			set w help${filename}en
		} else {
			set w help${filename}
		}

		status_log "filename: $filename"

		# Used to avoid a bug for dbusviewer where the $filename points to /home/user/.amsn the dot makes 
		# tk think it's a window's path separator and it says that the window .help/home/user/ doesn't exit (for .amsn to be its child)
		set w ".[string map {. "_" " " "__"} $w]"


		if { [winfo exists $w] } {
			raise $w
			return
		}

		toplevel $w
		wm title $w "$title"

		ShowTransient $w


		#Top frame (Help text area)
		frame $w.info
		frame $w.info.list -class Amsn -borderwidth 0
		text $w.info.list.text -background white -width 80 -height 30 -wrap word \
			-yscrollcommand "$w.info.list.ys set" -font   splainf
		scrollbar $w.info.list.ys -command "$w.info.list.text yview"
		pack $w.info.list.ys 	-side right -fill y
		pack $w.info.list.text -expand true -fill both -padx 1 -pady 1
		pack $w.info.list 		-side top -expand true -fill both -padx 1 -pady 1
		pack $w.info 			-expand true -fill both -side top

		#Bottom frame (Close button)
		button $w.close -text "[trans close]" -command "destroy $w"
		button $w.eng -text "English version" -command [list ::amsn::showHelpFileWindow $file "$title - English version" 1]
		bind $w <<Escape>> "destroy $w"
		pack $w.close

		if {$langcode != "en" && $english != 1} {
			pack $w.eng  -side right -anchor e -padx 5 -pady 3
		}
		pack $w.close  -side right -anchor e -padx 5 -pady 3

		#Insert FAQ text
		set id [open $filename r]
		fconfigure $id -encoding $encoding
		$w.info.list.text insert 1.0 [read $id]
		close $id

		$w.info.list.text configure -state disabled

		update idletasks

		set x [expr {([winfo vrootwidth $w] - [winfo width $w]) / 2}]
		set y [expr {([winfo vrootheight $w] - [winfo height $w]) / 2}]
		wm geometry $w +${x}+${y}

		#Should we disable resizable? Since when we make the windows smaller (in y), we lost the "Close button"
		#wm resizable .about 0 0
		return $w
	}

	#///////////////////////////////////////////////////////////////////////////////

	proc messageBox { message type icon {title ""} {parent ""}} {

		#If we are on MacOS X, don't put the box in the parent because there are some problems
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			set answer [tk_messageBox -message "$message" -type $type -icon $icon]
		} else {
			if { $parent == ""} {
				set parent [focus]
				if { $parent == ""} { set parent "."}
			}
				set answer [tk_messageBox -message "$message" -type $type -icon $icon -title $title -parent $parent]
		}
		return $answer
	}

	#///////////////////////////////////////////////////////////////////////////////

	#///////////////////////////////////////////////////////////////////////////////
	# Shows the error message specified by "msg"
	proc errorMsg { msg } {
		::amsn::messageBox $msg ok error "[trans title] Error"
	}
	#///////////////////////////////////////////////////////////////////////////////

	#///////////////////////////////////////////////////////////////////////////////
	# Shows the error message specified by "msg"
	proc infoMsg { msg {icon "info"} } {
		::amsn::messageBox $msg ok $icon [trans title]
	}
	#///////////////////////////////////////////////////////////////////////////////

	#///////////////////////////////////////////////////////////////////////////////
	proc blockUnblockUser { user_login } {
		if { [::MSN::userIsBlocked $user_login] } {
			unblockUser $user_login
		} else {
			blockUser $user_login
		}
	}
	#///////////////////////////////////////////////////////////////////////////////



	#///////////////////////////////////////////////////////////////////////////////
	proc blockUser {user_login} {
		set answer [::amsn::messageBox "[trans confirmbl] ($user_login)" yesno question [trans block]]
		if { $answer == "yes"} {
			set name [::abook::getNick ${user_login}]
			::MSN::blockUser ${user_login} [urlencode $name]
		}
	}
	#///////////////////////////////////////////////////////////////////////////////


	#///////////////////////////////////////////////////////////////////////////////
	proc unblockUser {user_login} {
		set name [::abook::getNick ${user_login}]
		::MSN::unblockUser ${user_login} [urlencode $name]
	}
	#///////////////////////////////////////////////////////////////////////////////


	#///////////////////////////////////////////////////////////////////////////////
	#Delete user window, user can choose to delete user, cancel the action or block and delete the user
	proc deleteUser {user_login { grId ""} } {
		global variableblock

		set variableblock 0

		set w .deleteUserWindow

		#If the window was there before, destroy it and create the newone
		if {[winfo exists $w]} {
			destroy $w
		}

		#Create the window
		toplevel $w
		wm title $w "[trans delete] - $user_login"

		#Create the 2 frames
		frame $w.top
		frame $w.buttons

		#Create the picture of warning (at left)
		label $w.top.bitmap -image [::skin::loadPixmap warning]
		pack $w.top.bitmap -side left -pady 5 -padx 10
		#Text to show to delete the user
		label $w.top.question -text "[trans confirmdu]" -font bigfont
		pack $w.top.question -pady 5 -padx 10

		#Create the three buttons, Yes and block / Yes / No

		checkbutton $w.top.yesblock -text "[trans yesblock]" -variable variableblock

		button $w.buttons.yes -text "[trans yes]" -command \
			"::amsn::deleteUserAction $w $user_login $grId" -default active -width 6
		button $w.buttons.no -text "[trans no]" -command "destroy $w" -width 6

		#Pack buttons
		pack $w.buttons.yes -pady 5 -padx 5 -side right
		pack $w.buttons.no -pady 5 -padx 5 -side left

		# if already blocked don't show 'Yes and Block' button
		if {[lsearch [::abook::getLists $user_login] BL] == -1} {
			pack $w.top.yesblock -pady 5 -padx 10 -side left
		}


		#Pack frames
		pack $w.top -pady 5 -padx 5 -side top
		pack $w.buttons -pady 5 -padx 5 -side right

		moveinscreen $w 30
		bind $w <<Escape>> "catch {destroy $w}"
		#This function will be executed when the button is pushed

	}
	#///////////////////////////////////////////////////////////////////////////////
	# deleteUserAction {w user_login answer grId}
	# Action to do when someone click delete a user
	proc deleteUserAction {w user_login {grId ""} } {
		global variableblock
		#If he wants to delete AND block a user
		if { $variableblock == "1"} {
			set name [::abook::getNick ${user_login}]
			::MSN::blockUser ${user_login} [urlencode $name]
			::MSN::deleteUser ${user_login} $grId
			::abook::setContactData $user_login alarms ""
		#Just delete the user
		} elseif { $variableblock == "0"} {
			::MSN::deleteUser ${user_login} $grId
			::abook::setContactData $user_login alarms ""
		}
		#Remove .deleteUserWindow window
		destroy $w
		return
	}

	proc InkSend { win_name filename {friendlyname ""}} {


		set chatid [::ChatWindow::Name $win_name]

		if { $chatid == 0 } {
			status_log "VERY BAD ERROR in ::amsn::InkSend!!!\n" red
			return 0
		}

		#Blank ink
		if {$filename == ""} { return 0 }

		if { $friendlyname != "" } {
			set nick $friendlyname
			set p4c 1
		} elseif { [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] != ""} {
			set friendlyname [::abook::parseCustomNick [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] [::abook::getPersonal MFN] [::abook::getPersonal login] "" [::abook::getpsmmedia] ]
			set nick $friendlyname
			set p4c 1
		} elseif { [::config::getKey p4c_name] != ""} {
			set nick [::config::getKey p4c_name]
			set p4c 1
		} else {
			set nick [::abook::getPersonal MFN]
			set p4c 0
		}
		#Postevent when we send a message
		set evPar(nick) nick
		set evPar(ink) filename
		set evPar(chatid) chatid
		set evPar(win_name) win_name
		::plugins::PostEvent chat_ink_send evPar

			

		#Draw our own message
		#Does this image ever gets destroyed ? When destroying the chatwindow it's embeddeed in it should I guess ? This is not the leak I'm searching for though as I'm not sending inks...
		set img [image create photo [TmpImgName] -file $filename]
		SendMessageFIFO [list ::amsn::ShowInk $chatid [::abook::getPersonal login] $nick $img ink $p4c] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
		::MSN::ChatQueue $chatid [list ::MSN::SendInk $chatid $filename]


		::plugins::PostEvent chat_ink_sent evPar

	}


	proc FileTransferSend { win_name {filename ""} } {
		
		if {![winfo exists $win_name] } {
			set win_name [::amsn::chatUser $win_name]
		}
			
		global starting_dir

#		set filename [ $w.top.fields.file get ]
		if { $filename == "" } {