---- Why another parsing-routine? Because the other ones like cmdline or OptProc are a little overweighted or just too complex. Here in the wiki, I found links to various useful parsing routines, but still I decided to write one of my own; here is the result. The input is checked/processed against a template, and the result is given back as a list suitable for '''array set'''. Switchnames may be shortened. At the bottom of the page later I will add some examples of how a commandline and the corresponding templates can look like. ---- # Simple ParameterParsing (SPar) # 08.03.2005 proc spar {tpl cmd} { if {[catch {array set a $tpl}]} { return -code error {invalid template}; # we could'nt handle this error }; # don't stop with other errors - give pgmr the chance to decide later set needmore {} set count 0 set seeopts 1 foreach item $cmd { if {[string equal $item "--"]} { set seeopts 0; # end of -flag-processing } elseif {[string length $needmore]} { set a($needmore) $item set needmore {} } elseif {$seeopts == 1 && [string range $item 0 0] == "-"} { set matches [array names a -glob $item*]; # allows shortening if {[llength $matches]} { set match [lindex [lsort $matches] 0] if {[string index $match end] == ":"} { set needmore $match; # -f: means: 'value follows' } else { set a($match) 1; # otherwise simply return 'true' } } else { lappend a(swiunknown) $item } } else { incr count; # each arg counts, even if there are too much if {[info exists a($count)]} { set a($count) $item set a(argcount) $count } else { lappend a(argsuper) $item } } } if {[string length $needmore]} { set a(swinovalue) $needmore; # missing value after -switch: at the very end } return [array get a]; # double conversion is the price for using arrays } ---- # Tests set tpl [list -f1 0 -f2 0 -f3: "*" -f4 0 -test 0 1 "" 2 "" 3 "Default3" -? 0] puts "Template: $tpl\n" puts Commandline: gets stdin cmd if {![catch {array set a [spar $tpl $cmd]} rc]} { puts "Resultarray:\n" parray a } else { puts $rc } ---- ''(Examples will be added later)'' ---- '''Command Line Parsing, enhanced (but yet simple) version with integrated help support''' # Simple ParameterParsing (SPar) SPAR.TCL # (C) M.Hoffmann 2004-2006 # # 26.03.2005: Erweiterung: Hilfetexte mit übergeben, formatierte Hilfeausgabe # 05.07.2005: ReView, Ergänzungen # 09.07.2005: endgültige Hilfeformatierung festgelegt # 11.07.2005: Leere pos. Args überschreiben nicht Default; Hilfe integriert; # package # 01.09.2005: BUG-Fix (alle %v's erhielten den selben Inhalt.....) -> WIKI!!! # 15.11.2005: Fehlerrückgabe geändert: Fehler immer in (_error) & Abbruch! # Vereinfacht übergeordnete Benutzung! Testroutine noch anpassen! # Hilferückgabe in _help. Hilferückgabe aufgetrennt in (_sytx) und # (_help) zwecks besserer Aufbereitbarkeit im Mainprog. Rückgabe # überzähliger Elemente als (_argsuper), Element ist sonst leer. # 08.02.2006: Bugfix. _argcount instead of argcount contains the number of positional Args. # Changed format of Syntax Help # # ToDo: # - namespace # - Testcase # - Wiki Update # # Support for special charachters in Help: # %s - ergibt den Switchnamen selbst (bei Pos.args nicht sinnvoll!) # %v - ergibt [Vorgabewert] # %n - Spaltengerechter manueller Zeilenumbruch package provide Spar 1.1 proc spar {tpl cmd} { if {[catch {array set a $tpl}]} { return -code error {invalid template}; # we could'nt handle this error }; # don't stop with other errors - give pgmr the chance to decide later # Help extension, formerly in separate proc set col 0 set sntx {} set help {} set a(_argsuper) "" foreach name [lsort [array names a]] { set lCol [lindex $a($name) 1]; # left side of help set rCol [lrange $a($name) 2 end]; # right side of help set a($name) [lindex $a($name) 0]; # the value ifself set rCol [string map [list %v \\\[$a($name)\\\]] $rCol]; # Bugfix 01.09. set lCol [string map "%s $name" $lCol]; # 'switch' replaces %s if {[string length $lCol]} { append sntx "$lCol " append help " \[format %-\${col}s \"$lCol\"\]$rCol\n" set l [string length $lCol] ; # determine begin of set col [expr {$l > $col ? $l : $col}]; # right side of help } } incr col set nl "\n[string repeat " " $col]" set a(_sytx) $sntx set a(_help) [string map [list %n $nl] [subst $help]] # Help extension End set needmore {} set count 0 set seeopts 1 foreach item $cmd { if {[string equal $item "--"]} { set seeopts 0; # end of -flag-processing } elseif {[string length $needmore]} { set a($needmore) $item set needmore {} } elseif {$seeopts == 1 && [string range $item 0 0] == "-"} { set matches [array names a -glob $item*]; # allows shortening if {[llength $matches]} { set match [lindex [lsort $matches] 0] if {[string index $match end] == ":"} { set needmore $match; # -f: means: 'value follows' } else { set a($match) 1; # otherwise simply return 'true' } } else { return -code error "Unbekannter Schalter: $item" } } else { incr count; # each arg counts, even if there are too much if {[info exists a($count)]} { if {[string length $item]} { # Defaults can only be overridden by 'real' values set a($count) $item; # empty string causes skip } set a(_argcount) $count } else { lappend a(_argsuper) $item; # das ist KEIN Fehler! } } } if {[string length $needmore]} { # missing value after -switch: at the very end return -code error "Wert fehlend: $needmore" } return [array get a]; # double conversion is the price for using arrays... } '''Testroutine''' (like documentation and translation, is still a work in progress...) # Tests for Simple Parameter parsing (Spar) module # 11.07.2005, 01.08.2005, 01.09.2005, 08.02.2005 # (C) M.Hoffmann lappend auto_path ./ package require Spar 1.1 # Template Format # # The template must be a proper list suitable for `array set`! # # basic format (without help) { # -flagname|-optionname:|{1|2|...} default_value # -flagname|-optionname:|{1|2|...} default_value # : : # } # # where: # '-flagname' is - well - a flag: the presence of it always returns # 1 (true), so the default value should almost always be 0 (false); # '-optionname:' denotes a named arg, again initializied with a # default value; # 1,2,...n is a placeholder for a positional argument. it's also # possible to specify a default value for missing positional args. # # extended format (with help) { # -flagname|-optionname:|{1|2|...} {default_value helptext ...} # -flagname|-optionname:|{1|2|...} {default_value helptext ...} # : : # } # # Helptext itself is formatted in two columns: the first elements in each row # represent the left column, the rest represents the rigth column. # helptext may contain %s (replaced by flag/optionname), %v # (replaced by defaultvalue, surrounded with brackets) or %n # (newline) # Setup Array With Example Template ## ## 1) für DYNAMISCHE DEFAULTS muss das Ganze in Quotes eingeschlossen werden können, nicht {} ! ## problematisch wegen für ARRAY SET notwendiger Struktur!!! ## ## 2) was ist mit '-?' - funktioniert das? ## set tst $env(ComputerName) # Warning: usage of $tst here leads to errors later (because of substitution in proc, where no $tst exists) set tpl {-flag1 {0 %s A boolean flag. if present, 1 is returned. Default is irrelevant.} -f2 {- %s A boolean flag. if present, 1 is returned. This helptext is very%n long, so a linebreak is manually inserted with % followed by n.} -n: {n_default {%s } A named argument (key-value-pair). After this help text, the%n initial value appears in brackets. %v} -test 0 1 {"" The first positional arg.} 2 {"" The second positional arg. no default (empty string).} 3 {tst The third positional arg. if missing, a default is returned,%n which here is of dynamic nature: %v} -? 0 } # Auflösung erfolgt trotz {} wegen Subst! set tpl " -flag1 {0 %s A boolean flag. if present, 1 is returned. Default is irrelevant.} -f2 {- %s A boolean flag. if present, 1 is returned. This helptext is very%n long, so a linebreak is manually inserted with % followed by n.} -n: {n_default {%s } A named argument (key-value-pair). After this help text, the%n initial value appears in brackets. %v} -test 0 1 {{} The first positional arg.} 2 {{} The second positional arg. no default (empty string).} 4 {$tst The third positional arg. if missing, a default is returned,%n which here is of dynamic nature: %v} -? 0 " puts {Commandline (type 'template' or 'help' or leave blank, than hit ):} gets stdin cmd if {[string match -nocase template* $cmd]} { puts $tpl\n exit } if {![catch {array set a [spar $tpl $cmd]} rc]} { if {[string match -nocase help* $cmd]} { puts "Syntax: $a(_sytx)\n\nSwitches:\n" puts $a(_help) exit; } puts "Resultarray:\n" parray a; # hier eigentlich Hilfe ausblenden } else { puts "Error:\n" puts $rc } ---- [MHo] April 12, 2006: It turned out that it's not always wanted to show the switches '''sorted'''. Will fix this later. ---- [Category Argument Processing] - [Category String Processing]