diff --git a/tcl/seacom.tcl b/tcl/seacom.tcl index 7d3b2da..eadf5de 100644 --- a/tcl/seacom.tcl +++ b/tcl/seacom.tcl @@ -13,7 +13,7 @@ set vars "" proc publishLazy {command {level User}} { set desc [sicsdescriptor $command] if {$desc eq "notfound"} { - Publish $command $level + Publish $command $level } elseif {$desc eq "Macro"} { # clientput $command already published } else { @@ -149,7 +149,7 @@ proc scanargs {arglist array args} { if {$array ne "var"} { upvar $array arg } - + # read formal arguments set name "" set idx 0 @@ -180,7 +180,7 @@ proc scanargs {arglist array args} { # clientput $arglist # clientput [array get values] # clientput [array get names] - + # read actual arguments if {$nargs > 0} { set phase 0 @@ -649,7 +649,7 @@ proc stick_sensors {sensor1 sensor2} { GraphItem shown tt.ts_2 0 } else { GraphItem shown tt.ts_2 1 - } + } } proc ts_sensor {sensor} { @@ -683,7 +683,7 @@ proc ts_sensor2 {sensor {rescode 0}} { GraphItem shown tt.ts_2 0 } else { GraphItem shown tt.ts_2 1 - } + } } } @@ -692,7 +692,7 @@ proc stick {name} { } proc import {device} { - + set file ${device}.config if {![file exists $file]} { set file ${device}.config.inc @@ -778,7 +778,7 @@ proc obj_dependency {command {mama ""} {kid ""}} { error "Usage: obj_dependency list" } foreach obj [obj_dependencies items] { - clientput "$obj: [result obj_dependencies $obj]" + clientput "$obj: [result obj_dependencies $obj]" } return } @@ -845,7 +845,7 @@ proc sort_layout {} { foreach item [lsort $layoutlist] { device_layout makeitem [lindex $item 2] [lindex $item 3] } -} +} proc stopall {} { catch { @@ -1040,6 +1040,7 @@ proc samenv args { set inside_samenv 0 } set device_name none + device makeitem confirmed "" restore killerr save_samenv none return "samenv = none" @@ -1150,6 +1151,10 @@ proc samenv args { default load device name $name + if {$name ne [silent 0 hval /device/confirmed]} { + device makeitem confirmed "" + } + obj_list savefile "" if { [string length $objects_created] != 0 } { clientput "create: $objects_created" @@ -1172,7 +1177,7 @@ proc samenv args { addon permanent $a } - if {[sicsdescriptor sics] eq "RemServer"} { + if {[sicsdescriptor sics] eq "RemServer"} { # update_remob sics nowait sea nowait update_remob } @@ -1323,7 +1328,7 @@ proc addon args { makeobject addon_$name array obj_list makeitem addon_$name ADDON - + if {$permanent_addon} { addon_list makeitem $name permanent } else { @@ -1360,7 +1365,7 @@ proc addon args { if {[sicsdescriptor sics] eq "RemServer"} { # update_remob sics nowait sea nowait update_remob - } + } save_samenv return OK } @@ -1563,7 +1568,7 @@ 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 } @@ -1618,7 +1623,7 @@ proc statInp { name period value } { set n(min$idx) $value set n(last) $now } else { - minMax n $idx $value + minMax n $idx $value } set n(maxn) $n(max0) @@ -1633,13 +1638,13 @@ proc statInp { name period value } { } 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" @@ -1655,7 +1660,7 @@ proc ChnState {} { 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} { @@ -1669,7 +1674,7 @@ proc do_not_change_to_none {{value 2}} { } return 2 } - + publishLazy do_not_change_to_none proc startAutodeviceCron {} { @@ -1706,6 +1711,7 @@ proc autodeviceCron {} { } device action "" } elseif {$act eq "rebuild"} { + # rebuild SECoP objects after description change device action "" set objdict [dict create] foreach obj [obj_list items] { @@ -1756,24 +1762,33 @@ clientput "CONFIG $device/$stick/$addons" set unplugged_device [result device name] if {$unplugged_device ne "none"} { clientput "unplugged $unplugged_device" + device makeitem confirmed "" set change_device_to_none [expr $now + 60] } } else { clientput "none $act" + device makeitem confirmed none samenv -q none } } elseif {$act eq "plugged" && $new eq [result device name]} { clientput "$new plugged, no change" + device makeitem confirmed $new } else { - clientput "$new $act" - catch {samenv -q $new} msg - clientput $msg + if {[result device name] ne "none" && $act eq "plugged"} { + clientlog "unplugged time too short [result device name] -> $new" + } else { + device makeitem confirmed $new + clientput "LOAD $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 + device makeitem confirmed none samenv -q none } if {![device exists force_status_save]} { @@ -1925,13 +1940,13 @@ proc grsGroup {path} { proc groGroup {obj} { foreach item [$obj loggeditems] { - GraphInput $item + 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.tShift tt.shiftUp tt.shiftLow tt.state \ tt.ScanChan tt.t0 tt.t1 tt.t2 tt.t3 tt.t4} foreach item $tt_loggedlist { @@ -1939,7 +1954,7 @@ foreach item $tt_loggedlist { } proc connectionsGroup {} { - global unconfigured_list + global unconfigured_list if {[info exists unconfigured_list]} { set list $unconfigured_list } else { @@ -1992,7 +2007,7 @@ proc connectionsGroup {} { } proc configGroup {} { - global unconfigured_list + global unconfigured_list Group connections "connections" foreach obj [split [obj_list items]] { set opath [silent 0 hgetpropval /sics/$obj objectPath] @@ -2047,7 +2062,7 @@ proc showStatus {obj {respectIgnore 0}} { 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] || [string match "offline*" $s]} if {[string match "*no*response*" $s] || [string match "disconnected*" $s]} { NoNewline Style warning @@ -2094,7 +2109,7 @@ proc ignoreMsg {obj {ignore read}} { } else { ignore_msg makeitem $obj $status } -} +} publishLazy ignoreMsg @@ -2270,7 +2285,7 @@ proc -deviceGroup {} { # OkButton 1 "Change Device" # SwitchButton 1 "Cancel" # Newline - + # samenv list Item selectList @@ -2415,7 +2430,7 @@ proc webSelectGroup {} { proc mainGroup {{forweb ""}} { global tt device_name test_betrieb shown_groups - + # clientput "FORWEB $forweb" GraphicsId [result vars] Tip "[result deviceDesc]" @@ -2506,15 +2521,15 @@ proc find_interval {table rev section x} { # x the value to be found # # an empty table is replaced by 0 0 -# the result allows to distinguish differnt cases: +# 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" } @@ -2632,7 +2647,7 @@ proc interpolate {table rev x args} { set y1 -88 } } - + if {$res != 0} { # outside cases if {[llength $slope] == 0} { @@ -2647,7 +2662,7 @@ proc interpolate {table rev x args} { } } else { set slope [expr ($y1 - $y0) / double($x1 - $x0)] - } + } set y [expr $y0 + $slope * ($x - $x0)] if {$logy} { if {$y > 88} { @@ -2767,7 +2782,7 @@ 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]} { diff --git a/tcl/seainit.tcl b/tcl/seainit.tcl index e531018..27ec3a2 100644 --- a/tcl/seainit.tcl +++ b/tcl/seainit.tcl @@ -143,7 +143,7 @@ if {$instrument eq "seaman"} { restore $statusfile backup -array_init device name unknown changetime 0 stick_menu {} stick_name {} newdevice {} olddevice {} rack {} +array_init device name unknown changetime 0 stick_menu {} stick_name {} newdevice {} olddevice {} rack {} confirmed {} array_init device frappy_u_config 0 frappy_u_stick 0 frappy_u_addon 0 frappy_main {} frappy_stick {} frappy_addons {} connect_sics diff --git a/tcl/startup/frappy.tcl b/tcl/startup/frappy.tcl index d8cc670..748a3b5 100644 --- a/tcl/startup/frappy.tcl +++ b/tcl/startup/frappy.tcl @@ -177,10 +177,12 @@ proc get_param_values {hp} { } proc check_or_do {doit service cfgs} { + # result: 1: no change needed, 0: change needed, 2: failure set result 1 set config "" set stick "" set addons [list] + foreach cfg $cfgs { if {[regexp {(.*)\.addon} $cfg -> addon]} { if {![addon_list exists $addon]} { @@ -195,10 +197,20 @@ proc check_or_do {doit service cfgs} { device makeitem frappy_u_config 1 if {$config ne [hval /device/name]} { if {$doit} { + if {[hval /device/confirmed] eq [hval /device/name]} { + set msg "do not allow frappy to change from [hval /device/name] to $config" + clientlog $msg + return $msg + } + clientlog 0 + clientlog TRANSACTIONFINISHED samenv -q $config } else { device makeitem frappy_u_config 0 } + if {[hval /device/name] == "none"} { + return none + } set result 0 } } @@ -206,15 +218,22 @@ proc check_or_do {doit service cfgs} { device makeitem frappy_u_stick 1 if {$stick ne [hval /device/stick_name]} { if {$doit} { + clientlog 0 + clientlog TRANSACTIONFINISHED addon stick $stick } else { device makeitem frappy_u_stick 0 } + if {[hval /device/name] == "none"} { + return nonestick + } set result 0 } } foreach addon $addons { if {$doit} { + clientlog 0 + clientlog TRANSACTIONFINISHED addon $addon } else { device makeitem frappy_u_addon 0