chiark / gitweb /
move multiplexer's arg parsing into new lib.tcl
authorian <ian>
Sat, 31 May 2008 21:01:12 +0000 (21:01 +0000)
committerian <ian>
Sat, 31 May 2008 21:01:12 +0000 (21:01 +0000)
hostside/lib.tcl [new file with mode: 0644]
hostside/multiplex

diff --git a/hostside/lib.tcl b/hostside/lib.tcl
new file mode 100644 (file)
index 0000000..04fa119
--- /dev/null
@@ -0,0 +1,38 @@
+proc badusage {m} {
+    global argv0
+    puts stderr "$argv0: bad usage: $m"
+    exit 8
+}
+
+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)
+    global argv settings
+    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=..."
+           }
+           upvar #0 $var varset
+           set varset $val
+       } elseif {[regexp {^--$} $a]} {
+           incr i
+           break
+       } elseif {[regexp {^-} $a]} {
+           badusage "unknown command line option $a"
+       } else {
+           break
+       }
+    }
+    set argv [lrange $argv $i end]
+    if {[llength $formalargs]==1 && [string compare * [lindex $formalargs 0]] \
+           && [llength $formalargs] != [llength $argv]} {
+       if {![llength $formalargs]} {
+           badusage "no non-option arguments expected"
+       } else {
+           badusage "needed non-option arguments: [concat $formalargs]"
+       }
+    }
+}
index cd04917abe8711ec9cbd8fc49828ff7069920b8e..84545fdc20dcc4f160c1aff8536f1038fc3efc01 100755 (executable)
@@ -43,6 +43,8 @@
 #       picio out polarity ...
 #    70 detect <seg> 0|1
 
+source lib.tcl
+
 #---------- replay, general utilities, etc. ----------
 
 proc compile-glob-patterns {pats procname} {
@@ -668,20 +670,20 @@ proc binding {addr blist} {
 }
 
 proc startup {} {
-    global queueing executing argv me realtime port
+    global queueing executing me realtime port
     catch { close $master }; catch { unset master }
+
     set port 2883
+    set settings(me) {^[01]$}
+    set me 0
+
+    parse_argv {}
+    
     uplevel #0 source multiplex-config
     set queueing {}
     set executing 0
     realtime-notrunning-init
-    foreach e $argv {
-       if {[regexp {^--(\w+)\=(.*)$} $e dummy var val]} {
-           set e [list set $var $val]
-       }
-       uplevel #0 $e
-    }
-    if {![info exists me]} {
+    if {$me} {
        commandloop -async -prompt1 { return "% " } -prompt2 { return "> " }
     } else {
        fconfigure stdin -translation binary -buffering line -blocking 0