Code
# autoopts v0.1.0
# This module automatically processes command line arguments and generates a
# usage message based on the arguments that your main proc takes. To use it,
# simply source this file and call ::autoopts::go ?your-main-proc?.
# Copyright (c) 2017 dbohdan
# License: MIT
package require Tcl 8.5
namespace eval ::autoopts {}
proc ::autoopts::has-prefix name {
return [regexp {^--?} $name]
}
proc ::autoopts::generate-spec proc {
set spec {named {} positional {}}
foreach arg [info args $proc] {
set info {}
dict set info name $arg
if {[info default $proc $arg default]} {
dict set info default $default
}
if {[has-prefix $arg]} {
dict lappend spec named $info
} else {
dict lappend spec positional $info
}
}
return $spec
}
proc ::autoopts::me {} {
return [file tail [info script]]
}
proc ::autoopts::generate-usage spec {
set usage "usage: [me]"
foreach info [dict get $spec positional] {
set name [dict get $info name]
if {[dict exists $info default]} {
append usage " \[$name\]"
} else {
append usage " $name"
}
}
foreach info [dict get $spec named] {
set name [dict get $info name]
if {[dict exists $info default]} {
append usage " \[$name [dict get $info default]\]"
} else {
append usage " $name [string toupper [string trimleft $name -]]"
}
}
return $usage
}
proc ::autoopts::parse {spec arguments} {
set named [dict get $spec named]
set positional [dict get $spec positional]
set count [llength $arguments]
set eon 0 ;# End of named arguments.
set names {}
set pos 0 ;# Number of positional arguments encountered.
set values {} ;# Result.
foreach info $named {
lappend names [dict get $info name]
}
for {set i 0} {$i < $count} {incr i} {
set arg [lindex $arguments $i]
if {[has-prefix $arg] && !$eon} {
if {$arg eq {--}} {
set eon 1
continue
}
if {$arg ni $names} {
error "unknown option: $arg"
}
if {$i + 1 < $count} {
dict set values $arg [lindex $arguments $i+1]
} else {
error "missing value for option $arg"
}
incr i
} else {
if {$pos >= [llength $positional]} {
error {too many positional arguments}
}
dict set values [dict get [lindex $positional $pos] name] $arg
incr pos
}
}
set keys [dict keys $values]
for {set i $pos} {$i < [llength $positional]} {incr i} {
set info [lindex $positional $i]
if {[dict exists $info default]} {
dict set values [dict get $info name] [dict get $info default]
} else {
error {too few positional arguments}
}
}
foreach info $named {
set name [dict get $info name]
if {$name ni $keys} {
if {[dict exists $info default]} {
dict set values $name [dict get $info default]
} else {
error "missing required option $name"
}
}
}
return $values
}
proc ::autoopts::invoke {proc values} {
set procArgs {}
foreach arg [info args $proc] {
lappend procArgs [dict get $values $arg]
}
$proc {*}$procArgs
}
proc ::autoopts::go {{proc main}} {
set spec [generate-spec $proc]
if {[string trim $::argv] in {-h --help}} {
puts stderr [generate-usage $spec]
exit 0
}
if {[catch {
set values [parse $spec $::argv]
} err]} {
puts stderr $err
puts stderr [generate-usage $spec]
exit 1
}
invoke $proc $values
}
# Testing.
proc ::autoopts::assert-equal {actual expected} {
if {$actual ne $expected} {
error "expected \"$expected\", but got \"$actual\""
}
}
proc ::autoopts::test {} {
proc ::autoopts::foo {-n --hello} {
return [list ${-n} ${--hello}]
}
proc ::autoopts::bar {inputfile {outputfile -} {--format pdf}} {
return [list $inputfile $outputfile ${--format}]
}
set fooSpec {named {{name -n} {name --hello}} positional {}}
set barSpec {named {{name --format default pdf}}\
positional {{name inputfile} {name outputfile default -}}}
# generate-spec.
set spec [generate-spec foo]
assert-equal $spec $fooSpec
assert-equal [generate-usage $spec] "usage: [me] -n N --hello HELLO"
set spec [generate-spec bar]
assert-equal $spec $barSpec
assert-equal [generate-usage $spec] \
"usage: [me] inputfile \[outputfile\] \[--format pdf\]"
# parse.
catch {parse $fooSpec {}} err
assert-equal $err {missing required option -n}
catch {parse $fooSpec {-n 5}} err
assert-equal $err {missing required option --hello}
catch {parse $fooSpec foo} err
assert-equal $err {too many positional arguments}
catch {parse $fooSpec {-n 5 --hello world --with-cheese}} err
assert-equal $err {unknown option: --with-cheese}
catch {parse $fooSpec {-n 5 --hello world --with-cheese no}} err
assert-equal $err {unknown option: --with-cheese}
assert-equal [parse $fooSpec {-n 5 --hello world}] {-n 5 --hello world}
catch {parse $barSpec {}} err
assert-equal $err {too few positional arguments}
catch {parse $barSpec {x y z}} err
assert-equal $err {too many positional arguments}
catch {parse $barSpec {x --what? z}} err
assert-equal $err {unknown option: --what?}
assert-equal [parse $barSpec foo.doc] \
{inputfile foo.doc outputfile - --format pdf}
assert-equal [parse $barSpec {foo.doc bar.pdf}] \
{inputfile foo.doc outputfile bar.pdf --format pdf}
assert-equal [parse $barSpec {foo.doc bar.xlsx --format xlsx}] \
{inputfile foo.doc outputfile bar.xlsx --format xlsx}
# invoke.
assert-equal [invoke foo {-n 42 --hello universe}] {42 universe}
assert-equal [invoke bar {
inputfile /dev/zero outputfile /dev/null --format N/A
}] {/dev/zero /dev/null N/A}
rename ::autoopts::foo {}
rename ::autoopts::bar {}
}
# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
::autoopts::test
}
Use example
Code
#! /usr/bin/env tclsh
proc main {{input -} {--shift 4}} {
set ch [expr {$input eq "-" ? "stdin" : [open $input]}]
while {[gets $ch line] > 0} {
puts [string repeat { } ${--shift}]$line
}
}
source autoopts.tcl
::autoopts::go
Session transcript
$ ./autoopts-example.tcl --help
usage: autoopts-example.tcl [input] [--shift 4]
$ ./autoopts-example.tcl --wrong
unknown option: --wrong
usage: autoopts-example.tcl [input] [--shift 4]