My goal is to add commands to a loop that is already running , I know how to do it with global variables like this :
proc myLoop {} {
global cmd1 cmd2 cmd3
if {$cmd1} {
# do something...
}
if {$cmd2} {
# do something...
}
# ...
after 1000 myLoop
}
set cmd1 0 ; set cmd2 1
myLoop
I’d like to do this on the fly :
addCmdInLoop [list myCmd $arg1 $arg2] . I had thought to rename my myLoop every time and replace it but I don’t know if this is possible or efficient.
You can put your commands in a list and process that list every time. To add a command, just append it to the list.
proc myLoop {} {
global cmdlist
foreach cmd $cmdlist {
# Execute the command in the global scope
uplevel #0 $cmd
}
after 1000 myLoop
}
set cmdlist [list $cmd1 $cmd2]
# Start the loop
myLoop
# Add a command
lappend cmdlist [list myCmd $arg1 $arg2]
You can also get fancy with a coroutine to avoid using a global variable:
proc myLoop {cmdlist} {
foreach cmd $cmdlist {
# Execute the command in the global scope
uplevel #0 $cmd
}
after 1000 [list [info coroutine] continue]
while {[set arg [yield]] ne "continue"} {
lappend cmdlist $arg
}
}
coroutine addCmdInLoop myLoop $cmd1 $cmd2
Then your proposed addCmdInLoop [list myCmd $arg1 $arg2] command will work to add myCmd to any future runs of the loop.
If myLoop is already running, then I don't know how you could interrupt the loop to change the variable. Without changing the variable, then the loop would already act the same way.
You could certainly change some external to Tcl. What if your loop checked for existence of a filename instead of the value of a variable?
What you probably want to do instead is to add a trace to these variables.
https://www.tcl-lang.org/man/tcl/TclCmd/trace.htm
proc do_cmd1 args {
global cmd1
if {$cmd1 == 1} {
puts "cmd1 is 1"
}
}
trace add variable cmd1 write do_cmd1
Once the trace is assigned to the variable, then the do_cmd1 proc is executed anytime a value is written to cmd1.
tcl8.6.8> set cmd1 0
0
tcl8.6.8> set cmd1 1
cmd1 is 1 <------ Look at that!!
1
However, this only runs the proc when the cmd1 variable is set. That's not really a loop behavior.
Related
I'm trying to run proc with new process
I'm trying to call proc1 and proc2 from main function , but each should run separately with a new process (or subprocess) and also wait till it finish
proc main { var } {
puts "main function with var: $var"
#call proc1 with new process
exec proc1 1
#wait till proc1 finish
#call proc2 with new process
exec proc2 2
#wait till proc2 finish
puts "Finished"
}
proc proc1 { var1 } {
puts "proc1 function with var: $var1"
}
proc proc2 { var2 } {
puts "proc2 function with var: $var2"
}
I tried using exec but it did not work
I tried googling it, but did not succeed to find a solution
How can I make it run ?
Thanks a lot!
The simplest mechanism is to put the procedures in a separate file (e.g., myprocs.tcl) with the following bit of extra code at the end of the file:
# Take a command from stdin, evaluate it, and write result to stdout
puts [eval [read stdin]]
Then you call those procedures using the following helper:
proc runproc {procname args} {
exec [info nameofexecutable] myprocs.tcl << [list $procname {*}$args] 2>#stderr
}
# Demonstrating
set result [runproc proc1 1]
The above isn't the most robust mechanism however. In particular, if you have a bug in your procedures, things will go quite wonky. Here's a more robust mechanism that works very well provided you change your procedures to return their results instead of putsing them:
Callee side:
set cmd [read stdin]
catch $cmd msg opts
puts [list $msg $opts]
exit
Caller side:
proc runproc {procname args} {
set cmd [list $procname {*}$args]
set pair [exec [info nameofexecutable] myprocs.tcl << $cmd 2>#stderr]
lassign $pair msg opts
return -options $opts $msg
}
Transferring a normal stdout across at the same time, or allowing the subprocess to access the caller's stdin, requires more work again to move the command-and-control channel to be other than a standard pipe, and the above is good enough for a lot of things.
I have a file like this:
set position {0.50 0.50}
set visibility false
set text {ID: {entity.id}\n Value: {entity.contour_val}}
And I want to do something similar to source, but I want to use a file handle only.
My current attempt looks like this:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
set cl [expr "$cl + 1"]
set line [gets $fileHandle]
if [$line eq {}] continue
puts $line
namespace eval ::__esg_priv "
uplevel 1 {*}$line
"
info vars ::__esg_priv::*
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
In place of uplevel I tried many combinations of eval and quoting.
My problem is, it either fails on the lines with lists or it does not actuall set the variables.
What is the right way to do it, if the executed commands are expected to be any valid code.
An extra question would be how to properly apply error checking, which I haven't tried yet.
After a call to
readArray [open "myFile.tcl" r] arr
I expect that
parray arr
issues something like:
arr(position) = 0.50 0.50
arr(text) = ID: {entity.id}\n Value: {entity.contour_val}
arr(visibility) = false
BTW: The last line contains internal {}, which are supposed to make it into the string variables. And there is no intent to make this a dict.
This code works, but there are still some problems with it:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
incr cl ;# !
set line [gets $fileHandle]
if {$line eq {}} continue ;# !
puts $line
namespace eval ::__esg_priv $line ;# !
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
I've taken out a couple of lines that didn't seem necessary, and changed some lines a bit.
You don't need set cl [expr "$cl + 1"]: incr cl will do.
if [$line eq {}] continue will fail because the [...] is a command substitution. if {$line eq {}} continue (braces instead of brackets) does what you intend.
Unless you are accessing variables in another scope, you won't need uplevel. namespace eval ::__esg_priv $line will evaluate one line in the designated namespace.
I didn't change the following, but maybe you should:
set varName [string map { ::__esg_priv:: "" } $varPath] works as intended, but set varName [namespace tail $varPath] is cleaner.
Be aware that if there exists a global variable with the same name as one of the variables in your file, no namespace variable will be created; the global variable will be updated instead.
If you intend to use the value in the text variable as a dictionary, you need to remove either the \n or the braces.
According to your question title, you want to evaluate the file line by line. If that requirement can be lifted, your code could be simplified by reading the whole script in one operation and then evaluating it with a single namespace eval.
ETA
This solution is a lot more robust in that it reads the script in a sandbox (always a good idea when writing code that will execute arbitrary external code) and redefines (within that sandbox) the set command to create members in your array instead of regular variables.
proc readArray {fileHandle arrayName} {
upvar 1 $arrayName arr
set int [interp create -safe]
$int alias set apply {{name value} {
uplevel 1 [list set arr($name) $value]
}}
$int eval [read $fileHandle]
interp delete $int
}
To make it even more safe against unexpected interaction with global variables etc, look at the interp package in the Tcllib. It lets you create an interpreter that is completely empty.
Documentation: apply, continue, eof, foreach, gets, if, incr, info, interp package, interp, list, namespace, proc, puts, set, string, uplevel, upvar, while
Is there any way to list all the procedures(proc) in a myFile.tcl using another tcl file or in the same file.
You can use [info procs] before and after sourcing the file in question and compare the results to determine which procs were added. For example:
proc diff {before after} {
set result [list]
foreach name $before {
set procs($name) 1
}
foreach name $after {
if { ![info exists procs($name)] } {
lappend result $name
}
}
return [lsort $result]
}
set __before [info procs]
source myFile.tcl
set __after [info procs]
puts "Added procs: [diff $__before $__after]"
One thing I like about this solution is that the diff procedure is really just a generic set differencing utility -- it's not specific to comparing lists of defined procedures.
The cheapest way is to just open the file and use regexp to pick out the names. It's not perfectly accurate, but it does a reasonably good job.
set f [open "sourcefile.tcl"]
set data [read $f]
close $f
foreach {dummy procName} [regexp -all -inline -line {^[\s:]*proc (\S+)} $data] {
puts "Found procedure $procName"
}
Does it deal with all cases? No. Does it deal with a useful subset? Yes. Is the subset large enough for you? Quite possibly.
Yes it is, although not that easy. The basic idea is to source the file in a modified slave interp that only executes some commands:
proc proc_handler {name arguments body} {
puts $name
}
set i [interp create -safe]
interp eval $i {proc unknown args {}}
interp alias $i proc {} proc_handler
interp invokehidden source yourfile.tcl
This approach will fail if the file requires other packages (package require will not work), relies on the result of some usually auto_load'ed commands etc..
It also does not take namespaces into account. (namespace eval ::foo {proc bar a {}} creates a proc with the name ::foo::bar
For a more complex implementation you could look into auto.tcl's auto_mkindex, which has a similar goal.
Here is a different approach:
Create a temporary namespace
Source (include) the script in question, then
Use the info procs command to get a list of procs
Delete the temporary namespace upon finish
Here is my script, *list_procs.tcl*:
#!/usr/bin/env tclsh
# Script to scan a Tcl script and list all the procs
proc listProcsFromFile {fileName} {
namespace eval TempNamespace {
source $fileName
set procsList [info procs]
}
set result $::TempNamespace::procsList
namespace delete TempNamespace
return $result
}
set fileName [lindex $::argv 0]
set procsList [listProcsFromFile $fileName]
puts "File $fileName contains the following procs: $procsList"
For example, if you have the following script, procs.tcl:
proc foo {a b c} {}
proc bar {a} {}
Then running the script will produce:
$ tclsh list_procs.tcl procs.tcl
File procs.tcl contains the following procs: foo bar
I just started to learn Tcl. I wanted to write a simple procedure.
When the procedure starts, it opens a browse window to browse for files.
There you can select a file you want to open.
Then a pop-up windows comes up and asks if you want to selected another file.
Every file that you select has to go into an array.
I have to following code:
########## Defining the sub procedures ############
proc open_file {} {
set n 0
set title "Select a file"
set types {
{{GDS files} {.gds} }
{{All Files} * }
}
set filename [tk_getOpenFile -filetypes $types -title $title]
set opendFiles($n) $filename
set n [expr $n + 1]
set answer [tk_messageBox -message "Load another GDS file?" -type yesno -icon question]
if {$answer == yes } {
open_file
} else {
show_files ($opendFiles)
}
}
proc show_files {} {
foreach key [array names opendFiles] {
puts $opendFiles($key)
}
}
########## Main Program ###########
open_file
I having the following problems. Because I always recall the proc 'open_file' the variable $n keeps setting to 0. But I don't know how to recall the opening of the window without recalling the whole subroutine....
The second problem is sending the array to the next proc. When I send to the to the proc 'show_files', I always get the next error : can't read "opendFiles": variable is array.
I can't seem to find both answers..
You need global variables for that. This works for me:
########## Defining the sub procedures ############
set n 0
array set openedFiles {}
proc open_file {} {
set title "Select a file"
set types {
{{GDS files} {.gds} }
{{All Files} * }
}
set filename [tk_getOpenFile -filetypes $types -title $title]
set ::openedFiles($::n) $filename
incr ::n
set answer [tk_messageBox -message "Load another GDS file?" -type yesno -icon question]
if {$answer == yes } {
open_file
} else {
show_files
}
}
proc show_files {} {
foreach key [array names ::openedFiles] {
puts $::openedFiles($key)
}
}
########## Main Program ###########
open_file
Array Problem
In Tcl you can't send arrays to procs. You need to convert them to a list with array get send this list to the proc and than convert it back to an array again with array set.
Global variables are very useful at times, but I believe they are best avoided where possible. In this case I'd rather process the loop and the array in the main program rather than the proc.
Also, where you'd use an array in other programming languages, it's often better to use a list in Tcl, so something like:
proc open_file {} {
set title "Select a file"
set types {
{{GDS files} {.gds} }
{{All Files} * }
}
set filename [tk_getOpenFile -filetypes $types -title $title]
return $filename
}
proc show_files {files} {
foreach file $files {
puts $file
}
}
set openedFiles [list]
set answer yes
while {$answer == yes}
lappend openedFiles [open_file]
set answer [tk_messageBox -message "Load another GDS file?" -type yesno -icon question]
}
show_files $openedFiles
If you're into brevity, show_files could be written
proc show_files {files} {
puts [join $files \n]
}
and, now that it's so short, you could just put it in line, rather than have another proc.
Finally, have you considered what you want to do if the user presses cancel in tk_getOpenFile? In this case filename will be set to an empty (zero-length) string. You could either
ignore these; or
get rid of the tk_messageBox call and have the user press cancel when they have entered as many files as they want.
If you want to just ignore those times when the user pressed cancel, you could do
set filename [open_file]
if {[string length $filename] > 0} {
# The user entered a new filesname - add it to the list
lappend openedFiles $filesname
} else {
# The user pressed cancel - just ignore the filename
}
If you wanted to use cancel to break out of the loop, then the main program becomes something like:
set openedFiles [list]
set filename dummy
while {[string length $filename] > 0} {
set filename [open_file]
if {[string length $filename] > 0} {
lappend openedFiles $filename
}
}
show_files $openedFiles
in this case, you might want to put up a message box right at the start of the main program telling the user what's going on.
For the state of a variable to persist between calls to a procedure, you need to make that variable live outside the procedure. The easiest way is to use a global variable:
# Initialize it...
set n 0
proc open_file {} {
# Import it...
global n
...
# Use it...
set openedFiles($n) $filename
incr n
...
}
Arrays are not values, and as such can't be passed directly to another procedure. You can handle this by passing in the name and using upvar 1 to link a local alias to the variable in the calling stack frame:
proc show_files {varName} {
upvar 1 $varName ary
foreach key [array names ary] {
puts $ary($key)
}
}
Which is called using the name of the array, so no $:
show_files openedFiles
(You could also pass a serialization of the array in with array get openedFiles to serialize and array set ary $serialization to deserialize, but that carries some overhead.)
You probably ought to add that openedFiles variable to the global line, so that it is persistent across all invokations of open_file.
Here is the code I am testing:
proc check_eval {} {
set cmd {set return_val {}; set return_val}
puts "Command to evaluate : $cmd"
uplevel eval $cmd
}
I encountered the following problem: when I am calling "check_eval", it looks like the statement "set return_val {}" is ignored. I.e., the interpeter looks for existing return_val variable in the calling scope.
Example:
tcl>unset return_val
tcl>check_eval
Command to evaluate : set return_val {}; set return_val
can't read "return_val": no such variable
while evaluating check_eval
tcl>set return_val 556
556
tcl>check_eval
Command to evaluate : set return_val {}; set return_val
556
tcl>
On the other hand, if I replace "set return_val {}" in the procedure by, for example, "set return_val 10000", it will show 10000 when running:
tcl>set return_val 556
556
tcl>check_eval
Command to evaluate : set return_val 10000; set return_val
10000
tcl>set return_val
10000
Does anybody can explain me please what is going on here?
Thanks.
You're doing two levels of evaluation/interpreting, first with uplevel then with eval, and the brace grouping around the cmd script only protects you from the first one.
You don't need eval, this will suffice:
uplevel $cmd
EDIT: Both eval and uplevel concat:enate all their arguments together into a flat string and evaluate it as a script (with uplevel you can choose another stack frame to run it in). They don't use the first argument as a single command name and the rest of the arguments as arguments to send to that command. If that was the case, you'd get an error message from your eval that the command "set return_val {}; set return_val" couldn't be found. So you're using eval correctly but uplevel wrong.
uplevel runs this script...
eval set return_val {}; set return_val
...which is broken in more ways than one, because you didn't list quote (group) it's arguments.
eval isn't needed in your example, but should you need to call a single command uplevel, without it's arguments getting concatenated, the way to quote static strings when you don't need any substitutions, is with braces:
uplevel {after 1000 {set return_val {}; set return_val}}
...and the way to quote dynamic strings with substituted values in it, is with list:
set cmd {set return_val {}; set return_val}
uplevel [list after 1000 $cmd]