diff options
author | welch <welch> | 1998-06-29 15:30:16 (GMT) |
---|---|---|
committer | welch <welch> | 1998-06-29 15:30:16 (GMT) |
commit | 9f3869587887d7104addbb0423000d468cc198bd (patch) | |
tree | e5d2957e0ca63321138bf46f64ce92c4f8d13b2d /library/opt0.1 | |
parent | 456c19cd15beb3a33e96c9d0d22b3b29acca121f (diff) | |
download | tcl-9f3869587887d7104addbb0423000d468cc198bd.zip tcl-9f3869587887d7104addbb0423000d468cc198bd.tar.gz tcl-9f3869587887d7104addbb0423000d468cc198bd.tar.bz2 |
expr bracing
Diffstat (limited to 'library/opt0.1')
-rw-r--r-- | library/opt0.1/optparse.tcl | 49 | ||||
-rw-r--r-- | library/opt0.1/pkgIndex.tcl | 2 |
2 files changed, 28 insertions, 23 deletions
diff --git a/library/opt0.1/optparse.tcl b/library/opt0.1/optparse.tcl index 12135da..4f859dd 100644 --- a/library/opt0.1/optparse.tcl +++ b/library/opt0.1/optparse.tcl @@ -13,9 +13,9 @@ # written initially with Brent Welch, itself initially # based on work with Steve Uhler. Thanks them ! # -# SCCS: @(#) optparse.tcl 1.13 97/08/21 11:50:42 +# SCCS: %Z% $Id: optparse.tcl,v 1.2 1998/06/29 15:30:44 welch Exp $ -package provide opt 0.2 +package provide opt 0.3 namespace eval ::tcl { @@ -416,9 +416,6 @@ proc ::tcl::OptProcArgGiven {argname} { OptNextDesc descriptions; set state [OptCurState $descriptions]; } - if {![Lempty $arguments]} { - return -code error [OptTooManyArgs $descriptions $arguments]; - } } # Process one step for the state machine, @@ -431,8 +428,12 @@ proc ::tcl::OptProcArgGiven {argname} { # the special state/instruction "args" eats all # the remaining args (if any) if {($state == "args")} { - OptCurSetValue descriptions $arguments; - set arguments {}; + if {![Lempty $arguments]} { + # If there is no additional arguments, leave the default value + # in. + OptCurSetValue descriptions $arguments; + set arguments {}; + } # puts "breaking out ('args' state: consuming every reminding args)" return -code break; } @@ -489,8 +490,8 @@ proc ::tcl::OptProcArgGiven {argname} { value { set item [OptCurDesc $descriptions]; # Test the values against their required type - if [catch {OptCheckType $arg\ - [OptType $item] [OptTypeArgs $item]} val] { + if {[catch {OptCheckType $arg\ + [OptType $item] [OptTypeArgs $item]} val]} { return -code error [OptBadValue $item $arg $val] } # consume the value @@ -509,8 +510,8 @@ proc ::tcl::OptProcArgGiven {argname} { optValue { set item [OptCurDesc $descriptions]; # Test the values against their required type - if ![catch {OptCheckType $arg\ - [OptType $item] [OptTypeArgs $item]} val] { + if {![catch {OptCheckType $arg\ + [OptType $item] [OptTypeArgs $item]} val]} { # right type, so : # consume the value OptNextArg arguments; @@ -541,10 +542,14 @@ proc ::tcl::OptKeyParse {descKey arglist} { } OptDoAll desc arglist; + + if {![Lempty $arglist]} { + return -code error [OptTooManyArgs $desc $arglist]; + } # Analyse the result # Walk through the tree: - OptTreeVars $desc "#[expr [info level]-1]" ; + OptTreeVars $desc "#[expr {[info level]-1}]" ; } # determine string length for nice tabulated output @@ -583,13 +588,13 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { switch -exact -- $type { int { - if ![regexp {^(-+)?[0-9]+$} $arg] { + if {![regexp {^(-+)?[0-9]+$} $arg]} { error "not an integer" } return $arg; } float { - return [expr double($arg)] + return [expr {double($arg)}] } script - list { @@ -602,7 +607,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { return $arg; } boolean { - if ![regexp -nocase {^(true|false|0|1)$} $arg] { + if {![regexp -nocase {^(true|false|0|1)$} $arg]} { error "non canonic boolean" } # convert true/false because expr/if is broken with "!,... @@ -644,7 +649,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { set larg [string tolower $arg]; set len [string length $larg]; - set last [expr $len-1]; + set last [expr {$len-1}]; foreach item [lrange $desc 1 end] { set flag [OptName $item] @@ -798,7 +803,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { # varname type value # varname value comment - if [regexp {^-(.+)$} $arg1 x type] { + if {[regexp {^-(.+)$} $arg1 x type]} { # flags/optValue as they are optional, need a "value", # on the contrary, for a variable (non optional), # default value is pointless, 'cept for choices : @@ -813,7 +818,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { } } 4 { - if [regexp {^-(.+)$} $arg1 x type] { + if {[regexp {^-(.+)$} $arg1 x type]} { return [OptNewInst $state $varname $type $arg2 $arg3]; } else { return -code error [OptOptUsage $item]; @@ -827,13 +832,13 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} { # Auto magic lasy type determination proc OptGuessType {arg} { - if [regexp -nocase {^(true|false)$} $arg] { + if {[regexp -nocase {^(true|false)$} $arg]} { return boolean } - if [regexp {^(-+)?[0-9]+$} $arg] { + if {[regexp {^(-+)?[0-9]+$} $arg]} { return int } - if ![catch {expr double($arg)}] { + if {![catch {expr {double($arg)}}]} { return float } return string @@ -1029,7 +1034,7 @@ proc ::tcl::Lvarincr {listName indexLst {howMuch 1}} { # Increments the value of one cell of a list proc ::tcl::Lvarincr1 {listName index {howMuch 1}} { upvar $listName list; - set newValue [expr [lindex $list $index]+$howMuch]; + set newValue [expr {[lindex $list $index]+$howMuch}]; set list [lreplace $list $index $index $newValue]; return $newValue; } diff --git a/library/opt0.1/pkgIndex.tcl b/library/opt0.1/pkgIndex.tcl index 7a7ad90..7f2baaf 100644 --- a/library/opt0.1/pkgIndex.tcl +++ b/library/opt0.1/pkgIndex.tcl @@ -4,4 +4,4 @@ # the package now, so they can readily use it # and even "namespace import tcl::*" ... # (tclPkgSetup just makes things slow and do not work so well with namespaces) -package ifneeded opt 0.2 [list source [file join $dir optparse.tcl]] +package ifneeded opt 0.3 [list source [file join $dir optparse.tcl]] |