[ulis], 2003-11-24. A hacked procs flow tracing package that I use now intensively.

----
'''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
  }

----
[Category Dev. Tools]