#---------------------------------------------------------------------------
# sea configuration scripts
#---------------------------------------------------------------------------

if {[sicsdescriptor hvali] eq "notfound"} {
  # replacement for hvali for use with old sics version
  definealias hvali hval
}

global vars
set vars ""

proc publishLazy {command {level User}} {
  set desc [sicsdescriptor $command]
  if {$desc eq "notfound"} {
    Publish $command $level   
  } elseif {$desc eq "Macro"} {
#    clientput $command already published
  } else {
    clientput publish will not overwrite $command of type $desc
  }
}

publishLazy publishLazy

proc result {cmd args} {
  set res [eval $cmd $args]
  set list [split $res =]
  if {[llength $list] > 1} {
    return [string trim [lindex $list 1]]
  } else {
    return [string trim $res]
  }
}

proc get_num {var args} {
  # used for matlab interface
  if {[string match /* $var]} {
    set cmd "hval $var"
  } elseif {[llength $var] == 1} {
    if {[string match *.* $var]} {
      set second [lassign [split $var .] var]
    } else {
      set second [list ]
    }
    set cmd "result $var [join $second /]"
    switch [sicstype $var] {
      COM - DRIV {
      }
      default {
        set cmd "hval /$var/[join $second /]"
      }
    }
  } else {
    set cmd $var
  }
  if {[catch {set res [eval "$cmd $args"]} msg]} {
    return $msg
  }
  return $res
}

publishLazy get_num spy

proc set_num {args} {
  # used for matlab interface
  set value [lindex $args end]
  set var [lrange $args 0 end-1]
  if {[string match /* $var]} {
    set cmd "hset $var $value"
  } elseif {[llength $var] == 1} {
    if {[string match *.* $var]} {
      set second [lassign [split $var .] var]
    } else {
      set second [list ]
    }
    set cmd "$var [join $second /] $value"
    switch [sicstype $var] {
      COM {
      }
      DRIV {
        if {[llength $second] == 0} {
          set cmd "run $var $value"
        }
      }
      default {
        set cmd "hset /$var/[join $second /] $value"
      }
    }
  } else {
    set cmd "$var $value"
  }
  if {![catch {eval $cmd} msg]} {
    return 1
  }
  return $msg
}

publishLazy set_num

proc is_busy {{variable "ANY"}} {
  if {$variable eq "ANY"} {
    return [expr {[listexe] ne "Machine Idle"}]
  }
  foreach var [listexe] {
    if {$variable eq $var} {
      return 1
    }
  }
  return 0
}

publishLazy is_busy spy

proc wait_for {{variable "ANY"}} {
  while {[is_busy $variable]} {
    wait 0.1
    incr cnt
    if {$cnt > 20} {
      clientput "."
      set cnt 0
    }
  }
  return 1
}

publishLazy wait_for spy

proc do_as_manager code {
  if {[result config myrights] == 2} { # user rights -> change to manager
    config rights seamanager seager
    if {[catch {uplevel 1 $code} msg]} {
      clientput "ERROR: in $code:\nERROR: $msg"
    }
    config rights seauser seaser
  } else {
    if {[catch {uplevel 1 $code} msg]} {
      clientput "ERROR: in $code:\nERROR: $msg"
    }
  }
}

proc scanargs {arglist array args} {
# scans arguments arglist and puts them into the array "array"
# or into separate variables, when array is "var"
# the number of elements in args returned, and stored in array(-cnt)
# formal arguments are given as -<name> [ <default value> ]

  if {$array ne "var"} {
    upvar $array arg
  }
  
# read formal arguments
  set name ""
  set idx 0
  foreach a $args {
    if {[string match {-[A-Za-z]*} $a]} {
      if {$name ne ""} {
        set values($name) ""
        set done($name) -1
        set names($idx) $name
        incr idx
      }
      set name $a
    } elseif {$name ne ""} {
      set values($name) $a
      set done($name) 0
      set names($idx) $name
      incr idx
      set name ""
    }
  }
  if {$name ne ""} {
    set values($name) ""
    set done($name) -1
    set names($idx) $name
    incr idx
  }
  set nargs $idx
#  clientput $arglist
#  clientput [array get values]
#  clientput [array get names]
  
# read actual arguments
  if {$nargs > 0} {
    set phase 0
  } else {
    set phase 2
  }
  set idx 0
  set argocnt 0
  set argsout [list]
  set name ""
  foreach a $arglist {
    if {$phase > 1} {
      lappend argsout $a
      incr argocnt
    } elseif {[string match {-[A-Za-z]*} $a]} {
      if {$phase == 0} {
        set phase 1
      }
      if {$name ne ""} {
        error "missing value for $name"
      }
      if {![info exists values($a)]} {
        set phase 2
        lappend argsout $a
        incr argocnt
      } else {
        if {$done($a) == 1} {
          error "double argument: $a"
        }
        set name $a
      }
    } else {
      if {$name eq ""} {
        if {$phase == 0 && $idx == $nargs - 1 && $names($idx) eq "-args"} {
          set phase 1
        }
        if {$phase == 1} {
          set phase 2
          lappend argsout $a
          incr argocnt
        } else {
          set name $names($idx)
          incr idx
          if {$idx >= $nargs} {
            set phase 2
          }
        }
      }
      set values($name) $a
      set done($name) 1
      set name ""
    }
  }
  if {$name ne ""} {
    error "missing value for $name"
  }
  if {$nargs > 0 && $names([expr $nargs - 1]) eq "-args"} {
    if {$done(-args) == 1} {
      if {[llength $argsout] > 0} {
        error "$args\nERROR: superfluous args: $argsout"
      }
    } else {
      set values(-args) $argsout
      set done(-args) 1
    }
  } elseif {[llength $argsout] > 0} {
    error "$args\nERROR: superfluous args (no -args argument at end): $argsout"
  }
  for {set idx 0} {$idx < $nargs} {incr idx} {
    set name $names($idx)
    if {$done($name) < 0} {
      error "$args\nERROR: missing $name argument: $arglist"
    }
    if {$array eq "var"} {
      upvar [string range $name 1 end] x
#      clientput "upvar [string range $name 1 end] $values($name)"
      set x $values($name)
    } else {
#      clientput "array $array ([string range $name 1 end]) $values($name)"
      set arg([string range $name 1 end]) $values($name)
    }
  }
  set arg(-cnt) $argocnt
  return $argocnt
}

proc cfgenv {{obj ""} args} {
  if {$obj eq "" || $obj eq "list"} {
    set objs [split [result cfg_env items]]
    foreach obj $objs {
      set val [result cfg_env $obj]
      if {[desc_env exists $obj]} {
        set des [result desc_env $obj]
      } else {
        set des ""
      }
      if {$val ne "undefined"} {
        if {[string length $obj] < 8} {
          clientput [format "%2s%-8s %-20s (%s)" " " $obj $val $des]
        } else {
          clientput [format "%10s %-20s (%s)" $obj $val $des]
        }
      }
    }
    clientput " "
    clientput "Usage:"
    clientput "   cfgenv <object> <terminalserver>:<port>\[:<driver>\]"
    clientput "       (port is usually 3000 + channel number)"
    clientput "   cfgenv remove <terminalserver>"
    clientput "   cfgenv remove <object>"
#    cfg_env list
    return ""
  } elseif {[llength $args] == 0} {
    set obj [silent $obj result alias_hostport $obj]
    if {[cfg_env exists $obj]} {
      return "cfgenv $obj = [result cfg_env $obj]"
    } else {
      return "cfgenv $obj = "
    }
  } elseif {$obj eq "remove"} {
    foreach obj [result cfg_env items] {
      set val [result cfg_env $obj]
      set host [lindex [split $val :] 0]
      set host [lindex [split $host .] 0]
      if {[string match "*.$host.*" ".[join $args .]."] \
        || [string match "* $obj *" " $args "]} {
        clientput "remove $obj $val"
        cfg_env deleteitem $obj
      }
    }
  } else {
    set ca [concat $args]
    set aobj [silent $obj result alias_hostport $obj]
    if {$ca eq "="} {
      cfg_env deleteitem $aobj
    } else {
      if {[lindex $args 0] eq "="} {
        set ca [lrange $args 1 end]
      }
      set old [silent unknown result cfg_env $aobj]
      cfg_env makeitem $aobj $ca
      if {[sicsdescriptor $obj] ne "notfound"} {
      	driverKind $obj hostport
	if {$ca ne $old || $ca ne $hostport} {
          $obj reconnect $ca
        }
      }
    }
  }
}

proc driverKind {obj {connectaddress 0} {drivername 0}} {
  if {$connectaddress ne 0} {
    upvar $connectaddress term
  }
  if {$drivername ne 0} {
    upvar $drivername driver
  }
  if {[sicsdescriptor $obj] eq "dummyremote"} {
    set term [result silent "" sics [hgetpropval $obj remobj] hostport]
    set driver " "
    return dummyremote
  }
  set cre [split [silent 0 result $obj creationCmd]]
  if {[llength $cre] == 4} {
    set term [lindex $cre 3]
    set driver [lindex $cre 2]
    return ease
  }
  set cre [split [silent 0 hgetpropval /sics/$obj creationCmd]]
  if {[lindex $cre 0] eq "stdConfig::make"} {
    set term [lindex $cre 3]
    set driver [lindex $cre 1]
    return stdsct
  } elseif {[llength $cre] == 3} {
    set term [lindex $cre 2]
    set driver [lindex [split [lindex $cre 0] _] 0]
    return oldsct
  }
  set cre [split [silent 0 hgetpropval /sics/$obj _makecmd]]
  if {[lindex $cre 0] eq "makesctcontroller"} {
    set term [$obj hostport]
#    set term [lindex $cre 3]
    set driver [lindex $cre 2]
    return sctcontroller
  }
  set term " "
  set driver " "
  return unknown
}

proc driverName {{obj 0}} {
  global makenv_object inside_samenv
  if {$obj eq "0" && $inside_samenv} {
    set obj $makenv_object
  }
  set drivername unknown
  driverKind $obj 0 drivername
  return $drivername
}

publishLazy driverName

proc showDeviceConfig { } {
  clientput " "
  clientput "Object Driver Connected to        Description"
  clientput \
"-------------------------------------------------------------------------------"
  set list [split [obj_list items]]
  set bad 0
  foreach obj $list {
    set kind [driverKind $obj term driver]
    set stat [silent "" result $obj status]
    set des [result obj_list $obj]
    if {[result config myrights] < 3} { # not when in spy mode
      switch -- $kind {
        sctcontroller - stdsct {
          desc_env makeitem $obj $des
        }
        oldsct {
#          cfg_env makeitem $obj $term
          desc_env makeitem $obj $des
        }
        ease {
#          cfg_env makeitem $obj $term
          desc_env makeitem $obj $des
        }
      }
    }
    set col123 [format "%-6s %-6s %-19s" $obj $driver $term]
    clientput [format "%-33s %s" [string trim $col123] "$des"]
    if { [string length $stat] > 0 } {
      clientput "    $stat"
      if {[lindex [split $stat " "] 0] eq "connecting"} {
        if {$bad == 0} {
          set bad 1
        }
      } else {
        set bad 2
      }
    }
  }
  if {$bad == 2} {
    clientput "  "
    clientput "Please check the cabling to the proper ports and terminalservers"
    clientput "If the configuration has to be changed, use"
    clientput " "
    clientput "  cfgenv"
    clientput " "
    clientput "and enter again"
    clientput " "
    clientput "  samenv [result device name]"
  }
  if {$bad == 1} {
    clientput " "
    clientput "Please check if the connection was successful with:"
    clientput " "
    clientput "  samenv"
  }
}

proc showUnconfigured { } {
  global device_name unconfigured_list
  set list $unconfigured_list
  if {[llength $list] > 1} {
    clientput "ERROR: connections for [join $list ,] are not configured"
  } else {
    clientput "ERROR: connection for [join $list] is not configured"
  }
  clientput " "
  clientput "Configure connections:"
  clientput " "
  foreach obj $list {
    clientput "  cfgenv $obj <terminalserver>:<port>\[:<driver>\]"
  }
  clientput "       (port is usually 3000 + channel number)"
  clientput " "
  clientput "and enter"
  clientput " "
  clientput "  samenv $device_name"
  clientput " "
  error     "again."
}

set inside_samenv 0

proc makenv args {
  global objects_created objects_replaced objects_already
  global inside_samenv unconfigured_list makenv_object

  if {$inside_samenv == 0} {
    clientput "ERROR: .config/.addon/.stick files must not be called directly"
    SetInt abortbatch
    return
  }

  set argc [scanargs $args var -objname -driver -controller 0 -port 0 -visibility user -args]

  set makenv_object $objname
  if {$controller eq "0"} {
    set dobj _$objname
  } else {
    set dobj $controller
  }
  if {[string match like-* $driver]} {
    set hostport [silent 0 result cfg_env $dobj]
    set hpl [split $hostport ":"]
    if {[llength $hpl] > 2} {
      set driver [lindex $hpl 2]
    } else {
      if {[lindex $hpl 1] == 7777} {
        set driver 336_lsc
      } else {
        set driver [string range $driver 5 end]
      }
    }
  }
  set ret [source_sct_driver $driver]
  if {$ret == 2} return
  if {$ret} {
    set kind stdsct
  } elseif {[llength [info procs ${driver}_Make]] == 1} {
    set dobj $objname
    set kind oldsct
  } else {
    set kind ease
    set dobj $objname
    set des [driverlist $driver]
    if {$des eq "notfound"} {
      error "unknown driver: $driver"
    }
    desc_env makeitem $objname $des
  }
  if {$port ne "0"} {
    set arg $port
  } elseif {[cfg_env exists $dobj] && ([result cfg_env $dobj] ne "")} {
    set arg [result cfg_env $dobj]
  } else {
    cfg_env makeitem $dobj
    if {$kind eq "ease"} {
      cfg_env $dobj ""
      lappend unconfigured_list $dobj
      clientput "$dobj not configured"
      return
    }
    cfg_env $dobj undefined
  }
  switch $kind {
    stdsct {
      set cmd [list stdConfig::make $driver $objname $controller -port $port]
      if {[llength $args] > 0} {
        foreach a $args {
          lappend cmd $a
        }
      }
      # clientput "STDSCT: $cmd"
      set oldcmd [silent none hgetpropval /sics/$objname creationCmd]
      if {[string equal -nocase $cmd $oldcmd]} {
        append objects_already "$objname "
        if {! [obj_list exists $objname]} {
          obj_list makeitem $objname unknown
        }
      } elseif {[catch {eval $cmd} msg]} {
        clientput "ERROR: in $cmd:"
        clientput "ERROR: $msg"
      } else {
        Layout /$objname
        device_layout /$objname [silent 0 hgetpropval /$objname layoutpos]
        if {$oldcmd eq "none"} {
          append objects_created "$objname "
        } else {
          append objects_replaced "$objname "
        }
      }
      if {$visibility ne "user"} {
        hsetprop /sics/$objname groupMode $visibility
      }
    }
    oldsct {
      set cmd "${driver}_Make $objname $arg"
      set oldcmd [silent none hgetpropval /sics/$objname creationCmd]
      if {[string equal -nocase $cmd $oldcmd]} {
        append objects_already "$objname "
        if {! [obj_list exists $objname]} {
          obj_list makeitem $objname unknown
        }
      } elseif {[catch {set des [eval $cmd]} msg]} {
        clientput "ERROR: in $cmd:"
        clientput "ERROR: $msg"
      } else {
        if {$oldcmd eq "none"} {
          append objects_created "$objname "
        } else {
          append objects_replaced "$objname "
        }
        obj_list makeitem $objname $des
      }
      Layout /$objname
      device_layout /$objname [silent 0 hgetpropval /$objname layoutpos]
    }
    ease {
      set cmd "makeobject $objname $driver $arg"
      # clientput "EASE $cmd"
      set oldcmd [silent none result $objname creationcmd]
      if {[string equal -nocase $cmd $oldcmd]} {
        append objects_already "$objname "
        if {! [obj_list exists $objname]} {
          obj_list makeitem $objname unknown
        }
      } elseif {[catch {eval $cmd} msg]} {
        clientput "ERROR: in $cmd:"
        clientput "ERROR: $msg"
      } else {
        if {$oldcmd eq "none"} {
          append objects_created "$objname "
        } else {
          append objects_replaced "$objname "
        }
        obj_list makeitem $objname $des
      }
    }
  }
}

proc stick_sensors {sensor1 sensor2} {
  set stick_name [result default stick]
  catch {
    set sn "${stickname}_[hgetpropval /tt/ts/curve shortname]"
    hsetprop /tt/ts/curve sensorname $sn
  }
  catch {
    tt ts/curve $sensor1
  }
  if {$sensor1 eq "undefined"} {
    GraphItem shown tt.ts 0
    GraphItem shown tt.setsamp.power 0
    GraphItem shown tt.setsamp.reg 0
  } else {
    GraphAdd tt.ts K T_sample blue
  }
  catch {
    tt
    defineTemperature tt
  }
  source config/stick.list
  if {[string match "code*" $sensor2]} {
    set code [lindex [split $sensor2=0 =] 1]
    set table_code [silent -1 set stick_cfgtable($stick_name)]
    if {$table_code != $code} {
      clientput "ERROR: code $code in $stick_name.stick does not match value from config/sticklist: $table_code"
    }
    set sensor2 code
  } else {
    catch {
      set sn "${stickname}_[hgetpropval /tt/ts_2/curve shortname]"
      hsetprop /tt/ts/curve sensorname $sn
    }
  }
  catch {
    tt ts_2/curve $sensor2
  }
  GraphItem label tt.ts_2 T_sample2
  GraphItem units tt.ts_2 K
  GraphItem color tt.ts_2 cyan
  if {$sensor2 eq "code" || $sensor2 eq "undefined"} {
    GraphItem shown tt.ts_2 0
  } else {
    GraphItem shown tt.ts_2 1
  }      
}

proc ts_sensor {sensor} {
  catch {
    catch {
      set sn "[result device stick_name]_[hgetpropval /tt/ts/curve shortname]"
      hsetprop /tt/ts/curve sensorname $sn
    }
    tt ts/curve $sensor
    if {$sensor eq "undefined"} {
      GraphItem shown tt.ts 0
    } else {
      GraphAdd tt.ts K T_sample blue
    }
    defineTemperature tt
  }
}

proc ts_sensor2 {sensor {rescode 0}} {
  # rescode is not used
  catch {
    catch {
      set sn "[result device stick_name]_[hgetpropval /tt/ts_2/curve shortname]"
      hsetprop /tt/ts/curve sensorname $sn
    }
    tt ts_2/curve $sensor
    GraphItem label tt.ts_2 T_sample2
    GraphItem units tt.ts_2 K
    GraphItem color tt.ts_2 cyan
    if {$sensor eq "code" || $sensor eq "undefined"} {
      GraphItem shown tt.ts_2 0
    } else {
      GraphItem shown tt.ts_2 1
    }      
  }
}

proc stick {name} {
  set ::selected_stick $name
}

proc import {device} {
  
  set file ${device}.config
  if {![file exists $file]} {
    set file ${device}.config.inc
    if {![file exists $file]} {
      return "$file not found"
    }
  }
  set deviceDesc [result deviceDesc]
clientput "read $file"
  source $file
  deviceDesc = $deviceDesc
}

proc prettyList { name desc } {
  clientput [format "%-10s %s" $name $desc]
}

proc findDesc {filename name} {
  set desc 0
  if {[catch {set fil [open $filename]}] == 0} {
    while {[gets $fil line] >= 0} {
      set s [split $line =]
      if {[string trim [lindex $s 0]] eq $name} {
        set desc [string trim [lindex $s 1]]
        break
      }
    }
    close $fil
  }
  return $desc
}

proc obj_dependency {command {mama ""} {kid ""}} {
  switch $command {
    set {
      if {$mama eq ""} {
        clientput "Usage: obj_dependency set <mama> <kid>"
        clientput "       obj_dependency set <mama> LOCK"
        error "illegal syntax"
      }
      if {$kid eq ""} {
        return
      }
      set d [silent "" result obj_dependencies $mama]
      foreach k $kid {
        set d [lsearch -all -inline -not -exact $d $k]
        lappend d $k
      }
      obj_dependencies makeitem $mama $d
    }
    kill {
      if {$mama eq ""} {
        clientput "Usage: obj_dependency kill <mama> <kid>"
        clientput "       obj_dependency kill <mama>"
        error "illegal syntax"
      }
      if {$kid eq ""} {
        # remove all items for mama
        catch {obj_dependencies deleteitem $mama}
      } else {
        set d [silent "" result obj_dependencies $mama]
        # remove item $kid
        set d [lsearch -all -inline -not -exact $d $kid]
        obj_dependencies makeitem $mama $d
      }
    }
    check {
      if {$kid ne ""} {
        error "Usage: obj_dependency check <mama>"
      }
      foreach kid [silent "" result obj_dependencies $mama] {
        if {$kid eq "LOCK"} {
          return 0
        }
        if {[sicsdescriptor $kid] ne "notfound"} {
          return 0
        }
      }
      return 1
    }
    list {
      if {$mama ne ""} {
        error "Usage: obj_dependency list"
      }
      foreach obj [obj_dependencies items] {
        clientput "$obj: [result obj_dependencies $obj]" 
      }
      return
    }
    default {
      error "Usage: obj_dependency (set | kill | check | list) \[<mama>\] \[<kid>\]"
    }
  }
}

proc remove_these_objects {list} {
  set cnt 1
  set newlist [list]
  # make while loop as long as at least one object is removed
  while {$cnt > 0} {
    set cnt 0
    foreach obj $list {
      if {[obj_dependency check $obj]} {
        if {[sicsdescriptor $obj] ne "notfound"} {
          catch { removeobject $obj } msg
          clientput $msg
          if {[regexp addon_(.*) $obj -> addonname]} {
            # remove addon from addon_list
            catch {addon_list deleteitem $addonname} msg
            if {$msg ne ""} {
              clientput $msg
            }
          }
          if {[sicsdescriptor $obj] eq "notfound"} {
            catch {obj_list deleteitem $obj}
            catch {obj_dependencies deleteitem $obj}
            incr cnt
          } else {
            clientput "could not delete $obj"
          }
        } else {
          catch {obj_list deleteitem $obj}
          catch {obj_dependencies deleteitem $obj}
        }
      } else {
        lappend newlist $obj
      }
    }
    set list $newlist
  }
}

proc sort_layout {} {
  set layoutlist [list]
  set cnt 500
  foreach item [device_layout items] {
    set val [result device_layout $item]
    # make value positive and with a fixed number of digits
    set key 5000000000
    if {[string is integer -strict $val]} {
      incr key $val
    } else {
      set val 0
    }
    incr cnt
    lappend layoutlist "$key $cnt $item $val"
    #clientput "$key $cnt $item $val"
    device_layout deleteitem $item
  }
  foreach item [lsort $layoutlist] {
    device_layout makeitem [lindex $item 2] [lindex $item 3]
  }
}  

proc stopall {} {
  catch {
    set running [listexe]
    if {$running ne "Machine Idle"} {
      clientput "stop $running"
      catch {stopexe run}
      for {set j 0} {$j < 2} {incr j} {
        set start [DoubleTime]
        set sleep 0.01
        for {set i 0} {[DoubleTime] < $start + 5} {incr i} {
          catch {wait 0.01}
          set sleep [expr $sleep * 1.1]
          set running [listexe]
          if {$running eq "Machine Idle"} break;
        }
        if {$running eq "Machine Idle"} break;
        # force stop of script context objects
        foreach obj $running {
          if {[catch {hsetprop /$obj status idle} msg]} {
            clientput $msg
          }
        }
      }
      set tim [expr [DoubleTime] - $start]
      if {$tim > 0.1} {
        clientput "time for stop [format %.2f $tim] ($i x)"
      }
      if {$running eq "Machine Idle"} {
        clientput "stopped"
      } else {
        clientput "RESET SERVER"
        resetserver
        wait 1
      }
    }
  } msg
  set running [listexe]
  if {$running ne "Machine Idle"} {
    clientput $msg
    clientput "could not stop $running"
  }
}

proc samenv args {
  global inside_samenv unconfigured_list vars logbase
  global objects_created objects_replaced objects_already device_name
  global selected_stick selected_addons
  global change_device_to_none

  set inside_samenv 0
  set verbose 1
  foreach a $args {
    switch -glob -- $a {
      -q* {
        set verbose 0
      }
      default {
        lappend arg $a
      }
    }
  }
  if {[info exists arg]} {
    set name [lindex $arg 0]
  } else {
    set name ""
  }
  set dev [result device name]
  set stk [result device stick_name]
  if {$stk ne "" && $stk ne $dev} {
    append dev /$stk
  }
  foreach a [result addon_list items] {
    if {$a ne $stk} {
      append dev /$a
    }
  }

  switch $name {
    name {
      return $dev
    }
    list {
      set list [lsort [glob *.config]]
      if {[llength $arg] == 1} {
        set func prettyList
      } else {
        set func [lindex $arg 1]
      }
      foreach item $list {
        $func [file rootname $item] [findDesc $item deviceDesc]
      }
      return ""
    }
    reload {
      set name $dev
    }
    "" {
      if {$verbose && $dev ne "none"} {
        clientput "$dev: [result deviceDesc]"
        showDeviceConfig
        clientput " "
        return "samenv = $dev"
      }
      return "samenv = $dev ([result deviceDesc])"
    }
  }

  set change_device_to_none 0

  set nl [split $name /]
  if {[llength $nl] == 1} {
    set selected_stick ""
    set selected_addons [list]
  } else {
    set name [lindex $nl 0]
    set selected_stick [lindex $nl 1]
    if {[file exists ${selected_stick}.stick]} {
      set selected_addons [lrange $nl 2 end]
    } else {
      set selected_stick ""
      set selected_addons [lrange $nl 1 end]
    }
  }

  set permanent_addons [list]
  foreach addon [addon_list items] {
    if {[result addon_list $addon] eq "permanent"} {
      lappend permanent_addons $addon
    } else {
    }
  }

  set file ${name}.config
  if { [file exists $file] == 0 } {
    return "$file not found"
  }

  device stick_menu ""
  if {$name eq "none" && [result device stick_name] ne ""} {
    addon delete [result device stick_name]
  }
  device stick_name ""
  device name none
  device makeitem stickrot_hostport unconnected

  stopall

  if {[default name] eq $name} {
    # save defaults
    clientput "--- save defaults ---\n[default list]\n---"
  } else {
    default clear
  }

  foreach seaclient [silent {} seaclient_list items] {
    obj_list makeitem $seaclient
    seaclient_list deleteitem $seaclient
  }

  set objects_to_kill [obj_list items]

  if { [llength $objects_to_kill] != 0 } {
    clientput " "
    clientput --- remove $dev ---
  }
#  catch {removeobject samenv_vars}

  remove_these_objects $objects_to_kill
  foreach item [split [device_layout items]] {
    device_layout deleteitem $item
  }

  GraphKill samenv
  GraphOrder
  # clear ignoreMsg flags:
  ignoreMsg 0

  reload

  if {$name eq "none" &&
      [llength $selected_addons] == 0 && [llength $permanent_addons] == 0} {
    device makeitem rack_used 0
    do_as_manager {
      set inside_samenv 1
      source none.config
      sort_layout
      request_items $name

      catch {array unset ::config_failed}
      device stickrot_hostport unconnected
      set inside_samenv 0
    }
    set device_name none
    restore killerr
    save_samenv none
    return "samenv = none"
  }
  clientput " "
  clientput --- install $name ---

  set vars ""

  set objects_created ""
  set objects_replaced ""
  set objects_already ""
  set ::device_name $name
  set ::stick_name $name
  ccu4_device 0

  if {[info exists unconfigured_list]} {
    unset unconfigured_list
  }
  set inside_samenv 1

  do_as_manager {
    catch {array unset ::config_failed}
    if {[catch {source $file} msg]} {
      clientput "ERROR: in $file\nERROR: $msg"
      set ::config_failed("_device") "error in $file: $msg"
    }
    request_items $name
  }
  device changetime [DoubleTime]
  set inside_samenv 0
  if {[info exists unconfigured_list]} {
    showUnconfigured
  }
  default name $name

  if {$selected_stick eq ""} {
    set selected_stick [silent "" default stick]
    if {$selected_stick ne ""} {
      clientput "set stick to $selected_stick"
    }
  }
  if {$selected_stick eq ""} {
    if {[silent none hvali /tt/ts/curve] eq "undefined"} {
      set selected_stick $name
      if {[silent "" result device stick_menu] eq ""} {
        device stick_menu $name
      }
    } elseif {[silent "" result device stick_menu] ne ""} {
      set selected_stick "none"
    }
  }
#  if {$selected_stick ne ""} {
#    set inside_samenv 1
#    clientput "selected_stick $selected_stick"
#    set ::stick_name $selected_stick
#    do_as_manager {
#      source ${selected_stick}.stick
#    }
#    unset ::stick_name
#    set inside_samenv 0
#    device stick_name $selected_stick
#    default stick $selected_stick
#  }

# make sure that endinit flag is set
  obj_list endinit

  sort_layout

  set ccudesc [sicsdescriptor cc]
  if {$ccudesc eq "ccu4"} {
    device makeitem rack_used 1
# should be given explicitely as arg to makeCCU4
#    ccu4_device default
  } else {
    device makeitem rack_used 0
    if {$ccudesc eq "notfound"} {
      set rack [silent other result device rack]
      catch {
        set autorack [get_rack $rack]
        if {$autorack ne $rack} {
          set racks [get_rack]
          if {[llength $racks] == 1} {
            set rack $racks
          } else {
            # this is an error message
            clientput "RACKS: $racks"
          }
        }
      }
      if {$rack ne "no" && $rack ne "" && $rack ne "other"} {
        do_as_manager {
          set inside_samenv 1
          makenv cc ccu4
          set inside_samenv 0
          ccu4_show_device $device_name
        }
      }
    }
  }

#  makeobject samenv_vars array
  GraphLoad $vars samenv

  default stick $selected_stick

  default load

  device name $name
  obj_list savefile ""
  if { [string length $objects_created] != 0 } {
    clientput "create: $objects_created"
  }
  if { [string length $objects_replaced] != 0 } {
    clientput "replace: $objects_replaced"
  }
  if { [string length $objects_already] != 0 } {
    clientput "already there: $objects_already"
  }
  if {$verbose} showDeviceConfig

  if {$selected_stick ne ""} {
    addon stick $selected_stick
  }
  foreach a $selected_addons {
    addon $a
  }
  foreach a $permanent_addons {
    addon permanent $a
  }

  if {[sicsdescriptor sics] eq "RemServer"} { 
#    update_remob
    sics nowait sea nowait update_remob
  }
  save_samenv
  return "samenv = $name"
}

proc addon args {
  global inside_samenv unconfigured_list vars permanent_addon
  global selected_addons
  global objects_created objects_replaced objects_already

  switch [lindex $args 0] {
    permanent {
      set permanent_addon 1
      if {$inside_samenv} {
        if {[llength $args] > 1} {
          error "ERROR: usage inside an addon: addon permanent"
        }
        return
      }
      if {[llength $args] != 2} {
        error "ERROR: usage: addon permanent <addon>"
      }
      set name [lindex $args 1]
      set state [silent notfound result addon_list $name]
      if {$state ne "notfound"} {
        if {$state ne "permanent"} {
          foreach o [result obj_dependencies addon_$name] {
            obj_dependency set $o addonlock_$name
          }
          makeobject addonlock_$name string
          obj_list makeitem addonlock_$name
          addon_$name makeitem addonlock_$name
          addon_list $name permanent
          clientput "addon $name set to permanent"
        } else {
          clientput "addon $name is already permanent"
        }
        return
      }
      set file ${name}.addon
    }
    delete {
      if {$inside_samenv} {
        error "ERROR: addon delete inhibited inside config scripts"
      }
      if {[llength $args] != 2} {
        error "ERROR: usage: addon delete <addon>"
      }
      stopall
      set name [lindex $args 1]
      catch {
        set olist [silent 0 addon_$name items]
        clientput "(addon delete: remove $olist)"
        if {$olist ne "0"} {
          remove_these_objects "$olist addon_$name"
        }
        catch {addon_list deleteitem $name}
        GraphKill $name
        obj_dependency kill addon_$name
        return ""
      } msg
      if {$msg ne ""} {
        clientput $msg
      }
      device changetime [DoubleTime]
      save_samenv
      return
    }
    stick {
      if {[llength $args] == 1} {
        return [result device stick_name]
      }
      if {$inside_samenv} {
        error "ERROR: addon stick inhibited inside config scripts"
      }
      if {[llength $args] != 2} {
        error "ERROR: usage: addon stick <stick>"
      }
      set name [lindex $args 1]
      set ::stick_name $name
      if {$name eq "cancel"} {
        return [result device stick_name]
      }
      if {[result device stick_name] ne ""} {
        clientput "(addon delete [result device stick_name])"
        addon delete [result device stick_name]
      }
      device stick_name $name
      default stick $name
      set file ${name}.stick
      set permanent_addon 0
    }
    list {
      return [string map "{[result device stick_name]} {}" [addon_list items]]
    }
    default {
      if {[llength $args] != 1} {
        error "ERROR: usage: addon \[permanent | delete\] <addon>"
      }
      set name [lindex $args 0]
      if {$inside_samenv} {
        lappend selected_addons $name
      }
      set permanent_addon 0
      if {[addon_list exists $name]} {
        addon delete $name
        catch {unset ::config_failed($name)}
      }
      set file ${name}.addon
    }
  }
  if { [file exists $file] == 0 } {
    return "$file not found"
  }
  if {[info exists unconfigured_list]} {
    unset unconfigured_list
  }
  set vars ""
  set objects_created ""
  set objects_replaced ""
  set objects_already ""
  set old_inside $inside_samenv
  set inside_samenv 1
  if {[catch {
      if {[result config myrights] == 2} {
        config rights seamanager seager
        source $file
        config rights seauser seaser
      } else {
        source $file
      }
    } msg]} {
    clientput "ERROR: in $file\nERROR: $msg"
    set ::config_failed($name) "error in $file: $msg"
  } else {
    catch {unset ::config_failed($name)}
  }
  device changetime [DoubleTime]
  set inside_samenv $old_inside
  if {[info exists unconfigured_list]} {
    showUnconfigured
  }
  obj_list endinit

  sort_layout

  makeobject addon_$name array
  obj_list makeitem addon_$name ADDON
  
  if {$permanent_addon} {
    addon_list makeitem $name permanent
  } else {
    addon_list makeitem $name volatile
  }
  GraphLoad $vars $name
  if { [string length $objects_created] != 0 } {
    clientput "create: $objects_created"
  }
  if { [string length $objects_replaced] != 0 } {
    clientput "replace: $objects_replaced"
  }
  if { [string length $objects_already] != 0 } {
    clientput "already there: $objects_already"
  }
  set objlist [string trim "$objects_created $objects_replaced $objects_already"]
  set dep ""
  foreach o $objlist {
    foreach d [silent "" result obj_dependencies $o] {
      addon_$name makeitem $d
    }
    addon_$name makeitem $o
    append dep " $o [silent "" result obj_dependencies $o]"
  }
  obj_dependency set addon_$name $dep
  if {$permanent_addon} {
    foreach o $dep {
      obj_dependency set $o addonlock_$name
    }
    makeobject addonlock_$name string
    addon_$name makeitem addonlock_$name
    obj_list makeitem addonlock_$name
  }
  if {[sicsdescriptor sics] eq "RemServer"} {
#    update_remob
    sics nowait sea nowait update_remob
  }  
  save_samenv
  return OK
}

proc ConfigState {} {
  if {[array exists ::config_failed]} {
    foreach {name msg} [array get ::config_failed] {
      Style warning
      Label "$msg"
    }
  }
}


proc defineTemperature {obj} {
  if {[silent "" result findalias temperature] ne $obj} {
    do_as_manager {
      definealias temperature $obj
    }
    clientput "definealias temperature $obj"
  }
}

publishLazy samenv Spy
publishLazy addon Spy
publishLazy cfgenv Spy
publishLazy defineTemperature User

catch { unset autoFlowPar }
catch { unset tempStat }
catch { unset powStat }
catch { unset flowStat }

proc appendVars args {
  global vars inside_samenv
  if {$inside_samenv} {
    if {[string length $vars] == 0} {
      append vars $args
    } else {
      append vars " " $args
    }
    return 1
  } else {
    return 0
  }
}

set now [clock seconds]

proc e args {
  clientput [eval [join $args]]
}

publishLazy e

proc ctrlTable args {
  if {[llength $args] < 2} {
    error "ERROR: need at least 2 args"
  }
  set obj [lindex $args 0]
  if {$obj eq "fixed"} {
    set obj [lindex $args 1]
    if {[llength $args] < 3} {
      error "ERROR: fixed what ?"
    }
    set par [lindex $args 2]
    set res 0
    if {[sicsdescriptor fixed_$obj] eq "array"} {
      if {[string match -nocase "* $par *" " [fixed_$obj items] "]} {
        set res [result fixed_$obj $par]
      }
    }
    if {[llength $args] > 3} {
      if {[lindex $args 3] == 1} {
        if {[sicsdescriptor fixed_$obj] ne "array"} {
          makeobject fixed_$obj array
        }
        set res 1
      } else {
        set res 0
      }
      fixed_$obj makeitem $par $res
    }
    return "fixed_$obj $par = $res"
  }
  set par [lindex $args 1]
  if {[string match -nocase "* $par *" " [table_$obj items] "]} {
    if {[llength $args] < 3} {
      set res ""
      catch {set res [result table_$obj $par]}
      return "table_obj $par = $res"
    } elseif {[llength $args] >= 3} {
      set val [join [split [join [lrange $args 2 end]] ?]]
      set tbl [split [lindex $args 2] :]
      if {[llength $tbl] == 1} {
        return [table_$obj $par "? $val"]
      }
      set dirty 0
      set last 0
      set item1 [split [lindex $tbl 0]]
      if {[llength $item1] > 1} {
        set dirty 1
      }
      set xi [lindex [split [lindex $tbl 0]] end]
      set tbl [lrange $tbl 1 end]
      foreach item $tbl {
        set it [split $item]
        switch [llength $it] {
          1 {
            set last 1
          }
          2 {
            if {$last} {
              set dirty 1
            }
          }
          default {
            set dirty 1
          }
        }
        set yi [lindex $it 0]
        append new "$xi:$yi "
        set xi [lindex $it end]
      }
      if {$last != 1 || $dirty} {
        set val "? $val"
      }
      return [table_$obj $par $val]
    }
  }
  error "ERROR: ctrlTable syntax error"
}

publishLazy ctrlTable Spy

set lastset 0

proc intpol { obj par x {old none}} {
  # obsolete ? MZ May 2016
  set tbl [split [result table_$obj $par] :]
  if {[llength $tbl] == 1} {
    $obj $par [lindex [split $tbl] 0]
    return
  }
  set x0 0
  set x1 1e30
  set y0 0
  set y1 0
  set xi [lindex [split [lindex $tbl 0]] end]
  set tbl [lrange $tbl 1 end]
  foreach item $tbl {
    set it [split $item]
    set yi [lindex $it 0]
    if {$xi <= $x} {
      if {$xi > $x0} {
        set x0 $xi
        set y0 $yi
      }
    } else {
      if {$xi < $x1} {
        set x1 $xi
        set y1 $yi
      }
    }
    set xi [lindex $it end]
  }
  if {$y0 <= 0 || $y1 <= 0} {
    # linear in x and y
    set q [expr $x1 - $x0]
    if {$q > 0} {
      set y [expr $y0 + ($x - $x0) / $q * ($y1 - $y0)]
    } else {
      set y $y0
    }
  } else {
    # logarithmic in x and y
    set q [expr log($x1*1.0/$x0)]
    if {$q > 0} {
      set y [expr $y0*exp(log($x*1.0/$x0)/$q*log($y1*1.0/$y0))]
    } else {
      set y $y0
    }
  }
  if {$y != $old} {
    $obj $par $y
  }
}

proc putIntoLimits { name min max } {
  # if min > max min is ignored
  upvar $name v
  if {$v > $max} {
    set v $max
  } elseif {$v < $min} {
    set v $min
  }
}

proc pidControl { name dif prop inte min max} {
  upvar $name out
  upvar #0 pid_dif_$name d
  global deltaTime
  
  if { [info exists d] == 0} {
    set d 0
  }
  set out [expr $out + $prop * (($dif - $d) + $dif * $deltaTime / $inte)]
  #clientput "$name $dif $n(d) $out"
  set d $dif
  putIntoLimits out $min $max
  return $dif
}

proc minMax {name idx value {value2 none} } {
  upvar $name n
  if {"$value2" eq "none"} {
    set value2 $value
  }
  if {$value2 > $n(max$idx)} {
    set n(max$idx) $value2
  } elseif {$value < $n(min$idx)} {
    set n(min$idx) $value
  }
}

proc statInp { name period value } {
  upvar $name n
  global now

  if {$value eq "undefined"} {
    set n(spread) 1
    return
  }
  if { [info exists n(idx)] == 0} {
    set n(idx) 0
    set n(last) $now
    set n(spread) 1
    set n(min0) $value
    set n(min1) $value
    set n(min2) $value
    set n(min3) $value
    set n(max0) $value
    set n(max1) $value
    set n(max2) $value
    set n(max3) $value
  }
  set idx $n(idx)
  if {$now > $n(last) + ($period - 3)/ 4} {
    incr idx
    if {$idx >= 4} {
      set idx 0
    }
    set n(idx) $idx
    set n(max$idx) $value
    set n(min$idx) $value
    set n(last) $now
  } else {
    minMax n $idx $value 
  }

  set n(maxn) $n(max0)
  set n(minn) $n(min0)
  minMax n n $n(min1) $n(max1)
  minMax n n $n(min2) $n(max2)
  minMax n n $n(min2) $n(max3)

  set n(spread) [expr $n(maxn) - $n(minn)]
  if {$n(maxn) > -$n(minn)} {
    set n(absmax) $n(maxn)
  } else {
    set n(absmax) [expr -$n(minn)]
  }
  
  return $n(spread)
}

proc ChnState {} {
  global change_device_to_none unplugged_device
  
  if {[silent 0 set change_device_to_none] > 0 } {
    Style warning
    Label "[string toupper $unplugged_device] unplugged -> change to NONE in [expr $change_device_to_none - [clock seconds]] sec"
    NoNewline
    Style warning
    RadioGroup do_not_change_to_none
    RadioButton 0 "do not do it"
    Style warning
    NoNewline
    RadioButton 1 "do it now"
  }
}

proc do_not_change_to_none {{value 2}} {
  global change_device_to_none unplugged_device
  
  if {$value == 0} {
    set change_device_to_none 0
  } elseif {$value == 1} {
    set change_device_to_none [clock seconds]
  }
  if {$change_device_to_none == 0} {
    return 0
  }
  if {[clock seconds] >= $change_device_to_none} {
    return 1
  }
  return 2
}
 
publishLazy do_not_change_to_none

proc startAutodeviceCron {} {
  if {[sicscron count autodeviceCron] == 0} {
    sicscron 1 autodeviceCron
  }
}

proc autodevice_cnt {value} {
  set old [silent -1 sct oldvalue]
  if {abs($value - $old) <= abs($value + $old) * 0.01} {
    set update_cnt [sct update_cnt]
    if {$update_cnt < 9} {
      incr update_cnt
      sct update_cnt $update_cnt
    }
  } else {
    sct update_cnt 0
    sct oldvalue $value
  }
}

proc autodeviceCron {} {
  global change_device_to_none unplugged_device

  logconfig flush
  rack_check_connection
  set act [silent "" result device action]
  set now [clock seconds]
  if {$act eq "renew"} {
    if {[result device ccu4_device] ne "0"} {
      clientput "CCU4 has restarted - configure"
      ccu4_device renew
    }
    device action ""
  } elseif {$act eq "rebuild"} {
    device action ""
    set objdict [dict create]
    foreach obj [obj_list items] {
      if {[silent 0 hgetpropval /sics/$obj rebuild_addon]} {
        dict set objdict $obj 1
      }
    }
    set rebuildict [dict create]
    foreach addon [addon_list items] {
      foreach aobj [addon_$addon items] {
        if {[dict exists $objdict $aobj]} {
          dict set rebuildict $addon 1
          dict unset objdict $aobj
        }
      }
    }
    if {[llength $objdict]} {
      set device [result device name]
    } else {
      set device ""
    }
    set addons [list]
    set stick [list]
    set stick_name [result device stick_name]
    foreach {addon yes} $rebuildict {
      if {$addon eq $stick_name} {
        lappend stick $addon
      } else {
        lappend addons $addon
      }
    }
clientput "CONFIG $device/$stick/$addons"
    if {$device eq ""} {
      if {[llength %stick]} {
        addon stick $stick
      }
      foreach addon $addons {
        addon $addon
      }
    } else {
      samenv -q $device/$stick/[join $addons /]
    }
  } elseif {$act ne ""} {
    set new [silent 0 result device newdevice]
    set change_device_to_none 0
    if {$new eq "none"} {
      if {$act eq "plugged"} {
        set unplugged_device [result device name]
        if {$unplugged_device ne "none"} {
          clientput "unplugged $unplugged_device"
          set change_device_to_none [expr $now + 60]
        }
      } else {
        clientput "none $act"
        samenv -q none
      }
    } elseif {$act eq "plugged" && $new eq [result device name]} {
      clientput "$new plugged, no change"
    } else {
      clientput "$new $act"
      catch {samenv -q $new} msg
      clientput $msg
    }
    device action ""
  } else {
    set c2n [silent 0 set change_device_to_none]
    if {$c2n != 0 && $now > $c2n} {
      set change_device_to_none 0
      samenv -q none
    }
    if {![device exists force_status_save]} {
      device makeitem force_status_save 0
    } else {
      device force_status_save 0
    }
  }
  set curveD [silent 0 hvali /tt/ts_2/curve]
  if {$curveD eq "0" || $curveD eq "undefined"} {
    if {[string match "stick *" [silent 0 hvali /tt/status]]} {
      hupdate /tt/status ""
    }
  } else {
    source config/stick.list
    set devstk [silent none result device stick_name]
    if {$devstk ne "none"} {
      set rawpath /tt/ts_2/raw
      set r [silent -1 hvali $rawpath]
      set upd [silent -1 hgetpropval $rawpath update_cnt]
      if {$upd == -1} {
        hsetprop $rawpath update_cnt 0
        hsetprop $rawpath last_res_no 0
        _tt updatescript $rawpath autodevice_cnt
      }
      if {$r < -1} {
        set res_no [expr round(log10(-$r) * 12)]
        set last_res_no [hgetpropval $rawpath last_res_no]
        if {$res_no != $last_res_no} {
          hsetprop $rawpath update_cnt 0
          hsetprop $rawpath last_res_no $res_no
          if {[string match "stick *" [silent 0 hvali /tt/status]]} {
            hupdate /tt/status ""
          }
          return
        }
        if {$upd < 3} {
          return
        }
        set found_stick 0
        set bad_sticks [list]
        foreach {stk code} [array get stick_cfgtable] {
          if {$res_no == round(log10($code) * 12)} {
            if {$devstk eq $stk} {
              set found_stick 1
            } else {
              lappend bad_sticks $stk
            }
          }
        }
        if {$found_stick == 0 && [llength $bad_sticks] > 0} {
          # hupdate /tt/status "stick seems not to be $devstk (may be $bad_sticks?)"
        } elseif {[string match "stick *" [hvali /tt/status]]} {
          hupdate /tt/status ""
        }
      } elseif {$r >= 0 && $upd >= 3} { # no code on stick seen
        if {[info exists stick_cfgtable($devstk)]} {
          if {$r == 0} {
            hupdate /tt/status "stick not inserted? use stick 'none'"
          } else {
            hupdate /tt/status "stick with no coding inserted?"
          }
        } elseif {[string match "stick *" [hvali /tt/status]]} {
          hupdate /tt/status ""
        }
      }
    }
  }
}

proc debug args {
  config listen 1
  set verbose 2
  set debug 0
  set info "switch debugging mode on for:"
  if {$args eq "all"} {
    set objects [obj_list items]
  } elseif {$args eq "off"} {
    set objects [obj_list items]
    set debug -1
    set verbose 0
    set info "switch debugging mode off for:"
  } else {
    set objects $args
  }
  foreach obj $objects {
    switch [driverKind $obj term] {
      stdsct - oldsct {
        if {[result $term debug] != $debug} {
          $term debug $debug
          append info " $term/$obj"
        }
      }
      sctcontroller {
        if {[result $obj debug] != $debug} {
          $obj debug $debug
          append info " $obj"
        }
      }
      ease {
        if {[result $obj verbose] != $verbose} {
          $obj verbose $verbose
          append info " $obj"
        }
      }
    }
  }
  clientput $info
}

publishLazy debug

proc loggerCheck {node} {
  set logger_name [silent "" hgetprop $node logger_name]
  scan [hinfo $node] {%[a-z],%d,} type children
  if {$logger_name ne ""} {
    if {$type in [list int float]} {
      return -1
    }
    if {[silent "" hgetpropval $node cvtfunc] ne ""} {
      return -1
    }
    if {[silent "" hgetpropval $node enum] ne ""} {
      return -1
    }
  }
  if {$children > 0} {
    return [hdbScan $node/ loggerCheck]
  }
  return 1
}

proc loggerGroup {path} {
  hdbScan $path loggerShow
}

proc loggerShow {node} {
  GraphInput $node
  if {[hdbScan $node/ loggerCheck] < 0} {
    set title [silent "down $node" hgetpropval $node group]
    Group logger $title $node/
  }
  return 0
}

proc grsGroup {path} {
  loggerShow $path
}

proc groGroup {obj} {
  foreach item [$obj loggeditems] {
    GraphInput $item 
  }
}

set tt_loggedlist {tt.tm tt.ts tt.set tt.tr tt.te tt.tk tt.he tt.p tt.aux \
  tt.prop tt.int tt.deriv tt.set2 tt.power2 \
  tt.tShift tt.shiftUp tt.shiftLow tt.state \ 
  tt.ScanChan tt.t0 tt.t1 tt.t2 tt.t3 tt.t4}

foreach item $tt_loggedlist {
  set tt_loggeditems($item) 1
}

proc connectionsGroup {} {
  global unconfigured_list 
  if {[info exists unconfigured_list]} {
    set list $unconfigured_list
  } else {
    set list [list]
  }
  foreach obj [split [obj_list items]] {
    lappend list $obj
  }
  foreach obj $list {
    if {[cfg_env exists $obj]} {
      set cfg 0
      switch [sicsdescriptor $obj] {
        notfound {
          set cfg 1
        }
        array {}
        SctController {
          set mc [silent {0 0 0 0} hgetpropval /sics/$obj _makecmd]
          if {[lindex $mc 3] eq "without_connection"} {
            # this is a protocol without connection
            set cfg 0
          } else {
            set cfg 2
          }
        }
        default {
          if {[silent 0 $obj creationCmd] eq "0"} {
            # sct object: do not display hostport, is on controller
            set cfg 0
          } else {
            # ease object
            set cfg 3
          }
        }
      }
      if {$cfg > 0} {
        Newline
        Label "[silent $obj result obj_list $obj]:"
        Newline
        Tip "<terminal server>:3000+<channel number>"
        Tip "i.e. pstsXXX:300Y"
        Input "host:port for $obj" "cfgenv $obj" 16
        if {$cfg == 3} {
          NoNewline
          Label [silent "" result $obj status]
        }
      }
    }
  }
}

proc configGroup {} {
  global unconfigured_list 
  Group connections "connections"
  foreach obj [split [obj_list items]] {
    set opath [silent 0 hgetpropval /sics/$obj objectPath]
    if {$opath ne "0"} {
      Group grs "graphics for [silent $obj hgetpropval $opath group]" $opath
    } else {
      set desc [sicsdescriptor $obj]
      switch $desc {
        Macro - SctController {
        }
        default {
          Group gro "graphics for [silent $obj result obj_list $obj]" $obj
        }
      }
    }
  }
}

proc showStatus {obj {respectIgnore 0}} {
  set canNotConnect 0
  switch [sicsdescriptor $obj] {
    notfound {
      Newline
      Style warning
      set nam [silent 0 result desc_env $obj]
      if {$nam eq "0"} {
        set nam $obj
      } else {
        set nam "$obj ($nam)"
      }
      Tip "check setting of serial connections"
      Label "$nam: connection port unconfigured"
    }
    Macro {}
    default {
      set s [silent "" result $obj status]
      if {$s eq "no response" && [silent 0 hgetpropval /sics/$obj ignore_no_response]} {
        set s ""
      }
      if {$respectIgnore} {
        if {[ignoreMsg $obj]} {
          set s ""
        }
      }
      if {$s ne ""} {
        Newline
        Style warning
        set nam [result obj_list $obj]
        if {[cfg_env exists $obj]} {
          Tip "$nam: check cabling and setting of serial connections"
        } else {
          Tip $nam
        }
        Label "$obj: $s"
#        if {[string match "*no*response*" $s] || [string match "disconnected*" $s] || [string match "offline*" $s]} 
        if {[string match "*no*response*" $s] || [string match "disconnected*" $s]} {
          NoNewline
          Style warning
          CheckBox "reconnect" "reconnect_object $obj/0"
        } else {
          set canNotConnect 1
        }
        if {$respectIgnore} {
          NoNewline
          Style warning
          CheckBox "ignore" "ignoreMsg $obj"
        } elseif {[ignoreMsg $obj]} {
          Style warning
          CheckBox "ignore error message in header" "ignoreMsg $obj"
        }
        Newline
      }
    }
  }
  return $canNotConnect
}

proc ignoreMsg {obj {ignore read}} {
  if {$obj eq 0} {
# clear ignore messages
    foreach obj [ignore_msg items] {
      ignore_msg makeitem $obj ""
    }
    return
  }
  set status [silent "" result $obj status]
  if {$ignore eq "read"} {
# check ignore flag
    set imsg [silent "" result ignore_msg $obj]
    if {$imsg eq $status || $imsg eq "always"} {
      return 1
    }
    return 0
  }
  if {$ignore == 0} {
    ignore_msg makeitem $obj ""
  } elseif {$ignore eq "always"} {
    ignore_msg makeitem $obj "always"
  } else {
    ignore_msg makeitem $obj $status
  }
}   

publishLazy ignoreMsg

proc ObjState {} {
  global unconfigured_list
  if {[info exists unconfigured_list]} {
    set list $unconfigured_list
  } else {
    set list [list]
  }
  foreach obj [split [obj_list items]] {
    lappend list $obj
  }
  set canNotConnect 0
  foreach obj $list {
    if {$obj eq "_cc"} {
      set canNotConnect [showStatus _cc 1]
    } else {
      showStatus $obj 1
    }
  }
  if {[result device name] eq "none"} {
    Group rack "choose rack"
  } elseif {$canNotConnect} {
    Style warning
    if {[silent no result device rack] eq "other"} {
      Label "can not connect to CCU"
      Newline
      Style hotwarning
      Label "please check the network connection to the device server"
      Style hotwarning
      Label "or configure the connection to ccu4 or select rack"
    } else {
      if {[silent no result device rack] eq "no"} {
        Label "no rack selected"
      } else {
        Label "probably wrong rack selected"
      }
      Style hotwarning
      Label "please select rack (rack number as labelled on the top of the rack)"
    }
    Group rack "choose rack"
  }
}

proc Item {name desc} {
  Tip $desc
  RadioButton $name
}

proc listSelectDir {fil show} {
  global shown_groups
  global done_codes

  clientput -a
  while {[gets $fil line] >= 0} {
    set s [split [string trim $line]]
    if {[lindex $s 0] eq "END"} {
      return
    }
    if {[llength $s] >= 2 && ([lindex $s 0] eq "GROUP")} {
      set desc [lrange $s 1 end]
      set grp [lindex $s 1]
      if {$show} {
        clientput "-T$desc"
        clientput "-GS_$grp"
        if {[info exists shown_groups(S_$grp)]} {
          RadioGroup "samenv -q" [result device name]
          listSelectDir $fil 1
          clientput "-E1"
        } else {
          listSelectDir $fil 0
          clientput "-E0"
        }
      } else {
        listSelectDir $fil 0
      }
    } else {
      foreach dev [lsort [glob -nocomplain $s.config]] {
        if {[file exists $dev]} {
          set code [file rootname $dev]
          if {$show && ! [info exists done_codes($code)]} {
            if {$code eq "none"} {
              RadioButton reload "reload [samenv name]"
            }
            RadioButton $code "$code ([findDesc $dev deviceDesc])"
            Newline
          }
          set done_codes($code) 1
        }
      }
    }
  }
}

proc webDeviceGroup {} {
  global shown_groups
  global done_codes

  array unset done_codes
  if {[catch {set fil [open config/device.list]}]} {
    return [list]
  }
  clientput "-Tnone"
  set idx 0
  RadioGroup "samenv -q$idx" [result device name]
  RadioButton reload "reload [samenv name]"
  set failure [catch {
    # clientput -a
    while {[gets $fil line] >= 0} {
      set s [split [string trim $line]]
      if {[lindex $s 0] eq "END"} {
        continue
      }
      if {[llength $s] >= 2 && ([lindex $s 0] eq "GROUP")} {
        # group desc
        set grp [lindex $s 1]
        set desc [lrange $s 1 end]
        clientput "-T$desc"
        incr idx
        RadioGroup "samenv -q$idx" [result device name]
      } else {
        foreach dev [lsort [glob -nocomplain $s.config]] {
          if {[file exists $dev]} {
            set code [file rootname $dev]
            if {! [info exists done_codes($code)]} {
              RadioButton $code "$code ([findDesc $dev deviceDesc])"
              Newline
            }
            set done_codes($code) 1
          }
        }
      }
    }
  } msg]
  close $fil
  if {$failure} {
    error $msg
  }
}

proc selectList {} {
  global done_codes
  global shown_groups

  array unset done_codes
  if {[result device frappy_u_config]} {
    CheckBox "device controlled by NICOS/Frappy" "device frappy_u_config"
    Newline
    Style warning
    Label "the frappy main server is killed when the device is changed"
    Newline
    Style warning
    Label "or on deactivation of above check box"
    Newline
  }
  if {[catch {set fil [open config/device.list]}] == 0} {
    RadioGroup "samenv -q" [result device name]
    listSelectDir $fil 1
    close $fil
  }
}

proc -deviceGroup {} {
  NarrowColumn
#  OkButton 1 "Change Device"
#  SwitchButton 1 "Cancel"
#  Newline
  
#  samenv list Item

  selectList
#  Newline
#  OkButton 2 "Change Device"
#  SwitchButton 2 "Cancel"
#  Newline
}

proc Layout {func args} {
  device_layout makeitem $func "[join $args]"
}

proc otherSticksGroup {} {
  global stick_menu
  RadioGroup "addon stick"
  set list [lsort [glob *.stick]]
  foreach stickFile $list {
    scan $stickFile "%\[^.]" stick
    if {![info exists stick_menu($stick)] && $stick ne "none"} {
      RadioButton $stick "$stick ([findDesc $stickFile stickDesc])"
      Newline
    }
  }
}

proc -sticksGroup {} {
  global stick_menu
  if {[result device frappy_u_stick]} {
    CheckBox "stick is controlled by NICOS/Frappy" "device frappy_u_stick"
    Newline
    Style warning
    Label "the frappy stick server is killed when the stick is changed"
    Newline
    Style warning
    Label "or on deactivation of above check box"
    Newline
  }
  RadioGroup "addon stick"
  # close group after clicking on radio button:
  clientput -a
  if {[result device stick_menu] eq "all"} {
    set stick all
  } else {
    array unset stick_menu
    foreach stick [split [result device stick_menu]] {
      if {$stick eq "noother"} {
        break
      }
      RadioButton $stick "$stick ([findDesc ${stick}.stick stickDesc])"
      Newline
      set stick_menu($stick) 1
    }
  }
  if {$stick ne "noother"} {
    Group otherSticks "other sticks"
    RadioButton none
    Newline
    RadioButton cancel
  }
}

#proc -sticksGroup {} {
#  sticksGroup
#}

proc addonDesc args {
  # save addon name at a meaningful place
}

proc select_addon {addon {value none}} {
  set old [addon_list exists $addon]
  if {$old} {
    if {[result addon_list $addon] eq "permanent"} {
      set old 2
    }
  }
  if {$value eq "none" || $old == $value} {
    return $old
  }
  if {$value == 2} {
    addon permanent $addon
  } elseif {$value} {
    addon $addon
  } else {
    addon delete $addon
  }
}

publishLazy select_addon

proc -addonGroup {} {
  if {[result device frappy_u_addon]} {
    CheckBox "addons are controlled by NICOS/Frappy" "device frappy_u_addon"
    Newline
    Style warning
    Label "the frappy addons server is killed when an addon is removed"
    Newline
    Style warning
    Label "or on deactivation of above check box"
    Newline
  }
  set list [lsort [glob *.addon]]
  foreach addonFile $list {
    scan $addonFile "%\[^.]" addon
    CheckBox "$addon ([findDesc $addonFile addonDesc])" "select_addon $addon"
    NoNewline
    switch [select_addon $addon] {
      1 {
        RadioGroup "select_addon $addon"
        RadioButton 2 "make permanent"
      }
      2 {
        Label permanent
      }
    }
    Newline
  }
  #RadioButton cancel
}

proc webSelectGroup {} {
  # group name starting with '-': group is hidden until activated with button
  set u_device [string toupper [result device name]]
  set u_stick ""
  if {[result device stick_menu] ne ""} {
    set u_stick [string toupper [result device stick_name]]
  }
  clientput "-Tselect device"
  Group webDevice "select device ($u_device)"
  if {$u_stick ne ""} {
    Group -sticks "select stick ($u_stick)"
  }
  set u_adds [addon list]
  if {[llength $u_adds] == 0} {
    set u_adds ""
  } else {
    set u_adds " ($u_adds)"
  }
  Group -addon "select addon$u_adds"
}

proc mainGroup {{forweb ""}} {
  global tt device_name test_betrieb shown_groups
  
  # clientput "FORWEB $forweb"
  GraphicsId [result vars]
  Tip "[result deviceDesc]"
  Style header
  if {[info exists test_betrieb]} {
    Label Test-Betrieb
    Newline
    Label Markus ist am Testen
#    hdbLayout
    Newline
    Style header
  }
  Label [string toupper [result instrument]]
  NoNewline

  set u_device [string toupper [result device name]]
  set lab "Device: $u_device"
  SelectButton -device $lab
  NoNewline
  set u_stick ""
  if {[result device stick_menu] ne ""} {
    set u_stick [string toupper [result device stick_name]]
    SelectButton "-sticks" "Stick: $u_stick"
    NoNewline
  }
  set u_adds [addon list]
  set adds [addon list]
  if {[llength $adds] == 0} {
    set adds Add
    set u_adds ""
  } else {
    set adds "Add:$adds"
    set u_adds " ($u_adds)"
  }
  SelectButton "-addon" $adds

  if {$forweb == ""} {
    # for classic SEA client:
    # group name starting with '-': group is hidden until activated with button
    Group -device "select device ($u_device)"
    if {$u_stick ne ""} {
      Group -sticks "select stick ($u_stick)"
    }
    Group -addon "select addon$u_adds"
  } else {
    # for seaweb:
    Group webSelect "select device/stick/addon"
  }

  Newline
  catch {ConfigState}
  catch {TsState}
  catch {ChnState}
  ObjState
  Newline
  foreach p [device_layout items] {
    if {[string index $p 0] eq "/"} {
      hdbLayout $p
    } else {
      if {[catch {eval ${p}Layout [result device_layout $p]} msg]} {
        Style Warning
        Label $msg
      }
    }
  }
  if {![device_layout exists visibility]
      || [info exists shown_groups(expertMode)] } {
    Group config "configuration"
  }
}

proc make_array {name args} {
  global $name
  foreach n $args {
    set ${name}($n) ""
  }
}

proc find_interval {table rev section x} {
# find the interval containing x in a table
#
# arguments:
#   table    a 1D list  x(0) y(0) x(1) y(1) .... x(n) y(n).
#            The table does not need to be ordered.
#            A list with an odd length triggers an error.
#   rev      1 for inverting the table (exchange x and y)
#   section  the name of a variable to store the section as a list: x(a) y(a) x(b) y(b)
#   x        the value to be found
#
# an empty table is replaced by 0 0
# the result allows to distinguish differnt cases: 
#  0: (normal case) a section was found with was found xa <= x <= xb, section = x(a) y(a) x(b) y(b)
# -1: the table contained one single pair, x < x(0), section = x(0) y(0) x(0) y(0)
#  1: the table contained one single pair, x >= x(0), section = x(0) y(0) x(0) y(0)
# -2: x is lower than the lowest value in the table, section = x(0) y(0) x(1) y(1)
#  2: x is higher than the highest value in the table, section = x(n-1) y(n-1) x(n) y(n)
  
  upvar $section s
  
  if {[llength $table] % 2 != 0} {
    error "find_interval: table length must be even"
  }
  if {$rev} {
    set var {yi xi}
  } else {
    set var {xi yi}
  }
  set n [expr [llength $table]/2]
  if {$n == 0} {
    set n 2
    set table [list 0 0]
  }
  set a_empty 1
  set b_empty 1
  # find next higher and next lower x and their y value, result in xa xb ya yb
  foreach $var $table {
    if {$xi <= $x} {
      if {$a_empty || $xi > $xa} {
        set xa $xi
        set ya $yi
        set a_empty 0
      }
    } else {
      if {$b_empty || $xi < $xb} {
        set xb $xi
        set yb $yi
        set b_empty 0
      }
    }
  }
  if {$a_empty} {
    # no lower xi found, look for second lowest xi
    foreach $var $table {
      if {$xi > $xb && ($a_empty || $xi < $xa)} {
        set xa $xi
        set ya $yi
        set a_empty 0
      }
    }
    if {$a_empty} {
      set s [list $xb $yb $xb $yb]
      return -1
    }
    set s [list $xb $yb $xa $ya]
    return -2
  } elseif {$b_empty} {
    # no higher x found, look for second highest x
    foreach $var $table {
      if {$xi < $xa && ($b_empty || $xi > $xb)} {
        set xb $xi
        set yb $yi
        set b_empty 0
      }
    }
    if {$b_empty} {
      set s [list $xa $ya $xa $ya]
      return 1
    }
    if {$x == $xa} {
      set s [list $xb $yb $xb $yb]
      return 1
    }
    set s [list $xb $yb $xa $ya]
    return 2
  }
  set s [list $xa $ya $xb $yb]
  return 0
}

proc interpolate {table rev x args} {
  set res [find_interval $table $rev intval $x]
  set logx 0
  set logy 0
  set slope [list]
  foreach a $args {
    switch -- $a {
      logx {
        set logx 1
      }
      logy {
        set logy 1
      }
      extrapolate {
        if {abs($res) == 2} {
          # treat outside cases like inside cases
          set res 0
        }
       }
      default {
        lappend slope $a
      }
    }
  }
  set x0 [expr [lindex $intval 0]]
  set y0 [expr [lindex $intval 1]]
  set x1 [expr [lindex $intval 2]]
  set y1 [expr [lindex $intval 3]]
  if {$logx} {
    if [catch {set x0 [expr log($x0)]}] {
      set x0 -88
    }
    if [catch {set x1 [expr log($x1)]}] {
      set x1 -88
    }
    if [catch {set x [expr log($x)]}] {
      set x -88
    }
  }
  if {$logy} {
    if [catch {set y0 [expr log($y0)]}] {
      set y0 -88
    }
    if [catch {set y1 [expr log($y1)]}] {
      set y1 -88
    }
  }
  
  if {$res != 0} {
    # outside cases
    if {[llength $slope] == 0} {
      set slope 1
    }
    if {$res < 0} {
      set slope [lindex $slope 0]
    } else {
      set slope [lindex $slope end]
      set x0 $x1
      set y0 $y1
    }
  } else {
    set slope [expr ($y1 - $y0) / double($x1 - $x0)]
  } 
  set y [expr $y0 + $slope * ($x - $x0)]
  if {$logy} {
    if {$y > 88} {
      set y 88
    }
    set y [expr exp($y)]
  }
  return $y
}

proc parseValueUnit {str unitvar} {
  upvar $unitvar unit
  set value 0
  set unit ""
  if {[scan $str "%f%s" value unit] != 2} {
    return $value
  }
  set idx [string first [string index $unit 0] afpnum0kMGT]
  if {$idx < 0} {
    #no prefix
    return [expr double($value)]
  }
  set unit [string range $unit 1 end]
  return [expr $value * pow(10.0,$idx * 3 - 18)]
}

proc formatWithUnit {value {mindig 1}} {
  set dig [expr $mindig - 1]
  if {$dig < 0} {set dig 0}
  set me [split [format "%.${dig}e" $value] e]
  scan $me "%s %d" mant exp
  if {$exp < -18 || $exp > 14} {
    return [join $me e]
  }
  if {$exp % 3 > 0} {
    if {$exp % 3 == 2} {
      incr exp -2
      incr dig -2
    } else {
      incr exp -1
      incr dig -1
    }
    if {$dig < 0} {set dig 0}
    set mant [format %.${dig}f [expr $value / pow(10,$exp)]]
  }
   if {$exp == 0} {
    return $mant
  }
  return "$mant[string index afpnum0kMGT [expr ($exp+18)/3]]"
}

proc default {{cmd list} args}  {
  if {$cmd eq "clear"} {
    removeobject default_list
  }
  if {[sicsdescriptor default_list] eq "notfound"} {
    makeobject default_list array
    default_list makeitem "device.name"
    default_list makeitem "device.stick_name"
  }
  switch -- $cmd {
    clear {
      foreach item [default_list items] {
        if {![string match device.* $item]} {
          default_list deleteitem $item
        }
      }
      return ""
    }
    list {
      # list and save
      set res ""
      foreach item [default_list items] {
        set cmd [split $item .]
        set val [silent "NoValue" result $cmd]
        if {$val ne "NoValue"} {
          append res "$cmd $val\n"
          default_list $item $val
        }
      }
      return $res
    }
    name {
      if {"$args" ne ""} {
        default_list makeitem device.name "$args"
      }
      return [result default_list device.name]
    }
    stick {
      if {"$args" ne ""} {
        default_list makeitem device.stick_name "$args"
      }
      return [result default_list device.stick_name]
    }
    load {
      clientput "--- load defaults ---"
      foreach item [default_list items] {
        set cmd [split $item .]
        set val [result default_list $item]
        clientput "$cmd $val"
        if {$val ne "NoValue"} {
          catch { eval "$cmd $val" }
        }
      }
      clientput "---"
    }
    default {
      set item [join [concat $cmd $args] .]
      if {![default_list exists $item]} {
        default_list makeitem $item
      }
    }
  }
}

publishLazy default

proc source_sct_driver {driver} {
  global startupList
  
  foreach type [list $driver [lindex [split $driver _] end]] {
    set script drivers/${type}.tcl
    if {[file exists $script]} {
      set modtime [file mtime $script]
      if {![info exists startupList($script)]} {
        set startupList($script) 0
      }
      if {$startupList($script) ne $modtime} {
        if {[catch {source drivers/${type}.tcl} msg]} {
          clientput "ERROR: in ${type}.tcl:"
          clientput $msg
          return 2
        }
        clientput "loaded $script"
        set startupList($script) $modtime
      }
      return 1
    }
  }
  return 0
}

proc read_file {file} {
  set contents ""
  set fd ""
#  catch {
    set fd [open $file r]
#    catch {
      set contents [read $fd]
#    }
    close $fd
#  }
  return $contents
}

proc noTecs {} {
  defineTemperature tt
}

proc reload {} {
  global startupList
  # add here scripts which may be needed to reload (sourced in drivers)
  set stdlist {
    seacom.tcl stdsct.tcl
    drivers/magfield.tcl drivers/trun.tcl drivers/lsc.tcl
  }
  catch {
    lappend stdlist drivers/secop_[silent x set ::secop_version].tcl
  }
  if {[result instrument] eq "seaman"} {
    append stdlist " seamancom.tcl"
  }
  set i [result instrument]
  set filelist [concat $stdlist [glob startup/*.tcl]]
  do_as_manager {
    foreach script [concat $filelist [array names startupList]] {
      if {![info exists startupList($script)]} {
        set startupList($script) 0
      }
      # if file does no more exist, take old mtime in order not to trigger reload
      set modtime [silent $startupList($script) file mtime $script]
      if {$startupList($script) ne $modtime} {
        if {[catch { uplevel #0 "source $script" } msg]} {
          clientput "ERROR: in $script"
          clientput $msg
        } else {
          clientput "loaded $script"
          set startupList($script) $modtime
        }
      }
    }
  }
}

publishLazy reload

proc plugin {plugin args} {
# mechanism to call external programs in a safe way
# simple programs using stdout as output may just added to the first
# switch branch
  if {![file exists [pwd]/plugin/$plugin]} {
    error "unknown plugin: $plugin"
  }
  set cmd [linsert $args 0 exec [pwd]/plugin/safeplugin $plugin]
  return [eval $cmd]
}

publishLazy plugin

proc _tcl args {
  eval $args
}

publishLazy _tcl

global startupList
set startupList(seacom.tcl) [file mtime seacom.tcl]

reload

clientput "seacom.tcl completed"
