plugins.tcl

Linux下的MSN聊天程序源码

		# the loaded plugins
		variable loadedplugins
		# the path to the frame where are displayed pieces of information for a plugin
		variable mF

		# find the id of the currently selected plugin
		set selection [$w.plugin_list get [$w.plugin_list curselection]]
		# if the selection is empty, end proc
		if { $selection == "" } {
			return
		}

		# update the description
		$mF.name configure -text $selection
		$mF.author configure -text [getInfo $selection author]
		$mF.version configure -text [getInfo $selection plugin_version]
		$mF.desc configure -text [getInfo $selection description]
		
		# update the buttons

		$w.config configure -state normal

		if {[lsearch "$loadedplugins" $selection] != -1 } {
			# if the plugin is loaded, enable the Unload button and update the colors
			$w.load configure -state normal -text [trans unload] -command "::plugins::GUI_Unload"
			$w.plugin_list itemconfigure [$w.plugin_list curselection] -background #DDF3FE

			# if the plugin has a configlist, then enable configuration.
			# Otherwise disable it
			if {[info exists ::[getInfo $selection plugin_namespace]::configlist] == 1} {
				$w.config configure -state normal
			} else {
				$w.config configure -state disabled
			}
		} else { # plugin is not loaded
			# enable the load button and disable config button and update color
			$w.load configure -state normal -text "[trans load]" -command "::plugins::GUI_Load"
			$w.plugin_list itemconfigure [$w.plugin_list curselection] -background #FFFFFF
			$w.config configure -state disabled
		}
	}


	###############################################################
	# GUI_Load ()
	# 
	# This proc is called when the Load button is clicked. It loads a plugin
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc GUI_Load { } {
		# selected info, it will load this plugin
		variable selection
		# window path
		variable w
		#info about the plugins
		variable plugins
		# don't do anything is there is no selection
		if { $selection == "" } {
			plugins_log core "Cannot load plugin, none selected"
			return
		}

		# Do the actual loading and check if it loads properly
		if { [LoadPlugin $selection] == -1 } {
			return
		}

		#update the buttons and colors in the plugins dialog
		GUI_NewSel
	}


	###############################################################
	# GUI_Unload ()
	#
	# Unload the currently selected plugin. Called by the Unload button
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc GUI_Unload { } {
		# the selection, will unload the plugin
		variable selection
		# window path
		variable w

		if {$selection==""} {
		    return;
		}
		
		# do the actual unloading
		UnLoadPlugin $selection
		# update the buttons and colors in the dialog
		GUI_NewSel
	}


	###############################################################
	# GUI_Config ()
	#
	# The Configure button is cliecked. Genereates the configure dialog
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc GUI_Config { } {
	    # selection, will configure it
	    variable selection
	    # window path
	    variable w
	    #info about the plugins
	    variable plugins

	    #the standard "check for selection"
	    if { $selection == "" } {
		return
	    }

	    #name of the configuration window
	    set confw ${w}.winconf_${selection}

	    #If the window is already here, just raise it to the front
	    if { [winfo exists $confw] } {
		raise $confw
		return
	    } else {
		#create the configuration window
		set winconf [toplevel $confw]	
	    }

	    # list of callbacks for pressing save of frame types
	    variable saveframelist 
	    set saveframelist {}
	    
	    # get the name
	    set name $selection
	    set namespace [getInfo $selection plugin_namespace]

	    plugins_log core "Calling ConfigPlugin in the $name namespace\n"

	    # is there a config list?
	    if {[info exists ::${namespace}::configlist] == 0} {
	    	# no config list, just put a label "Nothing to configure" in the configure dialog
		plugins_log core "No Configuration variable for $name.\n"
		label $winconf.label -text "No Configuration variable for $name.\n"
		button $winconf.ok -text [trans ok] -command "destroy $winconf"
		pack $winconf.label
		pack $winconf.ok
	    } else { # configlist exists
		    # backup the current config
		    array set ::${namespace}::old_config [array get ::${namespace}::config]
		    # create the frame where the configuration is gonna get packed
		    set confwin [frame $winconf.area]
		    # id used for the item name in the widget
		    set i 0
		    # loop through all the items
		    foreach confitem [set ::${namespace}::configlist] {
			# Increment both variables
			incr i
			# Check the configuration item type and create it in the GUI
			switch [lindex $confitem 0] {
			    label {
				# This configuration item is a label (Simply text to show)
				label $confwin.$i -text [lindex $confitem 1]
				pack $confwin.$i -anchor w -padx 10
			    }
			    bool {
				# This configuration item is a checkbox (Boolean variable)
				checkbutton $confwin.$i -text [lindex $confitem 1] -variable \
				    ::${namespace}::config([lindex $confitem 2])
				pack $confwin.$i -anchor w -padx 20
			    }
			    ext {
				# This configuration item is a button (Action related to key)
				button $confwin.$i -text [lindex $confitem 1] -command \
				    ::${namespace}::[lindex $confitem 2]
				pack $confwin.$i -anchor w -padx 20 -pady 5
			    }
			    str {
				# This configuration item is a text input (Text string variable)
				set frame [frame $confwin.f$i]
				entry $frame.${i}e -textvariable \
				    ::${namespace}::config([lindex $confitem 2]) -bg white
				label $frame.${i}l -text [lindex $confitem 1]
				pack $frame.${i}l -anchor w -side left -padx 20
				pack $frame.${i}e -anchor w -side left -fill x
				pack $frame -fill x
			    }
			    pass {
				# This configuration item is a password input (Text string variable)
				set frame [frame $confwin.f$i]
				entry $frame.${i}e -show "*" -textvariable \
				    ::${namespace}::config([lindex $confitem 2])
				label $frame.${i}l -text [lindex $confitem 1]
				pack $frame.${i}l -anchor w -side left -padx 20
				pack $frame.${i}e -anchor w -side left -fill x
				pack $frame -fill x -anchor w
			    }
			    lst {
				# This configuration item is a listbox that stores the selected item.
				set height [llength [lindex $confitem 1]]
				listbox $confwin.$i -height $height -width 0 -bg white
				foreach item [lindex $confitem 1] {
				    $confwin.$i insert end $item
				}
				bind $confwin.$i <<ListboxSelect>> "::plugins::lst_refresh $confwin.$i ::${namespace}::config([lindex $confitem 2])"
				pack $confwin.$i -anchor w -padx 40
			    }
			    rbt {
				# This configuration item contains radiobutton
				set buttonlist [lrange $confitem 1 end-1]
				set value 0
				foreach item $buttonlist {
				    incr value
				    radiobutton $confwin.$i -text "$item" -variable ::${namespace}::config([lindex $confitem end]) -value $value
				    pack $confwin.$i -anchor w -padx 40
				    incr i
				}
				incr i -1
			    }
			    frame {
			    	# This configureation item creates a frame so the plugin can place whatever it like inside
				frame $confwin.$i
				[lindex $confitem 1] $confwin.$i
				if { "[lindex $confitem 2]" != "" } {
					lappend saveframelist "[lindex $confitem 2] $confwin.$i"
				}
				pack $confwin.$i -fill x -anchor w
			    }
			}
		    }
		}
		
		# set the name of the winconf
		wm title $confw "[trans configure] $selection"
		
		# Grid the frame
		pack $confwin -fill x
		# Create and grid the buttons
		button $winconf.save -text [trans save] -command "[list ::plugins::GUI_SaveConfig $winconf $name]"
		button $winconf.cancel -text [trans cancel] -command "[list ::plugins::GUI_CancelConfig $winconf $namespace]"
		pack $winconf.save -anchor se -pady 5 -padx 5 -side right
		pack $winconf.cancel -anchor se -pady 5 -padx 5 -side right
		bind $winconf <<Escape>> "destroy $winconf"
		moveinscreen $winconf 30
	}


	###############################################################
	# lst_refresh (path, config)
	#
	# The list box on config window changes its selected value, so
	# this proc refresh the associated variable with the new value
	#
	# Arguments
	# path - The listbox widget path 
	# config - The complete config entry (with plugin namespace)
	#
	# Return
	# none
	#
	proc lst_refresh { path config } {
		set ${config} [$path get [$path curselection] [$path curselection]]	
	}


	###############################################################
	# GUI_SaveConfig (w)
	#
	# The Save button in Configuration Window is clicked. Save the
	# plugins configuration and then destroy the Configuration Window
	#
	# Arguments
	# w - The configuration window widget path
	# name - The name of the plugin that was changed (if any)
	#
	# Return
	# none
	#
	proc GUI_SaveConfig { w {name ""}} {
		variable saveframelist
		
		if { $name != "" } {
			#add a postevent to warn the plugin when it is configured
			set evPar(name) $name
			::plugins::PostEvent PluginConfigured evPar
		}
		
		foreach call $saveframelist {
			eval $call
		}

		set saveframelist {}

		::plugins::save_config
		destroy $w;
	}


	###############################################################
	# GUI_CancelConfig (w, namespace)
	#
	# The Cancel button in Configuration Window is cliecked. Return to
	# original configuration and then destroy the Configuration Window
	#
	# Arguments
	# w - The configuration window widget path 
	# namespace - The namespace of the plugin not configured
	#
	# Return
	# none
	#
	proc GUI_CancelConfig { w namespace } {
		array set ::${namespace}::config [array get ::${namespace}::old_config]
		#unset the old array to save space
		unset ::${namespace}::old_config

		destroy $w;
	}


	###############################################################
	# GUI_Close ()
	#
	# The Close button is cliecked. Simply destroy the Plugins Window
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc GUI_Close { } {
		variable w
		destroy $w
	}


	###############################################################
	# UnLoadPlugins ()
	#
	# Unloads all loaded plugins (if any) 
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc UnLoadPlugins { {save 1} } {
		variable loadedplugins
		foreach {plugin} "$loadedplugins" {
			# the "0" is to tell UnLoadPlugin not to save the config
			::plugins::UnLoadPlugin $plugin $save
		}
	}


	###############################################################
	# UnLoadPlugin (plugin)
	#
	# Unloads the $plugin plugin, removes its events, executes its
	# destructor procedure (a.k.a. DeInit) and moves its config
	# array to global namespace (since its namespace will be removed)
	#
	# Arguments
	# plugin - The plugin to be removed
	#
	# Return
	# none
	#
	proc UnLoadPlugin { plugin {save 1}} {

		variable loadedplugins
		plugins_log core "Unloading plugin $plugin\n"

		#unregister events
		UnRegisterEvents $plugin

		#get the namespace and deinit proc and if it exists, call it
		set namespace [getInfo $plugin plugin_namespace]
		set deinit [getInfo $plugin deinit_proc]
		if {[info procs "::${namespace}::${deinit}"] == "::${namespace}::${deinit}"} {
			if { [catch {::${namespace}::${deinit}} res] } {
				plugins_log core "Error in deinit proc : $res"
			}
		}

		#copy the config array to a config plugin
		if {[array exists ::${namespace}::config]} {
			set ::plugins::config($plugin) [array get ::${namespace}::config]
		}

		#remove it from the loadedplugins list
		set loadedplugins [lreplace $loadedplugins [lsearch $loadedplugins "$plugin"] [lsearch $loadedplugins "$plugin"]]

		if {$save} { ::plugins::save_config }

	}


	###############################################################
	# LoadPlugins ()
	#
	# Loads all plugins that were previously loaded (stored in
	# configuration file plugins.xml) reading $loadedplugins
	# Also it loads all the core plugins
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc LoadPlugins {} {

	    variable loadedplugins
		# the "0" is to tell UnLoadPlugins not to save the config
		# the config should not be saved now, but when disconnecting or closing aMSN
	    ::plugins::UnLoadPlugins 0
	    
	    #resets the loadedplugins list to plugins that were loaded before
	    load_config

	    #"HACK" to load 'core' plugins for the 0.95 release
	    #HERE WE HAVE A LIST OF PLUGINS THAT ARE SHIPPED WITH AMSN AND SHOULD BE LOADED IF THE USER SEES 'M FOR THE FIRST TIME
	    #logic: if this is the first time the user logged in, then 
	    #the configuration list is empty which means load_config
	    #makes loadedplugins empty
	    if {[llength $loadedplugins] == 0} {
		    set loadedplugins [list "Nudge" "Cam Shooter" "remind"]
	    }

	    #update the list of installed plugins because this proc is usually 
	    #called when a new user logs in, so he migh have diff plugins in
	    # his ~/.amsn/{user}/plugins
	    ::plugins::updatePluginsArray

	    foreach plugin $loadedplugins {
		status_log "PLUGIN : $plugin\n" red
		#check if the plugin exists, then load it
		#TODO: what should we do if it doesn't exist?
		# - remove it from loadedplugins, but how to we know to load it if it exists
		# - (current) keep it and hope nothing calls a proc that depends on this plugin to be loaded (and checks if it is loaded)
		if {[array names ::plugins::plugins ${plugin}_name] != ""} {
			LoadPlugin $plugin
		}
	    }

	}


	###############################################################
	# LoadPlugin (plugin)
	#
	# Loads the $plugin plugin and restore its configuration from
	# global namespace if existed.
	#
	# The reason for all the arguments is developemnt testing,
	# we can test different files via the status_log window
	#
	# Arguments
	# plugin - The plugin to load (name)
	# required_version - Required aMSN version for the plugin to load
	# file - The plugin's TCL main file
        # namespace - The plugin's main namespace
        # init_proc - The plugin's init procedure
	#
	# Return
	# 1 - success
	# -1 - failiture
	#
	proc LoadPlugin { plugin } {

		variable loadedplugins

		set required_version [getInfo $plugin amsn_version]
		set file [getInfo $plugin plugin_file]
		set namespace [getInfo $plugin plugin_namespace]
		set init_proc [getInfo $plugin init_proc]

		#error checking
		if { ![CheckRequirements $required_version] } {
			msg_box "$plugin: [trans required_version $required_version]"
			return -1
		}

		if { [catch { source $file } res] } {
			msg_box "$plugin: Failed to load source with result:\n\n$res"
			return -1
		}

		#copy the config if it exists
		if {[array names ::plugins::config $plugin] != ""} {
			if {$::plugins::config(${plugin}) != ""} {
				array set ::${namespace}::config $::plugins::config(${plugin})
			}
		}
	    
		#add it to loadedplugins, if it's not there already
		#we need to add it before the init_proc is called!
		if {[lsearch "$loadedplugins" $plugin] == -1} {
			plugins_log core "appending to loadedplugins\n"
			lappend loadedplugins $plugin
		}

		#call the init proc if it exists
		if {[info procs ::${namespace}::${init_proc}] == "::${namespace}::${init_proc}"} {
			plugins_log core "Initializing plugin $plugin with ${namespace}::${init_proc}\n"
	
			#check for Tcl/Tk errors
			if {[catch {::${namespace}::${init_proc} [file dirname $file]} res] } {
				plugins_log core "Initialization of plugin $plugin with ${namespace}::${init_proc} failed\n$res\n$::errorInfo"
				msg_box "Plugins System: Can't initialize plugin:init procedure caused an internal error"
				UnLoadPlugin $plugin
				return -1
			#If proc returns -1, end because it failed because it's own reasons
			} elseif {$res == -1} {
				UnLoadPlugin $plugin
				return -1
			}
			#can someone explain what this is for?
			eval {proc ::${namespace}::${init_proc} {file} { return } }
		} else {
			msg_box "Plugins System: Can't initialize plugin:init procedure not found"
			return -1
		}

	    	if {[array names ::plugins::config $plugin] != ""} {
			if {$::plugins::config(${plugin}) != ""} {
				array set ::${namespace}::config $::plugins::config(${plugin})
			}
			unset ::plugins::config(${plugin})
		} else {
			plugins_log core "Plugins System: no config for plug-in $plugin\n"
		}
				
		#Call PostEvent Load
		#Keep in variable if we are online or not
		#TODO: dosn't exist on start?
		if { [catch { set stat [ns cget -stat] } ] } {
			set status offline
		} elseif { $stat == "o" } {
	      		set status online
		} else {
			set status offline
		}
		set evpar(name) $plugin
		set evpar(status) $status
		::plugins::PostEvent Load evpar