abook.tcl

Linux下的MSN聊天程序源码

		grid $nbIdent.fPhone -row 1 -column 0 -sticky nwse -padx { 0 4 } -pady { 8 0 }
		grid $nbIdent.fStats -row 1 -column 1 -sticky nwse -padx { 4 0 } -pady { 8 0 }
		grid columnconfigure $nbIdent { 0 1 } -weight 1
		
		pack $sw -expand true -fill both
		
		##############
		#User settings page
		#############
		set nbSettings [$w.nb getframe usersettings]
		ScrolledWindow $nbSettings.sw
		set sw $nbSettings.sw
		ScrollableFrame $nbSettings.sw.sf -constrainedwidth 1
		$nbSettings.sw setwidget $nbSettings.sw.sf
		set nbSettings [$nbSettings.sw.sf getframe]
		
		labelframe $nbSettings.fNick -relief groove -text [trans nick]
		label $nbSettings.fNick.customnickl -text "[trans customnick]:"
		frame $nbSettings.fNick.customnick
		entry $nbSettings.fNick.customnick.ent -font splainf -bg white
		menubutton $nbSettings.fNick.customnick.help -font sboldf -text "<-" -menu $nbSettings.fNick.customnick.help.menu
		menu $nbSettings.fNick.customnick.help.menu -tearoff 0
		$nbSettings.fNick.customnick.help.menu add command -label [trans nick] -command "$nbSettings.fNick.customnick.ent insert insert \\\$nick"
		$nbSettings.fNick.customnick.help.menu add command -label [trans email] -command "$nbSettings.fNick.customnick.ent insert insert \\\$user_login"
		if { [::config::getKey protocol] >= 11 } {
			$nbSettings.fNick.customnick.help.menu add command -label [trans psm] -command "$nbSettings.fNick.customnick.ent insert insert \\\$psm"
		}
		$nbSettings.fNick.customnick.help.menu add separator
		$nbSettings.fNick.customnick.help.menu add command -label [trans delete] -command "$nbSettings.fNick.customnick.ent delete 0 end"
		$nbSettings.fNick.customnick.ent insert end [::abook::getContactData $email customnick]
		pack $nbSettings.fNick.customnick.ent -side left -expand true -fill x
		pack $nbSettings.fNick.customnick.help -side left
		label $nbSettings.fNick.customfnickl -text "[trans friendlyname]:"
		frame $nbSettings.fNick.customfnick
		entry $nbSettings.fNick.customfnick.ent -font splainf -bg white
		menubutton $nbSettings.fNick.customfnick.help -font sboldf -text "<-" -menu $nbSettings.fNick.customfnick.help.menu
		menu $nbSettings.fNick.customfnick.help.menu -tearoff 0
		$nbSettings.fNick.customfnick.help.menu add command -label [trans nick] -command "$nbSettings.fNick.customfnick.ent insert insert \\\$nick"
		$nbSettings.fNick.customfnick.help.menu add command -label [trans email] -command "$nbSettings.fNick.customfnick.ent insert insert \\\$user_login"
                if { [::config::getKey protocol] >= 11 } {
                        $nbSettings.fNick.customfnick.help.menu add command -label [trans psm] -command "$nbSettings.fNick.customfnick.ent insert insert \\\$psm"
                }
		$nbSettings.fNick.customfnick.help.menu add separator
		$nbSettings.fNick.customfnick.help.menu add command -label [trans delete] -command "$nbSettings.fNick.customfnick.ent delete 0 end"
		$nbSettings.fNick.customfnick.ent insert end [::abook::getContactData $email customfnick]
		pack $nbSettings.fNick.customfnick.ent -side left -expand true -fill x
		pack $nbSettings.fNick.customfnick.help -side left
	
		label $nbSettings.fNick.ycustomfnickl -text "[trans myfriendlyname]:"
		frame $nbSettings.fNick.ycustomfnick
		entry $nbSettings.fNick.ycustomfnick.ent -font splainf -bg white
		menubutton $nbSettings.fNick.ycustomfnick.help -font sboldf -text "<-" -menu $nbSettings.fNick.ycustomfnick.help.menu
		menu $nbSettings.fNick.ycustomfnick.help.menu -tearoff 0
		$nbSettings.fNick.ycustomfnick.help.menu add command -label [trans nick] -command "$nbSettings.fNick.ycustomfnick.ent insert insert \\\$nick"
		$nbSettings.fNick.ycustomfnick.help.menu add command -label [trans email] -command "$nbSettings.fNick.ycustomfnick.ent insert insert \\\$user_login"
                if { [::config::getKey protocol] >= 11 } {
                        $nbSettings.fNick.ycustomfnick.help.menu add command -label [trans psm] -command "$nbSettings.fNick.ycustomfnick.ent insert insert \\\$psm"
                }
		$nbSettings.fNick.ycustomfnick.help.menu add separator
		$nbSettings.fNick.ycustomfnick.help.menu add command -label [trans delete] -command "$nbSettings.fNick.ycustomfnick.ent delete 0 end"
		$nbSettings.fNick.ycustomfnick.ent insert end [::abook::getContactData $email cust_p4c_name]
		pack $nbSettings.fNick.ycustomfnick.ent -side left -expand true -fill x
		pack $nbSettings.fNick.ycustomfnick.help -side left
		
		# The custom color frame
		label $nbSettings.fNick.lColor -text "[trans customcolor]:"
		frame $nbSettings.fNick.fColor -relief flat
		set colorval_$email [::abook::getContactData $email customcolor] 
		set showcustomsmileys_$email [::abook::getContactData $email showcustomsmileys]
		set ignorecontact_$email [::abook::getContactData $email ignored]

		frame $nbSettings.fNick.fColor.col -width 40 -bd 0 -relief flat -highlightbackground black -highlightcolor black
		if { [set colorval_$email] != "" } {
			if { [string index [set colorval_$email] 0] == "#" } {
				set colorval_$email [string range [set colorval_$email] 1 end]
			}
			set colorval_$email "#[string repeat 0 [expr {6-[string length [set colorval_$email]]}]][set colorval_$email]"
			#If the color is white we can't see the contact on the list : we ignore the custom color
			$nbSettings.fNick.fColor.col configure -background [set colorval_${email}] -highlightthickness 1 
		} else {
			$nbSettings.fNick.fColor.col configure -background [$nbSettings.fNick.fColor cget -background] -highlightthickness 0
		}
		button $nbSettings.fNick.fColor.bset -text "[trans change]" -command "::abookGui::ChangeColor $email $nbSettings" 
		button $nbSettings.fNick.fColor.brem -text "[trans delete]" -command "::abookGui::RemoveCustomColor $email $nbSettings" 
		pack $nbSettings.fNick.fColor.col -side left -expand true -fill y -pady 5 -padx 8
		pack $nbSettings.fNick.fColor.bset -side left -padx 3 -pady 2
		pack $nbSettings.fNick.fColor.brem -side left -padx 3 -pady 2
		
		grid $nbSettings.fNick.customnickl -row 0 -column 0 -sticky e
		grid $nbSettings.fNick.customnick -row 0 -column 1 -sticky we
		grid $nbSettings.fNick.customfnickl -row 1 -column 0 -sticky e
		grid $nbSettings.fNick.customfnick -row 1 -column 1 -sticky we
		grid $nbSettings.fNick.ycustomfnickl -row 2 -column 0 -sticky e
		grid $nbSettings.fNick.ycustomfnick -row 2 -column 1 -sticky we
		grid $nbSettings.fNick.lColor -row 3 -column 0 -sticky e
		grid $nbSettings.fNick.fColor -row 3 -column 1 -sticky w
		grid columnconfigure $nbSettings.fNick 1 -weight 1
		
		labelframe $nbSettings.fChat -relief groove -text [trans chat]
		checkbutton $nbSettings.fChat.showcustomsmileys -variable showcustomsmileys_$email -text "[trans custshowcustomsmileys]" -anchor w
		checkbutton $nbSettings.fChat.ignoreuser -variable ignorecontact_$email -text "[trans ignorecontact]" -anchor w
		pack $nbSettings.fChat.showcustomsmileys -side top -fill x
		pack $nbSettings.fChat.ignoreuser -side top -fill x
		
		labelframe $nbSettings.fGroup -relief groove -text [trans groups]
		::groups::Groupmanager $email $nbSettings.fGroup

		labelframe $nbSettings.fNotify -relief groove -text [trans notifywin]
		label $nbSettings.fNotify.default -font sboldf -text "*" -justify center
		label $nbSettings.fNotify.yes -font sboldf -text [trans yes] -justify center
		label $nbSettings.fNotify.no -font sboldf -text [trans no] -justify center
		
		#Set default values
		set ::notifyonline($email) [::abook::getContactData $email notifyonline ""]
		set ::notifyoffline($email) [::abook::getContactData $email notifyoffline ""]
		set ::notifystatus($email) [::abook::getContactData $email notifystatus ""]
		set ::notifymsg($email) [::abook::getContactData $email notifymsg ""]
		
		#Add the checkboxes
		AddOption $nbSettings.fNotify notifyonline notifyonline($email) [trans custnotifyonline] 1
		AddOption $nbSettings.fNotify notifyoffline notifyoffline($email) [trans custnotifyoffline] 2
		AddOption $nbSettings.fNotify notifystatus notifystatus($email) [trans custnotifystatus] 3
		AddOption $nbSettings.fNotify notifymsg notifymsg($email) [trans custnotifymsg] 4
		
		grid $nbSettings.fNotify.default -row 0 -column 0 -sticky we -padx 5
		grid $nbSettings.fNotify.yes -row 0 -column 1 -sticky we -padx 5
		grid $nbSettings.fNotify.no -row 0 -column 2 -sticky we -padx 5
		grid columnconfigure $nbSettings.fNotify 3 -weight 1
		
		grid $nbSettings.fNick -row 0 -column 0 -sticky nwse -columnspan 2 -pady { 0 4 }
		grid $nbSettings.fChat -row 1 -column 0 -sticky nwse -padx { 0 4 } -pady 4
		grid $nbSettings.fGroup -row 1 -column 1 -sticky nwse -padx { 4 0 } -pady 4
		grid $nbSettings.fNotify -row 2 -column 0 -sticky nwse -columnspan 2 -pady { 4 0 }
		grid columnconfigure $nbSettings { 0 1 } -weight 1
		
		pack $sw -expand true -fill both

		##############
		#Alarms frame
		##############
		set nbAlarm [$w.nb getframe alarms]
		ScrolledWindow $nbAlarm.sw
		pack $nbAlarm.sw -expand true -fill both
		ScrollableFrame $nbAlarm.sw.sf
		$nbAlarm.sw setwidget $nbAlarm.sw.sf

		set nbAlarm [$nbAlarm.sw.sf getframe]
		::alarms::configDialog $email $nbAlarm

		##############
		#UserDPs page
		##############
		set nbUserDPs [$w.nb getframe userDPs]
		# User's current display picture
		label $nbUserDPs.titlepic1 -text "[trans curdisplaypic]" -font bboldunderf
		label $nbUserDPs.displaypic -image [::skin::getDisplayPicture $email]
		# Other display pictures of user
		label $nbUserDPs.titlepic2 -text "[trans otherdisplaypic]" \
			-font bboldunderf

		#Other display pictures get loaded when the dp tab is raised
		#See proc userDPs_raise_cmd
		
		pack $nbUserDPs.titlepic1 -anchor w -padx 5 -pady 5
		pack $nbUserDPs.displaypic -anchor w -padx 7 -pady 5
		pack $nbUserDPs.titlepic2 -anchor w -padx 5 -pady 5

		##########
		#Common
		##########
		$w.nb compute_size
		[$w.nb getframe userdata].sw.sf compute_size
		[$w.nb getframe usersettings].sw.sf compute_size
		[$w.nb getframe alarms].sw.sf compute_size
		$w.nb compute_size
		$w.nb raise userdata
		
		frame $w.buttons
		
		button $w.buttons.ok -text [trans accept] -command [list ::abookGui::PropOk $email $w]
		button $w.buttons.cancel -text [trans cancel] -command [list ::abookGui::PropCancel $email $w]
		
		pack $w.buttons.ok $w.buttons.cancel -side right -padx 5 -pady 3
		
		pack $w.buttons -fill x -side bottom
		pack $w.nb -expand true -fill both -side bottom -padx 3 -pady 3
		#pack $w.nb
		
		#Ask to save or not to save when we close the user properties window on Mac OS X
		#Request from users with 800X600 screen (they can't see accept/cancel button)
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			wm protocol $w WM_DELETE_WINDOW "[list ::abookGui::closeProperties $email $w]"
			bind $w <<Escape>> "[list ::abookGui::closeProperties $email $w]"
		} else {
			bind $w <<Escape>> "[list ::abookGui::PropCancel $email $w]"
		}

		bind $w <Destroy> [list ::abookGui::PropDestroyed $email $w %W]
		
		moveinscreen $w 30
	}
	
	proc showUserAlarmSettings { email } {
		showUserProperties $email
		.user_[::md5::md5 $email]_prop.nb raise alarms
	}
	
	proc showCustomNickScreen { email } {
		set w ".user_[::md5::md5 $email]_cnick"
		if { [winfo exists $w] } {
			raise $w
			return
		}
		toplevel $w
		wm title $w "[trans customnick]: $email"
	
		label $w.customnickl -text "[trans customnick]:"
		frame $w.customnick
		entry $w.customnick.ent -font splainf -bg white
		menubutton $w.customnick.help -font sboldf -text "<-" -menu $w.customnick.help.menu
		menu $w.customnick.help.menu -tearoff 0
		$w.customnick.help.menu add command -label [trans nick] -command "$w.customnick.ent insert insert \\\$nick"
		$w.customnick.help.menu add command -label [trans email] -command "$w.customnick.ent insert insert \\\$user_login"
		$w.customnick.help.menu add separator
		$w.customnick.help.menu add command -label [trans delete] -command "$w.customnick.ent delete 0 end"
		$w.customnick.ent insert end [::abook::getContactData $email customnick]
		pack $w.customnick.ent -side left -expand true -fill x
		pack $w.customnick.help -side left
		label $w.customfnickl -text "[trans friendlyname]:"
		frame $w.customfnick
		entry $w.customfnick.ent -font splainf -bg white
		menubutton $w.customfnick.help -font sboldf -text "<-" -menu $w.customfnick.help.menu
		menu $w.customfnick.help.menu -tearoff 0
		$w.customfnick.help.menu add command -label [trans nick] -command "$w.customfnick.ent insert insert \\\$nick"
		$w.customfnick.help.menu add command -label [trans email] -command "$w.customfnick.ent insert insert \\\$user_login"
		$w.customfnick.help.menu add separator
		$w.customfnick.help.menu add command -label [trans delete] -command "$w.customfnick.ent delete 0 end"
		$w.customfnick.ent insert end [::abook::getContactData $email customfnick]
		pack $w.customfnick.ent -side left -expand true -fill x
		pack $w.customfnick.help -side left
		
		grid $w.customnickl -row 0 -column 0 -sticky ne
		grid $w.customnick -row 0 -column 1 -sticky we -padx 6
		grid $w.customfnickl -row 1 -column 0 -sticky ne
		grid $w.customfnick -row 1 -column 1 -sticky we -padx 6
		
		grid columnconfigure $w 1 -weight 1
	}
	
	#Ask the user if he wants to save or not the user properties window
	proc closeProperties {email w} {
		#Ask the user yes/no if he wants to save, parent=window to attach the question, title= totally useless on Mac
		set answer [::amsn::messageBox "[trans save] ?" yesno question "[trans save] ?"]
		#When the user answer yes, save preferences and close the window
		if {$answer == "yes"} {
			::abookGui::PropOk $email $w
		#When the user do not answer yes (no), then Restore previous preferences and close the window
		} else {
			::abookGui::PropCancel $email $w
		}
	}
	
	proc PropDestroyed { email w win } {
		global colorval_$email showcustomsmileys_$email ignorecontact_$email

		if { $w == $win } {
			#Clean temporal variables
			unset ::notifyonline($email)
			unset ::notifyoffline($email)
			unset ::notifystatus($email)
			unset ::notifymsg($email)
			catch {unset colorval_$email}
			catch {unset showcustomsmileys_$email}
			catch {unset ignorecontact_$email}
		}
	}
	
	proc AddOption { nbNotify name var text row} {
		radiobutton $nbNotify.${name}_default -value "" -variable $var
		radiobutton $nbNotify.${name}_yes -value 1 -variable $var
		radiobutton $nbNotify.${name}_no -value 0 -variable $var
		label $nbNotify.${name} -font splainf -text $text -justify left
		
		grid $nbNotify.${name}_default -row $row -column 0 -sticky we
		grid $nbNotify.${name}_yes -row $row -column 1 -sticky we
		grid $nbNotify.${name}_no -row $row -column 2 -sticky we
		
		grid $nbNotify.${name} -row $row -column 3 -sticky w
	}

	
	proc ChangeColor { email w } {
		global colorval_$email
		set color  [SelectColor $w.customcolordialog  -type dialog  -title "[trans customcolor]" -parent $w]
		if { $color == "" } { return }

		set colorval_$email $color
		$w.fNick.fColor.col configure -background [set colorval_${email}] -highlightthickness 1 
	}
	
	proc RemoveCustomColor { email w } {	
	   	global colorval_$email	
		set colorval_$email ""
		$w.fNick.fColor.col configure -background [$w.fNick.fColor cget -background] -highlightthickness 0
	}

	proc SetGlobalNick { } {
		
		if {[winfo exists .globalnick]} {
			return
		}
	
		toplevel .globalnick
		wm title .globalnick "[trans globalnicktitle]"
		frame .globalnick.frm -bd 1 
		label .globalnick.frm.lbl -text "[trans globalnick]" -font sboldf -justify left -wraplength 400
		entry .globalnick.frm.nick -width 50 -bg #FFFFFF -font splainf
		menubutton .globalnick.frm.help -font splainf -text "<-" -menu .globalnick.frm.help.menu
		menu .globalnick.frm.help.menu -tearoff 0
		.globalnick.frm.help.menu add command -label [trans nick] -command ".globalnick.frm.nick insert insert \\\$nick"
		.globalnick.frm.help.menu add command -label [trans email] -command ".globalnick.frm.nick insert insert \\\$user_login"
		.globalnick.frm.help.menu add command -label [trans psm] -command ".globalnick.frm.nick insert insert \\\$psm"
		.globalnick.frm.help.menu add command -label [trans customnick] -command ".globalnick.frm.nick insert insert \\\$customnick"
		.globalnick.frm.help.menu add separator
		.globalnick.frm.help.menu add command -label [trans delete] -command ".globalnick.frm.nick delete 0 end"

		pack .globalnick.frm.lbl -pady 2 -side top
		pack .globalnick.frm.nick -pady 2 -side left
		pack .globalnick.frm.help -side left
		bind .globalnick.frm.nick <Return> {
			::config::setKey globalnick "[.globalnick.frm.nick get]";
			::MSN::contactListChanged;
			cmsn_draw_online 0 2;
			destroy .globalnick
		}
		frame .globalnick.btn 
		button .globalnick.btn.ok -text "[trans ok]"  \
			-command {
			::config::setKey globalnick "[.globalnick.frm.nick get]";
			::MSN::contactListChanged;
			cmsn_draw_online 0 2;
			destroy .globalnick
			}
		button .globalnick.btn.cancel -text "[trans cancel]"  \
			-command "destroy .globalnick"
		bind .globalnick <<Escape>> "destroy .globalnick"
		pack .globalnick.btn.ok .globalnick.btn.cancel -side right -padx 5
		pack .globalnick.frm -side top -pady 3 -padx 5
		pack .globalnick.btn  -side top -anchor e -pady 3

		.globalnick.frm.nick insert end [::config::getKey globalnick]
	}

	proc PropOk { email w } {
		global colorval_$email showcustomsmileys_$email ignorecontact_$email
		
		if {[::alarms::SaveAlarm $email] != 0 } {
			return
		}
	
		set nbSettings [$w.nb getframe usersettings]
		set nbSettings [$nbSettings.sw.sf getframe]

		# Store custom display information options
		::abook::setAtomicContactData $email [list customnick customfnick cust_p4c_name customcolor showcustomsmileys ignored] \
			[list [$nbSettings.fNick.customnick.ent get] [$nbSettings.fNick.customfnick.ent get] [$nbSettings.fNick.ycustomfnick.ent get] [set colorval_$email] [set showcustomsmileys_$email] [set ignorecontact_$email]]

		# Store groups
		::groups::GroupmanagerOk $email
		
		# Store custom notification options
		::abook::setAtomicContactData $email [list notifyonline notifyoffline notifystatus notifymsg] \
			[list [set ::notifyonline($email)] [set ::notifyoffline($email)] [set ::notifystatus($email)] [set ::notifymsg($email)]]
		
		destroy $w
		::MSN::contactListChanged
		cmsn_draw_online
		::abook::saveToDisk
	}
	
	proc PropCancel { email w } {
		::groups::GroupmanagerClose $email
		destroy $w
	}

}