preferences.tcl

Linux下的MSN聊天程序源码

## Function to be called when <<ListboxSelect>> event occurs to change rbsel value ##
proc GroupSelectedIs { lfgroup lfcontact } {
	global rbsel
	if {[$lfgroup.lbgroup.fix.list.lb curselection] != "" } {
		set rbsel [$lfgroup.lbgroup.fix.list.lb curselection]
		#Get the rbsel-th group. Note that groups must be inserted same order
		array set groups [::abook::getContactData contactlist groups]
		set rbsel [lindex [lsort [array names groups]] $rbsel]
		MakeContactList $lfcontact 
	}
}

## Function to be called after pressing delete/rename/add group button ##
proc RefreshGroupList { lfgroup lfcontact } {
	global pgc pgcd
	if { $pgc == 1 } {
		vwait pgc
	}
	set pgc 1
	destroy $lfgroup.lbgroup.fix
	MakeGroupList $lfgroup $lfcontact
}

## Function to be called when a group is selected ##
proc MakeContactList { lfcontact } {
	global rbsel rbcon
	catch {DeleteContactList $lfcontact}
	
	if {![info exists rbsel]} { return; }
	if { ![::groups::Exists [::groups::GetName $rbsel]] || $rbsel == 0 } {
		if { $rbsel == 0 } {
			## fix the name of the group ##
			label $lfcontact.lbcontact.fix.l -text "[trans nogroup]" -font sboldf
			pack $lfcontact.lbcontact.fix.l -side top -pady 5 -padx 5  -anchor w
			frame $lfcontact.lbcontact.fix.list
			
			## create the listbox ##
			listbox $lfcontact.lbcontact.fix.list.lb -background white -yscrollcommand "$lfcontact.lbcontact.fix.list.sb set"
			scrollbar $lfcontact.lbcontact.fix.list.sb -command "$lfcontact.lbcontact.fix.list.lb yview" -highlightthickness 0 \
				-borderwidth 1 -elementborderwidth 2
			
			pack $lfcontact.lbcontact.fix.list.lb -side left -anchor w -expand true -fill both
			pack $lfcontact.lbcontact.fix.list.sb -side left -anchor w -fill y
			pack $lfcontact.lbcontact.fix.list -side top -anchor w -pady 5 -padx 5 -expand true -fill both
			## list contacts that don't have a group ##
			set contacts [::MSN::getList FL]
			set i 0
			while { $i < [llength $contacts] } {
				set contact [lindex $contacts $i]
				set g [::abook::getGroups $contact]
				if { [lindex $g 0] == 0 } {
					$lfcontact.lbcontact.fix.list.lb insert end $contact
				}
				incr i
			}
		## make the binding ##
		bind $lfcontact.lbcontact.fix.list.lb <<ListboxSelect>> "ContactSelectedIs $lfcontact"
		}
	} else {
		label $lfcontact.lbcontact.fix.l -text "[::groups::GetName $rbsel]" -font sboldf
		pack $lfcontact.lbcontact.fix.l -side top -pady 5 -padx 5 -anchor w
		frame $lfcontact.lbcontact.fix.list
		
		## create the listbox ##
		listbox $lfcontact.lbcontact.fix.list.lb -background white -yscrollcommand "$lfcontact.lbcontact.fix.list.sb set"
		scrollbar $lfcontact.lbcontact.fix.list.sb -command "$lfcontact.lbcontact.fix.list.lb yview" -highlightthickness 0 \
			-borderwidth 1 -elementborderwidth 2

		pack $lfcontact.lbcontact.fix.list.lb -side left -anchor w -expand true -fill both
		pack $lfcontact.lbcontact.fix.list.sb -side left -anchor w -fill y
		pack $lfcontact.lbcontact.fix.list -side top -anchor w -pady 5 -padx 5 -expand true -fill both

		set groups [::abook::getContactData contactlist groups]
		set contacts [::MSN::getList FL]
		set i 0
		while { $i < [llength $contacts] } {
			set contact [lindex $contacts $i]
			set group [::abook::getGroups $contact]
			set j 0
			while { $j < [llength $group] } {
				set g [lindex $group $j]
				if { $g == $rbsel } {
					$lfcontact.lbcontact.fix.list.lb insert end $contact
				}
				incr j
			}
			incr i
		}
		## make the binding ##
		bind $lfcontact.lbcontact.fix.list.lb <<ListboxSelect>> "ContactSelectedIs $lfcontact"
	}
}

## Function to be called when <<ListboxSelect>> event occurs to change rbsel value ##
proc ContactSelectedIs { lfcontact } {
	global rbcon
	if {[$lfcontact.lbcontact.fix.list.lb curselection] != "" } {
		set rbcon [$lfcontact.lbcontact.fix.list.lb get [$lfcontact.lbcontact.fix.list.lb curselection]]
	} else {
		set rbcon ""
	}
}

## Function to be called when the selected group becomes unvalid ##
proc DeleteContactList { lfcontact } {
	destroy $lfcontact.lbcontact.fix
	frame $lfcontact.lbcontact.fix
	pack $lfcontact.lbcontact.fix -side left -anchor n -expand 1 -fill x
}

## Function to be called when the selected group is deleted/renamed or a contact deleted/moved/copied/added ##
proc RefreshContactList { lfcontact } {
	global pcc
	if { $pcc == 1 } {
		vwait pcc
	}
	set pcc 1
	DeleteContactList $lfcontact
	MakeContactList $lfcontact
}

proc dlgMoveUser {} {
	global rbcon rbsel gsel pcc
	if {![info exists rbcon]} {return;}
	if {![info exists rbsel]} {return;}
	## check if window exists ##
	if { [winfo exists .dlgmu] } {
		set pcc 0
		return 0
	}
	## if no contact is selected -- return ##
	if { $rbcon == "" } {
		set pcc 0
		return 0
	}
	## calculate oldgid - now we get the first group int the group list - we have to improve it ##
	set oldgid [::abook::getGroups $rbcon]
	set oldgid [lindex $oldgid 0]
	## variable for the selected group -- we set to oldgid to avoid bugs ##
	set gsel $oldgid
	
	set bgcol2 #ABC8D2
	toplevel .dlgmu -highlightcolor $bgcol2
	wm title .dlgmu "[trans moveuser]"
	## radiobuttons for newgid ##
	frame .dlgmu.d
	array set groups [::abook::getContactData contactlist groups]
	foreach gr [array names groups] {
		if { $groups($gr) != "Individuals" } {
			radiobutton .dlgmu.d.$gr -text "$groups($gr)" -value $gr -variable gsel
			pack .dlgmu.d.$gr -side left
		}
	}
	pack .dlgmu.d -side top -pady 3 -padx 5
	## button options ##
	frame .dlgmu.b 
	button .dlgmu.b.ok -text "[trans ok]"  -font sboldf \
		-command " if {![info exists gsel]} {return;}; \
			::MSN::moveUser \$rbcon $oldgid \$gsel; \
			unset gsel; \
			destroy .dlgmu; "
	button .dlgmu.b.cancel -text "[trans cancel]"  -font sboldf \
		-command "destroy .dlgmu; set pcc 0;"
	pack .dlgmu.b.ok .dlgmu.b.cancel -side right -padx 5
	pack .dlgmu.b  -side top -anchor e -pady 3
}

proc dlgCopyUser {} {
	global rbcon rbsel gsel pcc
	if {![info exists rbcon]} {return;}
	if {![info exists rbsel]} {return;}
	if { [winfo exists .dlgcu] } {
		set pcc 0
		return 0
	}
	## if no contact is selected -- return ##
	if { $rbcon == "" } {
		set pcc 0
		return 0
	}
	## calculate oldgid - now we get the first group int the group list - we have to improve it ##
	set oldgid [::abook::getGroups $rbcon]
	set oldgid [lindex $oldgid 0]
	## protection --> the contacts who are in 'nogroup' will be moved, not copied ##
	set move 0
	if { $oldgid == 0 } {
		set move 1
	}
	## variable for the selected group -- we set to oldgid to avoid bugs ##
	set gsel $oldgid
	
	set bgcol2 #ABC8D2
	toplevel .dlgcu -highlightcolor $bgcol2
	wm title .dlgcu "[trans moveuser]"
	## radiobuttons for newgid ##
	frame .dlgcu.d
	array set groups [::abook::getContactData contactlist groups]
	foreach gr [array names groups] {
		if { $groups($gr) != "Individuals" } {
			radiobutton .dlgcu.d.$gr -text "$groups($gr)" -value $gr -variable gsel
			pack .dlgcu.d.$gr -side left
		}
	}
	pack .dlgcu.d -side top -pady 3 -padx 5
	## button options ##
	frame .dlgcu.b 
	if { $move == 0 } {
		button .dlgcu.b.ok -text "[trans ok]"  -font sboldf \
			-command " if {![info exists gsel]} {return;}; \
				::MSN::copyUser \$rbcon \$gsel; \
				unset gsel; \
				destroy .dlgcu; "
	}
	if { $move == 1 } {
		button .dlgcu.b.ok -text "[trans ok]" -font sboldf \
			-command " if {![info exists gsel]} {return;}; \
				::MSN::moveUser \$rbcon $oldgid \$gsel; \
				unset gsel; \
				destroy .dlgcu; "
	}
	button .dlgcu.b.cancel -text "[trans cancel]"  -font sboldf \
		-command "destroy .dlgcu; set pcc 0;"
	pack .dlgcu.b.ok .dlgcu.b.cancel -side right -padx 5
	pack .dlgcu.b  -side top -anchor e -pady 3
}

## This is used to move all the contacts from a group to nogroup ##
proc BuidarGrup { lfcontact } {
	global rbsel
	if {![info exists rbsel]} {return;}
	set answer [::amsn::messageBox "[trans confirmeg]" yesno question "[trans confirm]" .cfg]
	if { $answer == "no" } { return; }
	if { $rbsel == 0 } { return; }
	set contacts [::MSN::getList FL]
	set i 0
	while { $i < [llength $contacts] } {
		set contact [lindex $contacts $i]
		foreach gp [::abook::getContactData $contact group] {
			if { $gp == $rbsel } {
				::MSN::deleteUser $contact $rbsel
				RefreshContactList $lfcontact
			}
		}
		incr i
	}
}

## This is used to delete a group in preferences ##
proc dlgDelGroup { lfgroup lfcontact } {
	global rbsel
	if {![info exists rbsel]} {return;}
	set answer [::amsn::messageBox  "[trans confirmdg]" yesno question "[trans confirm]" .cfg]
	if { $answer == "no" } { return; }
	::groups::Delete $rbsel dlgMsg
	RefreshGroupList $lfgroup $lfcontact
}

## This is used to rename a group in preferences ##
proc dlgRenGroup { lfgroup lfcontact } {
	global rbsel
	if {![info exists rbsel]} {return;}
	::groups::dlgRenameThis $rbsel
	tkwait window .dlgthis
	RefreshGroupList $lfgroup $lfcontact
}

## This is used when we remove contact from list in preferences ##
proc dlgRFL { lfcontact } {
	global rbsel rbcon
	if {![info exists rbcon]} {return;}
	if {![info exists rbsel]} {return;}
	set answer [::amsn::messageBox "[trans confirmrfl]" yesno question "[trans confirm]" .cfg]
	if { $answer == "no" } { return; }
	if { $rbsel != -1 } {
		::MSN::deleteUser $rbcon $rbsel
		RefreshContactList $lfcontact
	}
}

## This is used to delete a user in preferences ##
proc dlgDelUser { lfcontact } {
	global rbcon
	if {![info exists rbcon]} {return;}
	set answer [::amsn::messageBox "[trans confirmdu]" yesno question "[trans confirm]" .cfg]
	if { $answer == "no" } { return; }
	::MSN::deleteUser $rbcon
	RefreshContactList $lfcontact
}

proc Preferences { { settings "personal"} } {
    global myconfig proxy_server proxy_port temp_BLP list_BLP Preftabs libtls proxy_user proxy_pass rbsel rbcon pager

    set temp_BLP $list_BLP
    ::config::setKey libtls_temp $libtls
    set pager "N"
    if {[ winfo exists .cfg ]} {
    	raise .cfg
        return
    }

    PreferencesCopyConfig	;# Load current configuration

    toplevel .cfg
    wm state .cfg withdraw

    if { [LoginList exists 0 [::config::getKey login]] == 1 } {
	wm title .cfg "[trans preferences] - [trans profiledconfig] - [::config::getKey login]"
    } else {
	wm title .cfg "[trans preferences] - [trans defaultconfig] - [::config::getKey login]"
    }

    wm iconname .cfg [trans preferences]

    # Frame to hold the preferences tabs/notebook
    frame .cfg.notebook -class Degt

    #set nb .cfg.notebook.nn
    set nb .cfg.notebook

	# Preferences Notebook
	# Modified Rnotebook to translate automaticly those keys in -tabs {}
	#Rnotebook:create $nb -tabs {personal appearance session privacy loging connection others advanced} -borderwidth 2
        #set Preftabs(personal) 1
        #set Preftabs(appearance) 2
        #set Preftabs(session) 3
        #set Preftabs(privacy) 4
        #set Preftabs(loging) 5
        ##BLOCKING
	#set Preftabs(blocking) 6
        #set Preftabs(connection) 6 
        #set Preftabs(others) 7 
        #set Preftabs(advanced) 8 
	NoteBook $nb.nn
	$nb.nn insert end personal -text [trans personal]
	$nb.nn insert end appearance -text [trans appearance]
	$nb.nn insert end session -text [trans session]
	$nb.nn insert end groups -text [trans groups]
	$nb.nn insert end privacy -text [trans privacy]
	$nb.nn insert end loging -text [trans loging]
	$nb.nn insert end connection -text [trans connection]
	$nb.nn insert end others -text [trans others]
	$nb.nn insert end advanced -text [trans advanced]


	#  .----------.
	# _| Personal |________________________________________________
	::skin::setPixmap prefpers prefpers.gif
	::skin::setPixmap prefprofile prefprofile.gif
	::skin::setPixmap preffont preffont.gif
	::skin::setPixmap prefphone prefphone.gif
	#set frm [Rnotebook:frame $nb $Preftabs(personal)]
	set frm [$nb.nn getframe personal]
	#Scrollable frame that will contain options
	ScrolledWindow $frm.sw
	ScrollableFrame $frm.sw.sf -constrainedwidth 1
	$frm.sw setwidget $frm.sw.sf
	pack $frm.sw -anchor n -side top -expand true -fill both
	set frm [$frm.sw.sf getframe]	

	## Nickname Selection Entry Frame ##
	set lfname [labelframe $frm.lfname -text [trans prefname] -font splainf]
	pack $frm.lfname -anchor n -side top -expand 1 -fill x
	frame $lfname.1 -class Degt
	label $lfname.pname -image [::skin::loadPixmap prefpers]
	frame $lfname.1.name -class Degt
	label $lfname.1.name.label -text "[trans enternick] :" -font sboldf -padx 10
	entry $lfname.1.name.entry -bg #FFFFFF -font splainf -width 45
	frame $lfname.1.p4c -class Degt
	label $lfname.1.p4c.label -text "[trans friendlyname] :" -font sboldf -padx 10
	entry $lfname.1.p4c.entry -bg #FFFFFF -font splainf -width 45
	pack $lfname.pname -anchor nw -side left
	pack $lfname.1 -side top -padx 0 -pady 3 -expand 1 -fill both
	pack $lfname.1.name.label $lfname.1.name.entry -side left
	pack $lfname.1.p4c.label $lfname.1.p4c.entry -side left
	pack $lfname.1.name $lfname.1.p4c -side top -anchor nw

	## Public Profile Frame ##
	set lfname [labelframe $frm.lfname2 -text [trans prefprofile]]
	pack $frm.lfname2 -anchor n -side top -expand 1 -fill x
	label $lfname.pprofile -image [::skin::loadPixmap prefprofile]
	label $lfname.lprofile -text [trans prefprofile2] -padx 10
	button $lfname.bprofile -text [trans editprofile] -command "::hotmail::hotmail_profile"
	pack $lfname.pprofile $lfname.lprofile -side left
	pack $lfname.bprofile -side right -padx 15


	## Chat Font Frame ##
	set lfname [labelframe $frm.lfname3 -text [trans preffont]]
	pack $frm.lfname3 -anchor n -side top -expand 1 -fill x