How can i specify switches on command line in tcl? - tcl

If i have an expect script and i want to execute certain part of code depending on the requirement.suppose if i have some procedures in my code like below
proc ABLOCK { } {
}
proc BBLOCK { } {
}
proc CBLOCK { } {
}
then while executing the script if i can use some switches like.
./script -A ABLOCK #executes only ABLOCK
./script -A ABLOCK -B BBLOCK #executes ABLOCK and BBLOCK
./script -V # just an option for say verbose output
where ABLOCK,BBLOCK,CBLOCK could be list of args argv

Why not:
foreach arg $argv {
$arg
}
and run it as ./script ABLOCK BLOCK CBLOCK
Someone could also pass exit, if you don't want that, check if it is valid:
foreach arg $argv {
if {$arg in {ABLOCK BLOCK CBLOCK}} {
$arg
} else {
# What else?
}
}
For switches, you could to the same (if they don't require a parameter):
proc -V {} {
set ::verbose 1
# Enable some other output
}
If you need arguments to switches, you could do the following:
set myargs $argv
while {[llength $myargs]} {
set myargs [lassign $myargs arg]
if {[string index $arg 0] eq {-}} {
# Option
if {[string index $arg 1] eq {-}} {
# Long options
switch -exact -- [string range $arg 2 end]
verbose {set ::verbose 1}
logfile {set myargs [lassign $myargs ::logfile]}
}
} else {
foreach opt [split [string range $arg 1 end] {}] {
switch -exact $opt {
V {set ::verbose 1}
l {set myargs [lassign $myargs ::logfile]}
}
}
}
} else {
$arg
}
}

Related

TCL: Redirect output of proc to a file

I need to redirect output of a proc to a file. The "redirect" command isn't working for the Tcl interpreter that my tool uses. So I'm trying "exec echo [proc_name]" instead, which was suggested in one of the threads on this site. But this doesn't work, the file ${dump_dir}/signal_list.txt comes out empty,
proc dump_signals {{dump_dir "."}} {
upvar build build
puts "Dumping signals.."
set my_file [open ${dump_dir}/signal_list.txt w]
exec echo [get_signals] > $my_file
}
'get_signals' is a proc, which calls another proc,
proc puts_name_and_value {name} {
set value [value %h $name]
puts "$name $value"
}
proc get_signals {} {
# Get list of signals
set signal_list {test.myreg test.myreg2}
foreach signal $signal_list {
puts_name_and_value $signal
}
}
My workaround for now is this, writing to the file in the bottom level proc by upvar'ing the file variable. This works but isn't the most clean way of doing this. Please let me know how to cleanly redirect the output of a proc to a file.
proc puts_name_and_value {name} {
upvar my_file my_file
set value [value %h $name]
puts $my_file "$name $value"
#puts "$name $value"
}
proc get_signals {} {
upvar my_file my_file
# Get list of signals
set signal_list {test.myreg test.myreg2}
foreach signal $signal_list {
puts_name_and_value $signal
}
}
proc dump_signals {{dump_dir "."}} {
upvar build build
puts "Dumping signals.."
set my_file [open ${dump_dir}/signal_list.txt w]
get_signals
}
Your dump_signals proc writes to standard output, and doesn't return anything. So of course trying to use a shell to redirect its output to a file isn't going to result in anything in the file.
One solution is to use tcl's transchan API with chan push and chan pop to temporarily override what stdout goes to. Example:
#!/usr/bin/env tclsh
proc redirector {fd args} {
switch -- [lindex $args 0] {
initialize {
# Sanity check
if {[lindex $args 2] ne "write"} {
error "Can only redirect an output channel"
}
return {initialize write finalize}
}
write {
puts -nonewline $fd [lindex $args 2]
}
finalize {
close $fd
}
}
}
proc writer_demo {} {
puts "line one"
puts "line two"
}
proc main {} {
chan push stdout [list redirector [open output.txt w]]
writer_demo
chan pop stdout
}
main
Running this script will produce a file output.txt with the contents of writer_demo's puts calls instead of having them go to standard output like normal.
You could also just pass the file handle to write to as an argument to your functions (Instead of using upvar everywhere):
proc puts_name_and_value {out name} {
set value [value %h $name]
puts $out "$name $value"
}
proc get_signals {{out stdout}} {
# Get list of signals
set signal_list {test.myreg test.myreg2}
foreach signal $signal_list {
puts_name_and_value $out $signal
}
}
proc dump_signals {{dump_dir "."}} {
upvar build build
puts "Dumping signals.."
set my_file [open ${dump_dir}/signal_list.txt w]
get_signals $my_file
}

Accessing variables in TCL across scopes

I'm trying to learn tcl scripting. My req is very simple. I need to access the array "args" in the second if condition in the for loop. I tried the code below. Since "argv" scope is limited to second if condition, it is NOT accessible in for loop
Then I tried declaring argv as global var -
array set args {}
right below the ned of first if condition. Even after declaring "args" as global array did NOT help.
How do I access the variable in the cope of second if contion, in the for loop below ?
if {$argc != 4} {
puts "Insufficient arguments"
exit 1
}
if { $::argc > 0 } {
set i 1
foreach arg $::argv {
puts "argument $i is $arg"
set args(i) arg
incr i
}
} else {
puts "no command line argument passed"
}
for {set x 0} { $x<2 } {incr x} {
puts "Arrray: [lindex $args $x]"
}
For your original code, this is the error I get:
can't read "args": variable is array
while executing
"lindex $args $x"
("for" body line 2)
invoked from within
"for {set x 0} { $x<2 } {incr x} {
puts "Arrray: [lindex $args $x]"
}"
(file "main.tcl" line 20)
In Tcl, arrays are not lists. You have to write
for {set x 0} { $x<2 } {incr x} {
puts "Arrray: $args($x)"
}
But then I get this:
can't read "args(0)": no such element in array
while executing
"puts "Arrray: $args($x)""
("for" body line 2)
invoked from within
"for {set x 0} { $x<2 } {incr x} {
puts "Arrray: $args($x)"
}"
(file "main.tcl" line 20)
Well there's several problems here. You're setting array elements starting with index 1 but reading them starting with index 0. So let's correct that to 0 everywhere:
set i 0
But also you're missing some $'s in the setting of the elements:
set args($i) $arg
That looks better. Final code:
if {$argc != 4} {
puts "Insufficient arguments"
exit 1
}
if { $::argc > 0 } {
set i 0
foreach arg $::argv {
puts "argument $i is $arg"
set args($i) $arg
incr i
}
} else {
puts "no command line argument passed"
}
for {set x 0} { $x<2 } {incr x} {
puts "Arrray: $args($x)"
}
So, scope wasn't quite the issue. You're getting there though!
Tcl does not import globals by default. You need to import your globals:
global args
set args(i) arg
Some people prefer to import globals at the top of the proc:
global args
if {$argc != 4} {
puts "Insufficient arguments"
exit 1
}
if { $::argc > 0 } {
set i 1
....
See: https://www.tcl.tk/man/tcl8.7/TclCmd/global.htm
Alternatively, you can directly access the global namespace, in fact you're already using that syntax with ::argc:
set ::args(i) arg

passing a list into a procedure in tcl

I want to pass a list into a procedure but not sure how to. I've looked at some examples of how to do this but the examples are too complicated and I don't understand them. The list and procedure are shown below.
set RS_CheckBoxes [list kl15_cb din1_cb din2_cb din3_cb din4_cb \
dinnc_cb ain1_cb ain2_cb ain3_cb ain4_cb a_cb \
b_cb u_cb v_cb w_cb sin_cb cos_cb th1_cb th2_cb hvil_cb]
tk::button .rs.enter -height 2 -text "Enter" -width 10 -command {x $RS_CheckBoxes}
proc x {$RS_CheckBoxes} {
if {$RS_CheckBoxes} {
puts "ON"
} else {
puts "OFF"
}
}
At present I'm using the below code but want to reduce the amount of lines.
tk::button .relSel.b -height 2 -text "Enter" -width 10 -command {if {$kl15_cb} {
puts "$kl15_cb"
} else {
puts "$kl15_cb"
}
if {$dinnc_cb} {
puts "$dinnc_cb"
} else {
puts "$dinnc_cb"
}
if {$din1_cb} {
puts "$din1_cb"
} else {
puts "$din1_cb"
}
if {......... etc}
............. etc
Your description is not entirely clear. Do you want to pass a list of global variable names into a proc and then print ON or OFF based on their boolean value?
Currently you just seem to be printing the value of the variables in a very complicated way.
if {$dinnc_cb} {
puts "$dinnc_cb"
} else {
puts "$dinnc_cb"
}
is equal to puts $dinnc_cb unless you want the code to throw an error when the value cannot be interpreted as a boolean.
If my understanding is correct, try this:
proc x {varlist} {
foreach varname $varlist {
upvar #0 $varname var
puts "$varname: [lindex {ON OFF} [expr {!$var}]]"
}
}
The upvar creates a link from the global variable in $varname to the local variable var. You can then use that to check the global variable.
To include a check that the variable is actually set:
proc x {varlist} {
foreach varname $varlist {
upvar #0 $varname var
if {[info exists var]} {
puts "$varname: [lindex {OFF ON} [string is true -strict $var]]"
} else {
puts "$varname: INDETERMINATE"
}
}
}

How to unset an arg in tcl

I am taking arguments from command line and passing all those arguments to another program (with expect spawn). I want to parse all options and omit some of them (or do something else). To do that I am doing this:
set arguments [lrange $argv 0 end]
#Check for -lp option. Set the program path
for {set var 0} {$var<$argc} {incr var} {
if {[lindex $arguments $var] == "-lp" || [lindex $arguments $var] == "--launcher-path"} {
if {[lindex $arguments [expr {$var+1}]] != ""} {
set program [lindex $arguments [expr {$var+1}]]
#unset [lindex $arguments $var]
} else {
puts "E: Argument missing for option: [lindex $arguments $var]"
exit 1
}
}
}
But I can't figure out how to unset those args that I used. For example, I need to unset [lindex $arguments [expr {$var+1}]] and [lindex $arguments $var].
This is how I am running the $program:
if {[catch {spawn $program --text {*}$arguments}]} {
puts "E: Launcher not found: $program"
exit 1
}
If your arguments are all key-value, then you can iterate over the arguments in pairs with foreach and build up a new list containing just the arguments you're interested in.
set newarguments [list]
foreach {arg value} $arguments {
switch -exact -- $arg {
"-lp" -
"--launcher-path" {
set program $value
}
default {
lappend newarguments $arg $value
}
}
}
If you have mixed flag and key-value options, then you will need to iterate using an index, similar to your code, but building up the new list of arguments will be roughly the same.
You could also check into the tcllib cmdline package, although that does not handle long options.
This is how I have done it:
set arguments [lreplace $arguments [expr {$var+1}] [expr {$var+1}]]
set arguments [lreplace $arguments $var $var]
As glenn-jackman pointed out, the above can be shortened to:
set arguments [lreplace $arguments $var [expr {$var+1}]]

example code to make puts log the output

I'm looking for some Tcl code that would duplicate what puts command sends to stdout to some log file. Yes, there is a possibility to change all calls to puts to some custom function. But I would like to make it as transparent as possible.
I have this trial code, but it doesn't really work that well:
set pass_log_output "0"
rename puts _puts
proc puts { args } {
global pass_log_output
if {[info exists pass_log_output]} {
# There can be several cases:
# -nonewline parameter, stdout specified or not
set stdout_dest [ lsearch $args stdout ]
set nonewline [ lsearch $args -nonewline ]
if { $stdout_dest != -1 } {
log_low_level "" [lindex $args [expr $stdout_dest + 1]] ""
} elseif { $nonewline != -1 && [ llength $args ] > 1} {
log_low_level "" [lindex $args [expr $nonewline + 1]] ""
} else {
log_low_level "" [lindex $args 0] ""
}
}
if { [ catch { eval _puts $args } err ] } {
return -code error $err
}
}
log_low_level function just stores the passed string in a file.
So far I'm getting this error:
Tcl Interpreter Error: too many nested evaluations (infinite loop?)
Does log_low_level use puts? That could be your infinite loop.
If so, try changing it to use _puts.
Thanks for the points. I just want to post the final working code for reference. It even takes care of the storing lines with -nonewline flag properly.
set pass_log_output "0"
set last_call_nonewline 0
rename puts _orig_puts
proc puts { args } {
global pass_log_output
global g_log_file
global last_call_nonewline
if {[info exists pass_log_output]} {
# Check if the logging was initialized
if {![info exists g_log_file]} {
_orig_puts "Log file wasn't initialized!"
return
}
# There can be several cases:
# -nonewline parameter, stdout specified or not
set stdout_dest [ lsearch $args stdout ]
set nonewline [ lsearch $args -nonewline ]
if {[ llength $args ] > 3} {
return -code error "wrong # args: should be puts ?-nonewline? ?channelId? string"
} elseif { $stdout_dest != -1 } {
set message [lindex $args end]
} elseif { $nonewline != -1 && [ llength $args ] == 2} {
set message [lindex $args [expr $nonewline + 1]]
} elseif {[ llength $args ] == 1} {
set message [lindex $args 0]
}
# Store the message in the file, if needed.
# Take into account if the last call was with -nonewline
if {[info exists message]} {
if {$last_call_nonewline == 0} {
_orig_puts -nonewline $g_log_file [clock format [clock seconds] -format "%T - "]
}
if {$nonewline != -1} {
set last_call_nonewline 1
_orig_puts -nonewline $g_log_file "$message"
} else {
set last_call_nonewline 0
_orig_puts $g_log_file "$message"
}
flush $g_log_file
}
}
if { [ catch { eval _orig_puts $args } err ] } {
return -code error $err
}
}
Since puts has very few options, it may be easier to consider the number of args given. Also, you should contain all uses of the original _puts to your new puts proc -- this new puts should be transparent even to your code.
I assume you only want to log stuff you're writing to stdout
rename puts _orig_puts
proc puts {args} {
switch -exact [llength $args] {
3 {
# both -newline and a channelId are given
set do_log [expr {[lindex $args 1] eq "stdout"}]
}
2 {
# only log if not writing to stdout
set chan [lindex $args 0]
set do_log [expr {$chan eq "-nonewline" || $chan eq "stdout"}]
}
1 {
set do_log true
}
default {
error {wrong # args: should be "puts ?-nonewline? ?channelId? string"}
}
}
if {$do_log} {
set chan [open $::mylogfile a]
_orig_puts $chan [lindex $args end]
close $chan
}
_orig_puts {*}$args
}