preferences.tcl

Linux下的MSN聊天程序源码

		$preferenceitem configure -enabled $val
		if {[winfo exists $itemPath.b]} {
			if { $val } {
				$itemPath.b configure -state normal 
			} else {
				$itemPath.b configure -state disabled
			}
		}
	}
	
	#Draw the button in the given path
	method draw { path } {

		set itemPath $path
		#Draw an input box
		
		if { $options(-enabled) } {
			set state normal
		} else {
			set state disabled
		}

		switch $options(-align) {
			left {
				set anchor w
			}
			right {
				set anchor e
			}
			default {
				set anchor center
			}

		}
	
		button $path.b -text $options(-text) -font sboldf -state $state -command [mymethod buttonPressed]
		pack $path.b -expand false -padx 5 -pady 3 -anchor $anchor
	}
	

	method buttonPressed {} {
		if { $options(-buttoncommand) != "" } {
			set the_command [concat $options(-buttoncommand) [list [$self getValue]]]
			set value [eval $the_command]
			$self setValue $value
		}

	}
}



#A text entry item. Child of PreferenceItem
#Usage:
# OPTIONS
# -text		The text that is shown in the label
# -align	right | left | center
::snit::type Label {
	
	#Delegate to PrferenceItem!!
	delegate method * to preferenceitem
	delegate option * to preferenceitem

	#The widget path
	variable itemPath ""
		
	constructor {args} {
		install preferenceitem using PreferenceItem %AUTO%
		$self configurelist $args
		
	}
	
	destructor {
		#Destroy the PreferenceItem instance
		$preferenceitem destroy
		#Destroy widgets
		destroy $itemPath.l
	}
	
	#########################
	#Static options (creation time)
	#########################
	
	#Text for the item label
	option -text -readonly yes -default ""
	option -align -readonly yes -default center
	
	#########################
	#Dinamic options
	#########################
	
	#Draw the text box in the given path
	method draw { path } {

		switch $options(-align) {
			left {
				set anchor w
			}
			right {
				set anchor e
			}
			default {
				set anchor center
			}

		}
		

		set itemPath $path
		label $path.l -text $options(-text) -font splainf
		pack $path.l -anchor $anchor
	}
}


::snit::widget PreferencesWindow {
	
	#Object is a children of PreferencesSection
	delegate method * to preferencessection
	
	#Window title
	option -title ""
	option -savecommand ""
	
	constructor {args} {
		install preferencessection using PreferencesSection %AUTO%
		$self configurelist $args
	}
	
	destructor {
		#Destroy the instance of the parent.
		#This will destroy subsections too
		$preferencessection destroy
		
		#Destroy the window
		if { [winfo exists $wname] } {
			destroy $wname
		}
		
	}

	#A list with section objects, one per listbox element
	variable sectionNames [list]
	variable wname ""
	
	#Show the preferences window
	method show { path } {
	
		#Create a window name and remember it
		set wname $path
		
		#Create the toplevel window
		toplevel $wname
		wm title $wname $options(-title)
    		bind $wname <Destroy> [list $self destroyWindow %W]
		bind $wname <<Escape>> [list destroy $wname]
		
		#Create the buttons
		set w [frame $wname.buttons]
		button $w.save -text [trans save] -default active -command [list $self savePressed]
		button $w.cancel -text [trans close] -command [list destroy $wname]
		pack $w.save $w.cancel -side right -padx 10 -pady 5
		pack $w -side bottom -fill x -expand false

		#Create the sections listbox and items area
		set w [frame $wname.top]

		#Create the sections listbox 
		listbox $w.sections -bg white -width 15
		#Create the items frame
		frame $w.items
		
		#Do the packing
		pack $w.sections -side left -fill y
		pack $w.items -side right -fill both -expand true
		bind $w.sections <<ListboxSelect>> [list $self sectionSelected]
		pack $w -side top -fill both -expand true

		#Add sections to the listbox
		foreach section [$self getSectionsList] {
			set sectionNames [concat $sectionNames [$section insertIntoList $w.sections 0]]
		}
		
		wm geometry $wname 625x450
	}
	
	#Invoked when a section is selected in the listbox
	method sectionSelected { } {

		#Get the section object name from the sectionNames list	
		set idx [$wname.top.sections curselection]
		set section [lindex $sectionNames $idx]
		
		#Create a new frames item, destroying previous one
		set items "$wname.top.items.f"
		if {[winfo exists $items]} {
			destroy $items
		}
		frame $items
		pack $items -anchor nw -fill both
		
		#Show the selected section
		$section show $items
		
	}
	
	method destroyWindow { w } {
		if { $w == $wname } {
			destroy $self
		}
	}

	method savePressed { } {
		if { $options(-savecommand) != "" } {
			$options(-savecommand)
		}

		$self storeItems

		destroy $wname
	}
	
}

#A section that contains zero, one or more preference items
::snit::type PreferencesSection {
	
	#List of items in this section
	variable items_list [list]
	#List of subsections
	variable sections_list [list]
	
	option -text -readonly yes -default ""
	
	destructor {
		#Destroy child items
		foreach item $items_list {
			$item destroy
		}
		#Destroy child sections
		foreach section $sections_list {
			$section destroy
		}
	}	
	
	method getSectionsList { } {
		return $sections_list
	}
	
	method addItem { item } {
		lappend items_list $item
	}

	method addSection {section} {
		lappend sections_list $section
	}
	
	#Insert this section and all subsections in the given listbox.
	#Retuns a list of this section and all subsections names (recursive calls)
	method insertIntoList { lb level } {
	
		#Append instance to sections list
		set sectionNames $self
	
		#Set identation
		set ident ""
		for { set idx 0 } { $idx < $level } {incr idx } {
			set ident "$ident   "
		}
		
		#Add current section to the listbox
		$lb insert end "$ident$options(-text)"
		
		#Add all subsections and append the result of the function call to the sections list
		foreach subsection $sections_list {
			set sectionNames [concat $sectionNames [$subsection insertIntoList $lb [expr {$level + 1}]]]
		}
		
		#Return the sections list for this section and all subsections
		return $sectionNames
	}
	
	#Show the items in this section in the given path
	method show { path } {
	
		set idx 0
		
		foreach item $items_list {
			set f [frame $path.f$idx]
			$item draw $f
			pack $f -side top -fill x
			incr idx

		}
	}

	method storeItems { } {
		#Add all subsections and append the result of the function call to the sections list
		foreach subsection $sections_list {
			$subsection storeItems
		}
		foreach item $items_list {
			$item store
		}
	}

}


proc test2 {item oldval newval} {
	status_log "$item: old=$oldval new=$newval\n" blue
	return [string is integer $newval]
}

proc new_preferences {} {
	PreferencesWindow create .prefs
	
	PreferencesSection create .prefs.personal
	PreferencesSection create .prefs.personal.nick
	
	.prefs.personal addItem 
	
	.pref_win 
}



if { $initialize_amsn == 1 } {
	global myconfig proxy_server proxy_port proxy_user proxy_pass rbsel rbcon pgc
	
	###################### Preferences Window ###########################
	array set myconfig {}   ; # configuration backup
	set proxy_server ""
	set proxy_port ""
	set proxy_pass ""
	set proxy_user ""
    	
	set pgc 1
}

proc PreferencesCopyConfig {} {
	global myconfig proxy_server proxy_port
	
	array set myconfig [::config::getAll]
	
	set proxy_server ""
	set proxy_port ""
	
	# Now process certain exceptions. Should be reverted
	# in the RestorePreferences procedure
	catch {
		set proxy_data $myconfig(proxy)
		set proxy_server [lindex $proxy_data 0]
		set proxy_port [lindex $proxy_data 1]
	}
}

## Function that makes the group list in the preferences ##
proc MakeGroupList { lfgroup lfcontact } {
	
	array set groups [::abook::getContactData contactlist groups]
	
	frame $lfgroup.lbgroup.fix
	pack $lfgroup.lbgroup.fix -side left -anchor n -expand 1 -fill x -padx 5 -pady 5
	label $lfgroup.lbgroup.fix.l -text \"[trans groups]\" -font sboldf
	pack $lfgroup.lbgroup.fix.l -side top -anchor w -pady 5
	
	frame $lfgroup.lbgroup.fix.list
	## create the listbox ##
	listbox $lfgroup.lbgroup.fix.list.lb -background white -yscrollcommand "$lfgroup.lbgroup.fix.list.sb set"
	scrollbar $lfgroup.lbgroup.fix.list.sb -command "$lfgroup.lbgroup.fix.list.lb yview" -highlightthickness 0 \
		-borderwidth 1 -elementborderwidth 2

	pack $lfgroup.lbgroup.fix.list.lb -side left -anchor w -pady 0 -padx 0 -expand true -fill both
	pack $lfgroup.lbgroup.fix.list.sb -side left -anchor w -pady 0 -padx 0 -fill y
	pack $lfgroup.lbgroup.fix.list -side top -expand true -fill both
	

	## entries ##
	$lfgroup.lbgroup.fix.list.lb insert end "[trans nogroup]"
	foreach gr [lsort [array names groups]] {
		if { $groups($gr) != "Individuals" } {
			$lfgroup.lbgroup.fix.list.lb insert end $groups($gr)
		}
	}
	## make binding ##
	bind $lfgroup.lbgroup.fix.list.lb <<ListboxSelect>> "GroupSelectedIs $lfgroup $lfcontact"
}