package require struct
proc FindCallers {callTree procName callList} {
global sourceCode
##puts stdout "Processing '$procName'"
##update idletask
##
## Get length once and start at the beginning
##
set len [string length $procName]
set index 0
set callerList {}
set skip 0
##
## Find all occurrences
##
while {[set pos [string first $procName $sourceCode $index]] != -1} {
##
## Verify this reference is not in a comment
##
set eol [string last "\n" $sourceCode $pos]
set line [string trim [string range $sourceCode $eol $pos]]
##puts stdout "\tFound at ($pos,$eol) in '$line'"
##update idletask
if {[string equal [string index $line 0] {#}]} {
##
## It is a comment, so cause processing to be skipped
##
set eol $pos
} else {
##
## Get the caller position and the EOL of the caller
##
set callerPos [string last "proc " $sourceCode $pos]
set eol [string first \{ $sourceCode $callerPos]
}
##
## If the EOL is after the position of the procName, then this is the line
## that defines the proc we are interested in (or it is a comment)
##
if {$eol < $pos} {
##
## Get the name of the caller
##
set callerLine [string range $sourceCode $callerPos $eol]
set callerName [lindex [split $callerLine] 1]
##
## Ignore it if it is in the list of calls passed in, i.e. we have recursion,
## or if it was already processed in this routine
##
if {([lsearch -exact $callList $callerName] == -1) &&
([lsearch -exact $callerList $callerName] == -1) &&
![$callTree exists $callerName]} {
##puts stdout "\tAddinging '$callerName' from '$callerLine' ($callerPos,$eol)"
##update idletask
##
## Add it to the list of callers processed so far
##
lappend callerList $callerName
$callTree insert $procName end $callerName
##
## Create a new static callers list and add this caller to it.
## And build its caller tree
##
set tempList callList
lappend tempList $callList
FindCallers $callTree $callerName $tempList
} else {
incr skip
}
}
##
## Advance the index past where we found this occurrence
##
set index [expr {$pos + $len}]
}
if {$skip && [$callTree isleaf $procName]} then {
$callTree insert $procName end "--$procName"
}
}
proc PrintLeaves {callTree node} {
if {[$callTree isleaf $node] && ![string equal "--" [string range $node 0 1]]} {
puts $node
}
}Usage:set ifd [open allMyCode.tcl r]
set sourceCode [read $ifd]
close $ifd
set callTree [::struct::tree $procName]
$callTree insert root end $procName
FindCallers $callTree $procName {}
$callTree walk root node {PrintLeaves $callTree $node}Here is some code that does Dynamic call graph
