diff --git a/tcl/hdbutil.tcl b/tcl/hdbutil.tcl
new file mode 100644
index 00000000..dde7e9fb
--- /dev/null
+++ b/tcl/hdbutil.tcl
@@ -0,0 +1,690 @@
+#-----------------------------------------------------------------------
+# This is a collection of utility procedures to help with Hipadaba and
+# Gumtree Swiss Edition. This file is supposed to be sourced by any
+# instrument using Hipadaba.
+#
+# Copyright: see file COPYRIGHT
+#
+# Collected from various files: Mark Koennecke, March 2008
+#
+# Requirements:
+# * the internal scan command xxxscan
+# * scan data to live /graphics/scan_data
+#----------------------------------------------------------------------
+if { [info exists hdbinit] == 0 } {
+ set hdbinit 1
+ InstallHdb
+ MakeStateMon
+ Publish getgumtreexml Spy
+ if {[string first tmp $home] < 0} {
+ set tmppath $home/tmp
+ } else {
+ set tmppath $home
+ }
+ Publish mgbatch Spy
+ Publish loadmgbatch Spy
+ Publish hsearchprop Spy
+ Publish hdbscan User
+ Publish hdbprepare User
+ Publish hdbcollect User
+ Publish listbatchfiles Spy
+ Publish makemumopos User
+ Publish dropmumo User
+ Publish hdbbatchpath User
+# Publish hmake Mugger
+# Publish hmakescript Mugger
+# Publish hlink Mugger
+# Publish hcommand Mugger
+}
+#===================================================================
+# Configuration commands provided:
+# hdbReadOnly
+# makesampleenv path
+# makestdscan path
+# makestdscangraphics path
+# makestdbatch
+# makeQuickPar name path
+# makeslit path left right upper lower
+# configures a slit. Missing motors can be indicated with NONE
+# makestdadmin
+# makecount path
+# makerepeat path
+# makekillfile path
+# makesuccess path
+# makestdgui
+# makewait path
+# makeevproxy rootpath hdbname devicename
+# makemumo rootpath mumoname
+# makeexe
+#===================== hfactory adapters ==========================
+proc hmake {path priv type {len 1}} {
+ hfactory $path plain $priv $type $len
+}
+#--------------------------------------------------------------------
+proc hmakescript {path readscript writescript type {len 1}} {
+ hfactory $path script $readscript $writescript $type $len
+}
+#-------------------------------------------------------------------
+proc hlink {path obj {treename NONE} } {
+ if {[string equal $treename NONE]} {
+ set treename $ob
+ }
+ append realpath $path / $treename
+ hfactory $realpath link $obj
+}
+#-------------------------------------------------------------------
+proc hcommand {path script} {
+ hfactory $path command $script
+}
+#================ make XML tree =====================================
+proc getdataType {path} {
+ return [lindex [split [hinfo $path] ,] 0]
+}
+#----------------------------------------------------------------------
+proc make_nodes {path result indent} {
+set nodename [file tail $path];
+set type [getdataType $path]
+set prefix [string repeat " " $indent]
+set newIndent [expr $indent + 2]
+#array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
+ set prop_list(control) true
+ set we_have_control [info exists prop_list(control)]
+ if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} {
+ append result "$prefix\n"
+ foreach p [property_elements $path $newIndent] {
+ append result $p
+ }
+ foreach x [hlist $path] {
+ set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
+ }
+ append result "$prefix\n"
+ }
+ return $result
+}
+#-------------------------------------------------------------------
+proc property_elements_old {path indent} {
+ set prefix [string repeat " " $indent]
+ foreach {key value} [string map {= " "} [hlistprop $path]] {
+ if {[string compare -nocase $key "control"] == 0} {continue}
+ lappend proplist "$prefix\n"
+# foreach v [split $value ,] {
+# lappend proplist "$prefix$prefix$v\n"
+# }
+ lappend proplist "$prefix$prefix$value\n"
+ lappend proplist "$prefix\n"
+ }
+ if [info exists proplist] {return $proplist}
+}
+#-----------------------------------------------------------------------
+proc property_elements {path indent} {
+ set prefix [string repeat " " $indent]
+ set data [hlistprop $path]
+ set propList [split $data \n]
+ foreach prop $propList {
+ set pl [split $prop =]
+ set key [string trim [lindex $pl 0]]
+ set value [string trim [lindex $pl 1]]
+ if {[string length $key] < 1} {
+ continue
+ }
+ lappend proplist "$prefix\n"
+ lappend proplist "$prefix$prefix$value\n"
+ lappend proplist "$prefix\n"
+ }
+ if [info exists proplist] {return $proplist}
+}
+#--------------------------------------------------------------------------
+proc getgumtreexml {path} {
+ append result "\n"
+ append result "\n"
+
+ if {[string compare $path "/" ] == 0} {
+ foreach n [hlist $path] {
+ set result [make_nodes $n $result 2]
+ }
+ } else {
+# set result [make_nodes $path $result 2]
+ foreach n [hlist $path] {
+ set result [make_nodes $path/$n $result 2]
+ }
+ }
+
+ append result "\n"
+}
+#==================== Gumtree batch =========================================
+proc searchPathForDrivable {name} {
+ set path [string trim [hmatchprop / sicsdev $name]]
+ if {[string compare $path NONE] != 0} {
+ return $path
+ }
+ set txt [findalias $name]
+ if {[string compare $txt NONE] == 0} {
+ return NONE
+ }
+ set l1 [split $txt =]
+ set l [split [lindex $l1 1] ,]
+ foreach alias $l {
+ set alias [string trim $alias]
+ set path [string trim [hmatchprop / sicsdev $alias]]
+ if {[string compare $path NONE] != 0} {
+ return $path
+ }
+ }
+ return NONE
+}
+#----------------------------------------------------------------
+proc searchForCommand {name} {
+ return [string trim [hmatchprop / sicscommand $name]]
+}
+#----------------------------------------------------------------
+proc treatsscan {scanpath command out} {
+ set l [split $command]
+ set len [llength $l]
+ set noVar [expr ($len-2)/3]
+ set np [lindex $l [expr $len -2]]
+ set preset [lindex $l [expr $len -1]]
+ for {set i 0} {$i < $noVar} {incr i} {
+ set start [expr $i * 3]
+ set scanVar [lindex $l [expr 1 + $start]]
+ set scanStart [lindex $l [expr 2 + $start]]
+ set scanEnd [lindex $l [expr 3 + $start]]
+ set scanStep [expr ($scanEnd*1. - $scanStart*1.)/$np*1.]
+ append hdbVar $scanVar ,
+ append hdbStart $scanStart ,
+ append hdbStep $scanStep ,
+ }
+ set hdbVar [string trim $hdbVar ,]
+ set hdbStart [string trim $hdbStart ,]
+ set hdbStep [string trim $hdbStep ,]
+ puts $out "\#NODE: $scanpath"
+ puts $out "clientput BatchPos = 1"
+ puts $out "hdbscan $hdbVar $hdbStart $hdbStep $np monitor $preset"
+}
+#----------------------------------------------------------------
+proc treatcscan {scanpath command out} {
+ set l [split $command]
+ set scanVar [lindex $l 1]
+ set scanCenter [lindex $l 2]
+ set scanStep [lindex $l 3]
+ set np [lindex $l 4]
+ set preset [lindex $l 5]
+ set hdbStart [expr $scanCenter - ($np*1.0)/2. * $scanStep*1.0]
+ puts $out "\#NODE: $scanpath"
+ puts $out "clientput BatchPos = 1"
+ puts $out "hdbscan $scanVar $hdbStart $scanStep $np monitor $preset"
+}
+#----------------------------------------------------------------
+proc translateCommand {command out} {
+ set drivelist [list drive dr run]
+ set textList [list for while source if]
+# clientput "Translating: $command"
+ set command [string trim $command]
+ if {[string length $command] < 2} {
+ return
+ }
+ set l [split $command]
+ set obj [string trim [lindex $l 0]]
+#------- check for drive commands
+ set idx [lsearch $drivelist $obj]
+ if {$idx >= 0} {
+ set dev [lindex $l 1]
+ set path [searchPathForDrivable $dev]
+ if {[string compare $path NONE] != 0} {
+ set realTxt [hgetprop $path sicsdev]
+ set realL [split $realTxt =]
+ set realDev [lindex $realL 1]
+ set mapList [list $dev $realDev]
+ set newCom [string map $mapList $command]
+ puts $out "\#NODE: $path"
+ puts $out "clientput BatchPos = 1"
+ puts $out $newCom
+ return
+ }
+ }
+#------ check for well known broken commands
+ set idx [lsearch $textList $obj]
+ if {$idx >= 0} {
+ puts $out "\#NODE: /batch/commandtext"
+ puts $out "clientput BatchPos = 1"
+ set buffer [string map {\n @nl@} $command]
+ puts $out "hset /batch/commandtext $buffer"
+ return
+ }
+#--------- check for simple commands
+ set path [searchForCommand $command]
+ if {[string compare $path NONE] != 0} {
+ puts $out "\#NODE: $path"
+ puts $out "clientput BatchPos = 1"
+ puts $out $command
+ return
+ }
+ set scancom [searchForCommand hdbscan]
+#---------- deal with scans
+ if {[string first sscan $obj] >= 0} {
+ if {[catch {treatsscan $scancom $command $out}] == 0} {
+ return
+ }
+ }
+ if {[string first cscan $obj] >= 0} {
+ if {[catch {treatsscan $scancom $command $out}] == 0} {
+ return
+ }
+ }
+#--------- give up: output as a text node
+ puts $out "\#NODE: /batch/commandtext"
+ puts $out "clientput BatchPos = 1"
+ set buffer [string map {\n @nl@} $command]
+ puts $out "hset /batch/commandtext $buffer"
+}
+#----------------------------------------------------------------
+proc mgbatch {filename} {
+ global tmppath
+ set f [open $filename r]
+ gets $f line
+ close $f
+ if {[string first MOUNTAINBATCH $line] > 0} {
+#--------- This is a mountaingum batch file which does not need
+# to be massaged
+ return $filename
+ }
+ set f [open $filename r]
+ set realfilename [file tail $filename]
+ set out [open $tmppath/$realfilename w]
+ puts $out \#MOUNTAINBATCH
+ while {[gets $f line] >= 0} {
+ append buffer $line
+ if {[info complete $buffer] == 1} {
+ translateCommand $buffer $out
+ unset buffer
+ } else {
+ append buffer \n
+ }
+ }
+ close $out
+ return $tmppath/$realfilename
+}
+#----------------------------------------------------------------
+proc loadmgbatch {filename} {
+ set txt [exe fullpath $filename]
+ set l [split $txt =]
+ set realf [lindex $l 1]
+ set realf [mgbatch $realf]
+ return [exe print $realf]
+}
+#============== hdbscan =========================================
+proc hdbscan {scanvars scanstart scanincr np mode preset} {
+ global stdscangraph hdbscanactive
+ xxxscan clear
+ xxxscan configure script
+ xxxscan function prepare hdbprepare
+ xxxscan function collect hdbcollect
+ set varlist [split $scanvars ,]
+ set startlist [split $scanstart ,]
+ set incrlist [split $scanincr ,]
+ hset $stdscangraph/scan_variable/name [lindex $varlist 0]
+ set count 0
+ foreach var $varlist {
+ if {[string first / $var] >= 0} {
+ set var [string trim [SplitReply [hgetprop $var sicsdev]]]
+ }
+ xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count]
+ incr count
+ }
+ set hdbscanactive 1
+ set status [catch {xxxscan run $np $mode $preset} msg]
+ set hdbscanactive 0
+ if {$status == 0} {
+ return $msg
+ } else {
+ error $msg
+ }
+}
+#------------------------------------------------------------------------------
+proc hdbprepare {obj userdata } {
+ global stdscangraph
+ stdscan prepare $obj userdata
+ hupdate $stdscangraph/dim
+}
+#------------------------------------------------------------------------------
+proc hdbcollect {obj userobj np} {
+ global stdscangraph
+ stdscan collect $obj $userobj $np
+ hupdate $stdscangraph/scan_variable
+ hupdate $stdscangraph/counts
+}
+#-----------------------------------------------------------------------------
+proc gethdbscanvardata {no} {
+ set np [string trim [SplitReply [xxxscan np]]]
+ if {$np == 0} {
+ return ".0 .0 .0"
+ }
+ set status [catch {SplitReply [xxxscan getvardata $no]} txt]
+ if {$status == 0} {
+ return [join $txt]
+ } else {
+ return ".0 .0 .0"
+ }
+}
+#----------------------------------------------------------------------------
+proc gethdbscancounts {} {
+ set np [string trim [SplitReply [xxxscan np]]]
+ if {$np == 0} {
+ return "0 0 0"
+ }
+ set status [catch {SplitReply [xxxscan getcounts]} txt]
+ if {$status == 0} {
+ return [join $txt]
+ } else {
+ return "0 0 0"
+ }
+}
+#================= helper to get the list of batch files =================
+proc listbatchfiles {} {
+ set ext [list *.tcl *.job *.run]
+ set txt [SplitReply [exe batchpath]]
+ set dirlist [split $txt :]
+ set txt [SplitReply [exe syspath]]
+ set dirlist [concat $dirlist [split $txt :]]
+# clientput $dirlist
+ set result [list ""]
+ foreach dir $dirlist {
+ foreach e $ext {
+ set status [catch {glob [string trim $dir]/$e} filetxt]
+ if {$status == 0} {
+ set filelist [split $filetxt]
+ foreach f $filelist {
+# clientput "Working at $f"
+ set nam [file tail $f]
+ if { [lsearch $result $nam] < 0} {
+# clientput "Adding $nam"
+ lappend result $nam
+ }
+ }
+ } else {
+# clientput "ERROR: $filetxt"
+ }
+ }
+ }
+ foreach bf $result {
+ append resulttxt $bf ,
+ }
+ return [string trim $resulttxt ,]
+}
+#-------------------------------------------------------------------------
+proc hsearchprop {root prop val} {
+ set children [hlist $root]
+ set childlist [split $children \n]
+ if {[llength $childlist] <= 0} {
+ error "No children"
+ }
+ foreach child $childlist {
+ if {[string length $child] < 1} {
+ continue
+ }
+ catch {hgetprop $root/$child $prop} msg
+ if { [string first ERROR $msg] < 0} {
+ set value [string trim [SplitReply $msg]]
+ if { [string equal -nocase $value $val] == 1} {
+ return $root/$child
+ }
+ }
+ set status [catch {hsearchprop $root/$child $prop $val} node]
+ if {$status == 0} {
+ return $node
+ }
+ }
+ error "Not found"
+}
+#============ various utility routines =====================================
+proc hdbReadOnly {} {
+ error "Parameter is READ ONLY"
+}
+#---------------------------------------------------------------------------
+proc makesampleenv {path} {
+ hfactory $path plain spy none
+ hsetprop $path type graphdata
+ hsetprop $path viewer mountaingumui.TimeSeries
+ hfactory $path/vars plain user text
+ hset $path/vars tomato
+ hfactory $path/rank plain user int
+ hset $path/rank 1
+ hfactory $path/dim plain user intar 1
+ hset $path/dim 300
+ hfactory $path/getdata plain user text
+ hsetprop $path/getdata type logcommand
+ hfactory $path/getdata/starttime plain spy text
+ hfactory $path/getdata/endtime plain spy text
+}
+#--------------------------------------------------
+proc makestdscan {path} {
+ hfactory $path command hdbscan
+ hsetprop $path type command
+ hsetprop $path viewer mountaingumui.ScanEditor
+ hsetprop $path priv user
+ hfactory $path/scan_variables plain user text
+ hsetprop $path/scan_variables argtype drivable
+ hfactory $path/scan_start plain user text
+ hfactory $path/scan_increments plain user text
+ hfactory $path/NP plain user int
+ hfactory $path/mode plain user text
+ hsetprop $path/mode values "monitor,timer"
+ hfactory $path/preset plain user float
+}
+#---------------------------------------------------
+proc makestdscangraphics {path} {
+ global stdscangraph
+
+ set stdscangraph $path
+
+ hfactory $path plain spy none
+ hsetprop $path type graphdata
+ hsetprop $path viewer default
+ hattach $path title title
+ hfactory $path/rank plain mugger int
+ hset $path/rank 1
+ hsetprop $path/rank priv internal
+ hfactory $path/dim script "xxxscan np" hdbReadOnly intar 1
+ hsetprop $path/dim priv internal
+ hfactory $path/scan_variable script "gethdbscanvardata 0" hdbReadOnly floatvarar 1
+ hsetprop $path/scan_variable type axis
+ hsetprop $path/scan_variable dim 0
+ hsetprop $path/scan_variable transfer zip
+ hsetprop $path/scan_variable priv internal
+ hfactory $path/scan_variable/name plain user text
+ hfactory $path/counts script "gethdbscancounts" hdbReadOnly intvarar 1
+ hsetprop $path/counts type data
+ hsetprop $path/counts transfer zip
+ hsetprop $path/counts priv internal
+}
+#----------------------------------------------------
+proc makeQuickPar {name path} {
+ hfactory /quickview/$name plain mugger text
+ hset /quickview/$name $path
+}
+#---------------------------------------------------
+proc makestdbatch {} {
+ hfactory /batch plain spy none
+ hfactory /batch/bufferlist script listbatchfiles hdbReadOnly text
+ sicspoll add /batch/bufferlist hdb 30
+ hfactory /batch/commandtext plain spy text
+ hsetprop /batch/commandtext viewer mountaingumui.TextEdit
+ hsetprop /batch/commandtext commandtext true
+ hfactory /batch/currentline plain user int
+}
+#-----------------------------------------------------
+proc makeslit {path left right upper bottom} {
+ hfactory $path plain spy none
+ hsetprop $path type part
+ if {![string equal $left NONE]} {
+ hattach $path $left left
+ }
+ if {![string equal $right NONE]} {
+ hattach $path $right right
+ }
+ if {![string equal $upper NONE]} {
+ hattach $path $upper upper
+ }
+ if {![string equal $bottom NONE]} {
+ hattach $path $bottom bottom
+ }
+}
+#---------------------------------------------------------
+proc makestdadmin {} {
+ hfactory /instrument/experiment plain spy none
+ hattach /instrument/experiment title title
+ hattach /instrument/experiment user user
+ hattach /instrument/experiment/user adress address
+ hattach /instrument/experiment/user phone phone
+ hattach /instrument/experiment/user email email
+ hfactory /instrument/experiment/datafilenumber script sicsdatanumber \
+ hdbReadOnly int
+ hsetprop /instrument/experiment/datafilenumber priv internal
+ hfactory /instrument/experiment/batchpath script "exe batchpath" \
+ "exe batchpath" text
+ hsetprop /instrument/experiment/batchpath priv user
+}
+#----------------------------------------------------------
+proc makecount {path} {
+ hfactory $path command count
+ hsetprop $path type command
+ hsetprop $path priv user
+ hfactory $path/mode plain user text
+ hsetprop $path/mode values "monitor,timer"
+ hfactory $path/preset plain user float
+ hset $path/preset 60000
+ hset $path/mode monitor
+}
+#----------------------------------------------------------
+proc makerepeat {path} {
+ hfactory $path command repeat
+ hsetprop $path type command
+ hsetprop $path priv user
+ hfactory $path/num plain user int
+ hfactory $path/mode plain user text
+ hsetprop $path/mode values "monitor,timer"
+ hfactory $path/preset plain user float
+ hset $path/preset 60000
+ hset $path/mode monitor
+}
+#----------------------------------------------------------
+proc makekillfile {path} {
+ hcommand $path killfile
+ hsetprop $path type command
+ hsetprop $path priv manager
+}
+#----------------------------------------------------------
+proc makesuccess {path} {
+ hcommand $path success
+ hsetprop $path type command
+ hsetprop $path priv user
+}
+#-----------------------------------------------------------
+proc makestdgui {} {
+ hfactory /gui plain spy none
+ hfactory /gui/status plain internal text
+ status hdbinterest /gui/status
+}
+#------------------------------------------------------------
+proc makewait {path} {
+ hfactory $path command wait
+ hsetprop $path type command
+ hsetprop $path priv user
+ hfactory $path/time plain user int
+}
+#------------------------------------------------------------
+proc makeevproxy {rootpath hdbname devicename} {
+ MakeProxy p${devicename} $devicename float
+ p${devicename} map upperlimit upperlimit float user
+ p${devicename} map lowerlimit lowerlimit float user
+ hlink $rootpath p${devicename} $hdbname
+ hsetprop $rootpath/$hdbname sicsdev $devicename
+ hsetprop $rootpath/$hdbname type drivable
+ sicspoll add $rootpath/$hdbname hdb 30
+}
+#================== multi motor stuff =======================
+proc getNamposList {mumo} {
+ set txt [$mumo list]
+ set l [split $txt "\n"]
+ set lala [llength $l]
+ for {set i 1} {$i < [llength $l]} {incr i} {
+ set pos [lindex $l $i]
+ if {[string length $pos] > 1} {
+ append result [lindex $l $i] ","
+ }
+ }
+ if { ![info exists result] } {
+# clientput "nampos = $txt"
+ append result UNKNOWN
+ }
+ return [string trimright $result ","]
+}
+#------------------------------------------------------------
+proc getNamPos {mumo} {
+ set txt [$mumo find]
+ set l [split $txt =]
+ return [string trim [lindex $l 1]]
+}
+#-----------------------------------------------------------
+proc updateNamePosValues {rootpath} {
+ hupdate $rootpath/namedposition/values
+ hupdate $rootpath/dropnamedposition/name/values
+}
+#------------------------------------------------------------
+proc makemumopos {mumo rootpath name} {
+ $mumo pos $name
+ updateNamePosValues $rootpath
+}
+#-----------------------------------------------------------
+proc dropmumo {mumo rootpath name} {
+ $mumo drop $name
+ updateNamePosValues $rootpath
+}
+#------------------------------------------------------------
+proc getDropList {mumo} {
+ set txt [getNamposList $mumo]
+ append txt ",all"
+ return $txt
+}
+#-------------------------------------------------------------
+proc makemumo {rootpath mumoname} {
+ hfactory $rootpath/namedposition script "getNamPos $mumoname" \
+ $mumoname text
+ hsetprop $rootpath/namedposition priv user
+ hfactory $rootpath/namedposition/values script \
+ "getNamposList $mumoname" hdbReadOnly text
+ hsetprop $rootpath/namedposition/values visible false
+ hupdate $rootpath/namedposition/values
+ hfactory $rootpath/assignname2current command \
+ "makemumopos $mumoname $rootpath"
+ hsetprop $rootpath/assignname2current priv user
+ hsetprop $rootpath/assignname2current type command
+ hfactory $rootpath/assignname2current/name plain user text
+ hset $rootpath/assignname2current/name "Undefined"
+ hfactory $rootpath/dropnamedposition command \
+ "dropmumo $mumoname $rootpath"
+ hsetprop $rootpath/dropnamedposition priv user
+ hsetprop $rootpath/dropnamedposition type command
+ hfactory $rootpath/dropnamedposition/name plain user text
+ hfactory $rootpath/dropnamedposition/name/values script \
+ "getDropList $mumoname" hdbReadOnly text
+ hsetprop $rootpath/dropnamedposition/name/values visible false
+ hupdate $rootpath/dropnamedposition/name/values
+}
+#-----------------------------------------------------------------
+proc hdbbatchpath {pathstring} {
+ exe batchpath $pathstring
+ hupdate /instrument/commands/batch/execute/file/values
+}
+#------------------------------------------------------------------
+proc makeexe {} {
+ set path /instrument/commands/batch
+ hfactory $path plain spy none
+ hfactory $path/batchpath script "exe batchpath" hdbbatchpath text
+ hsetprop $path/batchpath priv user
+ hfactory $path/execute command exe
+ hsetprop $path/execute type command
+ hsetprop $path/execute priv user
+ hfactory $path/execute/file plain user text
+ hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
+ sicspoll add $path/execute/file/values hdb 60
+}