classtreepane.tcl

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

                if {![info exists BasNum(${rot})]} {
                    set BasNum(${rot}) 1
                } else {
                    incr BasNum(${rot})
                }
            }
            if {[is_abstract ${rot}]} {
                set fnt $sn_options(def,abstract-font)
            } else {
                set fnt $sn_options(def,ctree-font)
            }
            if {${display_filenames}} {
                set cnt [read_matched_from_db "" cl -exact ${rot} "" "" "" -1\
                  -1 0 0]
                set file [lindex [split ${cnt} \t] 4]
                if {${file} != ""} {
                    set file "\n${file}"
                }
                $itk_component(canvas) create text -1000 -1000 \
			-text ${rot}${file}\
			-tags [list ${rot} cl] -anchor nw -font ${fnt}
            } else {
                $itk_component(canvas) create text -1000 -1000\
			-text ${rot}\
			-tags [list ${rot} cl]\
			-anchor nw -font ${fnt}
            }
        }
    }

    method Draw_Links {} {
        global sn_options
        foreach cls [all_sorted_cls] {
            if {![info exists class_drawn(${cls})]} {
                continue
            }
            foreach child [all_inheritences ${cls}] {
                if {[info exists class_drawn(${child})]} {
                    #refer itself, unended loop, catch it
                    if {${child} != ${cls}} {
                        $itk_component(canvas) create edge -1m -1m -1m -1m -tag\
                          [list ch:${child} e:${child} e:${cls}] -arrow last\
                          -fill $sn_options(def,canv-line-fg) -from ${cls}\
                          -to ${child}
                    }
                }
            }
        }
    }

    #invoked to view the super- or subclasses of a specified class
    method Focus_On {{tag ""} {lev -1}} {
        if {${tag} == ""} {
            set id [$itk_component(canvas) select item]
            if {${id} == ""} {
                return
            }
            #set tag [$can itemcget $id -text]
            set tag [currentclass ${id}]
        }\
        elseif {${tag} == "current"} {
            #set tag [$can itemcget $tag -text]
            set tag [currentclass ${tag}]
        }

        if {${tag} == ""} {
            return
        }

        catch {unset CanDraw}

        if {${lev} == -1} {
            set RelativClass ${tag}

            #get the first base class of the specified class
            #view super- and subcalsses
            set tag_level ""
            get_parent ${tag}

            if {${tag_level} == ""} {
                set show_tags ${tag}
            } else {
                set show_tags ${tag_level}
            }
        } else {
            #make the specified class to be root (view subclasses)
            #set show_tags [$can itemcget $tag -text]
            set show_tags [currentclass ${tag}]
            set tag ${show_tags}
        }
        if {${show_tags} != ""} {
            set base_root ${show_tags}
            Redraw
            see_item ${tag}
        }
    }

    method edit_it {name} {
        if {${name} == ""} {
            return
        }
        if {$itk_option(-doubleclickcommand) != ""} {
            ::eval $itk_option(-doubleclickcommand) [Selection]
        }
    }

    method mark_class {{cname ""}} {
        global sn_options
        upvar #0 $itk_component(canvas)-marked_edges m_edges
        upvar #0 $itk_component(canvas)-SupNum SupNum
        upvar #0 $itk_component(canvas)-BasNum BasNum

        if {${cname} == ""} {
            set id current
            set cname [currentclass ${id}]
        } else {
            set id [$itk_component(canvas) find withtag ${cname}]
        }

        if {${cname} == "" && $itk_option(-message_var) != ""} {
            set $itk_option(-message_var) " "
            return
        }
        catch {$itk_component(canvas) select from ${id} 0}
        catch {$itk_component(canvas) select to ${id} end}

        # If the selection is not owned by us we do not
	# want the marking to disappear.
        selection own $itk_component(canvas) " "

        # Unmark old selection.
        catch {$itk_component(canvas) itemconfig "e:${m_edges}"\
          -fill $sn_options(def,canv-line-fg)}
        set m_edges ${cname}

        $itk_component(canvas) itemconfig e:${cname}\
		-fill $sn_options(def,tree-select-line)
        $itk_component(canvas) raise e:${cname}

        control_buttons normal

        # Display number of super- and baseclasses of the marked class.
        if {[info exists SupNum(${cname})]} {
            set supnum $SupNum(${cname})
        } else {
            set supnum 0
        }
        if {[info exists BasNum(${cname})]} {
            set basnum $BasNum(${cname})
        } else {
            set basnum 0
        }

        if {$itk_option(-message_var) != ""} {
            if {[expr ${basnum} + ${supnum}] == 0} {
                set $itk_option(-message_var) ""
            } else {
                set $itk_option(-message_var) "Baseclasses: ${basnum}, Superclasses: ${supnum}"
            }
        }

        #execute assigned command, if availiable
        if {$itk_option(-selectcommand) != ""} {
            ::eval $itk_option(-selectcommand) [Selection]
        }

        if {$itk_option(-symbols) != ""} {
            $itk_option(-symbols) selecttext ${cname}
        }
        return [list ${cname} ${id}]
    }

    # This function assures that the item will be on the screen.
    method see_item {{cname ""}} {
        if {[string match {[0-9]*} ${cname}] == 0} {
            set opts [mark_class ${cname}]
            set cname [lindex ${opts} 0]
            set id [lindex ${opts} 1]
        } else {
            set id ${cname}
        }

        #selected class isn't drawn
        if {"${id}" == "" || ${id} == -1} {
            return "error"
        }

        set coords [$itk_component(canvas) bbox ${id}]
        set x1 [$itk_component(canvas) canvasx 0]
        set x2 [$itk_component(canvas) canvasx \
		[winfo width $itk_component(canvas)]]
        set y1 [$itk_component(canvas) canvasy 0]
        set y2 [$itk_component(canvas) canvasy \
		[winfo height $itk_component(canvas)]]
        set enclosed [$itk_component(canvas) find enclosed\
		${x1} ${y1} ${x2} ${y2}]

        # If the item is not fully on the screen, we scroll the canvas.
        if {[lsearch -exact ${enclosed} ${id}] == -1} {
            set scr_reg [lindex [$itk_component(canvas) configure\
		    -scrollregion] 4]

            if {${scr_reg} == ""} {
                return ""
            }

            set wid [expr [lindex ${scr_reg} 2] - [lindex ${scr_reg} 0]]
            set hei [expr [lindex ${scr_reg} 3] - [lindex ${scr_reg} 1]]

            set xoff [expr double([winfo width $itk_component(canvas)]) / 3]
            set pos [expr double([lindex ${coords} 0] - ${xoff}) / ${wid}]
            if {${pos} < 0.0} {
                set pos 0.0
            }
            $itk_component(canvas) xview moveto ${pos}

            set yoff [expr double([winfo height $itk_component(canvas)]) / 3]
            set pos [expr double([lindex ${coords} 1] - ${yoff}) / ${hei}]
            $itk_component(canvas) yview moveto ${pos}
        }
        return ""
    }

    method toggle_disp_files {} {
        upvar #0 ${this}-disp-files dispfiles
        set display_filenames ${dispfiles}
        Redraw
    }

    method DrawAll {} {
        set old_cls [lindex [Selection] 1]
        set base_root ""

        Redraw

        if {${old_cls} != ""} {
            goto "" ${old_cls}
        } else {
            control_buttons disabled
        }
    }

    method Redraw {} {

        # Block the UI during the redraw.
        tixBusy $itk_component(hull) on

        graph $itk_component(canvas) destroy
        $itk_component(canvas) delete all

        upvar #0 $itk_component(canvas)-SupNum SupNum
        upvar #0 $itk_component(canvas)-BasNum BasNum

        catch {unset class_drawn}
        catch {unset SupNum}
        catch {unset BasNum}

        # Draw all classes.
        if {${base_root} == ""} {
            foreach entry [all_sorted_cls] {
                Draw_Classes ${entry} 1
            }
            # Draw related classes.
        } else {
            if {[info exists CanDraw]} {
                Draw_Classes ${RelativClass} 1
            }
            foreach entry ${base_root} {
                Draw_Classes ${entry}
            }
        }

        Draw_Links
        set_sorted_order
        graph_new_layout

        # To refill classes into combo box.
        set displayed 0

        # Return UI control to the user.
        tixBusy $itk_component(hull) off
    }

    method values {} {
        return ${base_root}
    }

    method control_buttons {state} {

        if {${base_root} == ""} {
            set allstate disabled
            set allrel sunken
        } else {
            set allstate normal
            set allrel raised
        }

        if {$itk_option(-menu) != "" && [winfo exists $itk_option(-menu)]} {
            $itk_option(-menu) entryconfig [get_indep String MultiHierDef]\
		    -state ${state}
            $itk_option(-menu) entryconfig [get_indep String MultiHierRel]\
		    -state ${state}
            $itk_option(-menu) entryconfig [get_indep String MultiHierAll]\
		    -state ${allstate}
        }

        if {$itk_option(-toolbar) != ""} {
    #        set exp ${toolbar}.ctreefr

            $itk_component(showderived) configure -state ${state}

            if {${state} == "disabled"} {
                set relief "-relief raised"
            } else {
                set relief ""
            }

            $itk_component(showrelated) configure -state ${state}
            $itk_component(showall)  configure -state ${allstate}\
		    -relief ${allrel}
        }
    }

    method set_sorted_order {} {
        set items [$itk_component(canvas) find withtag all]
        if {${items} != ""} {
            eval graph $itk_component(canvas) add ${items}
            return ""
        } else {
            return "error"
        }
    }

    method graph_new_layout {{redraw 1}} {
        global sn_options
        upvar #0 ${this}-order order
        upvar #0 ${this}-layoutstyle layout

        if {${redraw}} {
            graph $itk_component(canvas) clear
            if {[set_sorted_order] != ""} {
                return
            }
        }

        if {${order} == ""} {
            set order 0
        }

        set cmd [list graph $itk_component(canvas) config\