Result
if 0 {
...
| <>option:key -text
| <- -text
| <>value:check string light
| <- light
| <>option:key -bg
| <- -background
| <>value:check color green4
| <- green4
| <>option:key -abg
| <- -activebackground
| <>value:check opt-color red1
| <- red1
| >>post:process .lb fi
| | <>create:gradient .lb red1
| | <- image1
| | <>create:gradient .lb green4
| | <- image2
----{.lb.c coords 1 20 20}
----{.lb.c coords 2 20 20}
----{.lb.c coords 3 20 20}
----{.lb.c coords 4 20 20}
| <<post:process .lb fi
| <>post:process .lb fs
| <>post:process .lb fc
| <>post:process .lb fr
<<::lightbutton::lb:create .lb -text light -bg green4 -abg red1
<- .lb
<<::lightbutton::lb:dispatch lb .lb -text light -bg green4 -abg red1
<- .lb
<>tk::ScreenChanged :0.0
<>::lightbutton::lb:dispose .lb
}Use
if 0 {
# control if proc should be traced
activate:trace
deactivate:trace
# control if enter/leave should be displayed
start:trace
stop:trace
# control displayed procs list
ignore:procs
know:procs
# display data
display:data
}Package
if {[info exists ::flow::version]} { return }
namespace eval ::flow \
{
# beginning of ::flow namespace definition
# ####################################
#
# flow
#
variable version 0.9
#
# ulis, (C) 2003
#
# ####################################
# ==========================
#
# entry points
#
# ==========================
namespace export activate:trace deactivate:trace
namespace export start:trace stop:trace
namespace export ignore:procs know:procs
namespace export flow:display
# ====================
#
# global variables
#
# ====================
variable {}
set (active) 0
set (start) 0
set (ignore) {}
set (last) ""
# ==========================
#
# package
#
# ==========================
package provide Flow $version
package require Tcl 8.4
rename ::proc ::flow::PROC
# ==========================
#
# activate/deactivate
#
# ==========================
# control if proc should be traced
::flow::PROC activate:trace {} { variable {}; incr (active) 1 }
::flow::PROC deactivate:trace {} { variable {}; incr (active) -1 }
# ==========================
#
# start/stop
#
# ==========================
# control if enter/leave should be displayed
::flow::PROC start:trace {} { variable {}; set (start) 1 }
::flow::PROC stop:trace {} { variable {}; set (start) 0 }
# ==========================
#
# ignore/know
#
# ==========================
# control displayed procs list
::flow::PROC ignore:procs {args} \
{
variable {}
foreach proc $args \
{
if {[lsearch -exact $(ignore) $proc] == -1} \
{ lappend (ignore) $proc }
}
}
::flow::PROC know:procs {args} \
{
variable {}
foreach proc $args \
{
if {[set n [lsearch -exact $(ignore) $proc]] != -1} \
{ set (ignore) [lreplace $(ignore) $n $n] }
}
}
# ==========================
#
# display
#
# ==========================
# display data
::flow::PROC flow:display {args} \
{
if {!$::flow::(active) || !$::flow::(start)} { return }
set lvl [info level]
set pref [string repeat "--" [incr lvl -1]]
puts $pref[string map [list \n \n$pref] $args]
}
# ==========================
#
# trace mechanism
#
# ==========================
::flow::PROC ::proc {name parms script} \
{
uplevel 1 [list ::flow::PROC $name $parms $script]
if {$::flow::(active)} \
{ uplevel 1 [list trace add execution $name {enter leave} ::flow::flow] }
}
::flow::PROC ::flow::flow {args} \
{
if {!$::flow::(active) || !$::flow::(start)} { return }
set lvl [info level]
set pref [string repeat "| " [incr lvl -1]]
switch [lindex $args end] \
{
enter \
{
set cmd [lindex [lrange $args 0 end-1] 0]
set n [string first " " $cmd]
if {$n == -1} { set n end } else { incr n -1 }
if {[lsearch -exact $::flow::(ignore) [string range $cmd 0 $n]] != -1} { return }
if {$::flow::(last) != ""} { puts $::flow::(pref)>>$::flow::(last) }
set ::flow::(last) $cmd
set ::flow::(pref) $pref
}
leave \
{
set cmd [lindex [lrange $args 0 end-3] 0]
set n [string first " " $cmd]
if {$n == -1} { set n end } else { incr n -1 }
if {[lsearch -exact $::flow::(ignore) [string range $cmd 0 $n]] != -1} { return }
if {$cmd == $::flow::(last)} { puts "$pref<>$cmd" } \
else \
{
if {$::flow::(last) != ""} { puts $::flow::(pref)>>$(last) }
puts "$pref<<$cmd"
}
set ::flow::(last) ""
set code [lindex $args end-2]
set result [lindex $args end-1]
switch $code \
{
0 { if {$result != ""} { puts "$pref <- $result" } }
default { puts "$pref***$code: $result" }
}
}
}
}
# end of ::flow namespace definition
}Staale, 2005-08-23. I'm not able to get this package working. Probably because I'm new to tcl. Could someone be kinde enogh to make my sample code work? (And maybe extend it?) When I run the code (with tclsh flowSample.tcl on windows 2000) I only get output from my own puts commands. Nothing from the flow package.Sample usage
# Copied the flow package code to a file flow.tcl and saved the file
# in path ./lib relative to my sample file (called flowUsage.tcl )
#
# Update the auto_path variable to contain the new ./lib path
lappend auto_path [file join [file dirname [info script]] ./lib]
#
# Create a pkgIndex.tcl file in the ./lib folder
pkg_mkIndex [file join [file dirname [info script]] ./lib] *.tcl
# pkgIndex.tcl is used by the command "package require <name>"
package require Flow
#
# Import the flow namespace
namespace import flow::*
#
# Some methods to be called, creating flow
proc test1 {} {puts "CALL to test1"; activate:trace; test2 }
proc test2 {} {puts "CALL: to test2"; test3}
proc test3 {} {puts "CALL: to test3"; test4}
proc test4 {} {puts "CALL: to test4"}
#
# Main part of code
puts "SCRIPT: starting"
start:trace
test1
flow:display
puts "SCRIPT: ending"