skins.tcl

来自「Linux下的MSN聊天程序源码」· TCL 代码 · 共 903 行 · 第 1/3 页

		set skins [glob -directory skins */settings.xml]
		set skins_in_home [glob -nocomplain -directory [file join $HOME skins] */settings.xml]
		set skins_in_home2 [glob -nocomplain -directory [file join $HOME2 skins] */settings.xml]
		set skins_in_extras [glob -nocomplain -directory [file join $HOME2 amsn-extras skins] */settings.xml]
		set skins [concat $skins $skins_in_home $skins_in_home2 $skins_in_extras]
		set skinlist [list]

		foreach skin $skins {
			set dir [file dirname $skin]
			set desc ""

			if { [file readable [file join $dir desc.txt] ] } {
				set fd [open [file join $dir desc.txt]]
				set desc [string trim [read $fd]]
				close $fd
			}

			set lastslash [expr {[string last "/" $dir]+1}]
			set skinname [list [string range $dir $lastslash end]]
			status_log "Skin: $skin. Dir is: $dir. Skinname: $skinname. Desc: $desc\n" white
			lappend skinname $desc
			lappend skinlist $skinname
		}

		return $skinlist
	}


	################################################################
	# ::skin::SetConfigKeys (cstack cdata saved_data cattr saved_attr args)
	# This procedure loads the skin's data from settings.xml into
	# the proper variables. Arguments supplied by the XML parser.
	proc SetConfigKeys {cstack cdata saved_data cattr saved_attr args} {
		upvar $saved_data sdata
		foreach key [array names sdata] {
			::skin::setKey [string range $key [expr {[string length $cstack] + 1}] [string length $key]] [string trim $sdata($key)]
		}

		# This bits are used to override certain keys loaded before with specific values for MacOS X (TkAqua)
	#	if { ![catch {tk windowingsystem} wsystem] && $wsystem == "aqua" } {
	#		if { [info exists sdata(${cstack}:chatwindowbg)] } { ::skin::setKey buttonbarbg [string trim $sdata(${cstack}:chatwindowbg)] }
	#			::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_paned_padx 0
	#			::skin::setKey chat_paned_pady 0
	#			
	#			::skin::setKey chat_status_padx 0
	#			::skin::setKey chat_status_pady 0
	#			
	#			::skin::setKey chat_top_padx 0
	#			::skin::setKey chat_top_pady 0
	#			
	#			::skin::setKey chat_output_padx 0
	#			::skin::setKey chat_output_pady 0
	#			
	#			::skin::setKey chat_sendbutton_padx 0
	#			::skin::setKey chat_sendbutton_pady 0
	#	}

		# Procedures binded to the XML parser must ALWAYS return 0
		return 0
	}
}

namespace eval ::skinsGUI {


	################################################################
	# ::skinsGUI::SelectSkin ()
	# This procedure creates the skins selector window and shows it.
	proc SelectSkin { } {
		set w .skin_selector

		if { [winfo exists $w] } {
			focus $w
			raise $w
			return
		}

		toplevel $w
		wm resizable $w 0 0
		wm title $w "[trans chooseskin]"
		wm geometry $w +100+100

		label $w.choose -text "[trans chooseskin]" -font bboldf
		pack $w.choose -side top

		label $w.restart -text "[trans restartforskin]" -fg #FF0000
                pack $w.restart -side top

		frame $w.main -relief solid -borderwidth 2
		frame $w.main.left -relief flat
		frame $w.main.right -relief flat
		frame $w.main.left.images -relief flat
		text $w.main.left.desc -height 6 -width 40 -relief flat -background [::skin::getKey mainwindowbg] \
			-font sboldf -wrap word
		listbox $w.main.right.box -yscrollcommand "$w.main.right.ys set" -font splainf -background \
			white -relief flat -highlightthickness 0  -height 8 -width 30
		scrollbar $w.main.right.ys -command "$w.main.right.box yview" -highlightthickness 0 \
			-borderwidth 1 -elementborderwidth 2

		bind $w <<Escape>> "::skinsGUI::SelectSkinCancel $w"

		pack $w.main.left.images -in $w.main.left -side top -expand 0 -fill both
		pack $w.main.left.desc -in $w.main.left -side bottom -expand 1 -fill both
		pack $w.main.left -in $w.main -side left -expand 1 -fill both
		pack $w.main.right.ys -side right -fill both
		pack $w.main.right.box -side left -expand 0 -fill both
		pack $w.main.right -side right -expand 1 -fill both
		pack $w.main -expand 1 -fill both

		label $w.status -text ""
		pack $w.status -side bottom

#		image create photo blank -width 1 -height 75
#		label $w.main.left.images.blank -image blank

#		image create photo blank2 -width 400 -height 1
#		label $w.main.left.images.blank2 -image blank2

		set select -1
		set idx 0

		label $w.getmore -text "[trans getmoreskins]" -fg #0000FF

		button $w.ok -text "[trans ok]" -command "::skinsGUI::SelectSkinOk $w" 
		button $w.cancel -text "[trans cancel]" -command "::skinsGUI::SelectSkinCancel $w" 
		checkbutton $w.preview -text "[trans preview]" -variable ::skin::preview_skin_change -onvalue 1 -offvalue 0
		
		pack $w.getmore -side left -padx 5
	        bind $w.getmore <Enter> "$w.getmore configure -font sunderf"
	        bind $w.getmore <Leave> "$w.getmore configure -font splainf"
		bind $w.getmore <ButtonRelease> "launch_browser $::weburl/skins.php"			
		
		pack $w.ok  $w.cancel $w.preview -side right -pady 5 -padx 5

		set the_skins [::skin::FindSkins]

		foreach skin $the_skins {
			if { [lindex $skin 0] == [::config::getGlobalKey skin] } { set select $idx } 
			$w.main.right.box insert end "[lindex $skin 0]"
			incr idx
		}

		set ::skin::skin_reloaded_needs_reset 0
		if { $select == -1 } {
			set select 0
			status_log "selecy = 0 --- didn't find current skin defaulting to first"

			$w.main.right.box selection set $select
	 		$w.main.right.box itemconfigure $select -background #AAAAAA

			set currentskin [lindex [lindex $the_skins 0] 0]
			if { $::skin::preview_skin_change == 1 } {
				set ::skin::skin_reloaded_needs_reset 1
				::skin::reloadSkin $currentskin
			}
		} else {
			status_log "select = $select --- [::config::getGlobalKey skin]\n"

			$w.main.right.box selection set $select
			$w.main.right.box itemconfigure $select -background #AAAAAA
		}
	
		::skinsGUI::DoPreview 1
		bind $w <Destroy> "grab release $w"
		bind $w.main.right.box <Button1-ButtonRelease> "::skinsGUI::DoPreview"

		moveinscreen $w 30
	}


	################################################################
	# ::skinsGUI::DoPreview ([skip_reload])
	# Updates the preview images (or skin if selected) when changing
	# the skin selection.
	# Arguments:
	#  - skip_reload => Don't reload the skin for preview.
	proc DoPreview { {skip_reload 0} } {
		set w .skin_selector
		set the_skins [::skin::FindSkins]
		set currentskin [lindex [lindex $the_skins [$w.main.right.box curselection]] 0]
		set currentdesc [lindex [lindex $the_skins [$w.main.right.box curselection]] 1]

		::skinsGUI::ClearPreview

		# If our skin hasn't the example images, take them from the default one
		image create photo preview1 -file [::skin::GetSkinFile pixmaps prefpers.gif $currentskin] -format cximage
		image create photo preview2 -file [::skin::GetSkinFile pixmaps bonline.gif $currentskin] -format cximage
		image create photo preview3 -file [::skin::GetSkinFile pixmaps offline.gif $currentskin] -format cximage
		image create photo preview4 -file [::skin::GetSkinFile pixmaps baway.gif $currentskin] -format cximage
		image create photo preview5 -file [::skin::GetSkinFile pixmaps amsnicon.gif $currentskin] -format cximage
		image create photo preview6 -file [::skin::GetSkinFile pixmaps butblock.gif $currentskin] -format cximage
		image create photo preview7 -file [::skin::GetSkinFile pixmaps butsmile.gif $currentskin] -format cximage
		image create photo preview8 -file [::skin::GetSkinFile pixmaps butsend.gif $currentskin] -format cximage
	
		label $w.main.left.images.1 -image preview1
		label $w.main.left.images.2 -image preview2
		label $w.main.left.images.3 -image preview3
		label $w.main.left.images.4 -image preview4
		label $w.main.left.images.5 -image preview5
		label $w.main.left.images.6 -image preview6
		label $w.main.left.images.7 -image preview7
		label $w.main.left.images.8 -image preview8

		grid $w.main.left.images.1 -in $w.main.left.images -row 1 -column 1
		grid $w.main.left.images.2 -in $w.main.left.images -row 1 -column 2
		grid $w.main.left.images.3 -in $w.main.left.images -row 1 -column 3
		grid $w.main.left.images.4 -in $w.main.left.images -row 1 -column 4
		grid $w.main.left.images.5 -in $w.main.left.images -row 1 -column 5
		grid $w.main.left.images.6 -in $w.main.left.images -row 1 -column 6
		grid $w.main.left.images.7 -in $w.main.left.images -row 1 -column 7
		grid $w.main.left.images.8 -in $w.main.left.images -row 1 -column 8
#		grid $w.main.left.images.blank -in $w.main.left.images -row 1 -column 10
#		grid $w.main.left.images.blank2 -in $w.main.left.images -row 2 -column 1 -columnspan 8

		$w.main.left.desc configure -state normal
		$w.main.left.desc delete 0.0 end
		$w.main.left.desc insert end "[trans description]\n\n$currentdesc"
		$w.main.left.desc configure -state disabled
	
		if { (!$skip_reload) && $::skin::preview_skin_change == 1 } {
			set ::skin::skin_reloaded_needs_reset 1
			::skin::reloadSkin $currentskin
		}
	}


	################################################################
	# ::skinsGUI::ClearPreview ()
	# Destroys every preview image on the skin selector.
	proc ClearPreview { } {
		if {[winfo exists .skin_selector.main.left.images]} {
			destroy .skin_selector.main.left.images.1
			destroy .skin_selector.main.left.images.2
			destroy .skin_selector.main.left.images.3
			destroy .skin_selector.main.left.images.4
			destroy .skin_selector.main.left.images.5
			destroy .skin_selector.main.left.images.6
			destroy .skin_selector.main.left.images.7
			destroy .skin_selector.main.left.images.8
		}
		catch {
#TODO the destruction of the images should be binded to the destruction of the widget they're in
			image delete preview1
			image delete preview2
			image delete preview3
			image delete preview4
			image delete preview5
			image delete preview6
			image delete preview7
			image delete preview8
		}
	}


	################################################################
	# ::skinsGUI::SelectSkinOk (w)
	# Checks if your selection is valid, if it is, it applies changes.
	# This procedure is called when OK in skin selector is pressed.
	# Arguments:
	#  - w => Path of the widget skin selector.
	proc SelectSkinOk { w } {
		if { [$w.main.right.box curselection] == "" } {
			$w.status configure -text "[trans selectskin]"
		} else {
			$w.status configure -text ""
			set skinidx [$w.main.right.box curselection]
			set skin [lindex [lindex [::skin::FindSkins] $skinidx] 0]
			status_log "Chose skin No $skinidx : $skin\n"
			config::setGlobalKey skin $skin
			save_config
			::config::saveGlobal
			unset ::skin::skin_reloaded_needs_reset
			::skin::reloadSkin $skin
			destroy $w
			ClearPreview
		}
	}


	################################################################
	# ::skinsGUI::SelectSkinCancel (w)
	# Checks if we need to reload current skin and destroys the selector.
	# This procedure is called when Cancel in skin selector is pressed.
	# Arguments:
	#  - w => Path of the widget skin selector.
	proc SelectSkinCancel { w } {
		if { $::skin::skin_reloaded_needs_reset } {
			::skin::reloadSkin [::config::getGlobalKey skin]
		}
		unset ::skin::skin_reloaded_needs_reset
		destroy $w
		ClearPreview
	}
}