#-----------------------------------------------------------------------
# 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
# 
# Many updates, till November 2008, Mark Koennecke
#----------------------------------------------------------------------
if { [info exists hdbinit] == 0 } {
  set hdbinit 1
  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 cscan       User
  Publish sscan       User
  Publish scan        Spy
  Publish hmake Mugger
  Publish hmakescript Mugger
  Publish hlink    Mugger
  Publish hcommand Mugger
  Publish hdbstorenexus User 
  Publish scaninfo Spy
}
#===================================================================
# 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 
#   confnxhdb path alias pass
#===================== 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 makeInitValue {path type prefix} {
    append result ""
    if {[string compare $type none] != 0 && [string compare $type func] != 0} {
	set test [catch {hgetprop $path transfer} msg]
	set tst [catch {hval $path} val]
	if {$test != 0 &&  $tst == 0} {
	    append result "$prefix  <initValue>\n"
            append result "$prefix    $val\n"
            append result "$prefix  </initValue>\n"
	}
    }
    return $result
}
#----------------------------------------------------------------------
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<component id=\"$nodename\" dataType=\"$type\">\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 [makeInitValue $path $type $prefix]
    append result  "$prefix</component>\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<property id=\"$key\">\n"
#    foreach v [split $value ,] {
#      lappend proplist "$prefix$prefix<value>$v</value>\n"
#    }
    lappend proplist "$prefix$prefix<value>$value</value>\n"  
    lappend proplist "$prefix</property>\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<property id=\"$key\">\n"
    lappend proplist "$prefix$prefix<value>$value</value>\n"  
    lappend proplist "$prefix</property>\n"
  }
  if [info exists proplist] {return $proplist}
}
#--------------------------------------------------------------------------
proc getgumtreexml {path} {
  append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
  append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"

  if {[string compare $path "/" ] == 0} {
    foreach n [hlist $path] {
      set result [make_nodes /$n $result 2]
    }
  } else {
    foreach n [hlist $path] {
      set result [make_nodes $path/$n $result 2]
    }
  }

  append result "</hipadaba:SICS>\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 ,]
    catch {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
    catch {hupdate $stdscangraph/dim}
}
#------------------------------------------------------------------------------
proc hdbcollect {obj userobj np} {
    global stdscangraph
    stdscan collect $obj $userobj $np
    catch {hupdate $stdscangraph/scan_variable}
    catch {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
    set status [catch {hattach /instrument/experiment/user adress address} msg]
    if {$status != 0} {
    set status [catch {hattach /instrument/experiment/user address address} msg]
    }
    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" \
	hdbbatchpath text
    hsetprop /instrument/experiment/batchpath priv user
    sicspoll add /instrument/experiment/batchpath hdb 60
    sicspoll add /instrument/experiment/datafilenumber hdb 60
}
#----------------------------------------------------------
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
    catch {batchroot $pathstring}
    catch {hupdate /instrument/commands/batch/execute/file/values}
    catch {hupdate /instrument/commands/batch/batchpath}
    catch {hupdate /instrument/experiment/batchpath}
    catch {hupdate /batch/bufferlist}
}
#------------------------------------------------------------------
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
}
#------------------------------------------------------------------
proc confnxhdb {path alias pass} {
    hsetprop $path nxalias $alias
    hsetprop $path nxpass $pass
}
#----------------------------------------------------------------------
proc hdbstorenexus args {
    if {[llength $args] < 2} {
	error "hdbstorenexus called with insufficient number of arguments"
    }
    set path [lindex $args 0]
    set pass [lindex $args 1]
    set childlist [split [hlist $path] \n]
    foreach child $childlist {
	if {[string length $child] < 1} {
	    continue
        }
	set status [catch {hgetpropval $path/$child nxpass} passval]
	if {$status == 0} {
	    set status [catch {hgetpropval $path/$child nxslab} slabval]
            # ------- slabbed writing
	    if {$status == 0 && [string first $pass $passval] >= 0} {
		set slabsizes [eval $slabval [lrange $args 2 end]]
		nxscript puthdbslab $path/$child [lindex $slabsizes 0] [lindex $slabsizes 1]
            }
            #--------- normal writing
	    if {[string first $pass $passval] >= 0} {
		nxscript puthdb $path/$child
	    }
        }
	eval hdbstorenexus $path/$child $pass [lrange $args 2 end]
    }
}
#===================== Syntactical sugar around hdbscan ===================
# center scan. A convenience scan for the one and only Daniel Clemens 
# at TOPSI. Scans around a given center point. Requires the scan command 
# for TOPSI to work.
#
# another convenience scan:
# sscan var1 start end var1 start end .... np preset 
# scans var1, var2 from start to end with np steps and a preset of preset  
#
# Mark Koennecke, August 1997
#
# Reworked for hdbscan, Mark Koennecke, November 2008
#-----------------------------------------------------------------------------
proc cscan { var center delta np preset } {
#------ start with some argument checking
        set t [SICSType $var]
        if { [string compare $t DRIV] != 0 } {
          ClientPut [format "ERROR: %s is NOT drivable!" $var]
          return
        } 
        set t [SICSType $center]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $center]
          return
        }
        set t [SICSType $delta]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $delta]
          return
        }
        set t [SICSType $np]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $np]
          return
        }
        set t [SICSType $preset]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $preset]
          return
        }
	set mode [string trim [SplitReply [scan mode]]]
#-------- store command in lastscancommand
        set txt [format "cscan %s %s %s %s %s" $var $center \
                 $delta $np $preset]
        catch {lastscancommand $txt}
#--------- calculate start and do scan
        set start [expr $center - $np * $delta]
	set ret [catch {hdbscan $var $start $delta [expr ($np * 2) + 1] $mode $preset} msg]
        if { $ret != 0} {
          error $msg
        } else {
	    return $msg
	}
}
#---------------------------------------------------------------------------
proc sscan args { 
         scan clear
#------- check arguments: the last two must be preset and np!
         set l [llength $args]
         if { $l < 5} {
            ClientPut "ERROR: Insufficient number of arguments to sscan"
            return
         }
         set preset [lindex $args [expr $l - 1]]
         set np     [lindex $args [expr $l - 2]]
         set t [SICSType $preset]
         ClientPut $t
         ClientPut [string first $t "NUM"]
         if { [string compare $t NUM] != 0 } {
            ClientPut [format "ERROR: expected number for preset, got %s" \
                      $preset]
            return
         }
         set t [SICSType $np]
         if { [string compare $t NUM] != 0 } {
            ClientPut [format "ERROR: expected number for np, got %s" \
                      $np]
            return
         }
#--------- do variables
         set nvar [expr ($l - 2) / 3]
         for { set i 0 } { $i < $nvar} { incr i } {
            set var [lindex $args [expr $i * 3]]
            set t [SICSType $var]
            if {[string compare $t DRIV] != 0} {
              ClientPut [format "ERROR: %s is not drivable" $var]
              return
            }
            set start [lindex $args [expr ($i * 3) + 1]]
            set t [SICSType $start]
            if { [string compare $t NUM] != 0 } {
               ClientPut [format "ERROR: expected number for start, got %s" \
                        $start]
                return
            }
            set end [lindex $args [expr ($i * 3) + 2]]
            set t [SICSType $end]
            if { [string compare $t NUM] != 0 } {
               ClientPut [format "ERROR: expected number for end, got %s" \
                        $end]
                return
            }
#--------- do scan parameters
	   append scanvars $var ","
           append scanstarts $start ","
           set step [expr double($end - $start)/double($np-1)]
	   append scansteps $step ","
         }
#------------- set lastcommand text
         set txt [format "sscan %s" [join $args]]
         catch {lastscancommand $txt}
#------------- start scan
         set scanvars [string trim $scanvars ,]
         set scanstarts [string trim $scanstarts ,]
         set scansteps [string trim $scansteps ,]
         set mode [string trim [SplitReply [scan mode]]]
         set ret [catch {hdbscan $scanvars $scanstarts $scansteps $np $mode $preset} msg]
         if {$ret != 0} {
            error $msg
         } else {
	     return $msg
	 }
}
#------------------------------------------------------------------------------
proc splitScanVar {txt} {
    set l1 [split $txt =]
    set var [lindex $l1 0]
    set vl [split $var .]
    lappend result [lindex $vl 1]
    lappend result [string trim [lindex $l1 1]]
    lappend result [string trim [lindex $l1 2]]
}
#-----------------------------------------------------------------------------
proc scaninfo {} {
    set novar [string trim [SplitReply [xxxscan noscanvar]]]
    if {$novar == 0} {
       return "0,1,NONE,0.,0.,default.dat"
    }
    append result "scaninfo = "
    append result [string trim [SplitReply [xxxscan np]]] "," $novar
    for {set i 0} {$i < $novar} {incr i} {
	set vl [splitScanVar [xxxscan getvarpar $i]]
	append result ", " [lindex $vl 0]
    }
    set vl [splitScanVar [xxxscan getvarpar 0]]
    append result "," [lindex $vl 1]
    append result "," [lindex $vl 2]
    append result "," [SplitReply [xxxscan getfile]]
    append result "," [SplitReply [sample]]
    append result ","  [sicstime]
    append result "," [SplitReply [lastscancommand]]
    return $result
}
#-------------------------------------------------------------
proc scan args {
    if {[llength $args] < 1} {
	error "Need keyword for scan"
    }
    set key [string trim [lindex $args 0]]
    switch $key {
	uuinterest { return [xxxscan uuinterest] }
	pinterest {}
	getcounts { set cts   [SplitReply [xxxscan getcounts]]
	    return "scan.Counts = $cts"
	}
	mode {
	    if {[llength $args] > 1} {
		return [counter setmode [lindex $args 1]]
	    } else {
		return [counter getmode]
	    }
        }
	clear {
	    return [xxxscan clear]
	}
	default {
	    error "scan does not support keyword $key"
	}
    }
}