When I am trying to rename the puts command inside name-space, It causes the problem. I am renaming puts because I don't want to display the echo statement of particular procedure.
namespace eval temp {
namespace export print_proc
proc replacement_puts args {}
proc silentEval {script} {
rename puts original_puts
interp alias {} puts {} temp::replacement_puts
catch [list uplevel 1 $script] msg opts
rename puts {}
rename original_puts puts
return -options $opts $msg
}
proc print_proc {} {
puts "before call"
silentEval {a}
puts "aftter call"
}
proc a {} {
puts "inner call"
}
}
package provide temp 1.0
In Example, I don't want to display the echo statement of proc a.
But after execution, It shows error that Invalid Command Name "puts"
Thanks
Glenn Jackman's answer should solve your problem. I'd just like to point out that you don't really need to rename anything. With this definition:
namespace eval temp {
namespace export print_proc
proc puts args {}
proc silentEval script {
catch [list uplevel 1 $script] msg opts
return -options $opts $msg
}
proc print_proc {} {
::puts "before call"
silentEval a
::puts "aftter call"
}
proc a {} {
puts "inner call"
}
}
when a is invoked and it calls puts, it will actually invoke the ::temp::puts command in preference to the global puts -- in effect, the namespace puts overrides the global puts. In print_proc we want the global puts to be invoked, so we add :: before the name.
Of course, all this goes for scripts defined within ::temp, like in the example.
(There isn't much point in calling catch if you're just going to re-throw the exception, but I suppose this is just placeholder code.)
Documentation: catch, list, namespace, proc, puts, return
You just have to be explicit that you're altering the global puts
namespace eval temp {
proc silentEval {script} {
rename ::puts ::original_puts
proc ::puts args {}
catch [list uplevel 1 $script] msg opts
rename ::puts {}
rename ::original_puts ::puts
return -options $opts $msg
}
}
Related
I have some generic procedure. I would like this procedure to be able to get the name of the namespace and names of the procedures within the namespace where this procedure is called.
I have tried following code:
proc register {} {
puts [info procs]
puts [namespace current]
}
namespace eval Foo {
proc bar {} {
puts bar
}
proc _baz {} {
puts baz
}
register
}
However, this prints results for the namespace where register is defined, not for the namespace where it is executed. It looks like there are no dedicated commands for these tasks or at least these are not info or namespace commands.
To get information about the calling context, use uplevel:
proc register {} {
puts [uplevel 1 [list info procs]]
puts [uplevel 1 [list namespace current]]
}
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
}
I am trying to use a TCL program to read TCL modulefiles and translate them into another language. This has worked quite well until now. For reasons too complicated explain I have to treat "puts stderr" differently in different parts of the modulefile. I am asking for help in trying to figure out a way to do this.
Below is an extremely abbreviated modulefile called "modfile". This "modfile" is translated or "sourced" by a second tcl program.
proc ModulesHelp { } {
puts stderr "(1) This is a help message"
}
puts stderr "(2) Here in modfile"
The puts statement inside ModulesHelp has to be treated differently from the second puts statement. Note that any solution CAN NOT CHANGE "modfile". That file is not under my control.
Here is my attempt at a solution:
#!/usr/bin/env tclsh
proc myPuts { stream msg } {
global putMode
puts stdout "putMode: $putMode" # <====== HERE 1
puts stdout $msg
}
proc report { message } {
puts stderr "$message"
}
proc execute-modulefile { m } {
global MODFILE putMode
set putMode "normal"
set slave "__mod"
interp create $slave
interp alias $slave puts {} myPuts
interp alias $slave report {} report
interp eval $slave {global putMode }
interp eval $slave [list "set" "putMode" $putMode]
interp eval $slave [list "set" "m" $m]
set errorVal [interp eval $slave {
set sourceFailed [catch {source $m } errorMsg]
if {[info procs "ModulesHelp"] == "ModulesHelp" } {
set putMode "InHelp" # <======= HERE 2
ModulesHelp
}
if {$sourceFailed} {
report $errorMsg
return 1
}
}]
interp delete $slave
return $errorVal
}
eval execute-modulefile $argv
To run this I do: $ ./try.tcl modfile where obviously the above script is "try.tcl" and the modulefile is "modfile". I am running this on a linux system with tcl 8.4.
What I would like to have happen is that at the line labelled "HERE 2" I like to somehow change the global variable of "putMode" from "normal" to "InHelp" so that I can change the behavior at the line labelled "HERE 1". No matter what I have tried to do I can not change the value of putMode at "HERE 1" by doing something at "HERE 2". The puts statement at "HERE1 always says "normal".
Using a global variable seems like the easiest solution but if someone could show me how to use namespaces or some other technique, I'll be happy with that as well.
Thanks for any insight.
I greatly appreciate the time that others have looked at my question. I am trying to use the proposed solution and I'm not quite seeing it. Here is my new attempt at a solution (This doesn't work at all). Can someone suggest how I modify this code to change "putMode" to inHelp where "HERE 2" is? Also is there something special that needs to go where "HERE 1" is?
#!/usr/bin/env tclsh
proc myPuts { stream msg } {
global putMode
puts stdout "putMode: $putMode" # <=== HERE 1
puts stdout $msg
}
proc report { message } {
puts stderr "$message"
}
proc PutModeTrace {childInterp operation realPutMode} {
# Alias the main array element for the purposes of this procedure
upvar \#0 PutMode($childInterp) realPutMode
if {$operation eq "read"} {
interp eval $childInterp [list set putMode $realPutMode]
} elseif {$operation eq "write"} {
set realPutMode [interp eval $childInterp {set putMode}]
}
}
proc execute-modulefile { m } {
global MODFILE putMode
set putMode "normal"
set slave [interp create]
interp alias $slave puts {} myPuts
interp alias $slave report {} report
interp eval $slave {global putMode }
interp eval $slave [list "set" "putMode" $putMode]
interp eval $slave [list "set" "m" $m]
interp eval $slave [list "set" "slave" $slave]
interp eval $slave {trace add variable putMode {read write} PutModeTrace}
interp alias $slave PutModeTrace {} PutModeTrace $slave
set errorVal [interp eval $slave {
set sourceFailed [catch {source $m } errorMsg]
if {[info procs "ModulesHelp"] == "ModulesHelp" } {
set start "help(\[\["
set end "\]\])"
PutModeTrace $slave "write" "inHelp" # <=== HERE 2
puts stdout $start
ModulesHelp
puts stdout $end
}
if {$sourceFailed} {
report $errorMsg
return 1
}
}]
interp delete $slave
return $errorVal
}
eval execute-modulefile $argv
The problem is that the slave and the master are different interpreters. This means that every interpreter has it's own
commands
variables
namespaces
channels
You can't simply change a variable in the master from the slave, so the easiest solution would be:
interp alias $slave InHelp {} set ::putMode InHelp
and calling this alias instead.
Some other notes:
An other option would be to change the puts alias when InHelp is called. Example
proc InHelp {slave} {
interp alias $slave puts {} HelpPuts
}
and using it with interp alias $slave {} InHelp $slave
You don't have to assign a name for the slave. Just do
set slave [interp create]
Single words don't have to be quoted, so
list "a" "b" "c"
is equal to
list a b c
If you need argument expansion (and use at least Tcl 8.5) use {*}$argv instead eval.
But because execute-modfile only accept one argument, execute-modfile [lindex $argv 0] should do the job.
As Johannes writes, variables are entirely separate in different interpreters; they're not shared at all.
However, you can use trace and some aliases to couple things together. I'll show how to do it for a simple scalar variable (with the parent having an array of them, presumably one for each child interpreter), under the assumption that you never want to have the setting of the variable in the master interpreter trigger a trace in the child.
interp eval $child {trace add variable putMode {read write} PutModeTrace}
interp alias $child PutModeTrace {} PutModeTrace $child
proc PutModeTrace {childInterp varName elementName operation} {
# Ignore the elementName argument
# Alias the main array element for the purposes of this procedure
upvar \#0 PutMode($childInterp) realPutMode
if {$operation eq "read"} {
interp eval $childInterp [list set putMode $realPutMode]
} elseif {$operation eq "write"} {
set realPutMode [interp eval $childInterp {set putMode}]
}
}
This makes it so that whenever the child interpreter reads or writes the putMode variable, the read/write gets reflected into the master.
It's easier to map a command (via an alias) though, and if you were using Tcl 8.6 I'd suggest stacking and unstacking custom transformations on stderr instead. (But that's a massively more sophisticated technique.)
Thanks for all the help. It has taken me a while to understand what was being proposed. Here is the code that does what I want:
#!/usr/bin/env tclsh
proc myPuts { stream msg } {
global putMode
if {$putMode != "inHelp"} {
puts stderr $msg
} else {
puts stdout $msg
}
}
proc report { message } {
puts stderr "$message"
}
proc setPutMode { value } {
global putMode
set putMode $value
}
proc execute-modulefile { m } {
global MODFILE putMode
set putMode "normal"
set slave [interp create]
interp alias $slave puts {} myPuts
interp alias $slave setPutMode {} setPutMode
interp alias $slave report {} report
interp eval $slave {global putMode }
interp eval $slave [list "set" "putMode" $putMode]
interp eval $slave [list "set" "m" $m]
interp eval $slave [list "set" "slave" $slave]
interp eval $slave {trace add variable putMode {read write} PutModeTrace}
interp alias $slave PutModeTrace {} PutModeTrace $slave
set errorVal [interp eval $slave {
set sourceFailed [catch {source $m } errorMsg]
if {[info procs "ModulesHelp"] == "ModulesHelp" } {
set start "help(\[\["
set end "\]\])"
setPutMode "inHelp"
puts stdout $start
ModulesHelp
puts stdout $end
setPutMode "normal"
}
if {$sourceFailed} {
report $errorMsg
return 1
}
}]
interp delete $slave
return $errorVal
}
eval execute-modulefile $argv
Thanks again.
Within a proc can you get the proc name (without hardcoding it)? e.g.
proc my_proc { some_arg } {
puts "entering proc [some way of getting proc name]"
}
Of course you can!
Use info level command:
proc my_proc { some_arg } {
puts "entering proc [lindex [info level 0] 0]"
}
and you get exactly what you want
entering proc my_proc
Another way is to use info frame, which gives a dictionary with some other info, and read the proc key:
proc my_proc { some_arg } {
puts "entering proc [dict get [info frame 0] proc]"
}
this time, you'll get the fully qualified proc name:
entering proc ::my_proc
I need a procedure that will be able to access, read and change a variable from the namespace of the caller. The variable is called _current_selection. I have tried to do it using upvar in several different ways, but nothing worked. (I've written small test proc just to test the upvar mechanism). Here are my attempts:
call to proc:
select_shape $this _current_selection
proc:
proc select_shape {main_gui var_name} {
upvar $var_name curr_sel
puts " previously changed: $curr_sel"
set curr_sel [$curr_sel + 1]
}
For my second attempt:
call to proc:
select_shape $this
proc:
proc select_shape {main_gui} {
upvar _current_selection curr_sel
puts " previously changed: $curr_sel"
set curr_sel [$curr_sel + 1]
}
In all the attempts, once it reaches this area in the code it says can't read "curr_sel": no such variable
What am I doing wrong?
EDIT:
The call for the function is made from a bind command:
$this/zinc bind current <Button-1> [list select_shape $this _current_selection]
at start I thought that it doesn't matter. but maybe It does.
I believe that bind commands operate in the global namespace, so that's where the variable is expected to be found. This might work:
$this/zinc bind current <Button-1> \
[list select_shape $this [namespace current]::_current_selection]
for upvar to work the variable must exist in the scope that you are calling it in. consider the following:
proc t {varName} {
upvar $varName var
puts $var
}
#set x 1
t x
If you run it as it is you'll get the error you are reporting, uncomment the set x 1 line and it will work.
In the example below I've tried to cover the most variants of changing variables from other namespace. It 100% works for me. Maybe it will help.
proc select_shape {main_gui var_name} {
upvar $var_name curr_sel
puts " previously changed: $curr_sel"
incr curr_sel
}
namespace eval N {
variable _current_selection 1
variable this "some_value"
proc testN1 {} {
variable _current_selection
variable this
select_shape $this _current_selection
puts " new: $_current_selection"
}
# using absolute namespace name
proc testN2 {} {
select_shape [set [namespace current]::this] [namespace current]::_current_selection
puts " new: [set [namespace current]::_current_selection]"
}
select_shape $this _current_selection
puts " new: $_current_selection"
}
N::testN1
N::testN2
#-------------------------------------
# Example with Itcl class
package require Itcl
itcl::class C {
private variable _current_selection 10
public method testC {} {
select_shape $this [itcl::scope _current_selection]
puts " new: $_current_selection"
}
}
set c [C #auto]
$c testC