129 lines
3.6 KiB
Tcl
Executable File
129 lines
3.6 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
|
|
# $Revision: 1.8 $
|
|
# $Date: 2006-11-07 01:56:50 $
|
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
# Last revision by $Author: ffr $
|
|
|
|
# Load troubleshooting setup
|
|
source dmc2280_util.tcl
|
|
source troubleshoot_setup.tcl
|
|
source motorinfo.tcl
|
|
|
|
if { $argc > 0 } {
|
|
set configFileName [lindex $argv 0]
|
|
}
|
|
|
|
namespace eval sics_config {
|
|
proc loadConfig {fName} {
|
|
variable ContList
|
|
if [info exists ContList] {unset ContList}
|
|
# Temporarily define unknown proc to skip undefined procs
|
|
rename ::unknown _unknown
|
|
proc ::unknown {args} {}
|
|
if [catch {uplevel #0 source $fName} errMsg] {
|
|
rename ::unknown ""
|
|
rename _unknown ::unknown
|
|
error $errMsg
|
|
} else {
|
|
rename ::unknown ""
|
|
rename _unknown ::unknown
|
|
}
|
|
if [catch {set ContList [uplevel #0 info vars dmc2280_controller*]} result] {error $result}
|
|
if {[llength $ContList] == 0} {error "Error: There are no dmc2280_controllerN(host/port) arrays in the $fName configuration file"}
|
|
#Add the controller to the sics_config namespace
|
|
foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"}
|
|
}
|
|
|
|
proc subExists {contName sub} {
|
|
upvar #0 $contName controller
|
|
if [catch {::dmc_sendCmd $controller(socket) "LS $sub,0"} errMsg] {
|
|
error "Subroutine $sub does not exist on controller $contName"
|
|
}
|
|
::dmc_receive $controller(socket)
|
|
}
|
|
|
|
# Returns -1 if thread is not running, line number if it is
|
|
proc checkThread {contName thnum} {
|
|
upvar #0 $contName controller
|
|
::dmc_sendCmd $controller(socket) "MG _XQ$thnum"
|
|
set reply [::dmc_receive $controller(socket) ]
|
|
if {$reply == -1} {
|
|
error "Thread $thnum not running on controller $contName"
|
|
}
|
|
return $reply
|
|
}
|
|
|
|
# GUI STUFF
|
|
package require Tk
|
|
variable ContList
|
|
global ldFrame
|
|
set ldFrameName ".loadFile"
|
|
set ldFrame(button) $ldFrameName.ldConf
|
|
set ldFrame(entry) $ldFrameName.ldEntry
|
|
|
|
|
|
proc ::guiLoadC {} {
|
|
::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]
|
|
}
|
|
|
|
proc ::guiConnect {w cont} {
|
|
::dmc_connect $cont
|
|
$w configure -activebackground green
|
|
$w configure -background green
|
|
}
|
|
|
|
proc ::guiCheckSubs {w cont} {
|
|
global contSubs
|
|
foreach sub $contSubs($cont) {
|
|
::sics_config::subExists $cont $sub
|
|
}
|
|
$w configure -activebackground green
|
|
$w configure -background green
|
|
}
|
|
|
|
proc ::guiCheckThreads {w cont} {
|
|
global contThreads
|
|
foreach thr $contThreads($cont) {
|
|
::sics_config::checkThread $cont $thr
|
|
}
|
|
$w configure -activebackground green
|
|
$w configure -background green
|
|
}
|
|
|
|
frame $ldFrameName
|
|
pack $ldFrameName
|
|
button $ldFrame(button) -text "Load config" -command {guiLoadC; ::sics_config::mkGui}
|
|
entry $ldFrame(entry) -textvariable configFileName -width -1
|
|
pack $ldFrame(button) -side left
|
|
pack $ldFrame(entry) -side left
|
|
|
|
|
|
proc mkGui {} {
|
|
variable ContList
|
|
lappend Headings $ContList
|
|
frame .t -bg black
|
|
table .t $ContList
|
|
pack .t
|
|
testgui
|
|
}
|
|
proc table {w headings args} {
|
|
set r 0
|
|
|
|
foreach name $headings {
|
|
lappend Header [label $w.$name -text $name]
|
|
}
|
|
foreach name $headings {
|
|
lappend Connect [button $w.connect$name -text connect -command "guiConnect $w.connect$name $name"]
|
|
lappend CheckSubs [button $w.chkSubs$name -text "Check subs" -command "guiCheckSubs $w.chkSubs$name $name"]
|
|
lappend CheckThreads [button $w.chkThrs$name -text "Check threads" -command "guiCheckThreads $w.chkThrs$name $name"]
|
|
}
|
|
eval grid $Header -sticky news -padx 1 -pady 1
|
|
eval grid $Connect -sticky news -padx 1 -pady 1
|
|
eval grid $CheckSubs -sticky news -padx 1 -pady 1
|
|
eval grid $CheckThreads -sticky news -padx 1 -pady 1
|
|
|
|
}
|
|
}
|
|
|