gui.tcl

Linux下的MSN聊天程序源码

if {![::picture::Loaded]} {
	if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {	
		tk_messageBox -default ok -message "There's a problem loading a module of aMSN (TkCxImage) on this computer. \
			You need to update your system to Mac OS 10.3.9" -icon warning	
	} else {
		tk_messageBox -default ok -message "You can't load TkCximage, this is now needed to run \
			aMSN. Please compile amsn first, instructions on how to compile are located in the file INSTALL" -icon warning
	}
	exit
}
if {$::tcl_version <= 8.3} {
	tk_messageBox -default ok -message "You need TCL/TK 8.4 or better to run aMSN. Please upgrade."  -icon warning
	exit
}
package require AMSN_BWidget
if {[catch {package require tkdnd}] } {
	proc dnd { args } {}
	proc shape { args } {}
}
#package require pixmapbutton
if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
	#Use tclCarbonHICommand for window utilities
	catch {package require tclCarbonHICommand}
	catch {package require QuickTimeTcl}
	catch {load utils/macosx/Quicktimetcl3.1/quicktimetcl3.1.dylib}
} else {
	package require pixmapscroll
	#package require pixmapmenu
}


if { $initialize_amsn == 1 } {

	::skin::setKey mainwindowbg #7979f2
	::skin::setKey contactlistbg #ffffff
	::skin::setKey topcontactlistbg #ffffff
	::skin::setKey bannerbg #ffffff
	::skin::setKey contact_mobile #404040
	::skin::setKey chatwindowbg #EAEAEA

	::skin::setKey tabbarbg "[::skin::getKey chatwindowbg]"
	::skin::setKey tabfg #000000
	::skin::setKey tab_text_x 5
	::skin::setKey tab_text_y 5
	::skin::setKey tab_text_width 80
	::skin::setKey tab_close_x 85
	::skin::setKey tab_close_y 5
	::skin::setKey chat_tabbar_padx 0
	::skin::setKey chat_tabbar_pady 0
	::skin::setKey buttonbarbg #eeeeff
	::skin::setKey sendbuttonbg #c3c2d2
	::skin::setKey topbarbg #5050e5
	::skin::setKey topbarbg_sel #d3d0ce
	::skin::setKey topbartext #ffffff
	::skin::setKey topbarborder #000000
	::skin::setKey topbarawaybg #00AB00
	::skin::setKey topbarawaybg_sel #d3d0ce
	::skin::setKey topbarawaytext #000000
	::skin::setKey topbarawayborder #000000
	::skin::setKey topbarbusybg #CF0000
	::skin::setKey topbarbusybg_sel #d3d0ce
	::skin::setKey topbarbusytext #000000
	::skin::setKey topbarbusyborder #000000
	::skin::setKey topbarofflinebg #404040
	::skin::setKey topbarofflinebg_sel #d3d0ce
	::skin::setKey topbarofflinetext #ffffff
	::skin::setKey topbarofflineborder #000000
	::skin::setKey topbarpadx 6
	::skin::setKey topbarpady 6
	::skin::setKey chat_top_pixmap 0
	
	::skin::setKey statusbarbg #eeeeee
	::skin::setKey statusbarbg_sel #d3d0ce
	::skin::setKey statusbartext #000000
	::skin::setKey groupcolorextend #000080
	::skin::setKey groupcolorcontract #000080

	::skin::setKey button_border_left 6
	::skin::setKey button_border_right 6
	::skin::setKey button_border_top 6
	::skin::setKey button_border_bottom 6

	::skin::setKey button_ring_border_left 2
	::skin::setKey button_ring_border_right 2
	::skin::setKey button_ring_border_top 2
	::skin::setKey button_ring_border_bottom 2

	::skin::setKey chat_top_padx 0
	::skin::setKey chat_top_pady 0
	::skin::setKey chat_paned_padx 0
	::skin::setKey chat_paned_pady 0
	::skin::setKey chat_output_padx 0
	::skin::setKey chat_output_pady 0
	::skin::setKey chat_buttons_padx 0
	::skin::setKey chat_buttons_pady 0
	::skin::setKey chat_input_padx 0
	::skin::setKey chat_input_pady 0
	::skin::setKey chat_dp_padx 0
	::skin::setKey chat_dp_pady 0
	::skin::setKey chat_leftframe_padx 0
	::skin::setKey chat_leftframe_pady 0
	::skin::setKey chat_sendbutton_padx 0
	::skin::setKey chat_sendbutton_pady 0
	::skin::setKey chat_status_padx 0
	::skin::setKey chat_status_pady 0
	::skin::setKey chat_sash_width 2
	::skin::setKey chat_sash_relief raised
	::skin::setKey chat_sash_showhandle 0
	::skin::setKey chat_sash_pady 0

	::skin::setKey chat_status_border_color #000000
	::skin::setKey chat_output_border_color #000000
	::skin::setKey chat_output_back_color #ffffff
	::skin::setKey chat_input_border_color #000000
	::skin::setKey chat_input_back_color #ffffff
	::skin::setKey chat_buttons_border_color #000000
	::skin::setKey chat_dp_border_color #000000

	::skin::setKey chat_top_border 0
	::skin::setKey chat_output_border 0
	::skin::setKey chat_buttons_border 0
	::skin::setKey chat_input_border 0
	::skin::setKey chat_status_border 0
	::skin::setKey chat_dp_border 1
	
	::skin::setKey chat_show_sendbuttonframe 1
	::skin::setKey chat_show_statusbarframe 1
	::skin::setKey chat_show_topframe 1

	::skin::setKey menuforeground #000000
	::skin::setKey menuactivebackground #565672
	::skin::setKey menuactiveforeground #ffffff
	::skin::setKey mystatus grey
	::skin::setKey buddylistpad 4
	::skin::setKey showdisplaycontactlist 0
	::skin::setKey emailabovecolorbar 0
	::skin::setKey underline_contact 0
	::skin::setKey underline_group 0
	::skin::setKey changecursor_contact 1
	::skin::setKey changecursor_group 1		
	::skin::setKey bigstate_xpad 0
	::skin::setKey bigstate_ypad 0
	::skin::setKey mystatus_xpad 3
	::skin::setKey mystatus_ypad 0
	::skin::setKey mailbox_xpad 2
	::skin::setKey mailbox_ypad 2
	::skin::setKey contract_xpad 8
	::skin::setKey contract_ypad 6
	::skin::setKey expand_xpad 8
	::skin::setKey expand_ypad 6
	::skin::setKey x_dp_top 4
	::skin::setKey y_dp_top 4
	::skin::setKey balloonbackground #daeefe
	::skin::setKey balloonborderwidth 1
	::skin::setKey balloonborder #2e8afe
	::skin::setKey balloontext #0000dd
	::skin::setKey buddy_xpad 15
	::skin::setKey buddy_ypad 3

	::skin::setKey notifwidth 150
	::skin::setKey notifheight 100
	::skin::setKey x_notifyclose 140
	::skin::setKey y_notifyclose 2
	::skin::setKey x_notifydp 1
	::skin::setKey y_notifydp 22
	::skin::setKey x_notifytext 55
	::skin::setKey y_notifytext 22
	::skin::setKey width_notifytext 93
	::skin::setKey notify_font sboldf
	::skin::setKey notify_dp_border 0

	if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
		::skin::setKey balloonbackground #ffffca
		::skin::setKey menubackground #ECECEC
	} else {
		::skin::setKey balloonbackground #ffffaa
		::skin::setKey menubackground #eae7e4
	}
	::skin::setKey balloonfont sboldf
	::skin::setKey balloonborder #000000

	#Virtual events used by Button-click
	#On Mac OS X, Control emulate the "right click button"
	#On Mac OS X, there's a mistake between button2 and button3
	if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
		event add <<Button1>> <Button1-ButtonRelease>
		event add <<Button2>> <Button3-ButtonRelease>
		event add <<Button2-Press>> <ButtonPress-3>
		event add <<Button2-Motion>> <B3-Motion>
		event add <<Button3>> <Control-ButtonRelease>
		event add <<Button3>> <Button2-ButtonRelease>
		event add <<Button3-Press>> <ButtonPress-2>
		event add <<Escape>> <Command-w> <Command-W>
		event add <<Paste>> <Command-v> <Command-V>
		event add <<Copy>> <Command-c> <Command-C>
		event add <<Cut>> <Command-x> <Command-X>
	} else {
		event add <<Button1>> <Button1-ButtonRelease>
		event add <<Button2>> <Button2-ButtonRelease>
		event add <<Button2-Press>> <ButtonPress-2>
		event add <<Button2-Motion>> <B2-Motion>
		event add <<Button3>> <Button3-ButtonRelease>
		event add <<Button3-Press>> <ButtonPress-3>
		event add <<Button3-Motion>> <B3-Motion>
		event add <<Escape>> <Escape>
		event add <<Paste>> <Control-v> <Control-V>
		event add <<Copy>> <Control-c> <Control-C>
		event add <<Cut>> <Control-x> <Control-X>
	}


	#Set the default option for canvas -highlightthickness
	option add *Canvas.highlightThickness 0

	#OnUnix is defined later on so for 0.96 just use this, trunk has OnUnix here
	if { ![catch {tk windowingsystem} wsystem] && $wsystem  == "x11" } {
		#Mappings for Shift-BackSpace
		bind Entry <Terminate_Server> [bind Entry <BackSpace>]
		bind Text <Terminate_Server> [bind Text <BackSpace>]
	}

	if { $::tcl_version >= 8.4 } {
		#To avoid a bug inside panedwindow, by Youness
		rename ::tk::panedwindow::Cursor ::tk::panedwindow::Original_Cursor
		proc ::tk::panedwindow::Cursor { args } {
			catch { eval ::tk::panedwindow::Original_Cursor $args }
		}
	}
}

namespace eval ::amsn {

	namespace export initLook aboutWindow showHelpFile errorMsg infoMsg \
		blockUnblockUser blockUser unblockUser deleteUser \
		fileTransferRecv fileTransferProgress \
		errorMsg notifyAdd initLook messageFrom userJoins userLeaves \
		updateTypers ackMessage nackMessage chatUser

	##PUBLIC

	proc initLook { family size bgcolor} {
		global tcl_platform
		font create menufont -family $family -size $size -weight normal
		font create sboldf -family $family -size $size -weight bold
		font create splainf -family $family -size $size -weight normal
                font create sunderf -family $family -size $size -weight normal -underline yes
		font create sbolditalf -family $family -size $size -weight bold -slant italic
		font create sitalf -family $family -size $size -slant italic
		font create macfont -family [list {Lucida Grande}] -size 13 -weight normal

		if { [::config::getKey strictfonts] } {
			font create bboldf -family $family -size $size -weight bold
			font create bboldunderf -family $family -size $size -weight bold -underline true
			font create bplainf -family $family -size $size -weight normal
			font create bigfont -family $family -size $size -weight bold
			font create examplef -family $family -size $size -weight normal
		} else {
			font create bboldf -family $family -size [expr {$size+1}] -weight bold
			font create bboldunderf -family $family -size [expr {$size+1}] -weight bold -underline true
			font create bplainf -family $family -size [expr {$size+1}] -weight normal
			font create bigfont -family $family -size [expr {$size+2}] -weight bold
			font create examplef -family $family -size [expr {$size-2}] -weight normal
		}

		catch {tk_setPalette [::skin::getKey menubackground]}
		option add *Menu.font menufont

		option add *selectColor #DD0000
		option add *Photo.format cximage widgetDefault

		if { ![catch {tk windowingsystem} wsystem] && $wsystem  == "x11" } {
			option add *background [::skin::getKey menubackground]

			option add *borderWidth 1 widgetDefault
			option add *activeBorderWidth 1 widgetDefault
			option add *selectBorderWidth 1 widgetDefault

			option add *Listbox.background white widgetDefault
			option add *Listbox.selectBorderWidth 0 widgetDefault
			option add *Listbox.selectForeground white widgetDefault
			option add *Listbox.selectBackground #4a6984 widgetDefault

			option add *Entry.background white widgetDefault
			option add *Entry.borderWidth 1 widgetDefault
			option add *Entry.foreground black widgetDefault
			option add *Entry.selectBorderWidth 0 widgetDefault
			option add *Entry.selectForeground white widgetDefault
			option add *Entry.selectBackground #4a6984 widgetDefault
			option add *Entry.padX 2 widgetDefault
			option add *Entry.padY 4 widgetDefault

			option add *Text.background white widgetDefault
			option add *Text.selectBorderWidth 0 widgetDefault
			option add *Text.selectForeground white widgetDefault
			option add *Text.selectBackground #4a6984 widgetDefault
			option add *Text.padX 2 widgetDefault
			option add *Text.padY 4 widgetDefault

			option add *Menu.activeBorderWidth 0 widgetDefault
			option add *Menu.highlightThickness 0 widgetDefault
			option add *Menu.borderWidth 1 widgetDefault
			option add *Menu.background [::skin::getKey menubackground]
			option add *Menu.foreground [::skin::getKey menuforeground]
			option add *Menu.activeBackground [::skin::getKey menuactivebackground]
			option add *Menu.activeForeground [::skin::getKey menuactiveforeground]

			option add *Menubutton.activeBackground #4a6984 widgetDefault
			option add *Menubutton.activeForeground white widgetDefault
			option add *Menubutton.activeBorderWidth 0 widgetDefault
			option add *Menubutton.highlightThickness 0 widgetDefault
			option add *Menubutton.borderWidth 0 widgetDefault
			option add *Menubutton.padX 2 widgetDefault
			option add *Menubutton.padY 4 widgetDefault

			option add *Labelframe.borderWidth 2 widgetDefault
			option add *Frame.borderWidth 2 widgetDefault
			option add *Labelframe.padY 8 widgetDefault
			option add *Labelframe.padX 12 widgetDefault

			option add *highlightThickness 0 widgetDefault
			option add *troughColor #c3c3c3 widgetDefault

			option add *Scrollbar.width		10
			option add *Scrollbar.borderWidth		1
			option add *Scrollbar.highlightThickness	0 widgetDefault

			option add *Button.activeForeground #5b76c6 userDefault
		}
		option add *Font splainf userDefault
		#Use different width for scrollbar on Mac OS X
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			option add *background #ECECEC
			option add *highlightbackground #ECECEC
			option add *Scrollbar.width 15 userDefault
			option add *Button.Font macfont userDefault
			option add *Button.highlightBackground #ECECEC userDefault
		} elseif { $tcl_platform(platform) == "windows"} {
			option add *background [::skin::getKey menubackground]
			option add *Scrollbar.width 14 userDefault
			option add *Button.Font sboldf userDefault
		} else {
			option add *background [::skin::getKey menubackground]
			option add *Scrollbar.width 12 userDefault
			option add *Button.Font sboldf userDefault
		}




		#option add *Scrollbar.borderWidth 1 userDefault

		set Entry {-bg #FFFFFF -foreground #000000}
		set Label {-bg #FFFFFF -foreground #000000}
		::themes::AddClass Amsn Entry $Entry 90
		::themes::AddClass Amsn Label $Label 90
		::abookGui::Init


	#Register events
	::Event::registerEvent loggedIn all loggedInGuiConf
	::Event::registerEvent loggedOut all loggedOutGuiConf

	}

	#///////////////////////////////////////////////////////////////////////////////
	# Draws the about window
	proc aboutWindow {} {
		global tcl_platform langenc date weburl
		
		set filename "[file join docs README[::config::getGlobalKey language]]"
		
		set current_enc $langenc


		if {![file exists $filename]} {
			status_log "File $filename NOT exists!!\n\tUsing english one instead." red
			set filename README
			set current_enc "iso8859-1"

			if {![file exists $filename]} {
				status_log "no english README either .. Houston, we have a problem, you ***'ed up your aMSN install!"
				msg_box "[trans transnotexists]"
				return
			}