#!/bin/sh
# \
exec oagwish "$0" "$@"
set pemDebug 0

#
# $Log: not supported by cvs2svn $
# Revision 1.81  2010/10/29 18:18:33  soliday
# Added the Attic button which toggles the visability of the procedures
# that have been moved into the attic.
#
# Revision 1.80  2007/01/18 00:18:03  soliday
# Changed info hostname command to exec hostname command because of recent
# problems seen in the controlroom.
#
# Revision 1.79  2007/01/17 22:25:07  soliday
# Put the xhost command in a catch statement.
#
# Revision 1.78  2006/06/27 18:28:20  soliday
# Removed the Automatic execution mode selection from the main screen because
# it probably should never be used. It is still available from the Options
# pulldown menu.
#
# Revision 1.77  2006/01/26 19:15:44  sereno
# Modified to work around bug seen on linux machines.
#
# Revision 1.76  2004/05/26 19:09:04  soliday
# Found and removed problems related to the parsing of results created by the comm library.
#
# Revision 1.75  2004/05/24 20:28:02  soliday
# Started using comm libraries again.
#
# Revision 1.74  2004/05/24 18:40:25  soliday
# Went back to using the DP instead of the comm libraries because of problem
# I am trying to track down related to the comm libraries.
#
# Revision 1.73  2004/04/30 15:34:24  soliday
# Removed the option of using a remote execution host.
#
# Revision 1.72  2004/04/28 15:40:01  soliday
# Replaced dp_RPC calls with comm calls because comm is still supported by the
# Tcl community.
#
# Revision 1.71  2003/10/27 16:31:00  soliday
# Parallel processes now log the correct stack.
#
# Revision 1.70  2003/09/03 17:26:44  soliday
# Added package require dp command.
#
# Revision 1.69  2002/06/17 20:44:26  borland
# Now brings up the new pem error log review from the programs menu.
#
# Revision 1.68  2000/06/26 22:00:58  soliday
# Restricted procedures can now display there steps.
#
# Revision 1.67  2000/05/31 19:59:40  soliday
# There is now a security file that restricts access to specific users for
# the PEM procedures.
#
# Revision 1.66  2000/05/02 21:06:38  borland
# Now autoloads procedures if necessary for listing of steps.
#
# Revision 1.65  2000/03/18 16:38:50  borland
# Added "Programs" menu that allows invoking pem error log review script.
#
# Revision 1.64  1999/12/13 16:21:12  soliday
# Now displays the steps throughout a tree of procedures
#
# Revision 1.63  1999/12/10 20:21:26  soliday
# It now allows the operator to display the APSMpStep's from a procedure
#
# Revision 1.62  1999/10/01 14:18:38  soliday
# Modified the cursor for the new listbox
#
# Revision 1.61  1999/09/30 21:56:07  soliday
# Fixed bug from last change with the file open command
#
# Revision 1.60  1999/09/30 21:29:43  soliday
# The pemConfig files can now contain titles by prefixing the title with <TITLE>
#
# Revision 1.59  1999/05/13 15:34:40  soliday
# Fixed a bug when it tried to write to stdout after the xterm had been killed.
#
# Revision 1.58  1999/02/16 21:59:59  soliday
# Added ability to automatically start a procedure when the pem is started
#
# Revision 1.57  1999/01/20 18:08:38  soliday
# Fixed bug when two identical processes are run and the later one is
# aborted first.
#
# Revision 1.56  1999/01/20 17:37:47  soliday
# Added the ability to run identical procedures
#
# Revision 1.55  1998/11/19 18:49:07  soliday
# Replaced exec uname -n with info hostname.
#
# Revision 1.54  1998/11/10 21:11:11  borland
# Fixed problem with return value not getting set in multi-level parallel
# procedures.   I created some backup return variables that are set from
# the child process using dp_RPC.  Look at the end of runMP or in
# APSMpJoin for details.
#
# Revision 1.53  1998/11/10 16:07:49  borland
# Removed debugging statement.
#
# Revision 1.52  1998/11/06 22:36:14  borland
# Removed a debugging statement.  Fixed bug in abortMachineProcedure.
#
# Revision 1.51  1998/11/06 22:25:37  borland
# Fixed problems with interprocess communcation (?) that prevented proper
# abort and exit operation.
#
# Revision 1.50  1998/11/06 15:31:08  borland
# Improved the error message for the case where the abort button is
# pressed with nothing selected.
#
# Revision 1.49  1998/10/27 22:39:43  soliday
# Redesigned the packing and griding of the main window.  Fixed bug when
# cancel button is pressed on the file select dialog.
#
# Revision 1.48  1998/04/22 22:11:43  borland
# Now checks for existence of patch version of runMPserv.  Uses standard
# version if patch not found.
#
# Revision 1.47  1998/04/22 22:06:19  borland
# Made some interface improvements.  User can no longer select multiple
# procedures to execute or abort (doing so used to cause a cryptic
# error message to appear).
#
# Revision 1.46  1998/04/22 18:02:55  borland
# Now works with tcl 8.0 and dp 4.0
# Also added some debugging features.
#
# Revision 1.45  1996/12/17 23:12:03  saunders
# Modified to use localhost to circumvent current problems with inetd.
#
# Revision 1.44  1996/12/16 16:38:30  saunders
# Fixed race condition in abort sequence. Added info exists test in
# MpAbort for childPortToSd, since normal exit of child may unset this,
# but leave apsMpParallelList populated. Also added a debugging switch
# for future diagnosis work.
#
# Revision 1.43  1996/12/12 15:56:17  saunders
# Automate setting of xhost permissions as much as possible.
#
# Revision 1.42  1996/12/02 22:22:30  saunders
# Bug fix for procedures managing widget with list of currently running
# machine procedures. Also, user is not allowed to run more than one
# instance of the same procedure on the same host now.
#
# Revision 1.41  1996/10/17 21:20:57  saunders
# Numerous changes made to implement logDaemon logging of machine
# procedure execution Start,Finish,Error,Abort. Currently logs all
# pem and parallel procedures. More work needed to selectively log
# only call level 2 procedures (ie. only highest level).
#
# Revision 1.40  1996/09/25 16:29:12  saunders
# Added buttons to scrolled status widgets.
#
# Revision 1.39  1996/09/16 16:13:25  saunders
# Set up File/Quit button to do clean abort.
#
# Revision 1.38  1996/08/08 16:13:05  saunders
# Added "-safetyMode 1" option.
#
# Revision 1.37  1996/07/29 21:32:45  saunders
# Fixing yet another race condition raised by aborting a procedure
# which has outstanding parallel procedures.
#
# Revision 1.36  1996/07/29 20:50:53  saunders
# Moving abort functions in runMP from exit callback to a separate
# function called MpAbort. This to avoid some race conditions due
# to the order in which callback activity is scheduled.
#
# Revision 1.35  1996/07/29 20:35:50  saunders
# Abort button added to PEM which aborts selected procedure and any
# outstanding spawned parallel procedures.
#
# Revision 1.34  1996/07/02 21:48:52  saunders
# Minor fix in error trapping.
#
# Revision 1.33  1996/07/01 19:22:24  saunders
# Added error trapping for tcl errors in remote procedures.
#
# Revision 1.32  1996/06/27 19:34:22  saunders
# Pem now honors the APSDebugPath as well as pem cwd. Note that pem cwd
# does supersede any path additions via APSDebugPath.
#
# Revision 1.31  1996/06/24 21:52:06  saunders
# All stdout/stderr output from machine procedures is now funnelled
# through sockets back to the pem process and printed out.
#
# Revision 1.30  1996/06/24 17:25:55  saunders
# Yet another change in how I trap bad returns.
#
# Revision 1.29  1996/06/24 17:05:02  saunders
# Refined error return trapping further.
#
# Revision 1.28  1996/06/24 16:17:57  saunders
# Trap error that commonly occurs when user doesn't use APSMpReturn.
# Display useful error dialog when possible.
#
# Revision 1.27  1996/06/21 19:56:59  saunders
# Added "-pemConfig <filename>" command line option.
#
# Revision 1.26  1996/06/18 20:11:45  saunders
# Added APSMpParallel/APSMpJoin capability. Required a number of
# modifications to pem and related scripts.
#
# Revision 1.25  1996/06/13 15:21:20  saunders
# Fixed File menu problem. Fixed problem with DISPLAY var being :0.0
#
# Revision 1.24  1996/04/30 21:29:58  saunders
# Added lib_patch to auto_path of runMP.
#
# Revision 1.23  1996/03/04  21:13:36  saunders
# Added "semi-automatic" mode.
#
# Revision 1.22  1996/01/31  21:31:40  saunders
# Added host name to "currently executing procedures" window, and changed
# logic so that this entry is sure to clean up.
#
# Revision 1.21  1996/01/31  19:39:32  saunders
# Interface improvements. Arguments now passed to mp, and a dialog can
# be specified for prompting user at each mpStep.
#
# Revision 1.20  1996/01/30  00:05:15  saunders
# Added manual mode "continue", and "prompt" buttons.
#
# Revision 1.19  1996/01/29  23:06:49  saunders
# Assorted changes
#
# Revision 1.18  1996/01/29  21:29:44  saunders
# Now default args can be passed to machine procedure from pemConfig file.
#
# Revision 1.17  1996/01/29  19:11:56  saunders
# Adding argument handling.
#
# Revision 1.16  1996/01/29  17:27:01  saunders
# Minor status report format changes.
#
# Revision 1.15  1996/01/28  22:21:55  saunders
# Still don't full understand dp_CloseRPC.
#
# Revision 1.14  1996/01/28  22:03:12  saunders
# More sd stuff.
#
# Revision 1.13  1996/01/28  21:54:58  saunders
# Allow runMP to close down childSd.
#
# Revision 1.12  1996/01/28  21:51:40  saunders
# Add which executable is generating alert dialog (confusing).
#
# Revision 1.11  1996/01/28 21:34:27  saunders
# Added code which attempts to recover after IPC failure when possible.
#
# Revision 1.10  1996/01/28  03:14:26  saunders
# Added catch statements to all dp calls. Must look more into when
# I can clean up, and when I must exit completely.
#
# Revision 1.9  1996/01/25  23:23:19  saunders
# Fixed runMachineProcedure reentrancy problem by disabling Execute
# button until runMP process reports it is up. Also, I make a local
# copy of execHost to prevent midstream change to this from screwing
# pem up.
#
# Revision 1.8  1996/01/25  22:57:52  saunders
# Added unique number to uniquely identify open socket descriptor when
# async callback occurs. This should fix interleaving problem when
# multiple instances of one procedure are rapidly executed.
#
# Revision 1.7  1996/01/25  21:15:14  saunders
# Improved error checking and user messages when reading config file(s).
#
# Revision 1.6  1996/01/25  20:20:14  saunders
# Minor improvements.
#
# Revision 1.5  1996/01/25  20:06:32  saunders
# Reworked pemConfig file format. Added Open... to File menu.
#
# Revision 1.4  1996/01/25  16:43:09  saunders
# Small bug in passing cwd in context.
#
# Revision 1.3  1996/01/25  16:39:55  saunders
# Current working directory of PEM now passed in context to runMP.
#
#

set auto_path [linsert $auto_path 0 /usr/local/oag/apps/lib/$env(HOST_ARCH)]
set auto_path [linsert $auto_path 0  /usr/local/oag/lib_patch/$env(HOST_ARCH)]
set cwd [pwd]
set auto_path [linsert $auto_path 0 $cwd]
#APSDebugPath

# Initialize global vars

set execHostList {poseidon demo hera iris chiron pan echo herema}
set infoSuffix Info
set preSuffix Pre
set postSuffix Post
set procedureSelection ""
set abortSelection ""
set procArgs(-1) ""
set status "Initializing..."
set inetdPort 1605
set pemHost [exec hostname]
set execHost $pemHost
set prevExecHost $pemHost
set execMode "Semi-Automatic"
set execEnable "Enable"
set prevExecMode $execMode
set childPort -1
set childPortToSd($childPort) -1
set childPortToProcName($childPort) ""

# Initialize Command line options
set pemConfig $cwd/pemConfig
set safetyMode 0

# Process command line arguments
set args $argv
APSParseArguments {pemConfig safetyMode procedureSelection}
set pemConfigFile $pemConfig
if {$safetyMode} {
    set execEnable "Disable"
}

if {$tcl_platform(os) == "Linux"} {
    set xDisplay $env(DISPLAY)
} else {
    # Handle annoying case of DISPLAY with no host qualification, ie. :0.0
    if {![string compare [string index $env(DISPLAY) 0] ":"]} {
        set xDisplay ${pemHost}$env(DISPLAY)
    } else {
        set xDisplay $env(DISPLAY)
    }
}

# Check for APSDebugPath env variables.
if {[info exists env(OAG_DEBUG_PATH)]} {
    set debugPath $env(OAG_DEBUG_PATH)
} else {
    set debugPath ""
}
if {[info exists env(OAG_DEBUG_AUTO_PATH)]} {
    set debugAutoPath $env(OAG_DEBUG_AUTO_PATH)
} else {
    set debugAutoPath ""
}

if {![info exists env(useDP)]} {
    set env(useDP) 0
}
if {$env(useDP)} {
    package require dp
} else {
    if {[info exists tcl_pkgPath]} {
        set snitFile [file join [lindex $tcl_pkgPath 0] tcllib1.18 snit snit2.tcl]
        if {($tcl_platform(os) == "Linux") && [file exists $snitFile]} {
            source $snitFile
        } else {
            package require snit
        }
    } else {
        package require snit
    }
    if {[info exists tcl_pkgPath]} {
        set commFile [file join [lindex $tcl_pkgPath 0] tcllib1.18 comm comm.tcl]
        if {($tcl_platform(os) == "Linux") && [file exists $commFile]} {
            source $commFile
        } else {
            package require comm
        }
    } else {
        package require comm
    }
}

# Make our process capable of receiving RPC calls from runMP processes.
proc TestPort {} {
}
if {$env(useDP)} {
    if {[catch {dp_MakeRPCServer} result]} {
        APSAlertBox .ipcFail -errorMessage "pem: dp_MakeRPCServer call failed: $result"
        exit
    } else {
        if {$tcl_version<8.0} {
            set pemServerPort $result
        } else {
            set pemServerPort [fconfigure  $result -myport]
        }
    }
} else {
    set pemServerPort [::comm::comm self]
    ::comm::comm config -local 0
    #Try to connect to self to check that the port works.
    for {set i 0} {$i < 1000} {incr i} {
        if {[catch {::comm::comm send "$pemServerPort $pemHost" TestPort} result]} {
            incr pemServerPort
            ::comm::comm config -port $pemServerPort
            continue
        }
        break
    }
}
if {$pemDebug} {
    puts stderr "pemServerPort: $pemServerPort"
}

#
# childUp is executed by runMP process to notify us it is ready to 
# have a machine procedure executed in its context. Our 
# runMachineProcedure blocks until this var is set.
#
proc childUp {childServerPort} {
    global childPort
    set childPort $childServerPort
}

#
# childExit is executed by runMP process to notify us it is just
# about to exit. This allows us to free up connection resources.
#
proc childExit {childServerPort childHost childId} {
    global childPortToSd childPortToProcName
    global status current env
    set childPort $childServerPort
    set childSd $childPortToSd($childHost:$childPort:$childId)
    set childProcName $childPortToProcName($childHost:$childPort:$childId)
    unset childPortToSd($childHost:$childPort:$childId)
    unset childPortToProcName($childHost:$childPort:$childId)

    if {$env(useDP)} {
        if {[catch {dp_CloseRPC $childSd} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: dp_CloseRPC call failed in childExit: $result"
        }
    } else {
        if {[catch {::comm::comm shutdown $childSd} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: comm shutdown call failed in childExit: $result"
        }
    }
    set status "$childProcName: End"
    deleteCurrent $current "$childProcName on host $childHost" $childSd
}

# 
# childErrorCallback is executed asynchronously when the runMP process
# executing a particular machine procedure has encountered a tcl error
# that would normally abort a procedure. This callback receives the
# internal error message.
#
proc childErrorCallback {childSd procName errorMessage} {
    global status env
    APSAlertBox .rpcFail -errorMessage "Tcl error in $procName: $errorMessage"

    if {$env(useDP)} {
        if {[catch {dp_RPC $childSd set exitFlag 1} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: dp_RPC call in childErrorCallback failed: $result"
        }
    } else {
        if {[catch {::comm::comm send $childSd [list set exitFlag 1]} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: comm send call in childErrorCallback failed: $result"
        }
    }
    set status "$procName tcl error: $errorMessage"
}

#
# childResultCallback is executed asynchronously when the runMP process
# executing a particular machine procedure has returned. Here we get
# the returned results, and tell the runMP process to exit.
#
proc childResultCallback {args} {
    global childPortToSd childPortToProcName
    global status env
    
    if {$env(useDP)} {
        set result $args
    } else {
        set id ""
        set serial ""
        set chan ""
        set code ""
        set errorcode ""
        set errorinfo ""
        set result ""
#        APSStrictParseArguments {id serial chan code errorcode errorinfo result}
        APSParseArguments {id serial chan code errorcode result}
        if {$code == "error"} {
            childErrorCallback $id "PEM" $result
        }
        if {($code == -1) && (($result == "Connection shutdown by request") || ($result == "target application died or connection lost"))} {
            return
        }
        if {[catch {llength $result} resultlength]} {
            return
        }
    }
    set childPort [lindex $result 0]
    set childHost [lindex $result 1]
    set childId   [lindex $result 2]
    update
    # Trap error that commonly occurs when user doesn't use APSMpReturn
    #   in their machine procedure. Display dialog.
    if {![info exists childPortToSd($childHost:$childPort:$childId)]} {
        bell
        APSAlertBox .noReturn -errorMessage "Your machine procedure probably did not return correctly. You must use APSMpReturn, not the tcl return statement. APSMpReturn must also be the last executed statement of your procedure, even if you return nothing."
        set returnCode ""
        set returnData ""
        set status "Probable incorrect return from procedure."
        return
    }
    
    set childSd $childPortToSd($childHost:$childPort:$childId)
    set childProcName $childPortToProcName($childHost:$childPort:$childId)
    set returnCode [lindex $result 3]
    set returnData [lindex $result 4]
    if {$env(useDP)} {
        if {[catch {dp_RPC $childSd set exitFlag 1} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: dp_RPC call failed: $result"
        }
    } else {
        if {[catch {::comm::comm send $childSd [list set exitFlag 1]} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: comm send call failed: $result"
        }
    }
    set status "$childProcName: Completion status $returnCode"
}

#
# Permits selection of a host computer on which machine procedures are
# to be executed. Note that xhost permissions may not permit
# use of certain hosts.
#
proc hostDialog {} {
    global execHostList
    if {![winfo exists .hostDialog]} {
	APSDialogBox .hostDialog -name "PEM: Execution Host" -contextHelp \
            "For selection of a host computer for procedure execution."
	.hostDialog.buttonRow.cancel.button configure -command {
	    set execHost $prevExecHost
	    destroy .hostDialog
	}
	APSEnableButton .hostDialog.buttonRow.ok.button
	.hostDialog.buttonRow.ok.button configure -command {
	    set prevExecHost $execHost
	    destroy .hostDialog
	}
	APSRadioButtonFrame .hostrb -parent .hostDialog.userFrame -label \
            "Select Host for Execution" -variable execHost -buttonList \
            $execHostList -valueList \
            $execHostList -contextHelp \
            "Select which host you want your machine procedure to run on."
    } else {
	raise .hostDialog
    }
}

#
# Permits selection of execution mode for machine procedure. 
#
proc modeDialog {} {
    if {![winfo exists .modeDialog]} {
	APSDialogBox .modeDialog -name "PEM: Execution Mode" -contextHelp \
            "Allows selection of machine procedure execution mode."
	.modeDialog.buttonRow.cancel.button configure -command {
	    set execMode $prevExecMode
	    destroy .modeDialog
	}
	APSEnableButton .modeDialog.buttonRow.ok.button
	.modeDialog.buttonRow.ok.button configure -command {
	    set prevExecMode $execMode
	    destroy .modeDialog
	}
	APSRadioButtonFrame .hostrb -parent .modeDialog.userFrame -label \
            "Select Mode for Execution" -variable execMode -buttonList \
            {"Automatic" "Semi-Automatic" "Manual"} -valueList \
            {"Automatic" "Semi-Automatic" "Manual"} -contextHelp \
            "Select which mode you want your machine procedure to run in."
    } else {
	raise .modeDialog
    }
}


#
# Permits selection of a custom PEM configuration file
#
proc openDialog {} {
    global mpList env procListbox status mpWithTitlesList mpRestrictedList
    if {![winfo exists .openDialog]} {
	set fileName [APSFileSelectDialog .openDialog -listDir $env(HOME) \
                          -contextHelp "Select a PEM configuration file"]
	if {[string length $fileName]} {
            set procLists [sourceConfig $fileName]
            set mpList [lindex $procLists 0]
            set notFoundList [lindex $procLists 1]
            set mpWithTitlesList [lindex $procLists 2]
            set mpRestrictedList [lindex $procLists 3]
            if {[llength $mpList] == 0} {
                APSAlertBox .noConfig -errorMessage \
                    "PEM config file appears to be empty or not in auto_path."
                set status "PEM config file appears to be empty or not in auto_path. Try another."
            } else {
                $procListbox configure -state normal
                $procListbox delete 1.0 end
                set row 1
                set rowMax [llength $mpWithTitlesList]
                eval $procListbox tag delete [$procListbox tag names]
                foreach item $mpWithTitlesList {
                    if {[string range $item 0 6] == "<TITLE>"} {
                        set item [string range $item 7 end] 
                        if {$row == $rowMax} {
                            $procListbox insert end "$item"
                        } else {
                            $procListbox insert end "$item\n"
                        }
                        $procListbox tag add title$row $row.0 $row.end
                        $procListbox tag configure title$row -font {courier 12 bold} -foreground blue -underline true
                        $procListbox tag bind title$row <ButtonPress-1> [subst -nocommands {
                            procDescUpdate "" 0
                        }]
                        $procListbox tag bind title$row <Double-1> [subst -nocommands {
                            procDescUpdate "" 1
                        }]
                        $procListbox tag bind title$row <ButtonRelease-1> break
                        $procListbox tag bind title$row <Control-ButtonRelease-1> break
                        $procListbox tag bind title$row <Control-Button-1> break
                        $procListbox tag bind title$row <Shift-ButtonRelease-1> break
                        $procListbox tag bind title$row <Shift-Button-1> break
                        $procListbox tag bind title$row <Enter> "$procListbox configure -cursor X_cursor"
                        $procListbox tag bind title$row <Leave> "$procListbox configure -cursor {}"
                    } else {
                        if {$row == $rowMax} {
                            $procListbox insert end "$item"
                        } else {
                            $procListbox insert end "$item\n"
                        }
                        if {[lsearch -exact $mpRestrictedList $item] != -1} {
                            $procListbox tag add restricted$row $row.0 $row.end
                            $procListbox tag configure restricted$row -foreground \#888888
                            $procListbox tag bind restricted$row <ButtonPress-1> [subst -nocommands {
                                procDescUpdate "" 0
                            }]
                            $procListbox tag bind restricted$row <Double-1> [subst -nocommands {
                                procDescUpdate "" 1
                            }]
                            $procListbox tag bind restricted$row <ButtonRelease-1> break
                            $procListbox tag bind restricted$row <Enter> "$procListbox configure -cursor X_cursor"
                            $procListbox tag bind restricted$row <Leave> "$procListbox configure -cursor {}"
                            $procListbox tag bind restricted$row <Control-ButtonRelease-1> break
                            $procListbox tag bind restricted$row <Control-Button-1> break
                            $procListbox tag bind restricted$row <Shift-ButtonRelease-1> break
                            $procListbox tag bind restricted$row <Shift-Button-1> break
                        } else {
                            $procListbox tag add proc$row $row.0 $row.end
                            $procListbox tag bind proc$row <ButtonPress-1> [subst -nocommands {
                                procDescUpdate [$procListbox get proc$row.first proc$row.last] 0
                            }]
                            $procListbox tag bind proc$row <Double-1> [subst -nocommands {
                                procDescUpdate [$procListbox get proc$row.first proc$row.last] 1
                            }]
                            $procListbox tag bind proc$row <ButtonRelease-1> "eval $procListbox tag add sel [$procListbox tag ranges proc$row]"
                            $procListbox tag bind proc$row <Control-ButtonRelease-1> break
                            $procListbox tag bind proc$row <Control-Button-1> break
                            $procListbox tag bind proc$row <Shift-ButtonRelease-1> break
                            $procListbox tag bind proc$row <Shift-Button-1> break
                        }
                    }
                    incr row
                }
                $procListbox configure -state disabled




                #	    $procListbox delete 0 end
                #####	    eval $procListbox insert end $mpList
                set status "Click on Procedure to get information."
            }
            # Alert user to machine procedures not found in current auto_path.
            if {[llength $notFoundList] > 0} {
                APSAlertBox .unresolvedProcs -errorMessage \
                    "Warning: The following procedures were not found in auto_path: $notFoundList"
                set status "Warning: some procedures in config file not resolved."
            }
	}
    } else {
	raise .openDialog
    }
}

#
# Reads given PEM configuration file and attempts to resolve the given
# procedure names using "auto_load". Two lists are returned: First list 
# contains procedures found in auto_path, second list contains unresolved.
#
proc sourceConfig {fileName} {
    global procArgs apsScriptUser
    set filempList {}	
    set mpList {}
    set notFoundList {}
    set mpWithTitlesList {}
    set mpRestrictedList {}
    if {[file exists $fileName] && [file readable $fileName] && \
            [file isfile $fileName]} {
	set fp [open $fileName r]
	while {[gets $fp line] >= 0} {
	    if {[string length $line] > 0} {
		regexp "\[ \t\]*(\[^ \t\]*)\[ \t\]*(.*)" $line \
                    match procName args
		if {$procName != ""} {
		    lappend filempList [string trim $procName]
		    set fileArgs($procName) $args
		}
	    }
	}
	close $fp
	if {[catch {sdds load /home/helios/oagData/pem/security.sdds security} results]} {
	    APSSetVarAndUpdate status "Unable to load /home/helios/oagData/pem/security.sdds"
	    APSSetVarAndUpdate status "$results"
	    set security(Parameter.Procedure) ""
	    set security(Column.Users) ""
	}
	# Source the procedures given by mpList
	foreach mp $filempList {
	    if {[string range $mp 0 6] == "<TITLE>"} {
		lappend mpWithTitlesList $mp
	    } elseif {[auto_load $mp]} {
		set index [lsearch -exact $security(Parameter.Procedure) $mp]
		if {$index != -1} {
		    if {[lsearch -exact [lindex $security(Column.Users) $index] $apsScriptUser] == -1} {
			lappend mpRestrictedList $mp
		    }
		}
		lappend mpList $mp
		lappend mpWithTitlesList $mp
		set procArgs($mp) $fileArgs($mp)
	    } else {
		lappend notFoundList $mp
	    }
	    
	}	
    }
    return [list $mpList $notFoundList $mpWithTitlesList $mpRestrictedList]
}


proc APSScrolledListWithTitles { widget args } {
    global apsContextHelp
    set parent ""
    set noPack 0
    set packOption "-side top -fill both -expand 1"
    set name "Scroll Text"
    set height 15
    set callback ""
    set itemList ""
    set restrictedList ""
    set contextHelp ""
    set selectMode extended
    set width 20
    APSStrictParseArguments {parent noPack packOption height name  callback itemList contextHelp selectMode width restrictedList}
    global attic

    if {$contextHelp != ""} {
	set apsContextHelp($parent$widget) $contextHelp
    }
    if {$parent == ""} {
	toplevel $widget -bd 2
	wm title $widget $name
    } else {
	frame $parent$widget -bd 2 -relief ridge
	if {!$noPack} {
	    eval pack $parent$widget $packOption
	}
    }

    text $parent$widget.listbox  -height $height -width $width  -bd 1 -relief raised -setgrid 1 -exportselection 0  -yscrollcommand "$parent$widget.scroll set" -cursor ""
    scrollbar $parent$widget.scroll  -command "$parent$widget.listbox yview"
    pack $parent$widget.scroll -side right -fill y
    pack $parent$widget.listbox -side left -fill both -expand 1

    # Set listbox width so that longest item fits
    set maxWidth $width
    foreach item $itemList {
	set itemWidth [string length $item]
	if {$itemWidth > $maxWidth} {
	    set maxWidth $itemWidth
	}
    }
    $parent$widget.listbox configure -width $maxWidth

    $parent$widget.listbox configure -state normal
    $parent$widget.listbox delete 1.0 end
    bind $parent$widget.listbox <Motion> break
    bind $parent$widget.listbox <Shift-ButtonRelease-1> break
    bind $parent$widget.listbox <Shift-Button-1> break
    set row 1
    set rowMax [llength $itemList]
    set atticSection 0
    foreach item $itemList {
	if {[string range $item 0 6] == "<TITLE>"} {
            if {[string range $item 0 12] == "<TITLE>Attic_"} {
                set atticSection 1
                if {$attic == 0} { continue }
                set item [string range $item 13 end] 
            } else {
                set atticSection 0
                if {$attic == 1} { continue }
                set item [string range $item 7 end] 
            }
	    if {$row == $rowMax} {
		$parent$widget.listbox insert end "$item"
	    } else {
		$parent$widget.listbox insert end "$item\n"
	    }
	    $parent$widget.listbox tag add title$row $row.0 $row.end
	    $parent$widget.listbox tag configure title$row -font {courier 12 bold} -foreground blue -underline true
	    if {$callback != ""} {
		$parent$widget.listbox tag bind title$row <ButtonPress-1> [subst -nocommands {
		    $callback "" 3
		}]
		$parent$widget.listbox tag bind title$row <Double-1> [subst -nocommands {
		    $callback "" 1
		}]
		$parent$widget.listbox tag bind title$row <ButtonRelease-1> break
		$parent$widget.listbox tag bind title$row <Control-ButtonRelease-1> break
		$parent$widget.listbox tag bind title$row <Control-Button-1> break
		$parent$widget.listbox tag bind title$row <Shift-ButtonRelease-1> break
		$parent$widget.listbox tag bind title$row <Shift-Button-1> break
		$parent$widget.listbox tag bind title$row <Enter> "$parent$widget.listbox configure -cursor X_cursor"
		$parent$widget.listbox tag bind title$row <Leave> "$parent$widget.listbox configure -cursor {}"
	    }
	} else {
            if {($attic == 0) && ($atticSection == 1)} { continue }
            if {($attic == 1) && ($atticSection == 0)} { continue }
	    if {$row == $rowMax} {
		$parent$widget.listbox insert end "$item"
	    } else {
		$parent$widget.listbox insert end "$item\n"
	    }
	    if {[lsearch -exact $restrictedList $item] != -1} {
		$parent$widget.listbox tag add restricted$row $row.0 $row.end
		$parent$widget.listbox tag configure restricted$row -foreground \#888888
		if {$callback != ""} {
		    $parent$widget.listbox tag bind restricted$row <ButtonPress-1> [subst -nocommands {
			$callback [$parent$widget.listbox get restricted$row.first restricted$row.last] 2
		    }]
		    $parent$widget.listbox tag bind restricted$row <Double-1> [subst -nocommands {
			$callback "" 1
		    }]
		    $parent$widget.listbox tag bind restricted$row <ButtonRelease-1> break
		    $parent$widget.listbox tag bind restricted$row <Enter> "$parent$widget.listbox configure -cursor X_cursor"
		    $parent$widget.listbox tag bind restricted$row <Leave> "$parent$widget.listbox configure -cursor {}"
		    $parent$widget.listbox tag bind restricted$row <Control-ButtonRelease-1> break
		    $parent$widget.listbox tag bind restricted$row <Control-Button-1> break
		    $parent$widget.listbox tag bind restricted$row <Shift-ButtonRelease-1> break
		    $parent$widget.listbox tag bind restricted$row <Shift-Button-1> break
		}
	    } else {
		$parent$widget.listbox tag add proc$row $row.0 $row.end
		if {$callback != ""} {
		    $parent$widget.listbox tag bind proc$row <ButtonPress-1> [subst -nocommands {
			$callback [$parent$widget.listbox get proc$row.first proc$row.last] 0
		    }]
		    $parent$widget.listbox tag bind proc$row <Double-1> [subst -nocommands {
			$callback [$parent$widget.listbox get proc$row.first proc$row.last] 1
		    }]
		    $parent$widget.listbox tag bind proc$row <ButtonRelease-1> "eval $parent$widget.listbox tag add sel [$parent$widget.listbox tag ranges proc$row]"
		    $parent$widget.listbox tag bind proc$row <Control-ButtonRelease-1> break
		    $parent$widget.listbox tag bind proc$row <Control-Button-1> break
		    $parent$widget.listbox tag bind proc$row <Shift-ButtonRelease-1> break
		    $parent$widget.listbox tag bind proc$row <Shift-Button-1> break
		}
	    }
	}
	incr row
    }
    $parent$widget.listbox configure -state disabled

}

proc ListSteps {procName depth} {
    # Find the help procs
    if {![llength $procName]} {
	global restrictedProcName
	set procName $restrictedProcName
    }
    set procs [info procs $procName]
    if {[llength $procs] == 0} {
        catch {auto_load $procName}
        set procs [info procs $procName]
        if {[llength $procs] == 0} {
            APSSetVarAndUpdate status "No procedure selected ($procName)"
            return
        }
    }
    set body [split [info body $procs] \n]
    global desc
    if {$depth == 0} {
	$desc config -state normal
	$desc delete 1.0 end
    }
    set step 1
    set marker ""
    for {set i 0} {$i < $depth} {incr i} {
	append marker +
    } 
    foreach line $body {
	if {[catch {llength $line} length]} {
	    continue
	}
	lindex $line 0
	if {($length > 1) && ([lindex $line 0] == "APSMpStep")} {
	    set descIndex [lsearch -exact $line -desc]
	    if {$descIndex != -1} {
		incr descIndex
		$desc insert end "${marker}${step}. [lindex $line $descIndex]\n"
		incr step
	    } elseif {([lindex $line 1] != "init")} {
		$desc insert end "${marker}${step}. [lindex $line 1]\n"
		incr step
	    }
	    set procIndex [lsearch -exact $line -proc]
	    if {$procIndex != -1} {
		incr procIndex
		set name [lindex $line $procIndex]		
		if {[llength $name] == 1} {
		    ListSteps $name [expr {$depth + 1}]
		}
	    }
	}
    }
    if {$depth == 0} {
	$desc config -state normal
    }
    return
}

proc PrintDesc {} {
    global desc
    if {[llength [$desc get 1.0 end]]} {
	APSPrint -textWidget $desc -cmd lpr
	APSSetVarAndUpdate status "Printing description"
    }
}

#
# Set up graphical interface for PEM
#
APSApplication . -name "Procedure Execution Manager (PEM)" -version 1.0 \
    -overview "Coordinates execution of multiple machine procedures across multiple host machines." \
    -contextHelp "Coordinates execution of machine procedures."

# Add Open... entry to File menu
.menu.file.menu insert 1 command -label "Open..." -command openDialog

APSMenubarAddMenu .options -parent .menu -text Options
#.menu.options.menu add command -label "Execution Host..." -command hostDialog
.menu.options.menu add command -label "Automatic/Manual..." -command modeDialog

APSMenubarAddMenu .programs -parent .menu -text Programs
.menu.programs.menu add command -label "Review Error Log..." -command {exec PEMErrorLogReview -log scriptAction &}

APSScrolledStatus .ss -parent .userFrame -textVariable status \
    -packOption "-side top -fill x" -height 8 -withButtons 1\
    -contextHelp "Provides execution status and operation hints." -noPack 1
grid .userFrame.ss -column 0 -row 0 -columnspan 2 -sticky ew

set procLists [sourceConfig $pemConfigFile]
set mpList [lindex $procLists 0]
set notFoundList [lindex $procLists 1]
set mpWithTitlesList [lindex $procLists 2]
set mpRestrictedList [lindex $procLists 3]

label .userFrame.mp -text "Machine Procedures"
grid .userFrame.mp -column 0 -row 1 -sticky w -padx 7
label .userFrame.de -text "Description"
grid .userFrame.de -column 1 -row 1
label .userFrame.ce -text "Currently Executing Procedures"
grid .userFrame.ce -column 1 -row 3

frame .userFrame.atticFrame
grid .userFrame.atticFrame -column 0 -row 1 -sticky e
APSButton .attic -parent .userFrame.atticFrame -gridPack "-column 0 -row 0" -text "Attic" -size small -command {ToggleAttic}

frame .userFrame.stepsFrame
grid .userFrame.stepsFrame -column 1 -row 1 -sticky e
APSButton .steps -parent .userFrame.stepsFrame -gridPack "-column 0 -row 0" -text "Steps" -size small -command {ListSteps $procedureSelection 0}
APSButton .printSteps -parent .userFrame.stepsFrame -gridPack "-column 1 -row 0" -text "Print" -size small -command {PrintDesc}

set attic 0
proc ToggleAttic {args} {
    destroy .userFrame.procList
    global mpWithTitlesList mpRestrictedList attic
    set attic [expr !$attic]
    APSScrolledListWithTitles .procList -parent .userFrame \
      -name Procedures -itemList $mpWithTitlesList -restrictedList $mpRestrictedList \
      -callback procDescUpdate -height 27 \
      -contextHelp "Select a machine procedure for execution." \
      -selectMode single -noPack 1
    grid .userFrame.procList -column 0 -row 2 -rowspan 3 -sticky nsew -padx .05i
    if {$attic} {
        .userFrame.atticFrame.attic.button configure -text Normal
    } else {
        .userFrame.atticFrame.attic.button configure -text Attic
    }
}

APSScrolledListWithTitles .procList -parent .userFrame \
    -name Procedures -itemList $mpWithTitlesList -restrictedList $mpRestrictedList \
    -callback procDescUpdate -height 27 \
    -contextHelp "Select a machine procedure for execution." \
    -selectMode single -noPack 1
grid .userFrame.procList -column 0 -row 2 -rowspan 3 -sticky nsew -padx .05i

set procListbox .userFrame.procList.listbox

APSScrolledText .procText -parent .userFrame -noPack 1 \
    -contextHelp "Provides description of selected machine procedure."
grid .userFrame.procText -column 1 -row 2 -sticky nsew -padx .05i
set desc .userFrame.procText.text

APSScrolledList .currentProcs -parent .userFrame -height 12 \
    -callback currentProcCallback -noPack 1 \
    -contextHelp "Shows currently executing machine procedures. Select from this list for abort function." \
    -selectMode single
grid .userFrame.currentProcs -column 1 -row 4 -sticky nsew -padx .05i
set current .userFrame.currentProcs.listbox
$current configure -width 40
APSRepack $current

frame .userFrame.bfg
grid .userFrame.bfg -column 0 -row 5 -columnspan 2 -sticky ew -pady .02i
grid columnconfigure .userFrame 0 -weight 1
grid columnconfigure .userFrame 1 -weight 1
grid rowconfigure .userFrame 2 -weight 1
grid rowconfigure .userFrame 4 -weight 1


APSButton .execute -parent .userFrame.bfg -text "Execute..." \
    -packOption "-side left -padx 8" -highlight 1 \
    -command {runMachineProcedure $procedureSelection} \
    -contextHelp "Executes the selected machine procedure." \
    -noPack 1
grid .userFrame.bfg.execute -column 0 -row 0 -sticky w -padx .04i -pady .01i
set executeButton .userFrame.bfg.execute.button
set rowIndex 0
if {$safetyMode} {
    APSDisableButton $executeButton
    proc execEnableProc {} {
	global executeButton
	after 10000 { 
	    set execEnable "Disable"
	    APSDisableButton $executeButton
	}
	APSEnableButton $executeButton
    }
    proc execDisableProc {} {
	global executeButton
	APSDisableButton $executeButton
    }
    APSRadioButtonFrame .execEnable -parent .userFrame.bfg \
        -variable execEnable -orientation horizontal -label " Execute Button:" \
        -buttonList {Enable Disable} -valueList {Enable Disable} \
        -contextHelp "Enables Execute button, one procedure at a time." \
        -commandList {execEnableProc execDisableProc} -noPack 1
    grid .userFrame.bfg.execEnable -column 1 -row $rowIndex -sticky w -padx .04i -pady .01i
    incr rowIndex
}

APSRadioButtonFrame .execMode -parent .userFrame.bfg -label \
    " Execution Mode:" -variable execMode -buttonList \
    {Semi-Automatic Manual} \
    -orientation horizontal -valueList {Semi-Automatic Manual} \
    -noPack 1 -contextHelp \
    "Specified execution mode for selected machine procedure." 
grid .userFrame.bfg.execMode -column 1 -row $rowIndex -sticky w -padx .04i -pady .01i
incr rowIndex

APSButton .abort -parent .userFrame.bfg -text "  Abort   " \
    -packOption "-side left -padx 8" \
    -command {abortMachineProcedure} -noPack 1 \
    -contextHelp "Aborts the machine procedure selected in the \"Currently Executing\" window."
grid .userFrame.bfg.abort -column 0 -row 1 -sticky w -padx .04i -pady .01i
set abortButton .userFrame.bfg.abort.button

APSLabeledEntryFrame .abortSelection -parent .userFrame.bfg \
    -label "Abort Selection:" -orientation horizontal -variableList \
    {abortSelection} -contextHelp "Shows name of machine procedure selected to be aborted. Click on \"Currently Executing\" window to select one." \
    -width 38 -noPack 1
grid .userFrame.bfg.abortSelection -column 1 -row $rowIndex -sticky w -padx .04i -pady .01i
grid columnconfigure .userFrame.bfg 1 -weight 1

tkwait visibility .userFrame.bfg.abortSelection

# Alert user to machine procedures not found in current auto_path.
if {[llength $notFoundList] > 0} {
    APSAlertBox .unresolvedProcs -errorMessage \
        "Warning: The following procedures were not found in auto_path: $notFoundList"
    set status "Warning: some procedures in config file not resolved."
} elseif {[llength $mpList] == 0} {
    APSAlertBox .noConfig -errorMessage \
        "PEM configuration file not found, or it is empty. Please use File menu to select a configuration file."
    set status "No PEM config file found. Use File menu to open one."
} else {
    set status "Click on Procedure to get information."
}

#
# Executes a machine procedure by starting a runMP process. It waits
# until the runMP process indicates it has initialized completely.
# A connection is then established with the process, and the machine
# procedure is scheduled to be run (ie. dp_RDO returns immediately)
# The callback "childResultCallback" is executed upon completion
# of the machine procedure, and/or the "childExit" callback is
# invoked.
#
proc runMachineProcedure {procName} {
    global status childPort pemServerPort execHost pemHost execMode
    global childPortToSd childPortToProcName inetdPort env cwd
    global executeButton procArgs current xDisplay debugPath debugAutoPath
    global safetyMode execEnable apsScriptUser
    global pemDebug env

    if {$procName == ""} {
	set status "Select a procedure first"
	return
    }

    # Prevent global change to this var from screwing us up in the middle.
    set myExecHost $execHost
    set identString "$procName on host $myExecHost"

    # Only allow one instance of a given procedure to be running on a host
    if {[findCurrent $current $identString] != -1} {
	bell
	set status "$procName is already running on $myExecHost"
	set runAnother [tk_messageBox -type yesno -default no \
			    -message "$procName is already running on $myExecHost\nRun another?" \
			    -icon question]
	switch -exact $runAnother {
	    no {
		return
	    } yes {}
	}
    }

    set execEnable "Disable"
    APSDisableButton $executeButton
    set status "$procName: Begin"

    # Add xhost permission automatically, if possible
    if {![string compare $pemHost [extractDisplayHost $xDisplay]]} {
	catch {exec xhost + $myExecHost}
    }
    if {$pemDebug} {
        set status "set xhost permission for host $pemHost"
        update
    }

    # Execute runMPserv as local process if pemHost==execHost. This
    #  is temporary until inetd problem is resolved.
    if {![string compare $pemHost $myExecHost]} {
	set localProcess 1
    } else {
        APSSetVarAndUpdate status "Only local execution hosts are supported"
        return
    }
    if {$pemDebug} {
        set status "set xhost permission"
        update
    }

    if {$pemDebug} {
        set status "running local process"
        update
    }
    set runMPservExec /usr/local/oag/bin_patch/$env(HOST_ARCH)/runMPserv
    if {![file exists $runMPservExec]} {
        set runMPservExec /usr/local/oag/apps/bin/$env(HOST_ARCH)/runMPserv
        if {![file exists $runMPservExec]} {
            set runMPservExec /lustre/oagsoftware/bin/runMPserv
            if {![file exists $runMPservExec]} {
                set runMPservExec runMPserv
            }
        }
    }
    if {[catch {open "|oagtclsh $runMPservExec" r+} result]} {
        APSAlertBox .ipcFail -errorMessage "pem: open runMPserv failed: $result\n  Aborting machine procedure!"
        set status "open runMPserv failed, aborting machine procedure."
        if {!$safetyMode} {
            set execEnable "Enable"
            APSEnableButton $executeButton	
        }
        return
    } else {
        set runMPSd $result
        if {$pemDebug} {
            set status "runMPSd is $result"
            update
        }
    }

    # Capture stdout/stderr of runMP process and put on our stdout.
    fileevent $runMPSd readable [list processMpOutput $runMPSd]
    if {$pemDebug} {
        set status "fileevent set up"
        update
    }
    set geometry [winfo geometry .]

    if {[catch {puts $runMPSd "$pemServerPort~$pemHost~$xDisplay~1~$debugPath~$debugAutoPath~$apsScriptUser~$geometry~\n"} result]} {
        APSAlertBox .ipcFail -errorMessage "pem: puts runMPSd failed: $result\n   Aborting machine procedure!"
        set status "puts runMPSd failed, aborting machine procedure."
        close $runMPSd
        if {!$safetyMode} {
            set execEnable "Enable"
            APSEnableButton $executeButton	
        }
        return
    }
    flush $runMPSd

    if {$pemDebug} {
        set status "waiting for process to start"
        update
    }
    # Wait until runMP process has started up (it sets childPort with RPC call)
    tkwait variable childPort

    # For now, this will be closed by fileevent handler instead.
    #  close $runMPSd
    if {!$safetyMode} {
	set execEnable "Enable"
	APSEnableButton $executeButton
    }

    # Establish RPC connection with runMP process
    if {$env(useDP)} {
        if {[catch {dp_MakeRPCClient $myExecHost $childPort} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: dp_MakeRPCClient call failed: $result\n   Aborting machine procedure!"
            set status "dp_MakeRPCClient call failed, aborting machine procedure."
            return
        } else {
            set childSd $result
        }
    } else {
        set childSd "$childPort $myExecHost"
    }
    if {$pemDebug} {
        set status "connection established with process"
        update
    }

    # We first must save the socket descriptor for this particular runMP
    # instance. I use $execHost, $childPort, and a unique number to 
    # identify it. Technically, a unique number would suffice, but the
    # host and port info is better for debugging.
    #
    # When machine procedure completes and invokes our childResultCallback,
    # we index the associated socket descriptor using host, port, and id.
    #
    set id [APSUniqueNumber]
    set childPortToSd($myExecHost:$childPort:$id) $childSd
    set childPortToProcName($myExecHost:$childPort:$id) $procName
    
    # Set up execution context in runMP interpreter
    set context [list \
                     [list childId $id] \
                     [list childSdFP $childSd] \
                     [list childPortFP $childPort] \
                     [list execMode $execMode] \
                     [list cwd $cwd] \
                     [list invokedBy pem] \
                     [list procName $procName]]

    if {$env(useDP)} {
        if {[catch {dp_RPC $childSd configMP $procName $context} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: dp_RPC call failed: $result\n   Aborting machine procedure!"
            set status "dp_RPC call failed, aborting machine procedure."
            unset childPortToSd($myExecHost:$childPort:$id) $childSd
            unset childPortToProcName($myExecHost:$childPort:$id) $procName
            dp_CloseRPC $childSd
            return
        }
    } else {
        if {[catch {::comm::comm send $childSd [list configMP $procName $context]} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: comm send call failed: $result\n   Aborting machine procedure!"
            set status "comm send call failed, aborting machine procedure."
            unset childPortToSd($myExecHost:$childPort:$id) $childSd
            unset childPortToProcName($myExecHost:$childPort:$id) $procName
            ::comm::comm shutdown $childSd
            return
        }
    }
    
    # Execute MP asynchronously. Callback on completion.
    if {$env(useDP)} {
        set errorCb [list childErrorCallback $childSd $procName]
        set mpCmd [list dp_RDO $childSd -callback childResultCallback -onerror $errorCb $procName]
        if {[catch {eval $mpCmd $procArgs($procName)} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: dp_RDO call failed: $result\n   Machine procedure may or may not be executed."
            set status "dp_RDO call failed, machine procedure may or may not be executed."
        }
    } else {
        set mpCmd "::comm::comm send -command childResultCallback \"$childSd\" $procName"
        if {[catch {eval $mpCmd $procArgs($procName)} result]} {
            APSAlertBox .ipcFail -errorMessage "pem: comm send call failed: $result\n   Machine procedure may or may not be executed."
            set status "comm send call failed, machine procedure may or may not be executed."
        }
    }
    addCurrent $current $identString $myExecHost:$childPort:$id
}

#
# This fileevent callback handler is attached to the pem side of the
#   socket connection which is used to initially contact inetd and 
#   fire up a runMP process. Since inetd copies the sd to the runMP 
#   process' stdin/stdout/stderr, any time a machine procedure writes
#   to stdout or stderr, the bytes will appear here and invoke this
#   handler. As such, output from multiple outstanding machine 
#   procedures will probably be arbitrarily interleaved on a line
#   by line basis on pem's stdout.
#
proc processMpOutput {sd} {
    if {[eof $sd]} {
	catch {close $sd}
	return
    }
    gets $sd line
    if {[string length $line] > 0} {
        catch {puts stdout $line}
    }
}

proc procExists {name} {
    if {[info procs $name] == ""} {
	return 0
    } else {
	return 1
    }
}

proc abortMachineProcedure {} {
    global abortSelection current currentSdList status env

    if {[string length $abortSelection] == 0} {
	bell
	set status "You must select a procedure to abort first!  Select one from the list of \"currently executing procedures\"."
	return
    }

    set indx [$current curselection]
    if {[catch {set childSd $currentSdList($indx)} result]} {
        set status "You must select a procedure to abort first!  Select one from the list of \"currently executing procedures\"."
        return
    }
    if {$env(useDP)} {
        if {[catch {dp_RDO $childSd MpAbort pem} result]} {
            APSAlertBox .abortFail -errorMessage "pem: dp_RDO call failed during abort $childSd: $result"
            set status "dp_RDO call failed during abort"
            return
        }
    } else {
        if {[catch {::comm::comm send $childSd [list MpAbort pem]} result]} {
        }
    }
}

proc procDescUpdate {item dc} {
    global infoSuffix
    global desc
    global procedureSelection status
    # Single click
    if {$dc == 0} {
	set infoProc $item$infoSuffix
	set infoExists [procExists $infoProc]

	$desc config -state normal
	$desc delete 1.0 end
	
	# Load up description text widget
	if {$infoExists} {
	    set info [$infoProc]
	    $desc insert end $info\n
	} else {
	    $desc insert end "No information given\n"
	}
        
	$desc config -state disabled
	set procedureSelection $item
	set status "Press Execute to run."
    } elseif {$dc == 2} {
	set infoProc $item$infoSuffix
	set infoExists [procExists $infoProc]

	$desc config -state normal
	$desc delete 1.0 end
	
	# Load up description text widget
	if {$infoExists} {
	    set info [$infoProc]
	    $desc insert end $info\n
	} else {
	    $desc insert end "No information given\n"
	}
        
	$desc config -state disabled
	set procedureSelection ""
	global restrictedProcName
	set restrictedProcName $item
    } elseif {$dc == 3} {
	$desc config -state normal
	$desc delete 1.0 end
	
	$desc config -state disabled
	set procedureSelection ""
	global restrictedProcName
	set restrictedProcName ""
    }
}


proc findProcSteps {body} {
    set stepList {}
    set nlIndex [string first "\n" $body]

    while {$nlIndex != -1} {
	set stepName ""
	set line [string range $body 0 [expr {$nlIndex - 1}]]
	set lineLength [string length $line]

	# Find occurrence of APSMpStep string and extract out step name
	regexp "APSMpStep\[ \t\]*(\[a-zA-Z0-9\]*)" $line match stepName
	if {$stepName != ""} {
	    lappend stepList $stepName
	}
	
	set body [string range $body [expr {$nlIndex + 1}] end]
	set nlIndex [string first "\n" $body]
    }
    return $stepList
}

#   
# Procedures for manipulating list widget containing currently
# executing machine procedures: addCurrent findCurrent deleteCurrent
#
proc addCurrent {listWidget identString sdIndex} {
    global currentSdList childPortToSd

    set indx [$listWidget index end]
    $listWidget insert end $identString
    set currentSdList($indx) $childPortToSd($sdIndex)
}

proc findCurrent {listWidget identString} {
    set listContents [$listWidget get 0 end]
    set ix [lsearch -exact $listContents ${identString}]
    return $ix
}

proc deleteCurrent {listWidget identString childSd} {
    global currentSdList abortSelection autoRun
    set listContents [$listWidget get 0 end]
    set len [llength $listContents]
    set i1 0
    set found 0
    # Find list index of identString
    foreach item $listContents {
	if {(![string compare "${identString}" $item]) && ($currentSdList($i1) == $childSd)} {
	    set found 1
	    break
	}
	incr i1
    }
    if {$found} {
	# Re-adjust currentSdList, since deletion changes indexes
	set nextItemIx [expr {$i1 + 1}]
	for {set i2 $nextItemIx} {$i2 < $len} {incr i2} {
	    set currentSdList([expr {$i2 - 1}]) $currentSdList($i2)
	}
	unset currentSdList([expr {$len - 1}])

	# Delete from widget and clear abortSelection
	$listWidget delete $i1
	if {![string compare $abortSelection $identString]} {
	    set abortSelection ""
	}
    }
}

proc currentProcCallback {listboxItem doubleClick} {
    if {$doubleClick == 0} {
	global abortSelection
	set abortSelection [string range $listboxItem 0 \
                                [expr {[string length $listboxItem] - 2}]]
    }
}

# Given DISPLAY environment variable, return host prefix
proc extractDisplayHost {xDisplay} {
    regexp {([^:]*):} $xDisplay match host
    return $host
}

if {[llength $procedureSelection] == 1} {
    .userFrame.bfg.execute.button invoke
    wm iconify .
}


