includepane.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.
# 
#####################################################
##
## Include Browser that can be integrated in any subwindow.
##
#####################################################
itcl::class Include& {

    inherit sourcenav::MultiChild

    constructor {args} {
        global sn_options

        # Init some values.
        set topw [winfo toplevel $itk_component(hull)]

	# All thulls should be replaced with itk_component(hull)
        set thull $itk_component(hull)
        set can ${thull}.can

        set order $sn_options(def,include-disporder)
        set layoutstyle $sn_options(def,include-layout)

        eval itk_initialize $args

        #draw Menu & Toolbar entries
        #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 Includes]\
              -underline [get_indep Pos Includes] -command "${this} references to" -state disabled
            $itk_option(-menu) add command -label [get_indep String IncludedFrom]\
              -underline [get_indep Pos IncludedFrom] -command "${this} references by" -state disabled
            $itk_option(-menu) add command -label [get_indep String RemIncludes]\
              -underline [get_indep Pos RemIncludes] -command "${this} removeIncludes" -state disabled
            $itk_option(-menu) add command -label [get_indep String RemIncludedFrom]\
              -underline [get_indep Pos RemIncludedFrom] -command "${this} removeIncludedFrom" -state disabled
        }

        # View icons on the toolbar.
        if {$itk_option(-toolbar) != "" && [winfo exists $itk_option(-toolbar)]} {
            set exp $itk_option(-toolbar).incbr
            pack [frame ${exp}] -side left
            # DELETE Button
            button ${exp}.remove -takefocus 0 -image waste_image -command\
              " $itk_option(-menu) invoke {[get_indep String RemIncludes]} "\
              -state disabled
            balloon_bind_info ${exp}.remove [get_indep String RemIncludes]
            pack ${exp}.remove -side left

            #refered to Button
            button ${exp}.ref_to -takefocus 0 -image right_image -command\
              " $itk_option(-menu) invoke {[get_indep String Includes]} " -state disabled
            balloon_bind_info ${exp}.ref_to [get_indep String IncludesINFO]
            pack ${exp}.ref_to -side left

            button ${exp}.ref_by -takefocus 0 -image left_image -command\
              " $itk_option(-menu) invoke {[get_indep String IncludedFrom]} "\
              -state disabled
            balloon_bind_info ${exp}.ref_by [get_indep String IncludedFromINFO]
            pack ${exp}.ref_by -side left

            #draw the entry for the levels in the toolbar of the include browser
            set frame ${exp}
            frame ${frame}.space -width 5
            pack ${frame}.space -side left
            label ${frame}.lbl -relief groove -text [get_indep String\
              IncLevelTit] -underline [get_indep Pos IncLevelTit]
            entry ${frame}.txt -relief groove -textvar ${this}.incMaxLevels\
              -width 3
            bind ${frame}.txt <Return> "catch \{${this} view_include \[${this}\
              baseroot\]\}"
            pack ${frame}.lbl -side left -fill y
            pack ${frame}.txt -side left -fill y
        }

        canvas ${can} -borderwidth 2 -xscrollcommand "${this}.scrollx set"\
          -yscrollcommand "${this}.scrolly set" -xscrollincrement 20\
          -yscrollincrement 20
        ${can} bind inc <1> "${this} mark_item"
        ${can} bind inc <Double-1> "${this} edit_it \[%W itemcget current -text\]"
        ${can} bind inc <ButtonPress-3> "${this} mark_item; tk_popup\
          ${can}.menu %X %Y"

        #option menu
        set m ${can}.menu
        menu ${can}.menu -tearoff 0 -postcommand\
          "${this} update_post_menu"
        wm overrideredirect ${can}.menu 1
        ${m} add command -label [get_indep String Includes] -command "${this} references to" -state ${ref_to_state}
        ${m} add command -label [get_indep String IncludedFrom] -command "${this} references by" -state ${ref_by_state}
        ${m} add separator
        ${m} add command -label [get_indep String RemIncludes] -command "${this} removeIncludes" -state ${rem_to_state}
        ${m} add command -label [get_indep String RemIncludedFrom] -command "${this} removeIncludedFrom" -state ${rem_by_state}

        scrollbar ${thull}.scrollx -orient horiz -command " ${can} xview "\
          -jump $sn_options(def,canvas-tree-jump)
        scrollbar ${thull}.scrolly -command " ${can} yview "\
          -jump $sn_options(def,canvas-tree-jump)

        grid ${can} -row 0 -column 0 -sticky news
        grid ${thull}.scrollx -row 1 -column 0 -sticky ew
        grid  ${thull}.scrolly -row 0 -column 1 -sticky ns

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

        #Draw tree of required include
        start ${goto}

        #Display the built tree
        Redraw

        Update_Layout

        #call user defined function
        catch {sn_rc_include $itk_component(hull) ${can}}
    }

    destructor {
        # If this is the last object, reset the common variables.
        if {[itcl::find objects -class [info class]] == ${this}} {
            reset
        }
    }

    #load all include files into a common variable.
    proc all_includes {} {
        if {[::info commands paf_db_iu] != ""} {
            if {![info exists all_includes]} {
                set all_includes [paf_db_iu seq -data -col 0]
                eval lappend all_includes [paf_db_iu seq -data -col 2]
                set all_includes [::lunique [::lsort\
                  -dictionary ${all_includes}]]
            }
        } else {
            set all_includes ""
        }
        return ${all_includes}
    }

    method Redisplay {} {
        view_include [baseroot] 1
        set displayed 0
    }

    method start {selected} {
        reset

        #begin draeing with the selected include
        set includes_to_view ${selected}
        set base_root ${selected}

        FillValues
    }

    proc ResetIncludes {} {
        catch {unset Includes}
        catch {unset Included_From}
        catch {unset all_includes}
    }

    method reset {} {
        catch {unset sons}
        catch {unset parents}
        catch {unset all_roots}
        catch {unset root}
        set includes_to_view ""
    }

    #deletes an entry from string array
    proc DelArrEntry {array n} {
        upvar ${array} arr

        if {! [info exist arr]} {
            set arr ""
        }

        set i [lsearch ${arr} ${n}]
        if {${i} != -1} {
            set arr [lreplace ${arr} ${i} ${i}]
        }
    }

# FIXME: this print stuff needs to go in a common base class !
    method print {} {
        global sn_options tcl_platform
        if {$tcl_platform(platform) == "windows"} {
            ide_print_canvas ${can}
        } else {
            if {${print_dialog} == "" || [itcl::find objects ${print_dialog}]\
              == ""} {
                set print_dialog [PrintDialog $itk_component(hull).printdialog \
                  -leader ${topw} \
                  -modality application \
                  -canvas ${can}\
                  -file [file join $sn_options(profile_dir) include.ps]]
	        $print_dialog transient ${topw}
	        $print_dialog activate
	        itcl::delete object $print_dialog
            } else {
                ${print_dialog} raise
            }
        }
    }

    method Draw_Includes {rot} {
        global sn_options
        if {[info exists inc_drawn(${rot})]} {
            return
        }

        set inc_drawn(${rot}) 1

        set tid [${can} create text 0 0 -text ${rot} -tags [list ${rot} incT\
          inc] -anchor nw -font $sn_options(def,include_font)]

        lappend tids ${tid}

        foreach entry $sons(${rot}) {
            if {${rot} != ${entry}} {
                Draw_Includes ${entry}
            }
        }
    }

    method Draw_Links {} {
        global sn_options
        foreach include [array names parents] {
            if {![info exists inc_drawn(${include})]} {
                continue
            }
            foreach child $parents(${include}) {
                if {[info exists inc_drawn(${child})]} {
                    if {${child} != ${include}} {
                        set tid [${can} create edge -1m -1m -1m -1m -tag\
                          [list child:${child} e:${child} e:${include}\
                          b:${child}:${include} edge] -from [${can} find\
                          withtag ${child}] -to [${can} find withtag\
                          ${include}] -arrow last\
                          -fill $sn_options(def,canv-line-fg)]
                        lappend tids ${tid}
                    }
                }
            }
        }
    }

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

    method mark_item {{incname ""}} {
        global sn_options
        upvar #0 ${can}-marked_edges m_edges

        if {[string compare ${incname} ""] == 0} {
            #select current class
            set id current
            set incname [${can} itemcget ${id} -text]
        } elseif {[string match {[0-9]*} ${incname}]} {
            set id ${incname}
            set incname [${can} itemcget ${id} -text]
        } else {
            #select specified name
            set id [${can} find withtag ${incname}]
        }

        catch {${can} select from ${id} 0}
        catch {${can} select to ${id} end}

        #If the selection is not owned by us we do not
        #want the marking to disappear.
        selection own ${can} " "
        #selection own -command "$this lose_selection $id" $can

        #unmark old position
        catch {${can} itemconfig "e:${m_edges}"\
          -fill $sn_options(def,canv-line-fg)}
        set m_edges ${incname}

        ${can} itemconfig e:${incname} -fill $sn_options(def,tree-select-line)
        ${can} raise e:${incname}

        if {[winfo exists ${can}.w-${incname}]} {
            set relief sunken
        } else {
            set relief raised
        }

        #set the buttons to current configuration
        control_buttons

        if {$itk_option(-selectcommand) != "" && ${oldSelectedFile} != ${incname}} {
            eval $itk_option(-selectcommand) [Selection]
            set oldSelectedFile ${incname}
        }

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

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

        set c ${can}

        set coords [${c} bbox ${id}]

        set x1 [${c} canvasx 0]
        set x2 [${c} canvasx [winfo width ${c}]]
        set y1 [${c} canvasy 0]
        set y2 [${c} canvasy [winfo height ${c}]]
        set enclosed [${c} 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 [${c} configure -scrollregion] 4]

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

            set xoff [expr {double([winfo width ${c}]) / 3}]
            if {[info exists wid]} {
                set pos [expr {double([lindex ${coords} 0] - ${xoff}) / ${wid}}]
                ${c} xview moveto ${pos}
            }

            if {[info exists hei]} {
                set yoff [expr {double([winfo height ${c}]) / 3}]
                set pos [expr {double([lindex ${coords} 1] - ${yoff}) / ${hei}}]
                ${c} yview moveto ${pos}
            }
        }
    }

    method draw_rectangles {can} {
        foreach b [${can} find withtag incT] {
            set geom [${can} bbox ${b}]
            set t [${can} itemcget ${b} -text]
            set id [eval ${can} create rect ${geom} -tags [list boxes ${t}]]
            lappend tids ${id}
        }
    }

    method Redraw {} {

        if {![array exists parents]} {
            return
        }
        ${can} xview moveto 0
        ${can} yview moveto 0

        #delete all drawn widgets in the canvas
        graph ${can} destroy
        ${can} delete all

        catch {unset inc_drawn}

        # unset tids 
        set tids ""

        # Draw the tree
        if {[string compare ${base_root} ""] == 0} {
            foreach entry [array names parents] {
                Draw_Includes ${entry}
            }
        } else {
            foreach entry ${base_root} {
                Draw_Includes ${entry}
            }
        }

        Draw_Links

        set_sorted_order

        set geo [graph_new_layout 0]

        #		draw_rectangles $can
        ${can} raise incT
        #		$can raise edge incT

        set wd [lindex ${geo} 0]
        set he [lindex ${geo} 1]

        #filter include files
        set displayed 0
    }

    method FillValues {} {
        set includes_to_view [lsort -command sn_compare ${includes_to_view}]

        foreach n ${includes_to_view} {
            set parents(${n}) ""
            set sons(${n}) ""
        }

        ReadMaxLevels

        foreach n ${includes_to_view} {
            #append to every include file the included files in this
            FillValuesRec ${n} parents root 1 ${incMaxLevels}
        }
    }

    method FillValuesRec {n parents root level max_levels} {
        upvar ${parents} arr
        upvar ${root} r

        if {! [info exists sons(${n})]} {
            set sons(${n}) ""
        }

        if {[includes ${n}] == ""} {
            set r(${n}) 0
        } else {
            set r(${n}) 0

            # view up to the maximum levels if given
            if {${max_levels} > 0 && ${level} >= ${max_levels}} {
                return
            }