introduce "device confirmed" when device is plugged

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"
+      if {[result device name] ne "none" && $act eq "plugged"} {
-      catch {samenv -q $new} msg
+        clientlog "unplugged time too short [result device name] -> $new"
-      clientput $msg
+      } 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]} {

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

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