# Simple ParameterParsing (SPar)
# 08.03.2005
proc spar {tpl cmd} {
if {[catch {array set a $tpl}]} {
return -code error {invalid template}; # we couldn't 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 characters 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 couldn't 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...
}Test routine (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 right 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 <value>} A named argument (key-value-pair). After this help text, the%n
initial value appears in brackets. %v}
-test 0
1 {"" <pos1> The first positional arg.}
2 {"" <pos2> The second positional arg. no default (empty string).}
3 {tst <pos3> 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 line break is manually inserted with % followed by n.}
-n: {n_default {%s <value>} A named argument (key-value-pair). After this help text, the%n
initial value appears in brackets. %v}
-test 0
1 {{} <pos1> The first positional arg.}
2 {{} <pos2> The second positional arg. no default (empty string).}
4 {$tst <pos3> 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 <return>):}
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.
See:
