d88566d716
Pure TCL code for command line options parsing. PR: 10661 Submitted by: Mikhail Teterin <mi@aldan.algebra.com>
148 lines
4.7 KiB
Text
148 lines
4.7 KiB
Text
--- foxTypedOpts.tcl.orig Sat Feb 19 19:46:50 1994
|
|
+++ foxTypedOpts.tcl Thu Mar 18 16:15:13 1999
|
|
@@ -80,9 +80,8 @@
|
|
# typedopts several times with different <arg-list>s without losing the
|
|
# information from previous calls.
|
|
#
|
|
-# if typedopts can't parse its options for any reason, it will print an
|
|
-# error message to stderr and return a -1 without modifying any other
|
|
-# variables.
|
|
+# if typedopts can't parse its options for any reason, it return an
|
|
+# error message without modifying any other variables.
|
|
#
|
|
# EXAMPLE:
|
|
#
|
|
@@ -157,8 +156,7 @@
|
|
# Initial revision
|
|
#
|
|
|
|
-proc typedopts { args } {
|
|
-
|
|
+namespace eval foxOpts {
|
|
proc abbr { s1 s2 } {
|
|
if { [ set len [ string length $s1 ]] } then {
|
|
if { ! [ string compare $s1 [ string range $s2 0 [ expr $len - 1 ]]] } then {
|
|
@@ -298,8 +296,7 @@
|
|
return 1
|
|
}
|
|
default {
|
|
- puts stderr "Eek! Option type <$otype> not supported yet!"
|
|
- set var "isn't a supported type."
|
|
+ set var "<$otype> isn't a supported type."
|
|
return 0
|
|
}
|
|
}
|
|
@@ -315,54 +312,52 @@
|
|
"floats" -
|
|
"strings" {
|
|
if { [ llength $optlist ] } then {
|
|
- puts stderr "typedopts: Type $type doesn't take arguments"
|
|
- return ""
|
|
+ return -code error "typedopts: Type $type doesn't take arguments"
|
|
}
|
|
return [ string index $type 0 ]
|
|
}
|
|
"one-of" {
|
|
if { ! [ llength $optlist ] } then {
|
|
- puts stderr "typedopts: No arguments given to type $type"
|
|
- return ""
|
|
+ return -code error "typedopts: No arguments given to type $type"
|
|
}
|
|
return [ concat [ string index $type 0 ] $optlist ]
|
|
}
|
|
"list-of" -
|
|
"multiple" {
|
|
if { ! [ llength $optlist ] } then {
|
|
- puts stderr "typedopts: No arguments given to type $type"
|
|
- return ""
|
|
- }
|
|
- if { ! [ string length [ set subtype [ parseOption $optlist ]]] } then {
|
|
- return ""
|
|
+ return -code error "typedopts: No arguments given to type $type"
|
|
}
|
|
+ if [catch {parseOption $optlist} subtype] {
|
|
+ return -code error $subtype
|
|
+ }
|
|
return [ concat [ string index $type 0 ] $subtype ]
|
|
}
|
|
default {
|
|
- puts stderr "typedopts: Unknown option type $type"
|
|
- return ""
|
|
+ return -code error "typedopts: Unknown option type $type"
|
|
}
|
|
}
|
|
}
|
|
+}
|
|
+
|
|
+proc typedopts { args } {
|
|
|
|
set doinit 1
|
|
|
|
if { [ llength $args ] < 5 } then {
|
|
- puts stderr "typedopts: bad number of arguments."
|
|
- return -1
|
|
+ return -code error "typedopts: bad number of arguments."
|
|
}
|
|
|
|
- set args [ extract $args arglist optlist optret argret restret ]
|
|
+ set args [ foxOpts::extract $args arglist optlist optret argret restret ]
|
|
|
|
while { [ llength $args ] } {
|
|
- set opt [ shift args ]
|
|
- switch -exact [ findabbr { -noinitialize } $opt ] {
|
|
+ set opt [ foxOpts::shift args ]
|
|
+ switch -exact [ foxOpts::findabbr { -noinitialize } $opt ] {
|
|
-noinitialize {
|
|
set doinit 0
|
|
}
|
|
default {
|
|
- puts stderr "typedopts: bad option \"$opt\": should be -noinitialize or --"
|
|
- return -1
|
|
+ return -code error \
|
|
+ "typedopts: bad option \"$opt\": should be -noinitialize or --"
|
|
}
|
|
}
|
|
}
|
|
@@ -380,16 +375,15 @@
|
|
if { [ string length $type ] } then {
|
|
foreach arg $word {
|
|
if { [ lsearch -exact $arg $allopts ] > -1 } then {
|
|
- puts stderr "typedopts: option -$arg multiply declared."
|
|
- return -1
|
|
+ return -code error "typedopts: option -$arg multiply declared."
|
|
}
|
|
lappend allopts $arg
|
|
set opttype($arg) $type
|
|
}
|
|
set type ""
|
|
} else {
|
|
- if { ! [ string length [ set type [ parseOption $word ]]] } then {
|
|
- return -1
|
|
+ if [catch {foxOpts::parseOption $word} type] then {
|
|
+ return -code error $type
|
|
}
|
|
}
|
|
}
|
|
@@ -408,7 +402,7 @@
|
|
while { [ llength $arglist ] } {
|
|
switch -glob -- $arglist {
|
|
-- {
|
|
- shift arglist
|
|
+ foxOpts::shift arglist
|
|
break
|
|
}
|
|
-* {
|
|
@@ -417,10 +411,10 @@
|
|
break
|
|
}
|
|
}
|
|
- set opt [ string range [ shift arglist ] 1 end ]
|
|
- if { [ string length [ set fnd [ findabbr $allopts $opt ]]] } then {
|
|
+ set opt [ string range [ foxOpts::shift arglist ] 1 end ]
|
|
+ if { [ string length [set fnd [foxOpts::findabbr $allopts $opt]]] } then {
|
|
set type $opttype($fnd)
|
|
- if { [ parseOptionType $opttype($fnd) arglist arg ] } then {
|
|
+ if { [ foxOpts::parseOptionType $opttype($fnd) arglist arg ] } then {
|
|
if { $_opts($fnd) && ! [ string match "m*" $type ] } then {
|
|
set _args(_ERROR_) "Found multiple occurrences of option -$fnd"
|
|
set retval 0
|