How to create Tcl Procedure with options? - tcl

Question

I want to create tcl procedures with some options. I know procedures with arguments and optional arguments, but don't know options. For example, if I am calling my procedure arith in following three ways (-add for addition, -sub for subtraction):
1) arith 10 5
2) arith -add 10 5 or arith 10 5 -add
3) arith -sub 10 5 or arith 10 5 -sub
Respectively output should be 1) 15 (by default it should add), 2) 15, 3) 5
How to write this procedure in Tcl? I am new to tcl, please suggest me some online material or book for Tcl.

Answer 1

Complex argument parsing can be done with the cmdline package, which is part of Tcllib. The key command is ::cmdline::getoptions, which extracts the options from a variable and returns a dictionary describing them. It also modifies the variable so it contains just the arguments left over.
package require cmdline
proc arith args {
set options {
{op.arg "add" "operation to apply (defaults to 'add')"}
}
array set parsed [::cmdline::getoptions args $options]
if {[llength $args] != 2} {
return -code error "wrong # args: must be \"arith ?-op operation? x y\""
}
switch $parsed(op) {
add {return [::tcl::mathop::+ {*}$args]}
sub {return [::tcl::mathop::- {*}$args]}
default {
return -code error "Unknown -op \"$parsed(op)\": must be add or sub"
}
}
}
Demonstrating usage (including some error cases):
% arith
wrong # args: must be "arith ?-op operation? x y"
% arith 2 3
5
% arith -op sub 2 3
-1
% arith -op mult 2 3
Unknown -op "mult": must be add or sub
The main thing to be aware of is that the options descriptor takes the names of options without a leading - and with .arg on the end if you want to have an argument passed as well.

Answer 2

When it comes to options, it's a good idea to use even number of arguments
-op add -values {10 5}
-op sub -values {10 5}
With this, you can put the arguments into array as,
array set aArgs $args
where args is nothing but arguments passed to procedure.
proc arith {args} {
if {[catch {array set aArgs $args} err]} {
puts "Error : $err"
return 0
}
if {![info exists aArgs(-op)] || ![info exists aArgs(-values)] || [llength $aArgs(-values)]!=2} {
puts "Please pass valid args"
return 0
}
set x [lindex $aArgs(-values) 0]
set y [lindex $aArgs(-values) 1]
switch $aArgs(-op) {
"add" {
puts [expr {$x+$y}]
}
"sub" {
puts [expr {$x-$y}]
}
}
}
arith -op add -values {10 5}

Answer 3

In this example... I'm assuming that the operator is either the first or last option. The value would be -add or add. Just make the changes.
There is an optimization in the computation... to use lrange and ::mathop::.
proc arith args {
if {[llength $args] != 3} {
return -code error "wrong # args: must be \"arith ?-op operation? x y\""
}
set isadd [lsearch $args add]
set issub [lsearch $args sub]
if {$isadd != -1 && $issub == -1} {
return [expr [lindex $args 1] + [lindex $args [expr $isadd == 0 ? 2: 0]]]
}
if {$issub != -1 && $isadd == -1} {
return [expr [lindex $args [expr $issub == 0 ? 1: 0]] - [lindex $args [expr $issub == 0 ? 2: 1]]]
}
return -code error "Unknown -op must be add or sub"
}
example:
#arith add 1 2 3
#arith add sub 2
puts [arith add 1 2]
puts [arith 1 2 add]
puts [arith sub 1 2]
puts [arith 1 2 sub]
The two error examples were commented out because I need a catch instead... but it really depends on the big picture and how reusable it's intended to be.
proc arith args {
if {[llength $args] != 3} {
return -code error "wrong # args: must be \"arith ?-op operation? x y\""
}
set isadd [lsearch $args -add]
set issub [lsearch $args -sub]
if {$isadd != -1 && $issub == -1} {
return [::tcl::mathop::+ {*}[lrange $args [expr $isadd == 0] [expr ($isadd == 0) + 1]]]
}
if {$issub != -1 && $isadd == -1} {
return [::tcl::mathop::- {*}[lrange $args [expr $issub == 0] [expr ($issub == 0) + 1]]]
}
return -code error "Unknown -op must be add or sub"
}