summaryrefslogtreecommitdiffstats
path: root/library/opt
diff options
context:
space:
mode:
Diffstat (limited to 'library/opt')
-rw-r--r--library/opt/optparse.tcl54
1 files changed, 18 insertions, 36 deletions
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index b329190..8a86dfe 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -8,12 +8,12 @@
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
#
-# RCS: @(#) $Id: optparse.tcl,v 1.7 2002/08/20 15:33:32 dgp Exp $
+# RCS: @(#) $Id: optparse.tcl,v 1.8 2002/11/23 01:41:35 hobbs Exp $
package require Tcl 8
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
-package provide opt 0.4.3
+package provide opt 0.4.4
namespace eval ::tcl {
@@ -69,13 +69,6 @@ namespace eval ::tcl {
}
################### No User serviceable part below ! ###############
-# You should really not look any further :
-# The following is private unexported undocumented unblessed... code
-# time to hit "q" ;-) !
-
-# Hmmm... ok, you really want to know ?
-
-# You've been warned... Here it is...
# Array storing the parsed descriptions
variable OptDesc;
@@ -154,7 +147,7 @@ namespace eval ::tcl {
proc ::tcl::OptKeyRegister {desc {key ""}} {
variable OptDesc;
variable OptDescN;
- if {[string compare $key ""] == 0} {
+ if {[string equal $key ""]} {
# in case a key given to us as a parameter was a number
while {[info exists OptDesc($OptDescN)]} {incr OptDescN}
set key $OptDescN;
@@ -256,8 +249,7 @@ proc ::tcl::OptParse {desc arglist} {
# into local variable named "Args".
proc ::tcl::OptProc {name desc body} {
set namespace [uplevel 1 [list ::namespace current]];
- if { ([string match "::*" $name])
- || ([string compare $namespace "::"]==0)} {
+ if {[string match "::*" $name] || [string equal $namespace "::"]} {
# absolute name or global namespace, name is the key
set key $name;
} else {
@@ -464,7 +456,7 @@ proc ::tcl::OptProcArgGiven {argname} {
}
# consume the flag
OptNextArg arguments;
- if {[string compare "--" $arg] == 0} {
+ if {[string equal "--" $arg]} {
# return from 'flags' state
return -code return;
}
@@ -536,7 +528,7 @@ proc ::tcl::OptKeyParse {descKey arglist} {
set desc [OptKeyGetDesc $descKey];
# make sure -help always give usage
- if {[string compare "-help" [string tolower $arglist]] == 0} {
+ if {[string equal -nocase "-help" $arglist]} {
return -code error [OptError "Usage information:" $desc 1];
}
@@ -587,7 +579,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
switch -exact -- $type {
int {
- if {![regexp {^(-+)?[0-9]+$} $arg]} {
+ if {![string is integer -strict $arg]} {
error "not an integer"
}
return $arg;
@@ -598,23 +590,17 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
script -
list {
# if llength fail : malformed list
- if {[llength $arg]==0} {
- if {[OptIsFlag $arg]} {
- error "no values with leading -"
- }
+ if {[llength $arg]==0 && [OptIsFlag $arg]} {
+ error "no values with leading -"
}
return $arg;
}
boolean {
- if {![regexp -nocase {^(true|false|0|1)$} $arg]} {
+ if {![string is boolean -strict $arg]} {
error "non canonic boolean"
}
# convert true/false because expr/if is broken with "!,...
- if {$arg} {
- return 1
- } else {
- return 0
- }
+ return [expr {$arg ? 1 : 0}]
}
choice {
if {[lsearch -exact $typeArgs $arg] < 0} {
@@ -656,16 +642,14 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# (string length ought to be cheap)
set lflag [string tolower $flag];
if {$len == [string length $lflag]} {
- if {[string compare $larg $lflag]==0} {
+ if {[string equal $larg $lflag]} {
# Exact match case
OptSetPrgCounter desc $i;
return 1;
}
- } else {
- if {[string compare $larg [string range $lflag 0 $last]]==0} {
- lappend hitems $i;
- incr hits;
- }
+ } elseif {[string equal $larg [string range $lflag 0 $last]]} {
+ lappend hitems $i;
+ incr hits;
}
incr i;
}
@@ -680,11 +664,9 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
proc OptName {item} {
lindex $item 1;
}
- #
proc OptHasBeenSet {item} {
Lget $item {2 0};
}
- #
proc OptValue {item} {
Lget $item {2 1};
}
@@ -715,7 +697,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
lindex $item 5
}
proc OptNeedValue {item} {
- string compare [OptType $item] boolflag
+ expr {![string equal [OptType $item] boolflag]}
}
proc OptDefaultValue {item} {
set val [OptTypeArgs $item]
@@ -761,7 +743,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
set state "flags";
} elseif {$isopt} {
set state "optValue";
- } elseif {[string compare $varname "args"]} {
+ } elseif {![string equal $varname "args"]} {
set state "value";
} else {
set state "args";
@@ -783,7 +765,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# varname default
# varname help
set type [OptGuessType $arg1]
- if {[string compare $type "string"] == 0} {
+ if {[string equal $type "string"]} {
if {$isflag} {
set type boolflag
set def false