preferences.tcl

Linux下的MSN聊天程序源码

package require AMSN_BWidget

#TODO:
#Put items frame and listbox in scrollbars!!

namespace eval Preferences {

	proc Show {} {

		if [winfo exists .prefs] {
			raise .prefs
			catch {focus -force .prefs}
			return
		}
		
		#Set pixmaps
		::skin::setPixmap prefpers prefpers.gif
		::skin::setPixmap prefprofile prefprofile.gif
		::skin::setPixmap preffont preffont.gif
		::skin::setPixmap prefphone prefphone.gif

		::skin::setPixmap preflook preflook.gif
		::skin::setPixmap prefemotic prefemotic.gif
		::skin::setPixmap prefalerts prefalerts.gif
		
		
		if { [LoginList exists 0 [::config::getKey login]] == 1 } {
			PreferencesWindow .prefs -title "[trans preferences] - [trans profiledconfig] - [::config::getKey login]" -savecommand ::Preferences::Save
		} else {
			PreferencesWindow .prefs -title "[trans preferences] - [trans defaultconfig] - [::config::getKey login]" -savecommand ::Preferences::Save
		}
		
		#####################################################
		# Section "Personal"
		#####################################################
		set section [PreferencesSection .prefs.personal -text [trans personal]]
		
		set frame [ItemsFrame .prefs.personal.nicks -text [trans prefname] -icon prefpers]
		$frame addItem [TextEntry .prefs.personal.nicks.nick -width 40 -text "[trans enternick] :" \
			-storecommand ::Preferences::StoreNick -retrievecommand [list ::abook::getPersonal MFN]]
		$frame addItem [TextEntry .prefs.personal.nicks.chat -width 40 -text "[trans friendlyname] :" \
			-variable [::config::getVar p4c_name]]
		$section addItem $frame
		
		set frame [ItemsFrame .prefs.personal.preffont -text [trans preffont] -icon preffont]
		$frame addItem [Label .prefs.personal.preffont.lab -text [trans preffont2] -align center]
		$frame addItem [CommandButton .prefs.personal.preffont.changefont -text [trans changefont] \
			-variable [::config::getVar mychatfont] -buttoncommand ::Preferences::ChangeFont]
		$frame addItem [CommandButton .prefs.personal.preffont.changeincomingfont -text [trans changefont] \
			-variable [::config::getVar theirchatfont] -buttoncommand ::Preferences::ChangeFont]
		$section addItem $frame
	
		set frame [ItemsFrame .prefs.personal.prefphone -text [trans prefphone] -icon prefphone]
		#$frame addItem [Label create .prefs.personal.prefphone.lab -text [trans prefphone2]]
		$frame addItem [TextEntry .prefs.personal.prefphone.home -text "[trans myhomephone]:" -width 20 \
			-retrievecommand [list ::abook::getPersonal PHH]]
		$frame addItem [TextEntry .prefs.personal.prefphone.work -text "[trans myworkphone]:" -width 20 \
			-retrievecommand [list ::abook::getPersonal PHW]]
		$frame addItem [TextEntry .prefs.personal.prefphone.mobile -text "[trans mymobilephone]:" -width 20 \
			-retrievecommand [list ::abook::getPersonal PHM]]
		$frame addItem [CheckBox .prefs.personal.prefphone.allowsms -text [trans allow_sms] \
			-onvalue "Y" -offvalue "N" -storecommand [list ::abook::setPhone pager] -retrievecommand [list ::abook::getPersonal MOB]]
		$section addItem $frame
		

		.prefs addSection $section

		####################################################
		# Section Interface
		#####################################################
		set section [PreferencesSection interface -text [trans appearance]]
		.prefs addSection $section

		set frame [ItemsFrame look -text [trans preflook] -icon preflook]
		$frame addItem [Label preflook.labenc -text "[trans encoding2]:" -align left]
		$frame addItem [CommandButton preflook.encoding -text [trans encoding] -align left\
			-variable [::config::getVar encoding] -buttoncommand ::Preferences::ChangeEncoding]

		$frame addItem [Label preflook.labfont -text "[trans preffont3]:" -align left]
		$frame addItem [CommandButton preflook.font -text [trans changefont] -align left\
			-variable [::config::getGlobalVar basefont] -buttoncommand ::Preferences::ChangeBaseFont]

		$frame addItem [Label preflook.labdate -text "[trans dateformat]:" -align left]
		$frame addItem [RadioGroup preflook.date \
			-texts [list "[trans month]/[trans day]/[trans year]" "[trans day]/[trans month]/[trans year]" "[trans year]/[trans month]/[trans day]"] \
			-values [list MDY DMY YMD] -variable [::config::getVar dateformat]]

		$section addItem $frame
	
		####################################################
		# Section ...
		#####################################################
		set section [PreferencesSection .prefs.caca -text "Test"]
		$section addSection [PreferencesSection .prefs.caca2 -text "Test2"]
		$section addSection [PreferencesSection .prefs.caca3 -text "Test3"]
		
		.prefs addSection $section
			
		.prefs show .prefs_window
	
		Configure 1
		
	}

	proc Configure { {fullinit 0} } {

		if {![winfo exists .prefs]} {
			return
		} 

		if { $fullinit } {
	
			.prefs.personal.nicks.chat setValue [::config::getKey p4c_name]
			if { [::MSN::myStatusIs] == "FLN" } {
				.prefs.personal.nicks.nick configure -enabled 0
				.prefs.personal.prefphone.home configure -enabled 0
				.prefs.personal.prefphone.work configure -enabled 0
				.prefs.personal.prefphone.mobile configure -enabled 0
				.prefs.personal.prefphone.allowsms configure -enabled 0
				
			} else {
				.prefs.personal.nicks.nick configure -enabled 1
				.prefs.personal.prefphone.home configure -enabled 1
				.prefs.personal.prefphone.work configure -enabled 1
				.prefs.personal.prefphone.mobile configure -enabled 1
			}
			if { [::abook::getPersonal MBE] == "N" } {
				.prefs.personal.prefphone.allowsms -enabled 0
			}
		}

	
	}

	proc Save {} {

		set must_restart 0
		
		# Check and save phone numbers		
		if { [::MSN::myStatusIs] != "FLN" } {
			#set lfname [Rnotebook:frame $nb $Preftabs(personal)]
			set home [urlencode [.prefs.personal.prefphone.home getValue]]
			set work [urlencode [.prefs.personal.prefphone.work getValue]]
			set mobile [urlencode [.prefs.personal.prefphone.mobile getValue]]
			if { $home != [::abook::getPersonal PHH] } {
				::abook::setPhone home $home
			}
			if { $work != [::abook::getPersonal PHW] } {
				::abook::setPhone work $work
			}
			if { $mobile != [::abook::getPersonal PHM] } {
				::abook::setPhone mobile $mobile
			}
		}
		
		if { [preflook.font getValue] != [::config::getGlobalKey basefont]} {
			set must_restart 1
		}

		if { $must_restart } {
			msg_box [trans mustrestart]
		}


	}


	proc ChangeFont { currentfont } {

		#Get current font configuration
		set fontname [lindex $currentfont 0] 
		set fontstyle [lindex $currentfont 1]
		set fontcolor [lindex $currentfont 2]
	
		if { [catch {
				set selfont_and_color [SelectFont .fontsel -parent .prefs_window -title [trans choosebasefont] -font [list $fontname 12 $fontstyle] -initialcolor "#$fontcolor"]
			}]} {
			
			set selfont_and_color [SelectFont .fontsel -parent .prefs_window -title [trans choosebasefont] -font [list "helvetica" 12 [list]] -initialcolor "#000000"]
			
		}
		
		set selfont [lindex $selfont_and_color 0]
		set selcolor [lindex $selfont_and_color 1]
	
		if { $selfont == ""} {
			return $currentfont
		}
		
		set sel_fontfamily [lindex $selfont 0]
		set sel_fontstyle [lrange $selfont 2 end]
		
		
		if { $selcolor == "" } {
			set selcolor $fontcolor
		} else {
			set selcolor [string range $selcolor 1 end]
		}
		
		return [list $sel_fontfamily $sel_fontstyle $selcolor]
	}

	proc ChangeBaseFont {currentfont} {
		if { [winfo exists .basefontsel] } {
			raise .basefontsel
			return
		}

	
		if { [catch {
			set font [SelectFont .basefontsel -parent .prefs_window -title [trans choosebasefont] -font $currentfont -styles [list]]
			}]} {
		
			set font [SelectFont .basefontsel -parent .prefs_window -title [trans choosebasefont] -font [list "helvetica" 12 [list]] -styles [list]]
		
		}

		set family [lindex $font 0]
		set size [lindex $font 1]
			
		if { $family == "" || $size == ""} {
			return $currentfont
		}

		return [list $family $size normal]
	}

	proc ChangeEncoding { currentenc } {
		::amsn::messageBox "TODO" yesno question "[trans confirm]" .prefs_window
	}

	proc StoreNick { nick } {
		if {$nick != "" && $nick != [::abook::getPersonal MFN] && [::MSN::myStatusIs] != "FLN"} {
			::MSN::changeName [::config::getKey login] $nick
		}
	}

}

#This object type is a generic and abstract preference item.
# OPTIONS
# -variable	The variable where the value will be stored/retrieved
# -retrievecommand	
#		A command that needs to be called to retrieve the initial value of the text entry
# -storecommand		
#		A command that needs to be called to store the value of the text entry when the "store"
#		method is called. The command will be appended one argument, the text entry value
# -enabled	Enables or disabled the item
# METHODS
# getValue()	Return the current value of the item
# setValue(val) Sets the value of the item
# draw(path)	Draws the item inside the specified container
# store()	Store the item value in the related variable
::snit::type PreferenceItem {
	
	#The variable where the items stores its data
	option -variable -readonly no -default ""
	#The command that must be executed to retrieve the value. This command should return the variable value
	option -retrievecommand -readonly no -default ""
	#The command that must be executed to store the command. The value in the widget will be appended as parameter to the command
	option -storecommand -readonly no -default ""
	
	#Enable or disable the item
	option -enabled -default true

	##########################################
	#Common methods for all preference items
	##########################################
	
	constructor {args} {
		$self configurelist $args
	}

	onconfigure -variable { val } {
		upvar $val var
		$self setValue $var
		set options(-variable) $val
	}
	onconfigure -retrievecommand { val } {	
		$self setValue [eval $val]
		set options(-retrievecommand) $val
	}

	variable value ""

	#Return the item value
	method getValue {} {
		return $value
	}
	
	#Set the item value
	method setValue {new_val} {
		set value $new_val
	}
	
	#Draw the element in the given widget path (path must be a container)
	method draw {path} {
		label $path.l -text "Preference item"
		pack $path.l
	}

	#Store the object values
	method store {} {
		if {!$options(-enabled)} {
			status_log "$self disabled, not storing\n" blue
			return
		}
		status_log "Storing $self, value [$self getValue]\n" blue
		if { $options(-variable) != "" } {
			status_log "   in variable $options(-variable)\n" blue
			upvar $options(-variable) var
			set var [$self getValue]
		}		
		if { $options(-storecommand) != "" } {
			status_log "   with command $options(-storecommand)\n" blue
			eval [concat $options(-storecommand) [list [$self getValue]]]
		}
		
	}

	method valueVar {} {
		return [myvar value]
	}
}

#This type is child of PreferenceItem. It groups some options under a 
#frame with a label and an icon.
#Usage:
# OPTIONS
# -text 	The text to be shown in the frame header
# -icon 	A picture to be shown at the left, inside the frame
# -expand 	The frame should expand in the container. Defaults to YES
# -fill		The frame should fill all available space in X, Y or BOTH. Defaults to X
# -enabled	The frame and contained items is enabled/disabled
# METHODS
# addItem(item)		Add a PreferenceItem inside this frame
::snit::type ItemsFrame {

	#Delegate to PreferenceItem by default
	delegate method * to preferenceitem
	delegate option * to preferenceitem

	#The widget path to this item
	variable itemPath ""
	#The items contained inside the frame
	variable items [list]

	constructor {args} {
		install preferenceitem using PreferenceItem %AUTO%
		$self configurelist $args
	}
	
	destructor {
		#Destroy the PreferenceItem object
		$preferenceitem destroy
		
		#Destroy child items
		foreach item $items {
			$item destroy
		}

		#Destroy the container frame
		if [winfo exists $itemPath.f] {
			destroy $itemPath.f
		}
		
	}
	
	#########################
	#Static options (creation time)
	#########################
	
	#Text for the item label
	option -text -readonly yes -default ""
	#Icon for the frame
	option -icon -readonly yes -default ""
	#Options for packing the frame
	option -expand -readonly yes -default true
	option -fill -readonly yes -default x

	#########################
	#Dinamic options
	#########################
	option -enabled -default true
		
	#Add a new PreferenceItem to the group
	method addItem {item} {
		lappend items $item