diff -Naur oldCmdLineDir/ChangeLog newCmdLineDir/ChangeLog
--- oldCmdLineDir/ChangeLog Thu Aug 9 19:40:19 2001
+++ newCmdLineDir/ChangeLog Thu Aug 9 19:39:59 2001
@@ -1,3 +1,11 @@
+2001-08-09 Melissa Chawla <[email protected]>
+
+ * cmdline.tcl: Added getKnownOpt and getKnownOptions procedures to
+ the API. The procedures offer a way for arguments that are not in
+ the optionList to be ignored. This way, you can have two
+ independant locations in your application where commandline
+ arguments are parsed. I bumped the package version to 1.2.
+
2000-05-03 Brent Welch <[email protected]>
* cmdline.tcl: Changed cmdline::getopt to set boolean arguments to
diff -Naur oldCmdLineDir/cmdline.tcl newCmdLineDir/cmdline.tcl
--- oldCmdLineDir/cmdline.tcl Thu Aug 9 19:40:19 2001
+++ newCmdLineDir/cmdline.tcl Thu Aug 9 19:39:59 2001
@@ -11,9 +11,10 @@
#
# RCS: @(#) $Id: cmdline.tcl,v 1.6 2000/06/02 18:43:53 ericm Exp $
-package provide cmdline 1.1
+package provide cmdline 1.2
namespace eval cmdline {
- namespace export getArgv0 getopt getfiles getoptions usage
+ namespace export getArgv0 getopt getKnownOpt getfiles getoptions \
+ getKnownOptions usage
}
# Load the typed versions of these functions
@@ -52,6 +53,54 @@
proc cmdline::getopt {argvVar optstring optVar valVar} {
upvar 1 $argvVar argsList
+ upvar 1 $optVar option
+ upvar 1 $valVar value
+
+ set result [getKnownOpt argsList $optstring option value]
+
+ if {$result < 0} {
+ # Collapse unknown-option error into any-other-error result.
+ set result -1
+ }
+ return $result
+}
+
+# cmdline::getKnownOpt --
+#
+# The cmdline::getKnownOpt works in a fashion like the standard
+# C based getopt function. Given an option string and a
+# pointer to an array or args this command will process the
+# first argument and return info on how to procede.
+#
+# Arguments:
+# argvVar Name of the argv list that you
+# want to process. If options are found the
+# arg list is modified and the processed arguments
+# are removed from the start of the list. Note that
+# unknown options and the args that follow them are
+# left in this list.
+# optstring A list of command options that the application
+# will accept. If the option ends in ".arg" the
+# getopt routine will use the next argument as
+# an argument to the option. Otherwise the option
+# is a boolean that is set to 1 if present.
+# optVar The variable pointed to by optVar
+# contains the option that was found (without the
+# leading '-' and without the .arg extension).
+# valVar Upon success, the variable pointed to by valVar
+# contains the value for the specified option.
+# This value comes from the command line for .arg
+# options, otherwise the value is 1.
+# If getopt fails, the valVar is filled with an
+# error message.
+#
+# Results:
+# The getKnownOpt function returns 1 if an option was found,
+# 0 if no more options were found, -1 if an unknown option was
+# encountered, and -2 if any other error occurred.
+
+proc cmdline::getKnownOpt {argvVar optstring optVar valVar} {
+ upvar 1 $argvVar argsList
upvar 1 $optVar option
upvar 1 $valVar value
@@ -87,10 +136,11 @@
set argsList [lrange $argsList 1 end]
} else {
set value "Option \"$option\" requires an argument"
- set result -1
+ set result -2
}
} else {
- set value "Illegal option \"$option\""
+ # Unknown option.
+ set value "Illegal option \"$option\""
set result -1
}
}
@@ -107,7 +157,8 @@
# that lists the allowed flags if an incorrect flag is specified.
#
# Arguments:
-# arglistVar The name of the argument list, typically argv
+# arglistVar The name of the argument list, typically argv.
+# We remove all known options and their args from it.
# optlist A list-of-lists where each element specifies an option
# in the form:
# flag default comment
@@ -123,6 +174,113 @@
proc cmdline::getoptions {arglistVar optlist {usage options:}} {
upvar 1 $arglistVar argv
+
+ set opts [GetOptionDefaults $optlist result]
+
+ set argc [llength $argv]
+ while {[set err [cmdline::getopt argv $opts opt arg]]} {
+ if {$err < 0} {
+ set result(?) ""
+ break
+ }
+ set result($opt) $arg
+ }
+ if {[info exist result(?)] || [info exists result(help)]} {
+ error [cmdline::usage $optlist $usage]
+ }
+ return [array get result]
+}
+
+# cmdline::getKnownOptions --
+#
+# Process a set of command line options, filling in defaults
+# for those not specified. This ignores unknown flags, but generates
+# an error message that lists the correct usage if a known option
+# is used incorrectly.
+#
+# Arguments:
+# arglistVar The name of the argument list, typically argv. This
+# We remove all known options and their args from it.
+# optlist A list-of-lists where each element specifies an option
+# in the form:
+# flag default comment
+# If flag ends in ".arg" then the value is taken from the
+# command line. Otherwise it is a boolean and appears in
+# the result if present on the command line. If flag ends
+# in ".secret", it will not be displayed in the usage.
+# usage Text to include in the usage display. Defaults to
+# "options:"
+#
+# Results
+# Name value pairs suitable for using with array set.
+
+proc cmdline::getKnownOptions {arglistVar optlist {usage options:}} {
+ upvar 1 $arglistVar argv
+
+ set opts [GetOptionDefaults $optlist result]
+
+ # As we encounter them, keep the unknown options and their
+ # arguments in this list. Before we return from this procedure,
+ # we'll prepend these args to the argList so that the application
+ # doesn't lose them.
+
+ set unknownOptions [list]
+
+ set argc [llength $argv]
+ while {[set err [cmdline::getKnownOpt argv $opts opt arg]]} {
+ if {$err == -1} {
+ # Unknown option.
+
+ # Skip over any non-option items that follow it.
+ # For now, add them to the list of unknownOptions.
+ lappend unknownOptions [lindex $argv 0]
+ set argv [lrange $argv 1 end]
+ while {([llength $argv] != 0) \
+ && ![string match "-*" [lindex $argv 0]]} {
+ lappend unknownOptions [lindex $argv 0]
+ set argv [lrange $argv 1 end]
+ }
+ } elseif {$err == -2} {
+ set result(?) ""
+ break
+ } else {
+ set result($opt) $arg
+ }
+ }
+
+ # Before returning, prepend the any unknown args back onto the
+ # argList so that the application doesn't lose them.
+ set argv [concat $unknownOptions $argv]
+
+ if {[info exist result(?)] || [info exists result(help)]} {
+ error [cmdline::usage $optlist $usage]
+ }
+ return [array get result]
+}
+
+# cmdline::GetOptionDefaults --
+#
+# This internal procdure processes the option list (that was passed to
+# the getopt or getKnownOpt procedure). The defaultArray gets an index
+# for each option in the option list, the value of which is the option's
+# default value.
+#
+# Arguments:
+# optlist A list-of-lists where each element specifies an option
+# in the form:
+# flag default comment
+# If flag ends in ".arg" then the value is taken from the
+# command line. Otherwise it is a boolean and appears in
+# the result if present on the command line. If flag ends
+# in ".secret", it will not be displayed in the usage.
+# defaultArrayVar The name of the array in which to put argument defaults.
+#
+# Results
+# Name value pairs suitable for using with array set.
+
+proc cmdline::GetOptionDefaults {optlist defaultArrayVar} {
+ upvar 1 $defaultArrayVar result
+
set opts {? help}
foreach opt $optlist {
set name [lindex $opt 0]
@@ -141,17 +299,7 @@
set result($name) 0
}
}
- set argc [llength $argv]
- while {[set err [cmdline::getopt argv $opts opt arg]]} {
- if {$err < 0} {
- error [cmdline::usage $optlist $usage]
- }
- set result($opt) $arg
- }
- if {[info exist result(?)] || [info exists result(help)]} {
- error [cmdline::usage $optlist $usage]
- }
- return [array get result]
+ return $opts
}
# cmdline::usage --
diff -Naur oldCmdLineDir/cmdline.test newCmdLineDir/cmdline.test
--- oldCmdLineDir/cmdline.test Thu Aug 9 19:40:19 2001
+++ newCmdLineDir/cmdline.test Thu Aug 9 19:39:59 2001
@@ -72,7 +72,13 @@
set argList {-foo}
list [cmdline::getopt argList {foo.arg} opt arg] $argList $opt $arg
} {-1 {} foo {Option "foo" requires an argument}}
-test cmdline-1.10 {cmdline::getopt, multiple options} {
+test cmdline-1.10 {cmdline::getopt, unknown option} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-bar}
+ list [cmdline::getopt argList {foo.arg} opt arg] $argList $opt $arg
+} {-1 -bar bar {Illegal option "bar"}}
+test cmdline-1.11 {cmdline::getopt, multiple options} {
catch {unset opt}
catch {unset arg}
set argList {-foo}
@@ -315,6 +321,161 @@
set argv0 $oldargv0
set result
} foo
+
+# cmdline::getKnownOpt
+
+test cmdline-6.1 {cmdline::getKnownOpt} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {}
+ list [cmdline::getKnownOpt argList {a} opt arg] $argList $opt $arg
+} {0 {} {} {}}
+test cmdline-6.2 {cmdline::getKnownOpt, multiple options} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {}
+ list [cmdline::getKnownOpt argList {a b.arg c} opt arg] $argList $opt $arg
+} {0 {} {} {}}
+test cmdline-6.3 {cmdline::getKnownOpt, -- option} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-- -a}
+ list [cmdline::getKnownOpt argList {a} opt arg] $argList $opt $arg
+} {0 -a {} {}}
+test cmdline-6.4 {cmdline::getKnownOpt, non dash option} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {b -a}
+ list [cmdline::getKnownOpt argList {a} opt arg] $argList $opt $arg
+} {0 {b -a} {} {}}
+test cmdline-6.5 {cmdline::getKnownOpt, simple option} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-a b}
+ list [cmdline::getKnownOpt argList {a} opt arg] $argList $opt $arg
+} {1 b a 1}
+test cmdline-6.6 {cmdline::getKnownOpt, multiple letter option} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-foo b}
+ list [cmdline::getKnownOpt argList {foo} opt arg] $argList $opt $arg
+} {1 b foo 1}
+test cmdline-6.7 {cmdline::getKnownOpt, multiple letter option, no abbreviations} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-f b}
+ list [cmdline::getKnownOpt argList {foo} opt arg] $argList $opt $arg
+} {-1 {-f b} f {Illegal option "f"}}
+test cmdline-6.8 {cmdline::getKnownOpt, option with argument} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-foo bar baz}
+ list [cmdline::getKnownOpt argList {foo.arg} opt arg] $argList $opt $arg
+} {1 baz foo bar}
+test cmdline-6.9 {cmdline::getKnownOpt, option with argument, missing arg} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-foo}
+ list [cmdline::getKnownOpt argList {foo.arg} opt arg] $argList $opt $arg
+} {-2 {} foo {Option "foo" requires an argument}}
+test cmdline-6.10 {cmdline::getKnownOpt, unknown option} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-bar}
+ list [cmdline::getKnownOpt argList {foo.arg} opt arg] $argList $opt $arg
+} {-1 -bar bar {Illegal option "bar"}}
+test cmdline-6.11 {cmdline::getKnownOpt, multiple options} {
+ catch {unset opt}
+ catch {unset arg}
+ set argList {-foo}
+ list [cmdline::getKnownOpt argList {a.arg b foo c.arg} opt arg] $argList $opt $arg
+} {1 {} foo 1}
+
+# cmdline::getKnownOptions
+
+test cmdline-7.1 {cmdline::getKnownOptions} {
+ set argList {foo}
+ list [cmdline::getKnownOptions argList {}] $argList
+} {{} foo}
+test cmdline-7.2 {cmdline::getKnownOptions, secret flag} {
+ set argList {-foo}
+ list [cmdline::getKnownOptions argList {{foo.secret}}] $argList
+} {{foo 1} {}}
+test cmdline-7.3 {cmdline::getKnownOptions, normal flag} {
+ set argList {-foo}
+ list [cmdline::getKnownOptions argList {{foo}}] $argList
+} {{foo 1} {}}
+test cmdline-7.4 {cmdline::getKnownOptions, flag with arg} {
+ set argList {-foo bar}
+ list [cmdline::getKnownOptions argList {{foo.arg}}] $argList
+} {{foo bar} {}}
+test cmdline-7.5 {cmdline::getKnownOptions, missing flag with arg, default value} {
+ set argList {}
+ list [cmdline::getKnownOptions argList {{foo.arg blat}}] $argList
+} {{foo blat} {}}
+test cmdline-7.6 {cmdline::getKnownOptions, flag with arg, default value} {
+ set argList {-foo bar}
+ list [cmdline::getKnownOptions argList {{foo.arg blat}}] $argList
+} {{foo bar} {}}
+test cmdline-7.7 {cmdline::getKnownOptions, multiple flags with arg, default value} {
+ set argList {}
+ list [cmdline::getKnownOptions argList {{foo.arg blat} {a.arg b}}] $argList
+} {{foo blat a b} {}}
+test cmdline-7.8 {cmdline::getKnownOptions, ignore unknown option} {
+ set argList {-unknown -foo buzz}
+ list [cmdline::getKnownOptions argList {{foo.arg blat}}] $argList
+} {{foo buzz} -unknown}
+test cmdline-7.9 {cmdline::getKnownOptions, ignore unknown option} {
+ set argList {-foo buzz -unknown}
+ list [cmdline::getKnownOptions argList {{foo.arg blat}}] $argList
+} {{foo buzz} -unknown}
+test cmdline-7.10 {cmdline::getKnownOptions, ignore unknown option with args} {
+ set argList {-unknown u1 u2 u3 -foo buzz}
+ list [cmdline::getKnownOptions argList {{foo.arg blat}}] $argList
+} {{foo buzz} {-unknown u1 u2 u3}}
+test cmdline-7.11 {cmdline::getKnownOptions, ignore unknown option with args} {
+ set argList {-foo buzz -unknown u1 u2 u3}
+ list [cmdline::getKnownOptions argList {{foo.arg blat}}] $argList
+} {{foo buzz} {-unknown u1 u2 u3}}
+test cmdline-7.12 {cmdline::getKnownOptions, errors} {
+ set argList {-a -foo}
+ list [catch {cmdline::getKnownOptions argList {{foo.arg blat} a}} msg] $msg $argList
+} [list 1 "[cmdline::getArgv0] options:
+ -foo value <blat>
+ -a
+ -help Print this message
+ -? Print this message
+" {}]
+test cmdline-7.13 {cmdline::getKnownOptions, errors} {
+ set argList {-a -?}
+ list [catch {cmdline::getKnownOptions argList {{foo.arg blat} a}} msg] $msg \
+ $argList
+} [list 1 "[cmdline::getArgv0] options:
+ -foo value <blat>
+ -a
+ -help Print this message
+ -? Print this message
+" {}]
+test cmdline-7.14 {cmdline::getKnownOptions, errors} {
+ set argList {-help}
+ list [catch {cmdline::getKnownOptions argList {{foo.arg blat} a}} msg] $msg \
+ $argList
+} [list 1 "[cmdline::getArgv0] options:
+ -foo value <blat>
+ -a
+ -help Print this message
+ -? Print this message
+" {}]
+test cmdline-7.15 {cmdline::getKnownOptions, usage string in errors} {
+ set argList {-help}
+ list [catch {cmdline::getKnownOptions argList {{foo.arg blat} a} {testing}} msg] $msg \
+ $argList
+} [list 1 "[cmdline::getArgv0] testing
+ -foo value <blat>
+ -a
+ -help Print this message
+ -? Print this message
+" {}]
tcltest::cleanupTests
return
diff -Naur oldCmdLineDir/pkgIndex.tcl newCmdLineDir/pkgIndex.tcl
--- oldCmdLineDir/pkgIndex.tcl Thu Aug 9 19:40:19 2001
+++ newCmdLineDir/pkgIndex.tcl Thu Aug 9 19:39:59 2001
@@ -8,4 +8,4 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-package ifneeded cmdline 1.0 [list source [file join $dir cmdline.tcl]]
+package ifneeded cmdline 1.2 [list source [file join $dir cmdline.tcl]]
