- Added a script to generate XML for GumTree

SKIPPED:
	psi/hardsup/libhlib.a

tcl/gumxml.tcl

@@ -0,0 +1,181 @@
+#-------------------------------------------------------------------------------
+# This file contains the implementation of the routines which generate the 
+# XML file as required by GumTree from a SICS Hipadaba. 
+# 
+# Mark Koennecke, Tony Lam, Ferdi Franceccini, January 2007
+#------------------------------------------------------------------------------
+proc makeGumHeader {} {
+    return "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
+} 
+#---------------------------------------------------------------------------
+proc sicssplit {txt} {
+    set l [split $txt =]
+    return [string trim [lindex $l 1]]
+}
+#---------------------------------------------------------------------------
+proc getNodePriv {nodepath} {
+    set status [catch {hgetprop $nodepath priv} msg]
+    if {$status != 0} {
+	set priv user
+    } else {
+	set priv [sicssplit $msg]
+    }
+    if {[string length $priv] < 2} {
+	set priv user
+    }
+    set priv [string toupper $priv]
+    if {[string compare $priv INTERNAL] == 0} {
+	set priv READ_ONLY
+    }
+    return $priv    
+}
+#--------------------------------------------------------------------------
+proc getNodeNumType {nodepath} {
+    set txt [hinfo $nodepath]
+    set l [split $txt ,]
+    set numtype [lindex $l 0]
+    set numType [string totitle $numtype]
+    return $numType
+}
+#----------------------------------------------------------------------------
+proc makeXMLHeader {nodepath indent} {
+    set status [catch {hgetprop $nodepath type} msg]
+    if {$status != 0} {
+      set nodetype UNSPECIFIED
+    } else {
+	set nodetype [string tolower [sicssplit $msg]]	
+    }
+    set nodename [file tail $nodepath]
+    set prefix [string repeat " " $indent]
+    switch $nodetype {
+	instrument {
+	    append result "$prefix <Instrument xmlns:hipadaba=\"http://www.psi.ch/hipadaba\" label=\""
+	    append result "$nodename\">\n"
+        }
+        part {
+            set numtype [getNodeNumType $nodepath]
+            if {[string compare $numtype None] == 0} { 
+		append result "$prefix<part id=\"$nodename\">\n"
+            } else {
+                set priv [getNodePriv $nodepath]
+		append result "$prefix<part id=\"$nodename\" dataType=\"$numtype\" privilege=\"$priv\">\n"
+            }
+        }
+	motor {
+            set priv [getNodePriv $nodepath]
+	    append result "$prefix<device id=\"$nodename\" "
+           append result "deviceType=\"Motor\" dataType=\"Float\" privilege=\"$priv\">\n"
+        }
+	drivable {
+            set priv [getNodePriv $nodepath]
+	    append result "$prefix<device id=\"$nodename\" "
+            append result "deviceType=\"Drivable\" dataType=\"Float\" privilege=\"$priv\">\n"
+        }
+	graphset {
+	    append result "$prefix <Graphics  label=\""
+	    append result "$nodename\">\n"
+        }
+	commandset {
+	    append result "$prefix <Commands  label=\""
+	    append result "$nodename\">\n"
+        }
+        graphdata {
+	    set status [catch {hgetprop $nodepath viewer} msg]
+            if {$status == 0} {
+		set view [sicssplit $msg]
+		append result "$prefix<graphdata id=\"$nodename\" viewer=\"$view\">\n"
+            } else {
+		append result "$prefix<graphdata id=\"$nodename\">\n"
+	    }
+        }
+        command {
+            set priv [getNodePriv $nodepath]
+	    append result "$prefix<command id=\"$nodename\" privilege=\"$priv\">\n"
+        }
+        axis {
+	    set status [catch {hgetprop $nodepath dim} msg]
+            if {$status == 0} {
+                set dim [sicssplit $msg]
+            } else {
+                set dim 0
+	    }
+            set numtype [getNodeNumType $nodepath]
+	    append result "$prefix<axis privilege=\"READ_ONLY\" dataType=\"$numtype\" "
+            append result "id=\"$nodename\" dim=\"$dim\"/>\n"
+        }
+        data {
+            set numtype [getNodeNumType $nodepath]
+	    append result "$prefix<data privilege=\"READ_ONLY\" "
+            append result "dataType=\"$numtype\" id=\"$nodename\"/>\n"
+        }
+	default {
+            set numtype [getNodeNumType $nodepath]
+            set priv [getNodePriv $nodepath]
+	    append result "$prefix<property privilege=\"$priv\" dataType=\"$numtype\" id=\"$nodename\"/>\n"
+        }
+    }
+    return $result
+}
+#----------------------------------------------------------------------------
+proc makeXMLClose {nodepath indent} {
+    set status [catch {hgetprop $nodepath type} msg]
+    if {$status != 0} {
+      set nodetype UNSPECIFIED
+    } else {
+	set nodetype [string tolower [sicssplit $msg]]	
+    }
+    set nodename [file tail $nodepath]
+    set prefix [string repeat " " $indent]
+    switch $nodetype {
+	instrument {
+	    append result "$prefix</Instrument>\n"
+        }
+        part {
+	    append result "$prefix</part>\n"
+        }
+        drivable -
+        motor {
+	    append result "$prefix</device>\n"
+        }
+        graphset {
+	    append result "$prefix</Graphics>\n"
+        }
+        commandset {
+	    append result "$prefix</Commands>\n"
+        }
+        graphdata {
+	    append result "$prefix</graphdata>\n"
+        }
+        command {
+	    append result "$prefix</command>\n"
+        }
+	default {
+	   append result ""
+        }
+    }
+    return $result
+}
+#-----------------------------------------------------------------------------
+proc scanHdbDir {path indent} {
+    set txl [hlist $path]
+    if {[string compare $path "/"] == 0} {
+	set path ""
+    }
+    set nodelist [split $txl \n]
+    set result ""
+    foreach node $nodelist {
+        if {[string length $node] < 1} {
+	    continue
+        }
+        set nodepath $path/$node
+	append result [makeXMLHeader $nodepath $indent]
+	append result [scanHdbDir $nodepath [expr $indent + 2]]
+        append result [makeXMLClose $nodepath $indent]
+    }
+    return $result
+}
+#-----------------------------------------------------------------------------
+proc getgumtreexml {path } {
+    append result [makeGumHeader]
+    append result [scanHdbDir $path 0]
+}