Index: modules/cmdline/cmdline.man ================================================================== --- modules/cmdline/cmdline.man +++ modules/cmdline/cmdline.man @@ -69,14 +69,14 @@ [call [cmd ::cmdline::getKnownOpt] [arg argvVar] [arg optstring] [arg optVar] [arg valVar]] Like [cmd ::cmdline::getopt], except it ignores any unknown options in the input. -[call [cmd ::cmdline::getoptions] [arg arglistVar] [arg optlist] [opt [arg usage]]] +[call [cmd ::cmdline::getoptions] [arg argvVar] [arg optlist] [opt [arg usage]]] Processes the entire set of command line options found in the list -variable named by [arg arglistVar] and fills in defaults for those not +variable named by [arg argvVar] and fills in defaults for those not specified. This also generates an error message that lists the allowed flags if an incorrect flag is specified. The optional [arg usage]-argument contains a string to include in front of the generated message. If not present it defaults to @@ -112,11 +112,11 @@ [para] The result of the command is a dictionary mapping all options to their values, be they user-specified or defaults. -[call [cmd ::cmdline::getKnownOptions] [arg arglistVar] [arg optlist] [opt [arg usage]]] +[call [cmd ::cmdline::getKnownOptions] [arg argvVar] [arg optlist] [opt [arg usage]]] Like [cmd ::cmdline::getoptions], but ignores any unknown options in the input. [call [cmd ::cmdline::usage] [arg optlist] [opt [arg usage]]] Index: modules/cmdline/cmdline.tcl ================================================================== --- modules/cmdline/cmdline.tcl +++ modules/cmdline/cmdline.tcl @@ -169,11 +169,11 @@ # Process a set of command line options, filling in defaults # for those not specified. This also generates an error message # that lists the allowed flags if an incorrect flag is specified. # # Arguments: -# arglistVar The name of the argument list, typically argv. +# argvVar The name of the argument list, typically argv. # We remove all known options and their args from it. # In other words, after the call to this command the # referenced variable contains only the non-options, # and unknown options. # optlist A list-of-lists where each element specifies an option @@ -191,14 +191,14 @@ # usage Text to include in the usage display. Defaults to # "options:" # # Results # Name value pairs suitable for using with array set. -# A modified `arglistVar`. +# A modified `argvVar`. -proc ::cmdline::getoptions {arglistVar optlist {usage options:}} { - upvar 1 $arglistVar argv +proc ::cmdline::getoptions {argvVar optlist {usage options:}} { + upvar 1 $argvVar argv set opts [GetOptionDefaults $optlist result] set argc [llength $argv] while {[set err [getopt argv $opts opt arg]]} { @@ -220,11 +220,11 @@ # 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 +# argvVar The name of the argument list, typically argv. This # We remove all known options and their args from it. # In other words, after the call to this command the # referenced variable contains only the non-options, # and unknown options. # optlist A list-of-lists where each element specifies an option @@ -237,14 +237,14 @@ # usage Text to include in the usage display. Defaults to # "options:" # # Results # Name value pairs suitable for using with array set. -# A modified `arglistVar`. +# A modified `argvVar`. -proc ::cmdline::getKnownOptions {arglistVar optlist {usage options:}} { - upvar 1 $arglistVar argv +proc ::cmdline::getKnownOptions {argvVar optlist {usage options:}} { + upvar 1 $argvVar 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, @@ -341,26 +341,32 @@ # Results # A formatted usage message proc ::cmdline::usage {optlist {usage {options:}}} { set str "[getArgv0] $usage\n" + set longest 20 + set lines {} foreach opt [concat $optlist \ {{- "Forcibly stop option processing"} {help "Print this message"} {? "Print this message"}}] { - set name [lindex $opt 0] + set name "-[lindex $opt 0]" if {[regsub -- {\.secret$} $name {} name] == 1} { # Hidden option continue } if {[regsub -- {\.arg$} $name {} name] == 1} { - set default [lindex $opt 1] - set comment [lindex $opt 2] - append str [string trimright [format " %-20s %s <%s>" "-$name value" $comment $default]]\n + append name " value" + set desc "[lindex $opt 2] <[lindex $opt 1]>" } else { - set comment [lindex $opt 1] - append str [string trimright [format " %-20s %s" "-$name" $comment]]\n + set desc "[lindex $opt 1]" } + set longest [expr {max($longest, [string length $name])}] + lappend lines $name $desc + } + foreach {name desc} $lines { + append str "[string trimright [format " %-*s %s" $longest $name $desc]]\n" } + return $str } # ::cmdline::getfiles -- # @@ -712,11 +718,11 @@ # for those not specified. This also generates an error message # that lists the allowed options if an incorrect option is # specified. # # Arguments: -# arglistVar The name of the argument list, typically argv +# argvVar The name of the argument list, typically argv # optlist A list-of-lists where each element specifies an option # in the form: # # option default comment # @@ -758,14 +764,14 @@ # foo.xdigit.multi.secret # # Results # Name value pairs suitable for using with array set. -proc ::cmdline::typedGetoptions {arglistVar optlist {usage options:}} { +proc ::cmdline::typedGetoptions {argvVar optlist {usage options:}} { variable charclasses - upvar 1 $arglistVar argv + upvar 1 $argvVar argv set opts {? help} foreach opt $optlist { set name [lindex $opt 0] if {[regsub -- {\.secret$} $name {} name] == 1} { @@ -834,37 +840,42 @@ proc ::cmdline::typedUsage {optlist {usage {options:}}} { variable charclasses set str "[getArgv0] $usage\n" + set longest 20 + set lines {} foreach opt [concat $optlist \ {{help "Print this message"} {? "Print this message"}}] { - set name [lindex $opt 0] + set name "-[lindex $opt 0]" if {[regsub -- {\.secret$} $name {} name] == 1} { # Hidden option - - } else { - if {[regsub -- {\.multi$} $name {} name] == 1} { - # Display something about multiple options - } - - if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass] || - [regexp -- {\.\(([^)]+)\)} $opt dummy charclass] - } { - regsub -- "\\..+\$" $name {} name - set comment [lindex $opt 2] - set default "<[lindex $opt 1]>" - if {$default == "<>"} { - set default "" - } - append str [string trimright [format " %-20s %s %s" "-$name $charclass" \ - $comment $default]]\n - } else { - set comment [lindex $opt 1] - append str [string trimright [format " %-20s %s" "-$name" $comment]]\n - } - } + continue + } + + if {[regsub -- {\.multi$} $name {} name] == 1} { + # Display something about multiple options + } + + if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass] || + [regexp -- {\.\(([^)]+)\)} $opt dummy charclass] + } { + regsub -- "\\..+\$" $name {} name + append name " $charclass" + set desc [lindex $opt 2] + set default [lindex $opt 1] + if {$default != ""} { + append desc " <$default>" + } + } else { + set desc [lindex $opt 1] + } + lappend accum $name $desc + set longest [expr {max($longest, [string length $name])}] + } + foreach {name desc} $accum { + append str "[string trimright [format " %-*s %s" $longest $name $desc]]\n" } return $str } # ::cmdline::prefixSearch -- Index: modules/cmdline/cmdline.test ================================================================== --- modules/cmdline/cmdline.test +++ modules/cmdline/cmdline.test @@ -173,14 +173,15 @@ -a -- Forcibly stop option processing -help Print this message -? Print this message " {}] + test cmdline-2.11 {cmdline::getoptions, usage string in errors} { set argList {-help} list [catch {cmdline::getoptions argList {{foo.arg blat} a} {testing}} msg] $msg \ - $argList + $argList } [list 1 "[cmdline::getArgv0] testing -foo value -a -- Forcibly stop option processing -help Print this message @@ -233,10 +234,23 @@ -a -- Forcibly stop option processing -help Print this message -? Print this message " {}] + +test cmdline-3.4 {cmdline::usage, long options} { + set argList {-help} + list [catch {cmdline::getoptions argList {{mysecret blat} a {very-long-option.arg foobar {A very very long option}}}} msg] $msg \ + $argList +} [list 1 "[cmdline::getArgv0] options: + -mysecret blat + -a + -very-long-option value A very very long option + -- Forcibly stop option processing + -help Print this message + -? Print this message +" {}] # cmdline::getfiles # Run the script body in a slave process so we can collect stdout. Index: modules/cmdline/typedCmdline.test ================================================================== --- modules/cmdline/typedCmdline.test +++ modules/cmdline/typedCmdline.test @@ -105,11 +105,11 @@ catch {unset arg} set argList {-foo 123} list [cmdline::typedGetopt argList {a.arg foo.integer b} opt arg] $argList $opt $arg } {1 {} foo 123} -test typed-cmdline-6.14.0 {cmdline::typedGetopt, integer options} tcl8.6plus { +test typed-cmdline-6.14.0 {cmdline::typedGetopt, integer options} tcl8.6not8.7 { catch {unset opt} catch {unset arg} set argList {-foo 123} list [catch {cmdline::typedGetopt argList {a.arg foo.bar b} opt arg} msg] $msg $argList $opt $arg } [list 1 {Illegal option type specification: must be one of alnum|alpha|ascii|control|boolean|digit|double|entier|false|graph|integer|list|lower|print|punct|space|true|upper|wideinteger|wordchar|xdigit} {-foo 123} {} {}] @@ -125,10 +125,18 @@ catch {unset opt} catch {unset arg} set argList {-foo 123} list [catch {cmdline::typedGetopt argList {a.arg foo.bar b} opt arg} msg] $msg $argList $opt $arg } [list 1 {Illegal option type specification: must be one of alnum|alpha|ascii|control|boolean|digit|double|false|graph|integer|lower|print|punct|space|true|upper|wordchar|xdigit} {-foo 123} {} {}] + +test typed-cmdline-6.14.3 {cmdline::typedGetopt, integer options} tcl8.7plus { + catch {unset opt} + catch {unset arg} + set argList {-foo 123} + list [catch {cmdline::typedGetopt argList {a.arg foo.bar b} opt arg} msg] $msg $argList $opt $arg +} [list 1 {Illegal option type specification: must be one of alnum|alpha|ascii|control|boolean|dict|digit|double|entier|false|graph|integer|list|lower|print|punct|space|true|upper|unicode|wideinteger|wordchar|xdigit} {-foo 123} {} {}] + test typed-cmdline-6.15 {cmdline::typedGetopt, integer options} { catch {unset opt} catch {unset arg} set argList {-foo 123 -a 234} Index: modules/devtools/testutilities.tcl ================================================================== --- modules/devtools/testutilities.tcl +++ modules/devtools/testutilities.tcl @@ -214,10 +214,14 @@ [expr {[package vsatisfies [package provide Tcl] 8.5]}] ::tcltest::testConstraint tcl8.6plus \ [expr {[package vsatisfies [package provide Tcl] 8.6]}] + ::tcltest::testConstraint tcl8.6not8.7 \ + [expr { [package vsatisfies [package provide Tcl] 8.6] && + ![package vsatisfies [package provide Tcl] 8.7]}] + ::tcltest::testConstraint tcl8.6not10 \ [expr { [package vsatisfies [package provide Tcl] 8.6] && ![package vsatisfies [package provide Tcl] 8.6.10]}] ::tcltest::testConstraint tcl8.6.10plus \ @@ -227,10 +231,13 @@ [expr {![package vsatisfies [package provide Tcl] 8.5]}] ::tcltest::testConstraint tcl8.5minus \ [expr {![package vsatisfies [package provide Tcl] 8.6]}] + ::tcltest::testConstraint tcl8.7plus \ + [expr {[package vsatisfies [package provide Tcl] 8.7]}] + # ### ### ### ######### ######### ######### ## Cross-version code for the generation of the error messages created ## by Tcl procedures when called with the wrong number of arguments, ## either too many, or not enough.