clobber.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# the next line restarts using wish \
exec hyper "$0" "$@"

###############################################################################
#
# clobber.tcl
#
# Copyright (C) 1997 Cygnus Solutions, Inc.
#
# Description:
# This Tcl tool is used to show all the points of a program that modifies
# a global variable.
#
###############################################################################

# Take a class and method name and turn it into a fully-qualified C++ name.

proc qualify {class method} {
    if {[string compare "${class}" "\#"] == 0} {
        return ${method}
    }
    # C++ style naming
    return "${class}::${method}"
}

# Take a fully-qualified C++ name and break it into its component parts.

proc disqualify {name} {
    if {[regexp ".*::.*" ${name}] == 0} {
        return ${name}
    }
    set tokens [split ${name} ":"]
    return [concat [lindex ${tokens} 0] [lindex ${tokens} 2]]
}

# Take a simple abbreviation stored in the project database and turn it into
# a plain English description.

proc objtype {abbrev} {
    switch ${abbrev} {
        gv {
                return "global variable"
            }
        mi {
                return "method implementation"
            }
        fu {
                return "function"
            }
        iv {
                return "instance variable"
            }
        default {
                return "unknown object"
            }
    }
}

# Extract all the refers-to references from the project database.

proc torefs {path projname} {
    set db_functions [dbopen nav_func ${path}/${projname}.to RDONLY 0644 btree]
    return [${db_functions} seq]
}

if {${argc} != 3} {
    puts "Usage: ${argv0} projectdir project variable-name"
    exit
}

set projdir [lindex ${argv} 0]/.snprj
set var [lindex ${argv} 2]

wm withdraw .

foreach entry [torefs ${projdir} [lindex ${argv} 1]] {
    set subentry [lindex ${entry} 0]

    if {[llength [disqualify ${var}]] > 1} {
        set classname [lindex [disqualify ${var}] 0]
        set methodname [lindex [disqualify ${var}] 1]
    } else {
        set classname "\#"
        set methodname [disqualify ${var}]
    }

    if {"[lindex ${subentry} 3]" == "${classname}" && "[lindex ${subentry} 4]"\
      == "${methodname}" && "[lindex ${subentry} 6]" == "w"} {
        puts -nonewline "[objtype [lindex ${subentry} 2]] "
        puts -nonewline "[qualify [lindex ${subentry} 0] [lindex ${subentry}\
          1]] "
        puts -nonewline "modifies [objtype [lindex ${subentry} 5]] ${var} in "
        puts "[lindex ${subentry} 8]:[lindex ${subentry} 7]"
    }
}

exit