# controller.tcl --
 # 
 # Part of: The TCL'ers Wiki
 # Contents: demonstrates multitasking with TCL
 # Date: updated on June, 2003
 # 
 # Abstract
 # 
 #	Read the TCL'ers Wiki page "Multitasking and the event loop"
 #	to learn what this script does. Remember to create the
 #	"sleepers.tcl" script in the same directory of this one.
 #
 #	  This script is a little complex for a Wiki page, but I wanted
 #	to make it a demonstration of the task package features. You can
 #	find the task package description at the TCL'ers Wiki page
 #	"The task package". I'll also reuse this infrastructure in other
 #	TCL'ers Wiki pages.
 #
 #	  If someone is interested in demonstrating some object system
 #	package, like [Incr TCL] and XOTcl, and wants to take this code:
 #	just do it.
 #
 # Overview
 #
 #	There are six modules:
 #
 #	script -	the main module, resides in the "script"
 #			namespace; it's responsible for the script
 #			initialisation and finalisation and acts also
 #			as a mediator between the GUI and the process
 #			control modules;
 #
 #	gui -		the GUI module, resides in the "gui" namespace;
 #			draws the user interface and handles the commands
 #			associated to the widgets;
 #
 #	ptable -	the process table, resides in the "ptable"
 #			namespace; keeps track of the existing processes;
 #
 #	process -	the image of a sequence of executions of external
 #			programs, resides in the "process" namespace;
 #			
 #	protocol -	handles the communication between this script
 #			and the external programs, resides in the
 #			"protocol" namespace; it doesn't do much;
 #
 #	task -		the task package.
 #
 #	Widget commands handling. Whenever a command is requested by the
 #	user a procedure is evaluated in the "gui::command" namespace:
 #	it gets a chance to update the GUI and then invokes a procedure
 #	in the "script::command" namespace that actually does what it's
 #	meant.
 #
 # Copyright (c) 2003 Marco Maggi
 # 
 # The author  hereby grant permission to use,  copy, modify, distribute,
 # and  license this  software  and its  documentation  for any  purpose,
 # provided that  existing copyright notices  are retained in  all copies
 # and that  this notice  is included verbatim  in any  distributions. No
 # written agreement, license, or royalty  fee is required for any of the
 # authorized uses.  Modifications to this software may be copyrighted by
 # their authors and need not  follow the licensing terms described here,
 # provided that the new terms are clearly indicated on the first page of
 # each file where they apply.
 # 
 # IN NO  EVENT SHALL THE AUTHOR  OR DISTRIBUTORS BE LIABLE  TO ANY PARTY
 # FOR  DIRECT, INDIRECT, SPECIAL,  INCIDENTAL, OR  CONSEQUENTIAL DAMAGES
 # ARISING OUT  OF THE  USE OF THIS  SOFTWARE, ITS DOCUMENTATION,  OR ANY
 # DERIVATIVES  THEREOF, EVEN  IF THE  AUTHOR  HAVE BEEN  ADVISED OF  THE
 # POSSIBILITY OF SUCH DAMAGE.
 # 
 # THE  AUTHOR  AND DISTRIBUTORS  SPECIFICALLY  DISCLAIM ANY  WARRANTIES,
 # INCLUDING,   BUT   NOT  LIMITED   TO,   THE   IMPLIED  WARRANTIES   OF
 # MERCHANTABILITY,    FITNESS   FOR    A    PARTICULAR   PURPOSE,    AND
 # NON-INFRINGEMENT.  THIS  SOFTWARE IS PROVIDED  ON AN "AS  IS" BASIS,
 # AND  THE  AUTHOR  AND  DISTRIBUTORS  HAVE  NO  OBLIGATION  TO  PROVIDE
 # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 # 
 # $Id: 9059,v 1.2 2005-07-16 06:00:12 jcw Exp $
 
 #PAGE
 ## ------------------------------------------------------------
 ## Required packages.
 ## ------------------------------------------------------------
 
 package require Tcl 8
 package require Tk  8
 
 #PAGE
 ## ------------------------------------------------------------
 ## Script namespace.
 ## ------------------------------------------------------------
 
 namespace eval script {
     # At  the end  of  the script  (when  all the  namespaces have  been
     # created)  sub-namespaces are  created in  this namespace.  This is
     # required  because  [namespace import]  will  import only  existing
     # commands.
 
     namespace export get_value_var
 }
 
 #PAGE
 # script::main --
 #
 #	Main procedure; this procedure must be invoked at the end
 #	of the script like this:
 #
 #		::script::main $argc $argv
 #
 #	  This procedure declares a task to hold its data. The
 #	members are:
 #
 #	ptable -	the token of the process table task;
 #	gui -		the token of the GUI task;
 #	value -		a variable holding an integer that's
 #			incremented by a [button] widget to
 #			demonstrate that the GUI is alive when
 #			the external programs are running;
 #	quitflag -	the variable used signal events to this
 #			procedure.
 #
 #  Arguments:
 # 
 #	argc -		the number of elements in "argv"
 #	argv -		the list of command line arguments
 #
 #  Results:
 #
 #	  Operations:
 #
 #	- initialises the process table;
 #	- initialises the GUI;
 #	- waits for the user to submit the quit command;
 #	- finalises the process table.
 #
 #	  Exits with code zero.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc script::main { argc argv } {
     set main [task::constructor ptable gui value quitflag]
     set quitflag 0
     set value 0
 
     # Build the GUI. The module requires the main task's token to submit
     # command requests from the widgets to the rest of the program and to
     # access the "value" variable.
 
     set gui [gui::constructor $main]
 
     # Build  a process table.  The module  requires a  script to  run to
     # notify the GUI of process' state changes.
 
     set ptable [ptable::constructor "::gui::notify_process_event $gui"]
 
     # Wait for the quit command.
 
     set v [task::globname $main quitflag]
     vwait $v
 
     # Waits for all the processes in the table to be terminated.
 
     if { ! [ptable::finalise $ptable "::set $v 2"] } {
 	vwait $v
     }
 
     # Finalisation.
 
     ptable::destructor $ptable
     gui::destructor $gui
     task::destructor $main
     exit 0
 }
 
 #PAGE
 # script::get_value_var --
 #
 #	Access the "value" variable.
 #
 #  Arguments:
 # 
 #	main -		the task's token
 #
 #  Results:
 #
 #       Returns fully qualified name of the "value" task variable,
 #	this is required by the GUI module to increment the integer
 #	in it.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc script::get_value_var { main } {
     return [task::globname $main value]
 }
 
 #PAGE
 # script::quit --
 #
 #	Signals to the [main] [vwait] command that a request to
 #	terminate the script has been received.
 #
 #  Arguments:
 # 
 #	main -		the main token
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc script::quit { main } {
     task::global	$main quitflag
     if { $quitflag == 0 } {
 	set quitflag 1
     }
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## Script commands.
 ## ------------------------------------------------------------
 
 namespace eval script::command {
     # At  the end  of  the script  (when  all the  namespaces have  been
     # created)  sub-namespaces are  created in  this namespace.  This is
     # required  because  [namespace import]  will  import only  existing
     # commands.
 
     namespace export \[a-z\]*
 }
 
 # Stores a  value in the variable  used to signal events  to the [main]
 # procedure,   which  is  blocked   by  a   [vwait]  on   the  variable
 # itself. Returns the empty string.
 
 proc script::command::quit { main } {
     [namespace parent]::quit $main
 }
 
 proc script::command::start { main } {
     task::global	$main ptable
     process::constructor $ptable "[auto_execok tclsh] sleeper.tcl"
 }
 
 proc script::command::stop { main selected_process } {
     process::signal_stop $selected_process
 }
 
 proc script::command::resume { main selected_process } {
     process::signal_resume $selected_process
 }
 
 proc script::command::terminate { main selected_process } {
     process::signal_termination $selected_process
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## The GUI namespace.
 ## ------------------------------------------------------------
 
 namespace eval gui {
     # At  the end  of  the script  (when  all the  namespaces have  been
     # created)  sub-namespaces are  created in  this namespace.  This is
     # required  because  [namespace import]  will  import only  existing
     # commands.
 
     namespace export \[a-z\]*
 
     wm withdraw .
 
     variable	counter 0
     variable	message \
 "Start one or more tasks with \[Start\], then select a task by\
 clicking in the listboxes and \[Stop\] or \[Resume\] it.\
 
   While tasks are running, press the \[Push Me\] button to verify\
 that the GUI is still responding fine (the counter on the left is\
 incremented).\
 
   When you're tired: press the \[Quit\] button and see the tasks\
 terminate one by one."
     variable	buttonbar_buttons	{ start stop resume terminate quit }
     variable	state_listboxes		{ identifiers states counters }
 
     # Overall options.
 
     option add *borderWidth			1
 
     # Options  for  the  [message]  widget  explaining how  to  use  the
     # program.
 
     option add *Upper.ipadx			2m
     option add *Upper.ipady			2m
     option add *Upper.message.aspect		500
     option add *Upper.message.relief		sunken
     option add *Upper.message.background	white
     option add *Upper.message.text		$message
     option add *Upper.message.font		Roman
 
     # Options for the button bar.
 
     option add *Bbar.borderWidth		2
     option add *Bbar.relief			groove
     option add *Bbar.start.text			"Start"
     option add *Bbar.stop.text			"Stop"
     option add *Bbar.resume.text		"Resume"
     option add *Bbar.terminate.text		"Terminate"
     option add *Bbar.quit.text			"Quit"
 
     # Options for the frame of listboxes.
     
     option add *State.ipadx			2m
     option add *State.ipady			2m
     option add *State.Labelframe.relief		groove
     option add *State.Labelframe.borderWidth	2
     option add *State.Labelframe.ipadx		2m
     option add *State.Labelframe.ipady		2m
     option add *State.identifiers.text		"Identifiers"
     option add *State.states.text		"States"
     option add *State.counters.text		"Counters"
 
     option add *State*Labelframe.listbox.background		white
     option add *State*Labelframe.listbox.selectMode		single
     option add *State*Labelframe.listbox.exportSelection	no
 
     # Options for the frame of widgets demonstrating the liveness of the
     # GUI.
 
     option add *Stillalive.borderWidth		2
     option add *Stillalive.relief		groove
     option add *Stillalive.ipadx		1m
     option add *Stillalive.ipady		1m
 
     option add *Stillalive.label.background	white
     option add *Stillalive.label.width		5
     option add *Stillalive.label.relief		sunken
     option add *Stillalive.button.text		"Push me!"
 
 
     set s { _propagate_listbox_selection %W }
     bind Listbox <ButtonRelease-1> [namespace code $s]
 }
 
 #PAGE
 # gui::unique --
 #
 #	Return the pathname of a unique widget.
 #
 #  Arguments:
 # 
 #	parent -	optional pathname of the parent
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc gui::unique { {parent .} } {
     variable	counter
 
     if { [string equal $parent .] } {
 	return .[incr counter]
     } else {
 	return $parent.[incr counter]
     }
 }
 
 #PAGE
 # gui::constructor --
 #
 #	Initialises the GUI.
 #
 #  Arguments:
 # 
 #	main -		the token of the main task
 #
 #  Results:
 #
 #       Returns the GUI task' token.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc gui::constructor { main } {
     variable	buttonbar_buttons
     variable	state_listboxes
     set gui [task::constructor window identifiers states counters]
 
     # Toplevel.
 
     toplevel [set window [unique]] -class Window
     wm withdraw $window
     wm title    $window "Multitasking and the event loop"
     wm geometry $window +10+10
 
     # Upper frame.
 
     frame [set f [unique $window]] -class Upper
     grid  $f -sticky news
     message $f.message
     grid    $f.message -row 0 -column 0
 
     # Button bar.
 
     frame [set f [unique $window]] -class Bbar
     grid  $f -row 1 -column 0 -sticky news -padx 2m -pady 2m
     set i -1
     foreach n $buttonbar_buttons {
 	button $f.$n -command [namespace code "command::$n $gui $main"]
 	grid   $f.$n -row 0 -column [incr i]
     }
     unset f i
 
     # Listboxes.
 
     frame [set f $window.state] -class State
     grid  $f -sticky news -row 2 -column 0
     set i -1
     foreach n $state_listboxes {
 	labelframe $f.$n
 	grid       $f.$n -column [incr i] -row 0 -sticky news \
 		-padx 1m -pady 1m
 	listbox $f.$n.listbox -listvariable [task::globname $gui $n]
 	grid    $f.$n.listbox -sticky news -padx 1m -pady 1m
     }
     unset f i
 
     # Still-alive widgets.
 
     frame [set f [unique $window]] -class Stillalive
     grid  $f -sticky news -row 3 -column 0 -padx 1m -pady 1m
     label  $f.label	-textvariable [set v [script::get_value_var $main]]
     button $f.button	-command "incr $v"
     grid $f.label $f.button
     unset f v
 
     # Let's go.
 
     wm deiconify $window
     tkwait visibility $window
     return $gui
 }
 
 #PAGE
 # gui::destructor --
 #
 #	GUI destructor.
 #
 #  Arguments:
 # 
 #	gui -		the GUI's task token
 #
 #  Results:
 #
 #       Destroys the window and the task.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc gui::destructor { gui } {
     destroy [task::globget $gui window]
     task::destructor $gui
     return
 }
 
 #PAGE
 # gui::notify_process_event --
 #
 #	This procedure is invoked to update the GUI with the new
 #	state of a process. The recognised state identifiers are:
 #
 #	created -	the process has been created but no
 #			external program have been started yet;
 #
 #	running -	the process has started a new external
 #			program, with this state the "counter"
 #			argument must be used;
 #
 #	stopping -	the process has received a request to
 #			stop the execution of external programs;
 #
 #	stopped -	the process has been stopped;
 #
 #	resuming -	the process has received a request to
 #			resume itself;
 #
 #	terminating -	the process has received a request to
 #			terminate itself;
 #
 #	terminated -	the process has terminated itself, its
 #			data is removed from the GUI.
 #
 #  Arguments:
 # 
 #	gui -		the GUI's task token
 #	process -	the process' token
 #	state -		the new state identifier
 #	counter -	optional number of external programs
 #			run by the process so far
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc gui::notify_process_event { gui process state {counter {}} } {
     task::global	$gui identifiers states counters
 
     switch -exact -- $state {
 	created		{
 	    lappend identifiers $process
 	    lappend states	$state
 	    lappend counters	0
 	}
 	running		{
 	    set idx [lsearch $identifiers $process]
 	    lset states   $idx $state
 	    lset counters $idx $counter
 	}
 	stopping	-
 	stopped		-
 	terminating	{
 	    set idx [lsearch $identifiers $process]
 	    lset states   $idx $state
 	}
 	terminated	{
 	    set idx [lsearch $identifiers $process]
 	    set identifiers [lreplace $identifiers $idx $idx]
 	    set states      [lreplace $states      $idx $idx]
 	    set counters    [lreplace $counters    $idx $idx]
 	}
     }
     return
 }
 
 #PAGE
 # gui::get_selected_process --
 #
 #	Access the currently selected process.
 #
 #  Arguments:
 # 
 #	gui -		the GUI's task token
 #
 #  Results:
 #
 #       Returns the process identifier.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc gui::get_selected_process { gui } {
     task::global	$gui window identifiers
 
     set lb $window.state.identifiers.listbox
     return [lindex $identifiers [$lb curselection]]
 }
 
 #PAGE
 # gui::_propagate_listbox_selection --
 #
 #	Propagates the selection from a listbox to the others.
 #
 #  Arguments:
 # 
 #	widget -	the [listbox] widget that triggered
 #			the event
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc gui::_propagate_listbox_selection { widget } {
     variable	state_listboxes
     set idx	[$widget curselection]
     set granpa	[winfo parent [winfo parent $widget]]
 
     foreach frame $state_listboxes {
 	if { ! [string equal $widget $granpa.$frame.lb] } {
 	    $granpa.$frame.listbox selection clear 0 end
 	    $granpa.$frame.listbox selection set $idx
 	}
     }
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## GUI's commands namespace.
 ## ------------------------------------------------------------
 
 namespace eval gui::command {
     # At  the end  of  the script  (when  all the  namespaces have  been
     # created)  sub-namespaces are  created in  this namespace.  This is
     # required  because  [namespace import]  will  import only  existing
     # commands.
 
     namespace import ::gui::get_selected_process
 }
 
 proc gui::command::quit { gui main } {
     script::quit $main
 }
 
 proc gui::command::start { gui main } {
     script::start $main
 }
 
 proc gui::command::stop { gui main } {
     if { [string length [set process [get_selected_process $gui]]]  } {
 	script::stop $main $process
     }
 }
 
 proc gui::command::resume { gui main } {
     if { [string length [set process [get_selected_process $gui]]]  } {
 	script::resume $main $process
     }
 }
 
 proc gui::command::terminate { gui main } {
     if { [string length [set process [get_selected_process $gui]]]  } {
 	script::terminate $main $process
     }
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## Process' table namespace.
 ## ------------------------------------------------------------
 
 namespace eval ptable {
     # At  the end  of  the script  (when  all the  namespaces have  been
     # created)  sub-namespaces are  created in  this namespace.  This is
     # required  because  [namespace import]  will  import only  existing
     # commands.
 
     namespace export \[a-z\]*
 
     variable	period 500
 }
 
 #PAGE
 # ptable::constructor --
 #
 #	Builds a new process table. This procedure must be invoked
 #	when the script is initialised.
 #
 #	  The task members are:
 #
 #	process_list -		the list of identifiers of currently
 #				existing processes;
 #
 #	notify_script -		a script to be evaluated in the global 
 #				namespace to notify a change in state
 #				for a process, it must accept two
 #				mandatory arguments: the process
 #				identifier and the state identifier, and
 #				an optional argument: the count of
 #				external programs run so far;
 #
 #	finalise_script -	a script to be evaluated in the global
 #				namespace to notify the complete
 #				finalisation of the process table.
 #
 #  Arguments:
 # 
 #  	_notify_script -	the notifier script
 #
 #  Results:
 #
 #       Returns the instance's token.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::constructor { _notify_script } {
     set table [task::constructor process_list notify_script finalise_script]
 
     set process_list	{}
     set notify_script	$_notify_script
 
     return $table
 }
 
 #PAGE
 # ptable::destructor --
 #
 #	Process table destructor. It must be invoked after the table
 #	has been finalised.
 #
 #  Arguments:
 # 
 #	table -		the instance's token
 #
 #  Results:
 #
 #       Destroys the instance.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::destructor { table } {
     task::destructor $table
 }
 
 #PAGE
 # ptable::register --
 #
 #	Registers a process in the table. This is invoked by a
 #	process instance whenever it initialises itself.
 #
 #  Arguments:
 # 
 #	table -		the instance's token
 #	process -	the process identifier
 #
 #  Results:
 #
 #       Appends the identifier to the list. Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::register { table process } {
     task::global	$table process_list
     lappend process_list $process
     return
 }
 
 #PAGE
 # ptable::unregister --
 #
 #	Removes a process identifier from the list of registered
 #	processes. This is invoked by a process instance whenever
 #	it terminates itself.
 #
 #  Arguments:
 # 
 #	table -		the instance's token
 #	process -	the process identifier
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::unregister { table process } {
     task::global	$table process_list
 
     set idx [lsearch  $process_list $process]
     if { $idx >= 0 } {
 	set process_list [lreplace $process_list $idx $idx]
     } else {
 	return -code error "unknown process \"$process\""
     }
     return
 }
 
 #PAGE
 # ptable::notify_process_event --
 #
 #	This procedure is invoked by a process instance to signal
 #	changes in its state.
 #
 #  Arguments:
 # 
 #	table -		the ptable instance's token
 #	process -	the process identifier
 #	state -		a string identifying the new state
 #	counter -	optional number of external programs 
 #			run by the process so far
 #
 #  Results:
 #
 #	Evaluates the notifier script previously registered.
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::notify_process_event { table process state {counter {}} } {
     task::global	$table notify_script
     eval $notify_script { $process $state $counter }
     return
 }
 
 #PAGE
 # ptable::finalise --
 #
 #	Finalises all the processes.
 #
 #  Arguments:
 # 
 #	table -		the table's token
 #  	script -	a script to be evaluated in the global
 #			namespace whenever all the processes
 #			are terminated
 #
 #  Results:
 #
 #	If there are no processes in the table: returns one,
 #	else returns zero.
 #
 #	  In the latter case signals to all the registered processes
 #	that the execution has to terminate, then schedules a periodic
 #	script in the event loop that keeps track of the processes
 #	still existing and, when all of them are terminated,
 #	evaluates the "script" argument.
 #
 #         Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::finalise { table script } {
     variable	period
     task::global	$table process_list finalise_script
 
     if { [llength $process_list] == 0 } {
 	return 1
     }
 
     set finalise_script $script
     foreach process $process_list {
 	process::signal_termination $process
     }
     after $period [namespace code "_finalise_handler $table"]
     return 0
 }
 
 #PAGE
 # ptable::_finalise_handler --
 #
 #	This procedure is scheduled in the event loop by [finalise]
 #	to check when all the processes are terminated.
 #
 #	  It must be invoked with a valid script in the "finalise_script"
 #	variable. This script, when evaluated, must warn some other
 #	part of the program (probably a [vwait]) of the finalisation
 #	event.
 #
 #  Arguments:
 # 
 #	table -		the table's token
 #
 #  Results:
 #
 #	If the list of registered processes is empty: evaluates the
 #	registered script in the global namespace; else: reschedules
 #	itself.
 #
 #         Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc ptable::_finalise_handler { table } {
     variable	period
     task::global	$table process_list finalise_script
 
     if { [llength $process_list] == 0} {
 	namespace eval :: $finalise_script
     } else {
 	after $period [namespace code "_finalise_handler $table"]
     }
     return
 }
 #PAGE
 ## ------------------------------------------------------------
 ## Process module's namespace.
 ## ------------------------------------------------------------
 
 namespace eval process {
     # At  the end  of  the script  (when  all the  namespaces have  been
     # created)  sub-namespaces are  created in  this namespace.  This is
     # required  because  [namespace import]  will  import only  existing
     # commands.
 
     namespace export \[a-z\]*
 }
 
 #PAGE
 # process::constructor --
 #
 #	Builds a new avatar for a sequence of executions of an
 #	external program.
 #
 #	  The purpose of a process instance is execute the
 #	registered external command again and again until the
 #	termination request is received. A count of the execution
 #	number is kept and notified to the table this process belongs
 #	to. The execution sequence can be stopped and resumed with
 #	appropriate requests.
 #
 #	  A process can be in any of the following states:
 #	
 #	created -	the process has been created but no external
 #			program have been started yet;
 #
 #			* the instance is registered into the process
 #			  table;
 #			* a command is scheduled in the event loop to
 #			  run an instance of the  program, it'll switch
 #			  the state to "running";
 #
 #	running -	the process has started a new external
 #			program;
 #
 #	stopping -	the process has received a request to
 #			stop the execution of external programs;
 #
 #			* the request is registered and when the
 #			  running external program terminates the
 #			  state is switched to "stopped";
 #
 #	stopped -	the process has been stopped; no external
 #			programs are running or will be started until
 #			the process receives a "resume" request;
 #
 #	resuming -	the process has received a request to resume
 #			itself;
 #
 #			* a command is scheduled in the event loop to
 #			  run a new program, switching the state to
 #			  "running";
 #
 #	terminating -	the process has received a request to terminate
 #			itself;
 #
 #			* the request is registered and when the running
 #			  external program terminates the state is
 #			  switched to "terminated";
 #
 #	terminated -	the process has terminated itself;
 #
 #			* the instance is unregistered from the table;
 #			* the instance is destroyed.
 #
 #  Arguments:
 # 
 #	_ptable -	the process table this one belongs to
 #	_command -	the command used to run the external
 #			program
 #
 #  Results:
 #
 #       Returns the process instance's token.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::constructor { _ptable _command } {
     set process [task::constructor ptable state channel command counter]
 
     set ptable	$_ptable
     set command $_command
     set state	"created"
     set counter 0
 
     ptable::register $ptable $process
     ptable::notify_process_event $ptable $process $state
     
     after 0 [namespace code "_run $process"]
     return $process
 }
 
 #PAGE
 # process::destructor --
 #
 #	Destroys an instance.
 #
 #  Arguments:
 # 
 #	process -	the instance's token
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::destructor { process } {
     task::global	$process ptable
 
     ptable::unregister $ptable $process
     ptable::notify_process_event $ptable $process "terminated"
     task::destructor $process
     return
 }
 
 #PAGE
 # process::_run --
 #
 #	Starts a new external program. This procedure is scheduled
 #	in the event loop every time a new external program must
 #	be launched.
 #
 #  Arguments:
 # 
 #	process -	the process instance's token
 #
 #  Results:
 #
 #	Executes the registered program opening a bidirectional
 #	pipe with it; a handler script is registered.
 #
 #	  The external program must signal its termination with
 #	an appropriate command, written through the pipe, to the
 #	protocol module: this will trigger the registered event
 #	handler, that will take care of the cleanup and will
 #	reschedule this procedure.
 #
 #         Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::_run { process } {
     task::global	$process state ptable command channel counter
 
     set channel [open |$command {RDWR}]
     fconfigure $channel -buffering none -blocking yes
     fileevent  $channel readable [namespace code "_handler $process"]
 
     set state "running"
     incr counter
 
     ptable::notify_process_event $ptable $process $state $counter
     return
 }
 
 #PAGE
 # process::signal_stop --
 #
 #	This procedure is invoked whenever this process must stop
 #	the sequence of executions.
 #
 #  Arguments:
 # 
 #	process -	the instance's token
 #
 #  Results:
 #
 #	The request is registered and will be served as soon as
 #	the running external program terminates.
 #
 #         Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::signal_stop { process } {
     task::global	$process ptable state
 
     if { [string equal $state "running"] } {
 	set state "stopping"
 	ptable::notify_process_event $ptable $process $state
     }
     return
 }
 
 #PAGE
 # process::signal_resume --
 #
 #	This procedure is  invoked whenever this process must resume
 #	the sequence of executions.
 #
 #  Arguments:
 # 
 #	process -	the instance's token
 #
 #  Results:
 #
 #	A script is scheduled in the event loop to resume the sequence
 #	of executions. Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::signal_resume { process } {
     task::global	$process ptable state
 
     if { [string equal $state "stopped"] } {
 	set state "resuming"
 	ptable::notify_process_event $ptable $process $state
 	after 0 [namespace code "_run $process"]
     }
     return
 }
 
 #PAGE
 # process::signal_termination --
 #
 #	This procedure is invoked whenever this process must terminate
 #	the sequence of executions.
 #
 #  Arguments:
 # 
 #	process -	the instance's token
 #
 #  Results:
 #
 #	The request is registered and will be served as soon as
 #	the running external program terminates.
 #
 #         Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::signal_termination { process } {
     task::global	$process ptable state
 
     if { [string equal $state "running"] } {
 	set state "terminating"
 	ptable::notify_process_event $ptable $process $state
     } else {
 	destructor $process
     }
     return
 }
 
 #PAGE
 # process::_handler --
 #
 #	This procedure is attached to the external program's pipe
 #	as event handler.
 #
 #  Arguments:
 # 
 #	process -	the process instance's token
 #
 #  Results:
 #
 #       Returns the empty string.
 #
 #  Error codes:
 #
 #       None.
 #
 #  Side effects:
 #
 #       None.
 #
 
 proc process::_handler { process } {
     task::global	$process channel state ptable
 
     set eof 0
     gets $channel line
     if { [eof $channel] } {
 	set eof 1
 	set state "terminating"
     }
 
     if { $eof || [protocol::talk $line] } {
 	close $channel
 
 	switch $state {
 	    running	{ after 0 [namespace code "_run $process"] }
 	    stopping	{
 		set state "stopped"
 		ptable::notify_process_event $ptable $process $state		
 	    }
 	    terminating	{ after 0 [namespace code "destructor $process"] }
 	}
     }
     return
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## Protocol module's namespace.
 ## ------------------------------------------------------------
 
 namespace eval protocol {}
 
 proc protocol::talk { line } {
     switch $line {
 	HELLO	{ return 0 }
 	QUIT	{ return 1 }
     }
     return 0
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## The task package.
 ## ------------------------------------------------------------
 
 namespace eval task {
     namespace export \[a-z\]*
     variable counter 0
     variable ns [namespace current]
     variable map
     array set map {}
     namespace eval tmp {}
 }
 
 proc task::constructor { args } {
     variable	counter
     variable	map
     variable	ns
 
     while { [info exists map([incr counter])] } {}
     set map([set token $counter]) {}
     foreach varname $args {
 	while { [info exists [set n ${ns}::tmp::[incr counter]]] } {}
 	uplevel [list upvar [set map($token:$varname) $n] $varname]
     }
     return $token
 }
 
 proc task::destructor { token } {
     variable	map
     foreach k [array names map $token:*] {
 	# Some variables  may be unexistent, only registered,  so we use
 	#"-nocomplain".
 	unset -nocomplain -- $map($k)
 	unset map($k)
     }
     unset map($token)
     return
 }
 
 proc task::global { token varname args } {
     variable	map
 
     uplevel [list upvar $map($token:$varname) $varname]
     foreach varname $args {
 	uplevel [list upvar $map($token:$varname) $varname]
     }
     return
 }
 
 proc task::globname { token varname } {
     variable	map
     return $map($token:$varname)
 }
 
 proc task::globset { token varname value } {
     variable	map
     set $map($token:$varname) $value
     return
 }
 
 proc task::globget { token varname } {
     variable	map
     return [set $map($token:$varname)]
 }
 
 #PAGE
 ## ------------------------------------------------------------
 ## Main script.
 ## ------------------------------------------------------------
 
 namespace eval script {
     namespace eval task		{ namespace import ::task::* }
     namespace eval gui		{ namespace import ::gui::* }
     namespace eval ptable	{ namespace import ::ptable::* }
 
     namespace eval command {
 	namespace eval task	{ namespace import ::task::* }
 	namespace eval process	{ namespace import ::process::* }
     }
 }
 
 namespace eval gui {
     namespace eval task		{ namespace import ::task::* }
     namespace eval script	{ namespace import ::script::* }
     
     namespace eval command {
 	namespace eval script	{ namespace import ::script::command::* }
     }
 }
 
 namespace eval ptable {
     namespace eval task		{ namespace import ::task::* }
     namespace eval process	{ namespace import ::process::* }
 }
 
 namespace eval process {
     namespace eval task		{ namespace import ::task::* }
     namespace eval ptable	{ namespace import ::ptable::* }
 }
 
 script::main $argc $argv
 
 
 ### end of file
 # Local Variables:
 # mode: tcl
 # page-delimiter: "^#PAGE"
 # End: