1
0
mirror of https://git.FreeBSD.org/ports.git synced 2024-10-30 21:49:25 +00:00
freebsd-ports/devel/tclgetopts/files/patch-aa
Steve Price d88566d716 Initial import of tclGetOpts version 1.0.
Pure TCL code for command line options parsing.

PR:		10661
Submitted by:	Mikhail Teterin <mi@aldan.algebra.com>
1999-05-03 03:23:01 +00:00

149 lines
4.7 KiB
Plaintext

--- 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