classtreepane.tcl

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

# Copyright (c) 2000, 2001, 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.
# 
#####################################################
##
## Class hierarchy that can be integrated in any subwindow.
##
#####################################################
itcl::class ClassTree& {
    inherit sourcenav::MultiChild
    constructor {args} {
        global sn_options

        set topw [winfo toplevel $itk_component(hull)]

        # Set default layout and order for classtree.
        global ${this}-layoutstyle
        global ${this}-order
        set ${this}-order $sn_options(def,ctree-view-order)
        set ${this}-layoutstyle $sn_options(def,ctree-layout)

	itk_component add canvas {
	    canvas $itk_component(hull).canvas\
		    -borderwidth 2\
		    -xscrollcommand "${this}.scrollx set"\
		    -yscrollcommand "${this}.scrolly set"\
		    -xscrollincrement 20\
		    -yscrollincrement 20
	} { }

	itk_component add scrollx {
	    scrollbar $itk_component(hull).scrollx\
		    -orient horiz\
		    -command "$itk_component(canvas) xview"\
		    -jump $sn_options(def,canvas-tree-jump)
	}

	itk_component add scrolly {
	    scrollbar $itk_component(hull).scrolly\
		    -command "$itk_component(canvas) yview"\
		    -jump $sn_options(def,canvas-tree-jump)
	}

        grid $itk_component(canvas) -row 0 -column 0 -sticky news
        grid $itk_component(scrollx) -row 1 -column 0 -sticky ew
        grid $itk_component(scrolly) -row 0 -column 1 -sticky ns

        grid rowconfigure $itk_component(hull) 0 -weight 1
        grid columnconfigure $itk_component(hull) 0 -weight 1

        $itk_component(canvas) bind cl <1> "${this} mark_class"
        $itk_component(canvas) bind cl <Control-1>\
		"${this} Focus_On current 0"
        $itk_component(canvas) bind cl <Shift-1>\
		"${this} Focus_On current 0"
        $itk_component(canvas) bind cl <Double-1> "${this} edit_it \[%W itemcget current -text\]"

        # Display filenames with the classes.
        global ${this}-disp-files
        set ${this}-disp-files ${display_filenames}

	eval itk_initialize $args

        # Add menu entries for the class hierarchy.
        if {$itk_option(-menu) != "" && [winfo exists $itk_option(-menu)]} {

            $itk_option(-menu) add command\
		    -label [get_indep String MultiHierDef]\
		    -underline [get_indep Pos MultiHierDef]\
		    -command "${this} Focus_On"\
                    -state disabled

            $itk_option(-menu) add command\
		    -label [get_indep String MultiHierRel]\
		    -underline [get_indep Pos MultiHierRel]\
		    -command "${this} Focus_On \[$itk_component(canvas) select item\] 0"\
	            -state disabled

            $itk_option(-menu) add command\
		    -label [get_indep String MultiHierAll]\
		    -underline [get_indep Pos MultiHierAll]\
		    -command "${this} DrawAll"\
                    -state disabled

            $itk_option(-menu) add separator
            $itk_option(-menu) add checkbutton\
		    -label [get_indep String HierDispFiles]\
		    -underline [get_indep Pos HierDispFiles]\
		    -variable ${this}-disp-files\
		    -command " ${this} toggle_disp_files "
        }

        # View icons on the toolbar.
        if {$itk_option(-toolbar) != ""} {

	    itk_component add toolbar {
		frame $itk_option(-toolbar).classtreetoolbar
	    }

            pack $itk_component(toolbar) -side left

	    itk_component add showall {
		button $itk_component(toolbar).tree\
			-image tree_image\
			-takefocus 0 -command ""\
			-state normal
	    }

            bind $itk_component(showall) <Any-ButtonPress>\
		    "if {%b == 1} {
		         ${this} DrawAll
	             }"

            balloon_bind_info $itk_component(showall)\
		    [get_indep String MultiHierAllINFO]

	    itk_component add showrelated {
		button $itk_component(toolbar).deftree\
			-image stree_image -takefocus 0\
			-command "" -state disabled
	    }

            bind $itk_component(showrelated) <Any-ButtonPress>\
		    "if {%b == 1} {${this} Focus_On}"

            balloon_bind_info $itk_component(showrelated)\
		    [get_indep String MultiHierDefINFO]

	    itk_component add showderived {
		button $itk_component(toolbar).down\
			-image down_image -takefocus 0 -command "  "\
			-state disabled
	    }

            bind $itk_component(showderived) <Any-ButtonPress>\
		    "if {%b == 1} {
		         ${this} Focus_On \[$itk_component(canvas) select item\] 0
                     }"


	    balloon_bind_info $itk_component(showderived)\
		    [get_indep String MultiHierRelINFO]

            pack $itk_component(showall) -side left
            pack $itk_component(showrelated) -side left
            pack $itk_component(showderived) -side left
        }

        # Option menu for Class Tree items.
	itk_component add menu {
	    menu $itk_component(canvas).menu\
		    -tearoff 0 -postcommand\
		     "${this} update_post_menu $itk_component(canvas).menu"
	} {}
	
	wm overrideredirect $itk_component(menu) 1

        # See super- and baseclasses.
        $itk_component(menu) add command\
		-label [get_indep String MultiHierDef]\
		-underline [get_indep Pos MultiHierDef]\
		-command "${this} Focus_On"\
		-state disabled

        # See superclasses.
        $itk_component(menu) add command\
		-label [get_indep String MultiHierRel]\
		-underline [get_indep Pos MultiHierRel]\
		-command "${this} Focus_On \[$itk_component(canvas) select item\] 0"\
		-state disabled

        $itk_component(menu) add separator
        $itk_component(menu) add checkbutton\
		-label [get_indep String HierDispFiles]\
		-underline [get_indep Pos HierDispFiles]\
		-variable ${this}-disp-files\
		-command "${this} toggle_disp_files"

        $itk_component(menu) add separator

        # Bind option menu.
        $itk_component(canvas) bind cl <ButtonPress-3>\
		"${this} mark_class; tk_popup $itk_component(canvas).menu %X %Y"

        # Init some variables.
        FillValues

        Update_Layout

        # As first step load all availiable classes and build the
        # hierarchy.
        if {[info commands paf_db_cl] == ""} {
            reset
        }

        # Is a class selected?
        goto "" $itk_option(-classname)

        # Call user defined procedure.
        catch {sn_rc_classhierarchy ${this} $itk_component(canvas)}
    }

    destructor {
        # If this is the last object, reset the common variables.
        if {[itcl::find objects -class [info class]] == ${this}} {
            reset
        }
        foreach v [::info globals "${this}-*"] {
            catch {uplevel #0 unset ${v}}
        }
    }

    method update_post_menu {m} {
        set clname [currentclass current]

        set state normal
        ${m} entryconfig [get_indep String MultiHierDef] -state ${state}
        ${m} entryconfig [get_indep String MultiHierRel] -state ${state}

        set num [${m} index end]
        if {${num} >= 5} {
            ${m} delete 5 end
        }

        set vw ""

        set lbl " [get_indep String Of] '${clname}'"

        # Editor
        ${m} add command -label "${vw}[get_indep String MultiEditor]${lbl}"\
          -underline [get_indep Pos MultiEditor] -command "${this} edit_it ${clname}" -state normal

        #Class
        ${m} add command -label "${vw}[get_indep String MultiClass]${lbl}"\
          -underline [get_indep Pos MultiClass] -command "sn_classbrowser ${clname}" -state normal

        #Xref
        ${m} add command -label "${vw}[get_indep String MultiXRef]${lbl}"\
          -underline [get_indep Pos MultiXRef] -command " sn_xref both\
          ${clname}(cl) " -state normal
    }

    method print {} {
        global sn_options tcl_platform

        if {$tcl_platform(platform)=="windows"} {

            ide_print_canvas $itk_component(canvas)

        } else {
            if {${print_dialog} == "" || [itcl_info objects ${print_dialog}]\
              == ""} {
                set print_dialog [PrintDialog $itk_component(hull).printdialog \
                  -leader ${topw} \
                  -modality application \
                  -canvas $itk_component(canvas)\
                  -file [file join $sn_options(profile_dir)\
                  tree.ps]]

	        $print_dialog transient ${topw}
	        $print_dialog activate
	        itcl::delete object $print_dialog
            } else {
                ${print_dialog} raise
            }
        }
    }

    #returns a list of all classes that inherit the specified
    #class
    proc parent_inh {cls} {
        global sn_sep
        if {! [info exists parent_classes(${cls})]} {
            if {[::info commands paf_db_in] != ""} {
                set parent_classes(${cls}) [::lunique [::lsort\
                  -dictionary [paf_db_in seq -data -col 1 "${cls}${sn_sep}"]]]
            } else {
                set parent_classes(${cls}) ""
            }
        }
        return $parent_classes(${cls})
    }

    method get_parent {id} {
        set found 0
        set CanDraw(${id}) 1
        set prnts ""
        foreach a [parent_inh ${id}] {
            set found 1
            #set CanDraw($a) 1
            if {! [get_parent ${a}]} {
                lappend tag_level ${a}
            }
        }
        return ${found}
    }

    method Draw_Classes {rot {all 0} {base ""}} {
        global sn_options
        upvar #0 $itk_component(canvas)-SupNum SupNum
        upvar #0 $itk_component(canvas)-BasNum BasNum

        if {[info exists class_drawn(${rot})]} {
            if {${base} != ""} {
                if {![info exists SupNum(${base})]} {
                    set SupNum(${base}) 1
                } else {
                    incr SupNum(${base})
                }
                if {![info exists BasNum(${rot})]} {
                    set BasNum(${rot}) 1
                } else {
                    incr BasNum(${rot})
                }
            }
            return
        }

        foreach entry [all_inheritences ${rot}] {
            if {${rot} != ${entry}} {
                Draw_Classes ${entry} ${all} ${rot}
            }
        }

        if {${all} || ![info exists CanDraw] || [info exists CanDraw(${rot})]\
          && $CanDraw(${rot})} {
            set class_drawn(${rot}) 1

            if {${base} != ""} {
                if {![info exists SupNum(${base})]} {
                    set SupNum(${base}) 1
                } else {
                    incr SupNum(${base})
                }