better arg parsing for hostside/gui

diff --git a/hostside/lib.tcl b/hostside/lib.tcl
index 04fa119f06794de8f78d43e6c4879c6fccd12d5d..8367d7c785fb4cab56c0c235ad48d71562e5a3fc 100644 (file)
--- a/hostside/lib.tcl
+++ b/hostside/lib.tcl
@@ -1,10 +1,26 @@
+
+proc start_commandloop {} {
+    commandloop -async -prompt1 { return "% " } -prompt2 { return "> " }
+}
+
+proc fconfig-trainproto {file} {
+    fconfigure $file -translation {auto lf} -buffering line -blocking 0
+}
+
 proc badusage {m} {
     global argv0
     puts stderr "$argv0: bad usage: $m"
     exit 8
 }
 
-proc parse_argv {formalargs} {
+proc setting {varname defvalue regexp} {
+    upvar #0 $varname var
+    upvar #0 settings($varname) re
+    set var $defvalue
+    set re $regexp
+}
+
+proc parse-argv {formalargs} {
     # formalargs: list; if list is [list *] then any is allowed
     # sets argv to list of non-option args
     # checks settings($var)
@@ -12,8 +28,14 @@ proc parse_argv {formalargs} {
     for {set i 0} {$i < [llength $argv]} {incr i} {
        set a [lindex $argv $i]
        if {[regexp {^--(\w+)\=(.*)$} $a dummy var val]} {
-           if {[info exist settings] && ![info exists settings($var)]} {
-               badusage "unknown variable setting --$var=..."
+           if {[info exist settings]} {
+               upvar #0 settings($var) re
+               if {![info exists re]} {
+                   badusage "unknown variable setting --$var=..."
+               }
+               if {![regexp -- "^$re\$" $val]} {
+                   badusage "bad value for setting $var"
+               }
            }
            upvar #0 $var varset
            set varset $val
@@ -36,3 +58,6 @@ proc parse_argv {formalargs} {
        }
     }
 }
+
+setting port 2883 {\d+}
+

diff --git a/hostside/multiplex b/hostside/multiplex
index 84545fdc20dcc4f160c1aff8536f1038fc3efc01..a050f0804075e34b389d0c3233b590249fb23785 100755 (executable)
--- a/hostside/multiplex
+++ b/hostside/multiplex
@@ -601,7 +601,7 @@ proc find-permission {ipaddr} {
 proc connected {conn} {
     global conns
     upvar #0 c/$conn c
-    fconfigure $conn -blocking 0 -buffering none -translation {auto lf}
+    fconfig-trainproto $conn
     set c(q) {}
     set conns($conn) 1
     set perm [find-permission $c(ipaddr)]
@@ -670,25 +670,22 @@ proc binding {addr blist} {
 }
 
 proc startup {} {
-    global queueing executing me realtime port
+    global queueing executing cmdstdin realtime port
     catch { close $master }; catch { unset master }
 
-    set port 2883
-    set settings(me) {^[01]$}
-    set me 0
-
-    parse_argv {}
+    setting cmdstdin 0 {[01]}
+    parse-argv {}
     
     uplevel #0 source multiplex-config
     set queueing {}
     set executing 0
     realtime-notrunning-init
-    if {$me} {
-       commandloop -async -prompt1 { return "% " } -prompt2 { return "> " }
+    if {$cmdstdin} {
+       start_commandloop
     } else {
-       fconfigure stdin -translation binary -buffering line -blocking 0
+       fconfig-trainproto stdin
+       fconfig-trainproto stdout
        fileevent stdin readable [list readable realtime stdin]
-       fconfigure stdout -translation binary -buffering line -blocking 0
        set realtime stdout
     }
 }