Restored accidentally removed file.

r1244 | ffr | 2006-11-07 12:57:45 +1100 (Tue, 07 Nov 2006) | 2 lines

site_ansto/instrument/troubleShoot.tcl

@@ -0,0 +1,128 @@
+#!/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
+
+}
+}
+