From: ian <ian>
Date: Sat, 31 May 2008 21:35:07 +0000 (+0000)
Subject: better arg parsing for hostside/gui
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=df1ed79df897376fa14fe25080e4b1056d275c8d;p=trains.git

better arg parsing for hostside/gui
---

diff --git a/hostside/lib.tcl b/hostside/lib.tcl
index 04fa119..8367d7c 100644
--- 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 84545fd..a050f08 100755
--- 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
     }
 }