skins.tcl

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

	################################################################
	# ::skin::loadSound (sound_name)
	# Checks if sound_name is loaded and loads it if it isn't.
	# This function is for the Snack Library.
	# Arguments:
	#  - sound_name => The filename of the desired sound.
	proc loadSound {sound_name} {
		variable loaded_sounds

		if { [info exists loaded_sounds($sound_name)] } {
			return snd_$sound_name
		}

		snack::sound snd_$sound_name -file [::skin::GetSkinFile sounds $sound_name]
		set loaded_sounds($sound_name) 1

		return snd_$sound_name
	}


	################################################################
	# ::skin::reloadSkin (skin_name)
	# This procedure reloads everything that depends on skins.
	# Arguments:
	#  - skin_name => The new skin to switch on.
	proc reloadSkin { skin_name } {
		reloadSkinSettings $skin_name

		# Reload all pixmaps
		variable loaded_pixmaps
		variable pixmaps_names
		variable pixmaps_fblocation
		foreach name [array names loaded_pixmaps] {
			if { [catch {image create photo $loaded_pixmaps($name) -file [::skin::GetSkinFile pixmaps $pixmaps_names($name) $skin_name $pixmaps_fblocation($name)] -format cximage} res] } {
				status_log "skins::reloadSkin:: Error while loading pixmap $res"
				image create photo $loaded_pixmaps($name) -file [::skin::GetSkinFile pixmaps null \
			 -format cximage]	
			}
		}

		# Reload smileys
		variable loaded_smileys
		variable smileys_names
		variable smileys_fblocation
		foreach name [array names loaded_smileys] {
			if { [catch {image create photo $loaded_smileys($name) -file [::skin::GetSkinFile smileys $smileys_names($name) $skin_name $smileys_fblocation($name)] -format cximage} res] } {
				status_log "skins::reloadSkin:: Error while loading smiley $res"
				image create photo $loaded_smileys($name) -file [::skin::GetSkinFile smileys null \
			 -format cximage]
			}
		}

		# Now reload special images that need special treatment
		variable loaded_images
		if {[info exists loaded_images(displaypicture_std_none)]} {
			unset loaded_images(displaypicture_std_none)
			::skin::getNoDisplayPicture $skin_name
		}
		if {[info exists loaded_images(colorbar)]} {
			unset loaded_images(colorbar)
			::skin::getColorBar $skin_name
		}

		# Reload sounds
		variable loaded_sounds
		foreach name [array names loaded_sounds] {
			snd_$name configure -file [::skin::GetSkinFile sounds $name]
		}

		# Change frame color (For All Platforms except Mac)
		if {[catch {tk windowingsystem} wsystem] || $wsystem != "aqua"} {
			catch {.main configure -background [::skin::getKey mainwindowbg]}
			#We are not using pixmapscroll on Mac OS X
			# Reload pixmapscroll's images
			set psdir [LookForExtFolder $skin_name "pixmapscroll"]
			if {$psdir != 0 && [info proc ::pixmapscrollbar::reloadimages] != ""} {
				::pixmapscrollbar::reloadimages $psdir
				status_log "skin $skin_name 's scrollbar loaded"
			}	
		}


	}


	################################################################
	# ::skin::reloadSkinSettings (skin_name)
	# This procedure loads the XML file of the new skin and applies
	# its changes.
	# Arguments:
	#  - skin_name => The new skin to switch on.
	proc reloadSkinSettings { skin_name } {
		# Set defaults
		::skin::InitSkinDefaults
	
		# Load smileys info from default skin first
		set skin_id [sxml::init [::skin::GetSkinFile "" settings.xml default]]
		sxml::register_routine $skin_id "skin:smileys:emoticon" ::smiley::newEmoticon
		sxml::register_routine $skin_id "skin:smileys:size" ::skin::SetEmoticonSize
		sxml::parse $skin_id
		sxml::end $skin_id

		catch { unset ::emotions_cleared }
		
		# Then reload the real skin
		set skin_id [sxml::init [::skin::GetSkinFile "" settings.xml $skin_name]]

		if { $skin_id == -1 } {
			#If someone upgraded from 0.94 and he used another skin, we will use the default skin instead
			set skin_id [sxml::init [::skin::GetSkinFile "" settings.xml default]]
			
			if { $skin_id == -1 } {
				::amsn::errorMsg "[trans noskins]"
				exit
			}
		}

		set ::loading_skin $skin_name
		sxml::register_routine $skin_id "skin:Information" ::skin::SetSkinInfo
		sxml::register_routine $skin_id "skin:General:Colors" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:General:Geometry" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:General:Options" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:ContactList:Colors" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:ContactList:Geometry" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:ContactList:Options" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:ChatWindow:Colors" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:ChatWindow:Geometry" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:ChatWindow:Options" ::skin::SetConfigKeys
		sxml::register_routine $skin_id "skin:smileys:emoticon" ::smiley::newEmoticon
		sxml::register_routine $skin_id "skin:smileys:size" ::skin::SetEmoticonSize
		sxml::parse $skin_id
		sxml::end $skin_id
		unset ::loading_skin

		if { [winfo exists .smile_selector]} {destroy .smile_selector}
	}


	################################################################
	# ::skin::SetEmoticonSize (cstack cdata saved_data cattr saved_attr args)
	# Sets the default smiley size for this skin. Arguments supplied
	# by the XML parser.
	proc SetEmoticonSize {cstack cdata saved_data cattr saved_attr args} {
		upvar $saved_data sdata

		if { [info exists sdata(${cstack}:smilew)] } { ::skin::setKey smilew [string trim $sdata(${cstack}:smilew)] }
		if { [info exists sdata(${cstack}:smileh)] } { ::skin::setKey smileh [string trim $sdata(${cstack}:smileh)] }

		return 0
	}


	################################################################
	# ::skin::GetSkinFile (type, filename, [skin_override])
	# Forms the path to the desired filename and returns it.
	# Arguments:
	#  - type => The subdir in skins/ (pixmaps, sounds, smileys...)
	#  - filename => The desired filename (for example, online.gif)
	#  - skin_override => [NOT REQUIRED] Use this skin instead of current
	#  - fblocation => [NOT REQUIRED] Directory to check if file not found in the skins (for plugins)
	proc GetSkinFile { type filename {skin_override ""} {fblocation ""} } {
		global HOME2 HOME

		if { [catch { set skin "[::config::getGlobalKey skin]" } ] != 0 } {
			set skin "default"
		}
		if { $skin_override != "" } {
			set skin $skin_override
		}
		set defaultskin "default"
		#Get filename before .ext extension
		set filename_noext [::skin::filenoext $filename]
		#Get extension of the file
		set ext [string tolower [string range [::skin::fileext $filename] 1 end]]
		
		#If the extension is a picture, look in 4 formats
		if { $ext == "png" || $ext == "gif" || $ext == "jpg" || $ext == "bmp"} {
			#List the 4 formats we support (in order of priority to check)
			set ext [list png gif jpg bmp]
		}

		set locations [list]
		lappend locations 
		#Get file using global path
		if { "[string range $filename 0 0]" == "/" } {
			lappend locations ""
		}
		#Get from personal profile folder (needed for displaypics)
		lappend locations [file join $HOME $type]
		#Get file from program dir skins folder
		lappend locations [file join [set ::program_dir] skins $skin $type]
		#Get file from ~/.amsn/skins folder
		lappend locations [file join $HOME2 skins $skin $type]
		#Get file from ~/.amsn/profile/skins folder
		lappend locations [file join $HOME skins $skin $type]
		#Get file from ~/.amsn/amsn-extras/skins folder
		lappend locations [file join $HOME2 amsn-extras skins $skin $type]
		#Get file from default skin
                if { [::skin::getKey ignoredefaultsmileys] != 1 || $type != "smileys" } {
                        lappend locations [file join [set ::program_dir] skins $defaultskin $type]
                        #Get file from fallback location
                        if { ($fblocation != "") } {
                                lappend locations [file join $fblocation]
                        }
                }


		foreach location $locations {
			foreach extension $ext {
				if { [file readable [file join $location $filename_noext.$extension]] } {
					return "[file join $location $filename_noext.$extension]"
				}
			}
		}
				
		#If we didn't find anything...use null file
		set path [file join [set ::program_dir] skins $defaultskin $type null]
		return $path
	}

	#Proc used to find out where to get pixmaps for extra skinnable widgets
	proc LookForExtFolder { skin folder } {
		global HOME2 HOME
		
		#Get file from program dir skins folder
		if { [file readable [file join [set ::program_dir] skins $skin $folder]] } {
			return "[file join [set ::program_dir] skins $skin $folder]"
		#Get file from ~/.amsn/skins folder
		} elseif { [file readable [file join $HOME2 skins $skin $folder]] } {
			return "[file join $HOME2 skins $skin $folder]"
		#Get file from ~/.amsn/profile/skins folder
		} elseif { [file readable [file join $HOME skins $skin $folder]] } {
			return "[file join $HOME skins $skin $folder]"
		#Get file from ~/.amsn/amsn-extras/skins folder
		} elseif { [file readable [file join $HOME2 amsn-extras skins $skin $folder]] } {
			return "[file join $HOME2 amsn-extras skins $skin $folder]"
		#Get file from default skin
		} elseif { [file readable [file join [set ::program_dir] skins $skin $folder]] } {
			return "[file join [set ::program_dir] skins $skin $folder]"
		} elseif { [file readable [file join [set ::program_dir] utils $folder]] } {
			return "[file join [set ::program_dir] utils $folder]"
		} else {
			return 0
		}
	}
		
	
	











	#We already have theses 2 procs in protocol.tcl but skins.tcl is loaded before protocol.tcl 
	#And I didn't want to change the order and fucked up something
	#Theses 2 procs are used in ::skin::GetSkinFile
	proc filenoext { filename } {
		if {[string last . $filename] != -1 } {
			return "[string range $filename 0 [expr {[string last . $filename] - 1}]]"
		} else {
			return $filename
		}
	}
	
	proc fileext { filename } {
		if {[string last . $filename] != -1 } {
			return "[string range $filename [string last . $filename] end]"
		} else {
			return ""
		}
	}
	################################################################
	# ::skin::SetSkinInfo (cstack cdata saved_data cattr saved_attr args)
	# Gets the information of the skin from the XML file and puts it
	# in global variable $skin. Arguments supplied by the XML parser.
	proc SetSkinInfo {cstack cdata saved_data cattr saved_attr args} {
		global skin
		upvar $saved_data sdata

		foreach key [array names sdata] {
			set skin([string range $key [expr {[string length $cstack] + 1}] [string length $key]]) [string trim $sdata($key)]
		}

		return 0
	}


	################################################################
	# ::skin::FindSkins ()
	# It looks for all the skins with a settings.xml file that it can
	# find and adds them to a list. When it finish, it returns the list.
	proc FindSkins { } {
		global HOME HOME2