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

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}