classpane.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 Browser that can be integrated in any subwindow.
##
#####################################################

itcl::class Class& {
    inherit sourcenav::MultiChild

    constructor {args} {
        global sn_options

        set topw [winfo toplevel $itk_component(hull)]
        set cls [info class]

	itk_component add panedwindow {
	    tixPanedWindow $itk_component(hull).paned\
		    -orientation $sn_options(def,class-orientation)
	} { }

        if {$sn_options(def,members-order) == "first"} {
	    set member_expand 0.8
	    set class_expand 0.2
	} else {
	    set member_expand 0.2
	    set class_expand 0.8
	}


        itk_component add memberpane {
	    $itk_component(panedwindow) add mem -expand $member_expand
	} { }

	itk_component add classpane {
            $itk_component(panedwindow) add cls -expand $class_expand
	} { }

        set memlist $itk_component(memberpane).list

	eval itk_initialize $args

        # Init mixer variables.
        set i 0
        foreach p ${mixer_vars} {
            upvar #0 ${this}-mixer-${p} mv
            if {${i} < 6} {
                set mv 1
            } else {
                set mv 0
            }
            incr i
        }
 
        set and 0

        # Restore old setting.
        if {${flags} != ""} {
            set i 0
            foreach p ${mixer_vars} {
                upvar #0 ${this}-mixer-${p} mv
                set mv [lindex ${flags} ${i}]
                incr i
            }
        }

        set vis class

        # Add related menu entries to the class browser.
        if {$itk_option(-menu) != ""} {
        }

        # Add toolbar buttons related to the class browser.
        if {$itk_option(-toolbar) != ""} {

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

            pack $itk_component(toolbar) -side left

            # Create a combo box for the types of the class.
	    
	    itk_component add classcombo {
		Combo& $itk_component(toolbar).name_visib\
			-width 9 \
			-contents [list subclass class baseclass]\
			-entryvariable [itcl::scope visible] \
			-selectcommand [itcl::code ${this} ComboRefresh_cb]
	    } { }

            $itk_component(classcombo) selecttext ${vis}

            pack $itk_component(classcombo) -side left -fill x

            # Mixer.
	    itk_component add filter {
		button $itk_component(toolbar).mixer\
			-takefocus 0\
			-text [get_indep String Mixer]\
			-underline [get_indep Pos Mixer]\
			-pady 0\
			-command [itcl::code ${this} mixer]
	    } { }

            balloon_bind_info $itk_component(filter)\
		    [get_indep String MixerINFO]
            pack $itk_component(filter) -side left -fill y -expand n
        }

        # Create a tree for the class members.
	itk_component add memberlist {
	    Tree  $itk_component(memberpane).list\
		    -width 60 -height 15\
		    -exportselection 0 -fillselection 1\
		    -selectmode browse\
		    -tabs [list 250 150 150 400]\
		    -tabsize 3\
		    -labels [list "[get_indep String Name]"\
		     "[get_indep String Class]"\
		     "[get_indep String Type]"\
		     "[get_indep String Parameters]"]\
		    -info_label $itk_option(-mesg_area)\
		    -sortedinsertion 0\
		    -sortnocase 1\
		    -bestfit 1\
		    -truncate 1\
		    -font $sn_options(def,class-font)\
		    -propagate 1
	} { }

	$itk_component(memberlist) config \
		-fillcommand [itcl::code $this fillcbwrapper]

	itk_component add overridden {
	    checkbutton $itk_component(memberlist).filter.overridden\
		    -text [get_indep String ClassBrowOverridden]\
		    -under [get_indep Pos ClassBrowOverridden]\
		    -variable [itcl::scope overridden] \
		    -command [itcl::code ${this} fill] \
		    -relief groove
	} { }
	pack $itk_component(overridden) -side left\
		-before $itk_component(memberlist).filter.label

        set memlist_tree [$itk_component(memberlist) tree]

# FIXME: all these Tree bindings need to be replaced with something cleaner
        $itk_component(memberlist) treebind <space> [$itk_component(memberlist) treebind <Return>]
        $itk_component(memberlist) treebind <Double-1> "${this} handle_doubleclick"
        $itk_component(memberlist) treebind <ButtonRelease-1>\
		"${this} handle_click"
        $itk_component(memberlist) treebind <3>\
		"focus %W; ${this} select_post_members_menu %W %X %Y %y; break"

	itk_component add classtree {
	    sn_treetable $itk_component(classpane)\
		    -selectmode browse\
		    -indent 15\
		    -font $sn_options(def,class-font)\
		    -height 6 -borderwidth 0
	} { }

        bind $itk_component(classtree) <ButtonRelease-1>\
		"${this} handle_class_click"

        bind $itk_component(classtree) <1> "
			set tog \[$itk_component(classtree) identify %x %y\]
			set t_m_p \[$itk_component(classtree) nearest %y\]
			if {\$tog != \"\" && \$tog != \"text\" && \$t_m_p > -1} {
				${this} toggle_class \$t_m_p
			}
			unset tog; unset t_m_p
			break"

        bind $itk_component(classtree) <Control-1>\
		" set t_m_p \[%W nearest %y\]
			if {\$t_m_p > -1} {
			    ${this} tree_select \[%W get \$t_m_p\]
			}
			unset t_m_p
			break"

        bind $itk_component(classtree) <3>\
		"focus %W;${this} select_post_menu %W %X %Y %y; break"

        bind $itk_component(classtree) <Double-1>\
		"${this} edit_class %W \[%W nearest %y\]"

        bind $itk_component(classtree) <space>\
		"${this} edit_class %W; break"

        bind $itk_component(classtree) <Return>\
		"${this} edit_class %W; break"

        pack $itk_component(classtree) -fill both -expand y
        pack $itk_component(memberlist) -side top -fill both -expand y

        pack $itk_component(panedwindow) -fill both -expand y -side bottom

        # Call user defined procedure.
        catch {sn_rc_classbrowser $itk_component(hull) $itk_component(classtree)\
		$itk_component(memberlist)}

        if {$itk_option(-classname) != ""} {
            goto "" $itk_option(-classname)
        }

        ::focus $itk_component(memberlist)

        # Set title for the top window.
        SetTitle
    }

    destructor {
# FIXME: Remove when mixer vars are cleaned up.
        foreach v [::info globals "${this}-*"] {
            catch {uplevel #0 unset ${v}}
        }
    }

    # Post menu for members.
    method select_post_members_menu {w X Y y} {
        set m .cls_select_post_members_menu
        catch {destroy ${m}}
        menu ${m} -tearoff 0
        wm overrideredirect ${m} 1
        set y [${w} nearest ${y}]
        ${w} selection clear 0 end
        ${w} selection set ${y}
        set txt [Retriever&::convert_to_line $itk_component(memberlist)]
        if {${txt} != ""} {
            set txt [split ${txt} \t]
            set sym [lindex ${txt} 0]
            set cls [lindex ${txt} 1]
            set prm [lindex ${txt} 3]
            set fil [lindex ${txt} 4]
            set lin [lindex ${txt} 5]
            if {${cls} == ""} {
                set cls ${class_name}
            }
            set lbl " [get_indep String Of] '${cls}\:\:${sym}'"
            set state normal
        } else {
            set sym ""
            set cls ""
            set prm ""
            set fil ""
            set lin ""
            set lbl ""
            set state disabled
        }
        #set vw "[get_indep String View] "
        set vw ""

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

        #Class hierarchy
        ${m} add command -label "${vw}[get_indep String MultiClassHierarchy]\
          [get_indep String Of] '${cls}'" -underline [get_indep Pos\
          MultiClassHierarchy] -command "sn_classtree ${cls}" -state ${state}

        #Xref
        ${m} add command -label "${vw}[get_indep String MultiXRef]${lbl}"\
          -underline [get_indep Pos MultiXRef] -command " sn_xref both\
          [list ${cls}\:\:${sym}] [list ""] [list ${fil}] [list ${lin}] [list\
          ""] [list ${prm}] " -state ${state}

        ${m} add separator

        #add default menu entries
        $itk_component(memberlist) tree_post_menu ${m}

        tk_popup ${m} ${X} ${Y}
    }

    method select_post_menu {w X Y y} {
        global sn_options
        set m .cls_select_post_menu

        # It has to be destroyed because we might have problems with "tk_popup"!
        catch {destroy ${m}}

        menu ${m} -tearoff 0
        wm overrideredirect ${m} 1

        set y [${w} nearest ${y}]

        set str [tree_get ${w} ${y}]

        if {${str} == ""} {
            set str "selection"
            set target ""
            set state "disabled"
        } else {
            set target ${str}
            set state "normal"

            #select the entry
            ${w} selection clear 0 end
            ${w} selection set ${y}
        }
        ${m} add command -label [format [get_indep String SelectOnly] ${str}]\
          -command "${this} tree_select ${target}" -state ${state}
        ${m} add command -label [get_indep String SelectAll] -command "${this} tree_select -all" -accelerator "$sn_options(sys,alt-accelpref)+A"

        ${m} add separator

        tk_popup ${m} ${X} ${Y}
    }

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

    method handle_class_click {} {
        set sel [$itk_component(classtree) curselection]
        if {${sel} == ""} {
            return
        }
        set cls [$itk_component(classtree) get ${sel}]
        if {$itk_option(-selectcommand) != ""} {
            ::eval $itk_option(-selectcommand) [list cl ${cls} "" "" "" "" "" ""]
        }
    }
    method handle_click {} {
        if {$itk_option(-selectcommand) != ""} {
            ::eval $itk_option(-selectcommand) [Selection]
        }
    }

    method Title {{full 1}} {
        global sn_options
        set t "[get_indep String ClassBrowTitle]"
        if {${class_name} != ""} {
            set t "${t}: ${class_name}"
        }
        if {${full}} {
            return [sn_title ${t}]
        } else {
            return ${t}
        }
    }

    method Icon {} {
        global sn_options
        return [sn_view_icon [get_indep String ClassBrowTitle] ${class_name}]
    }

    method SetTitle {} {