gui wip coming along nicely

diff --git a/hostside/gui b/hostside/gui
index 6ab84e602061508670463141c37e83c1873a2212..279aa9cf348daead77bdb9131ca805eff4c878d0 100755 (executable)
--- a/hostside/gui
+++ b/hostside/gui
@@ -97,7 +97,11 @@ proc scmd_result {oknakerr message reporterrmsg} {
     if {[string length $reporterrmsg]} {
        report-problem "$ctrlr: $reporterrmsg"
     }
-    eval [list "$onresult-$oknakerr" $message] $args
+    set proc "$onresult-$oknakerr"
+    if {![string compare $oknakerr nak] && [catch { info args $proc }]} {
+       set proc "$onresult-err"
+    }
+    eval [list $proc $message] $args
 }
 
 register-event {} {} {^\+ack \S+ ok } { scmd_result ok $l "" }
@@ -112,7 +116,6 @@ proc routinecmd-nak {m args} { error "got nak to routine command: $m" }
 proc routinecmd-err {m args} { }
 proc routinecmd-ok {m args} { }
 
-proc mustsucceed-nak {m args} { error "unexpected nak: $m" }
 proc mustsucceed-err {m args} { error "unexpected error: $m" }
 proc mustsucceed-ok {m args} { }
 
@@ -304,7 +307,7 @@ proc speedw-new {w ctrlr} {
     upvar #0 speed/$w s
     global speedws
 
-    lappend $speedws $w
+    lappend speedws $w
     set s(ctrlr) $ctrlr
     set s(inhibit) 0
     set s(commanding) 0
@@ -327,7 +330,7 @@ proc speedw-notrains {w whystr} {
 proc speedw-train-noneselected {w whystr} {
     upvar #0 speed/$w s
     set s(train) {}
-    $w.train configure -text "($whystr)"
+    $w.train configure -text $whystr
     $w.speed configure -textvariable {} -text -
     speedw-inhibit $w
 }
@@ -358,7 +361,7 @@ proc speedw-train-selected {w t} {
 
 proc speedw-trains-available {w l} {
     upvar #0 speed/$w s
-    if {![llength $l]} { speedw-set-disabled $w "no trains"; return }
+    if {![llength $l]} { speedw-train-noneselected $w "(no trains)"; return }
     $s(optionmenu) delete 0 end
     $s(optionmenu) add radiobutton -label "(none)" -value {} \
            -command [list speedw-train-noneselected $w "(no train selected)"]
@@ -370,7 +373,7 @@ proc speedw-trains-available {w l} {
     $w.train configure -state normal
     if {[llength $l]==1} {
        $s(optionmenu) invoke 1
-    } elseif {[set ix [lsearch -exact $l $s(train)] >= 0]} {
+    } elseif {[set ix [lsearch -exact $l $s(train)]] >= 0} {
        $s(optionmenu) invoke [expr {$ix+1}]
     } elseif {![string length $s(train)]} {
        $s(optionmenu) invoke 0
@@ -439,14 +442,18 @@ register-event ?train_*_speed_commanded {train speed} \
     set cmd $speed
 }
 
-proc speedws-stastate-run {} {
-    global train_commanded
-    speedws-forall speedw-trains-available [array names train_commanded]
-}
-proc speedws-stastate-not-run {} {
-    global train_commanded
-    catch { unset train_commanded }
-    speedws-forall speedw-notrains "($stastate)"
+proc speedws-stastate-hook {} {
+    global train_commanded stastate
+    switch -exact $stastate {
+       Run {
+           set trains [array names train_commanded]
+           speedws-forall speedw-trains-available $trains
+       }
+       default {
+           catch { unset train_commanded }
+           speedws-forall speedw-notrains "($stastate)"
+       }
+    }
 }
 
 register-event &train_*_signalling-problem {train problem} \
@@ -631,22 +638,16 @@ proc train-event-eof {args} {
     error "lost connection to train set"
 }
 
-register-event ?stastate {state} \
-       {^.stastate (\w+|\-) } {
-    global ctrain trains statstate
-
+register-event ?stastate {ctxch state} {^(.)stastate (\w+|\-) } {
+    global ctrain trains stastate
     set stastate $state
-
-    switch -exact $stastate {
-       Run { speedws-stastate-run }
-       default { speedws-stastate-not-run }
-    }
+    if {[string compare ctxch |]} speedws-stastate-hook
 }
 
 register-event {} {} {^=connected } {
     global pages gui_pipe server port event_selections
 
-    scmd mustsucceed {} "select-replay [concat $event_selections]"
+    scmd replayed {} "select-replay [concat $event_selections]"
 
     foreach page $pages {
        set w [pagew $page]
@@ -661,6 +662,10 @@ register-event {} {} {^=connected } {
        fileevent $gui_pipe readable gui-pipe-readable
     }
 }
+proc replayed-err {m args} { error "replay failed: $m" }
+proc replayed-ok {m args} {
+    speedws-stastate-hook
+}
 
 register-event {} {} {^=failed } { error "multiplexer failed: $l" }
 register-event {} {} {^=denied } { error "multiplexer denied us: $l" }