classtreepane.tcl

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

		    -gridlock 1 -order ${order}]
        if {${order} == 0} {
            lappend cmd -nodespacev $sn_options(def,ctree-horizspace)\
              -nodespaceh $sn_options(def,ctree-vertspace)
        } else {
            lappend cmd -nodespacev $sn_options(def,ctree-vertspace)\
              -nodespaceh $sn_options(def,ctree-horizspace)
        }

        #execute graph command
        eval ${cmd}

        graph $itk_component(canvas) layout ${layout}

        set reg [$itk_component(canvas) bbox all]

        set wd [lindex ${reg} 2]
        set he [lindex ${reg} 3]
        $itk_component(canvas) configure -scrollregion [list 0 0 ${wd} ${he}]

        return [list ${wd} ${he}]
    }

    method Title {{full 1}} {
        global sn_options
        set t "[get_indep String ClassHierarchy]"
        if {${base_root} != ""} {
            set t "${t}: ${base_root}"
        }
        if {${full}} {
            return [sn_title ${t}]
        } else {
            return ${t}
        }
    }
    method Icon {} {
        return [sn_view_icon [get_indep String ClassHierarchy] ${base_root}]
    }
    method SetTitle {} {
        ${topw} configure -title [Title] -iconname [Icon]
    }

    # Fill combobox with the correct entries
    # Filter for symbols.
    method filter {{all 0}} {
        upvar #0 $itk_option(-symbols_filter)-related related
        if {$itk_option(-symbols) != ""} {
            if {${related} && ${base_root} != ""} {
                $itk_option(-symbols) configure -contents [array names class_drawn]
            } else {
                $itk_option(-symbols) configure -contents [all_sorted_cls]
            }
        }
    }

    # This function is called, when the symbols combobox
    # is called.
    method postcommand {m} {
        if {! ${displayed}} {
            filter
            set displayed 1
        }
    }

    method activate {} {
        #display the contents always by activating
        set displayed 0

        if {$itk_option(-menu) != "" && [winfo exists $itk_option(-menu)]} {
            set mn [string range $itk_option(-menu)\
		    0 [expr [string last "." $itk_option(-menu)] - 1]]
            ${mn} entryconfig [get_indep String MultiClassHierarchy]\
              -state normal
        }
        if {$itk_option(-toolbar) != ""} {
            pack $itk_component(toolbar) -side left
        }
        if {$itk_option(-symbols) != ""} {
            $itk_option(-symbols) configure -entrytext ${base_root}
        }
    }

    method deactivate {} {
        if {$itk_option(-menu) != "" && [winfo exists $itk_option(-menu)]} {
            set mn [string range $itk_option(-menu) 0\
		    [expr [string last "." $itk_option(-menu)] - 1]]
            ${mn} entryconfig [get_indep String MultiClassHierarchy]\
              -state disabled
        }

        if {$itk_option(-toolbar) != ""} {
            pack forget $itk_component(toolbar)
        }
    }

    method gotosymbol {{scope ""} {sym ""} {cls ""} {file ""} {from ""} {type\
      ""} {prm ""} {to ""} {always 1}} {
        if {${cls} != ""} {
            return [goto "" ${cls}]
        }
        if {${sym} != ""} {
            return [goto "" ${sym}]
        }
        return 0
    }

    method goto {combo class} {
        global sn_options sn_sep
        if {${class} == ""} {
            return
        }

        #is the class availiable
        if {[::info commands paf_db_cl] != ""} {
            set avail [paf_db_cl seq -data -first -col 0 "${class}${sn_sep}"]
            if {${avail} == ""} {
                return
            }
        } else {
            return
        }

        #dump the current view into the history stack
        ${topw} history_stack_add_point ${this}

        #class already displayed
        if {[see_item ${class}] == ""} {
            return
        }
        #draw the new class
        Focus_On ${class}

        if {$itk_option(-symbols) != ""} {
            $itk_option(-symbols) selecttext ${class}
        }
    }

    method currentclass {{id ""}} {
        if {${id} == ""} {
            set id current
        }
        return [lindex [split [$itk_component(canvas) itemcget ${id} -text] \n] 0]
    }

    method Selection {} {
        set sel [$itk_component(canvas) itemcget \
		[$itk_component(canvas) select item] -text]
        set sel [lindex [split ${sel} \n] 0]
        if {${sel} != ""} {
            return [list cl ${sel} "" "" "" "" "" ""]
        }
        return ""
    }

    method clearselection {} {
        $itk_component(canvas) select clear
    }

    method Focus {} {
        focus $itk_component(canvas)
    }

    #make a title for the Dump position, this is usefull
    #for the views stack (prev/next)
    method DumpTitle {{dump ""}} {
        if {${dump} == ""} {
            set dump [Dump]
        }
        return "CTree [lindex ${dump} 1]"
    }

    method AddHistoryFromDump {dump title} {
        set class [lindex ${dump} 1]
        sn_add_history ctree ${class} [sn_make_history_title tree "" ${class}]\
          sn_classtree
    }

    #return the important data to restore this widget
    #in later time again (used by saving the project)
    method Dump {} {
        return [Selection]
    }

    #gets the result from the function "Dump" to
    #restore the older state (used by restoring the project)
    method Restore {str} {
        eval ${this} gotosymbol ${str}
        #Focus
    }

    method Close {{mode 0}} {
        return 1
    }

    method Refresh_Display {} {
        global sn_options
        reset
        catch {unset sorted_classes}
    }

    method Update_Layout {} {
        global sn_options

        global ${this}-layoutstyle
        global ${this}-order

        #apply new colors to the canvas
        $itk_component(canvas) configure\
		-selectforeground $sn_options(def,select-fg)\
		-selectbackground $sn_options(def,select-bg)

        set ${this}-layoutstyle $sn_options(def,ctree-layout)
        set ${this}-order $sn_options(def,ctree-view-order)

        graph_new_layout 1
    }

    method whoami {} {
        return ctree
    }

    proc reset {} {
        catch {unset abstract_classes}
        catch {unset sorted_classes}
        catch {unset parent_classes}
    }

    proc is_abstract {cls} {
        global sn_sep
        #use cache to determine if the class has abstracts
        if {[info exists abstract_classes(${cls})]} {
            return $abstract_classes(${cls})
        }
        if {[::info commands paf_db_md] != ""} {
            set virtuals [paf_db_md seq -first -col [list 0 1\
              "5 :${virt_bit}:${virt_bit}"] "${cls}${sn_sep}"]
            if {${virtuals} == ""} {
                set virtuals [paf_db_md seq -first -col [list 0 1\
                  "5 :${purevirt_bit}:${purevirt_bit}"] "${cls}${sn_sep}"]
            }
        } else {
            set virtuals ""
        }
        if {${virtuals} != ""} {
            set abstract_classes(${cls}) 1
        } else {
            set abstract_classes(${cls}) 0
        }
        return $abstract_classes(${cls})
    }

    proc all_sorted_cls {} {
        if {[info exists sorted_classes]} {
            return ${sorted_classes}
        }

        if {[::info commands paf_db_cl] != ""} {
            set sorted_classes [::lunique [::lsort -dictionary [paf_db_cl seq\
              -uniq -data -col 0]]]
        } else {
            set sorted_classes ""
        }
        return ${sorted_classes}
    }

    #return a list of all inheritences of a class
    proc all_inheritences {cls} {
        if {[info exists inh_classes(${cls})]} {
            return $inh_classes(${cls})
        }
        if {[::info commands paf_db_in] != ""} {
            set inh_classes(${cls}) [::lunique [::lsort -dictionary\
              [paf_db_in seq -data -col [list 0 "1 +${cls}"]]]]
        } else {
            set inh_classes(${cls}) ""
        }
        return $inh_classes(${cls})
    }

    proc FillValues {} {
        global sn_options
        if {![info exists virt_bit]} {
            set virt_bit [Class&::convert_sym_to_bit {virtual}]
            set purevirt_bit [Class&::convert_sym_to_bit {{pure virtual}}]
        }
    }

    #view the hierarchy of a specified class.
    #probably create a new window
    proc ClassHierarchy {{class ""}} {
        global tkeWinNumber
        set s [MultiWindow&::find_Reusable]
        if {${s} == ""} {
            set new 1
            incr tkeWinNumber
            set s ".multiwindow-${tkeWinNumber}"
            MultiWindow& ${s} -raise ctree
        } else {
            ${s} view ctree
        }
        [${s} ActiveWidget] gotosymbol cl ${class}
    }

    protected variable print_dialog ""
    protected variable topw
    protected variable displayed 0
    protected variable CanDraw
    protected variable RelativClass ""
    protected variable class_drawn
    protected variable can ""
    protected variable list
    protected variable display_filenames 0

    common inh_classes
    common tag_level
    common abstract_classes
    common virt_bit
    common purevirt_bit
    common classes
    common sorted_classes
    common parent_classes

    public variable base_root ""

    # Goto this class.
    itk_option define -classname classname Classname "" {
        if {[winfo exists $itk_component(canvas)]} {
            goto "" $itk_option(-classname)
        }
    }

    # FIXME: These should be set using
    # option add *WhatEverClass.width 640 widgetDefault
    public variable width 640
    public variable height 480

    public variable goto ""
}

proc sn_classtree {{class ""}} {
    global Switch_Is_Enabled
    incr Switch_Is_Enabled -1

    ClassTree&::ClassHierarchy ${class}

    incr Switch_Is_Enabled
}