xrefpane.tcl

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

            if {$itk_option(-menu) != "" && [winfo exists $itk_option(-menu)]} {
                $itk_option(-menu) entryconfig [get_indep String CrfRefBy] -state disabled
            }
            if {$itk_option(-toolbar) != ""} {
                ${exp}.ref_by config -state disabled
            }
        }

        # Show referencies to.
        if {${ret} != "-1" && [lsearch ${type} "to"] != -1} {
            show_calls to ${id} ${MaxLevels}
            if {$itk_option(-menu) != "" && [winfo exists $itk_option(-menu)]} {
                $itk_option(-menu) entryconfig [get_indep String CrfRefTo] -state disabled
            }
            if {$itk_option(-toolbar) != ""} {
                ${exp}.ref_to config -state disabled
            }
        }

        # This is a workaround for 'tree'.
        ${can} delete %boxes%

        # Reset cancel variable
        cancel_Button_State disabled

        graph_new_layout 1

        control_buttons

        see_item ${id}
    }

    # This function assures that the item will be on the screen.
    method see_item {{id ""}} {
        if {${id} == ""} {
            set id [${can} select item]
            if {${id} == ""} {
                return
            }
        }
        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]

            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 ${c}]) / 3]
            set pos [expr double([lindex ${coords} 0] - ${xoff}) / ${wid}]
            ${c} xview moveto ${pos}

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

    proc draw_rectangles {can {draw 1}} {
        if {!${draw}} {
            return
        }
        foreach b [${can} find withtag sym] {
            set geom [${can} bbox ${b}]
            set y [expr [lindex ${geom} 1] - 2]
            set geom [lreplace ${geom} 1 1 ${y}]
            eval ${can} create rect ${geom} -tags %boxes%
        }
    }

    method bind_text_for_balloon {id {rebind ""}} {
        set class [lindex $xinfos(${id}) ${class1_pos}]
        set what [lindex $xinfos(${id}) ${what1_pos}]
        set file [lindex $xinfos(${id}) ${file1_pos}]
        set refart [lindex $xinfos(${id}) ${refart_pos}]
        set item " [lindex $xinfos(${id}) ${item1_pos}]"
        set param "([lindex $xinfos(${id}) ${param1_pos}])"
        set type [join [lindex $xinfos(${id}) ${type1_pos}]]

        if {${class} == "#"} {
            set class ""
        }
        if {${class} != ""} {
            set class " ${class}"
        }
        if {${type} != ""} {
            set type " ${type}"
        }
        #we accept for unknown symbols none empty parameter list
        #when an unknown symbol have empty parameter list, delete the
        #"()" from the parameter list.
        if {${what} != "ud" && [lsearch -exact ${scopes_with_parameters}\
          ${what}] == -1} {
            set param ""
        }\
        elseif {${what} == "ud" && ${param} == "()"} {
            set param ""
        }
        if {${param} != ""} {
            set param " ${param}"
        }
        if {${file} != ""} {
            set file " ${file}"
        }
        if {${refart} != ""} {
            set refart " ${refart}"
        }
        if {${param} != ""} {
            set param " ${param}"
        }

        set txt "${type}${class}${item}(${what})${param}${refart}${file}"

        if {${rebind} == ""} {
            canvas_bind_info ${can} ${id} ${txt}
        } else {
            canvas_rebind_info ${can} ${id} ${txt}
        }
    }

    #if level not equal ziro, don't view choose window
    method get_item_range {ref id {level 0}} {
        global sn_options sn_sep tkeWinNumber
        global ${this}-Wait
        upvar #0 ${this}-MaxLevels MaxLevels

        set line $xinfos(${id})
        set scope [lindex ${line} ${what1_pos}]
        set file [lindex ${line} ${file_pos}]
        set param [lindex ${line} ${param1_pos}]
        set cls [lindex ${line} ${class1_pos}]
        set sym [lindex ${line} ${item1_pos}]

        #localize the item to reference/edit
        while {1} {
            if {[lsearch -exact ${types_with_classes} ${scope}] != -1} {
                set key [string trim "${cls}${sn_sep}${sym}" " ${sn_sep}"]
                if {[::info commands paf_db_${scope}] != ""} {
                    set total [paf_db_${scope} seq -uniq -col {2 3 4 6 7}\
                      "${key}${sn_sep}"]
                } else {
                    set total ""
                }
            } else {
                set key [string trim ${sym}]
                if {[::info commands paf_db_${scope}] != ""} {
                    set total [paf_db_${scope} seq -uniq -col {1 2 3 5 6}\
                      "${key}${sn_sep}"]
                } else {
                    set total ""
                }
            }

            #if result is empty, it can be a function or method with
            #declaration only
            if {${total} == "" && [lsearch -exact {mi fu} ${scope}] != -1} {
                switch ${scope} {
                    "mi" {
                            set scope "md"
                        }
                    "fu" {
                            set scope "fd"
                        }
                    default {
                            break
                        }
                }
            } else {
                break
            }
        }

        #pick up a function in the same file as reference
        #this has the biggest priority
        foreach l ${total} {
            set prm [lindex ${l} 4]
            if {${file} == [lindex ${l} 1] && ${prm} == ${param}} {
                set line [lreplace ${line} ${range1_from} ${range1_from}\
                  [lindex ${l} 0]]
                set line [lreplace ${line} ${range1_to} ${range1_to}\
                  [lindex ${l} 2]]
                set line [lreplace ${line} ${file1_pos} ${file1_pos}\
                  [lindex ${l} 1]]
                set line [lreplace ${line} ${type1_pos} ${type1_pos}\
                  [lindex ${l} 3]]
                set xinfos(${id}) ${line}
                return ${line}
            }
        }

        #it can be more than one item availiable
        set cnt 0
        foreach l ${total} {
            set type [lindex ${l} 3]
            set prm [lindex ${l} 4]
            if {${prm} == ${param}} {
                incr cnt
                if {${cnt} == 1} {
                    set ll ${l}
                }\
                elseif {${cnt} > 1} {
                    break
                }
            }
        }

        #we have only one match, return it
        if {${cnt} == 1 || ${cnt} > 1 && ${level} != ${MaxLevels}} {
            set line [lreplace ${line} ${range1_from} ${range1_from}\
              [lindex ${ll} 0]]
            set line [lreplace ${line} ${range1_to} ${range1_to} [lindex ${ll}\
              2]]
            set line [lreplace ${line} ${file1_pos} ${file1_pos} [lindex ${ll}\
              1]]
            set line [lreplace ${line} ${type1_pos} ${type1_pos} [lindex ${ll}\
              3]]
            set xinfos(${id}) ${line}
            return ${line}

            #we have more than one match, retrieve one match
        }\
        elseif {${cnt} > 1} {

            incr tkeWinNumber
            set win "crossidentifyretriever-${tkeWinNumber}"

            #we use now a class
            Retriever& ${win} -pattern ${key} -what ${scope} -param ${param}\
              -titlename [get_indep String CrossRetriever]\
              -client_func "${this} recall_show_calls" -client_data\
              [list ${ref} ${id}] -terminate 1 -merge {{md mi} {fd fu}\
              {fr fu}} -variable ${this}-Wait -bell 0
            itcl::delete object ${win}
            return $xinfos(${id})
        }

        #there is no symbol matched the availiable parameters
        #pick up the first item, if there is only one item
        set len [llength ${total}]
        if {${total} != "" && ${len} == 1 || ${len} > 1 && ${level} !=\
          ${MaxLevels}} {
            set l [lindex ${total} 0]
            set line [lreplace ${line} ${range1_from} ${range1_from}\
              [lindex ${l} 0]]
            set line [lreplace ${line} ${range1_to} ${range1_to} [lindex ${l}\
              2]]
            set line [lreplace ${line} ${file1_pos} ${file1_pos} [lindex ${l}\
              1]]
            set line [lreplace ${line} ${type1_pos} ${type1_pos} [lindex ${l}\
              3]]
            set line [lreplace ${line} ${param1_pos} ${param1_pos}\
              [lindex ${l} 4]]
            set xinfos(${id}) ${line}
        }\
        elseif {${total} != "" && ${level} == ${MaxLevels}} {
            incr tkeWinNumber
            set win "crossidentifyretriever-${tkeWinNumber}"
            Retriever& ${win} -pattern ${key} -what ${scope} -param ""\
              -merge {{md mi} {fd fu} {fr fu}} -titlename [get_indep String\
              CrossRetriever] -client_func "${this} recall_show_calls"\
              -client_data [list ${ref} ${id}] -terminate 1\
              -variable ${this}-Wait -bell 0
            set ret [${win} return_status]
            itcl::delete object ${win}
            if {${ret} != 0} {
                return ""
            }
            return $xinfos(${id})

            #we don't find any thing about the item
            #search any item in the database
        }\
        elseif {${level} == ${MaxLevels}} {
            incr tkeWinNumber
            set win "crossidentifyretriever-${tkeWinNumber}"
            Retriever& ${win} -pattern ${key} -what all -merge {{md mi}\
              {fd fu} {fr fu}} -titlename [get_indep String CrossRetriever]\
              -client_func "${this} recall_show_calls" -client_data\
              [list ${ref} ${id}] -terminate 1 -variable ${this}-Wait -bell 0
            set ret [${win} return_status]
            itcl::delete object ${win}
            if {${ret} == 0} {
                #find pattern without merging fu=fd and mi=md
                Retriever& ${win} -pattern ${key} -what all\
                  -titlename [get_indep String CrossRetriever]\
                  -client_func "${this} recall_show_calls" -client_data\
                  [list ${ref} ${id}] -terminate 1 -variable ${this}-Wait\
                  -bell 0
                set ret [${win} return_status]
                itcl::delete object ${win}
                if {${ret} != 0} {
                    return ""
                }
            }
            return $xinfos(${id})
        }
        return ${line}
    }

    #given is a list of tags, show if 'tags' already contains the
    #tag text saved by 'tag', if yes, return the fully tag name
    #empty else.
    proc store_tags {tags tag} {
        set i [string first ${tag} ${tags}]
        if {${i} != -1} {
            incr i
            set rest [string range ${tags} ${i} end]
            set j [string first ${rest} " "]
            if {${j} == -1} {
                set j [string length ${rest}]
            }
            set in [string range ${tags} ${i} ${j}]
        } else {
            set in ""
        }
        return ${in}
    }

    #if we have an unknown symbol and we changed it with an known
    #we must rebin the tags to this symbol to fit to the state
    # of the new symbol
    method rebind_tags {id} {
        set have_to [read_references to $xinfos(${id}) 0 1]
        if {${have_to} != ""} {
            set have_to "have_to%${id}"
        } else {
            set have_to ""
        }
        set have_by [read_references by $xinfos(${id}) 0 1]
        if {${have_by} != ""} {
            set have_by "have_by%${id}"
        } else {
            set have_by ""
        }
        set tags [${can} itemcget ${id} -tags]
        set in_to [store_tags ${tags} " to%"]
        set in_by [store_tags ${tags} " by%"]

        if {${id} == ${root}} {
            set rt "%root%"
        } else {
            set rt ""
        }

        ${can} itemconfig ${id} -tags [string trim "${rt} sym ${in_to}\
          ${in_by}"]
    }

    #this function is called by retriever to identify current symbol
    #status. It's set the new informations to the symbol and display it
    #in the canvas.
    method recall_show_calls {w {target ""} {client_data ""}} {
        set ref [lindex ${client_data} 0]
        set id [lindex ${client_data} 1]

        #get selected item
        if {${w} != ""} {
            if {[catch {set sel [${w} curselection]}] || ${sel} == ""} {
                return
            }
            set target [${w} get [lindex ${sel} 0]]
            set data [${w} itemcget [lindex ${sel} 0] -data]

            set target [split ${target} \t]

            set data [split ${data} \t]
            set file [lindex ${data} 0]