includepane.tcl

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

                #recursive
                show_includes ${tid} [expr ${level} + 1] ${maxlevels}
            }\
            elseif {${eid} != ""} {
                graph ${can} add ${eid}
            }
        }

        #mark_item $sym
    }

    method all_children {can basename name result} {
        upvar ${result} res

        set ids ""

        if {! [info exist sons(${name})] || $sons(${name}) == "" ||\
          [info exist visited(${name})] && $visited(${name}) == 1} {
            return
        }

        set visited(${name}) 1

        foreach n $sons(${name}) {

            #do not delete the original name
            if {${n} == ${basename}} {
                continue
            }

            set ids [${can} find withtag ${n}]

            #delete this include from other parents
            catch {unset inc_drawn(${n})}

            #mark edges from and to the include
            eval lappend ids [${can} find withtag "e:${n}"]

            if {${ids} != ""} {
                eval lappend res ${ids}
            }

            all_children ${can} ${basename} ${n} res

            #delete item from his parents
            if {[info exist parents(${n})]} {
                foreach p $parents(${n}) {
                    DelArrEntry sons(${p}) ${n}
                }
            }
            catch {unset parents(${n})}

            #delete this include from other sons
            #			if { [info exist sons($n)] } {
            #				foreach s $sons($n) {
            #					DelArrEntry parents($s) $n
            #				}
            #			}
            catch {unset sons(${n})}
        }

        #remove the id's from tids
        foreach id ${ids} {
            DelArrEntry tids ${id}
        }
    }

    # This methods deletes the Includes Subtree of an Include
    method removeIncludes {{id ""}} {
        if {${id} == ""} {
            set id [${can} select item]
            if {${id} == ""} {
                return
            }
        }

        set name [${can} itemcget ${id} -text]
        set children_ids ""
        catch {unset visited}
        all_children ${can} ${name} ${name} children_ids
        catch {unset visited}

        if {${children_ids} == ""} {
            return
        }

        eval graph ${can} remove ${children_ids}
        eval ${can} delete ${children_ids}

        graph_new_layout 1

        control_buttons

        see_item ${id}
    }

    method all_parents {can basename name result} {
        upvar ${result} res

        set ids ""

        if {! [info exist parents(${name})] || $parents(${name}) == "" ||\
          [info exist visited(${name})] && $visited(${name}) == 1} {
            return
        }

        set visited(${name}) 1

        foreach n $parents(${name}) {

            #do not delete the original name
            if {${n} == ${basename}} {
                continue
            }

            set ids [${can} find withtag ${n}]

            catch {unset inc_drawn(${n})}

            #mark edges from and to the include
            eval lappend ids [${can} find withtag "e:${n}"]

            if {${ids} != ""} {
                eval lappend res ${ids}
            }
            all_parents ${can} ${basename} ${n} res

            #delete this include from other sons
            if {[info exist sons(${n})]} {
                foreach s $sons(${n}) {
                    DelArrEntry parents(${s}) ${n}
                }
            }
            catch {unset sons(${n})}
            catch {unset parents(${n})}
        }

        #remove the id's from tids
        foreach id ${ids} {
            DelArrEntry tids ${id}
        }
    }
    # This methods deletes the Included_From Subtree of an Include
    method removeIncludedFrom {{id ""}} {
        if {${id} == ""} {
            set id [${can} select item]
            if {${id} == ""} {
                control_buttons
                return
            }
        }
        set name [${can} itemcget ${id} -text]
        set children_ids ""

        catch {unset visited}
        all_parents ${can} ${name} ${name} children_ids
        catch {unset visited}

        if {${children_ids} == ""} {
            return
        }

        eval graph ${can} remove ${children_ids}
        eval ${can} delete ${children_ids}

        graph_new_layout 1

        control_buttons

        see_item ${id}
    }

    method baseroot {} {
        set sel [${can} itemcget [${can} select item] -text]
        if {${sel} == ""} {
            return ${baseroot}
        } else {
            return ${sel}
        }
    }
    method Title {{full 1}} {
        global sn_options
        set t [get_indep String IncludeTree]
        if {${baseroot} != ""} {
            set t "${t}: ${baseroot}"
        }
        if {${full}} {
            return [sn_title ${t}]
        } else {
            return ${t}
        }
    }
    method Icon {} {
        return [sn_view_icon [get_indep String IncludeTree] ${baseroot}]
    }
    method SetTitle {} {
        global sn_options

        set t [sn_title [get_indep String IncludeTree]]
        if {${baseroot} != ""} {
            set t "${t}: ${baseroot}"
            set icon "[get_indep String IncludeTree] ${baseroot}"
        } else {
            set icon [get_indep String IncludeTree]
        }

        ${topw} configure -title ${t} -iconname ${icon}
    }

    #Filter for symbols
    method filter {{all 0}} {
        if {$itk_option(-symbols) == ""} {
            return
        }
# FIMXE: we are accessing a global variable from somewhere, needs fixing.
        upvar #0 $itk_option(-symbols_filter)-related related
        if {${related}} {
            $itk_option(-symbols) configure -contents [::lsort -command sn_compare [array names\
              inc_drawn]]
        } else {
            $itk_option(-symbols) configure -contents [all_includes]
        }
    }

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

    method activate {} {
        #enable menu
        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 MultiInclude] -state normal
        }
        if {$itk_option(-toolbar) != "" && [winfo exists $itk_option(-toolbar)]} {
            pack $itk_option(-toolbar).incbr -side left
        }

        if {$itk_option(-symbols) != ""} {
            $itk_option(-symbols) configure -entrytext ${base_root}
        }

        #always fill combobox by activating
        set displayed 0
    }
    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 MultiInclude] -state disabled
        }
        if {$itk_option(-toolbar) != "" && [winfo exists $itk_option(-toolbar)]} {
            pack forget $itk_option(-toolbar).incbr
        }
    }

    method correct_include {inc} {
        global sn_options sn_sep sn_root
        if {${inc} == ""} {
            return
        }
        #is include availiable ?
        if {[catch {set avail [paf_db_iu seq -first -col 0\
          "${inc}${sn_sep}"]}] || ${avail} == ""} {
            #perhaps it's a .c file
            if {[catch {set avail [paf_db_iu seq -first -col 0 -end ${inc}]}]\
              || ${avail} == ""} {
                #add prefix and try again
                set inc "${sn_root}${inc}"
                if {[catch {set avail [paf_db_iu seq -first -col 0\
                  -strstr "${inc}${sn_sep}"]}] || ${avail} == ""} {
                    return ""
                }
                set inc [lindex ${avail} 0]
            }
        }
        return ${inc}
    }

    #view include relations to a selected string or to
    #a given filename
    method gotosymbol {{scope ""} {sym ""} {cls ""} {file ""} {from ""} {type\
      ""} {prm ""} {to ""} {always 1}} {
        set inc ""
        #selection has more priority !!
        if {${sym} != ""} {
            set inc [correct_include ${sym}]
        }
        if {${inc} == "" && ${file} != ""} {
            set inc [correct_include ${file}]
        }
        if {${inc} == "" || ${inc} == ${baseroot}} {
            return 1
        }
        #disp tree
        view_include ${inc}
        return 1
    }

    method goto {combo inc} {
        #disp tree
        view_include ${inc}
    }

    method Selection {} {
        #set sel [$can itemcget [$can select item] -text]
        set id [${can} select item]
        if {${id} == ""} {
            set id [${can} find withtag current]
        }
        set sel [${can} itemcget ${id} -text]
        if {${sel} != ""} {
            return [list "" "" "" ${sel} "" "" "" ""]
        } else {
            return ""
        }
    }

    method clearselection {} {
        ${can} select clear
    }

    proc ViewInclude {selected} {
        global tkeWinNumber

        set win [MultiWindow&::find_Reusable]
        if {${win} == ""} {
            incr tkeWinNumber
            set win ".multiwindow-${tkeWinNumber}"

            # Create the Include Hierarchy
            MultiWindow& ${win} -raise incbr
        } else {
            ${win} view incbr
        }
        [${win} ActiveWidget] goto "" ${selected}
        #sn_add_history inc  [list $selected]  [sn_make_history_title inc\
          "" $selected]  sn_include
    }

    method Refresh_Display {} {
        global sn_options
        ResetIncludes
        Redisplay
    }

    method Update_Layout {} {
        global sn_options

        ${can} configure -selectforeground $sn_options(def,select-fg)\
          -selectbackground $sn_options(def,select-bg)

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

        graph_new_layout 1
    }

    method Focus {} {
        focus ${can}
    }

    #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 "Include [lindex ${dump} 3]"
    }

    method AddHistoryFromDump {dump title} {
        set file [lindex ${dump} 1]
        sn_add_history inc [list ${file}] [sn_make_history_title inc\
          "" ${file}] sn_include
    }

    #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 whoami {} {
        return incbr
    }

    private variable layoutstyle
    private variable order

    protected variable topw
    protected variable can ""
    protected variable baseroot ""
    protected variable parents
    protected variable sons
    protected variable includes_to_view
    protected variable all_roots
    protected variable tids ""
    protected variable base_root ""
    protected variable root
    #so we can view the include list up to limited tree depth
    protected variable inc_drawn
    #with help this variable can cicyles be detected by searching the tree
    #to hide a node
    protected variable visited
    protected variable oldSelectedFile ""
    protected variable displayed 0

    protected variable ref_to_state "normal"
    protected variable ref_by_state "normal"
    protected variable rem_to_state "normal"
    protected variable rem_by_state "normal"

    common incMaxLevels 2
    common Includes
    common Included_From
    common selected_include ""

    #contains all include files
    common all_includes
    common tag_level ""

    public variable goto ""
    public variable width 640
    public variable height 480

    protected variable print_dialog ""
}

proc sn_include {{file ""}} {
    global Switch_Is_Enabled
    incr Switch_Is_Enabled -1

    Include&::ViewInclude ${file}

    incr Switch_Is_Enabled
}