xrefpane.tcl

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

            set from [lindex ${data} 1]
            set to [lindex ${data} 2]
            set scope [lindex ${data} 3]

        } else {
            set target [split ${target} \t]

            set file [lindex ${target} 4]
            set from [lindex ${target} 5]
            set to [lindex ${target} 6]
            get_key_and_scope [lindex ${target} 0] x scope
        }

        set class [lindex ${target} 1]
        set type [lindex ${target} 2]
        set param [lindex ${target} 3]
        set param [string range ${param} 1 end]
        if {${param} != ""} {
            set len [string length ${param}]
            set param [string range ${param} 0 [expr ${len} - 2]]
        }
        if {${class} == ""} {
            set class "#"
        }

        set line $xinfos(${id})
        set line [lreplace ${line} ${class1_pos} ${class1_pos} ${class}]
        set line [lreplace ${line} ${what1_pos} ${what1_pos} ${scope}]
        set line [lreplace ${line} ${file1_pos} ${file1_pos} ${file}]
        set line [lreplace ${line} ${range1_from} ${range1_from} ${from}]
        set line [lreplace ${line} ${range1_to} ${range1_to} ${to}]
        set line [lreplace ${line} ${type1_pos} ${type1_pos} ${type}]
        set line [lreplace ${line} ${param1_pos} ${param1_pos} ${param}]


        set item [lindex ${line} ${item1_pos}]
        if {${class} != "#"} {
            set tx [string trim "${item}(${scope}) ${class}"]
        } else {
            set tx [string trim "${item}(${scope})"]
        }

        #change the old displayed text to the correct new text
        ${can} itemconfig ${id} -text " ${tx}"

        #reset xinfos for the new changes
        set xinfos(${id}) ${line}

        #rebind tags accepting the new futures
        rebind_tags ${id}

        #rebind info help with the new text
        bind_text_for_balloon ${id} rebind

        graph_new_layout 1

        #reselect the item
        catch {
            ${can} select from ${id} 0
            ${can} select to ${id} end
        }
    }

    method read_references {ref line {uniq 1} {have 0}} {
        global sn_options sn_sep
        set scope [lindex ${line} ${what1_pos}]
        set name [lindex ${line} ${item1_pos}]

        #not all scopes can have references to, we don't
        #need to continue
        if {${name} == "" || ${ref} == "to" && [lsearch\
          -exact ${scopes_with_ref_to} ${scope}] == -1} {
            return ""
        }
        if {${accept_param}} {
            #get parameter list from line
            if {[string first ${scope} ${scopes_with_parameters}] != -1} {
                set param [lindex ${line} ${param1_pos}]
                set prm [list "=${param}"]
            } else {
                set prm [list "|"]
            }
            if {${ref} == "to"} {
                #verify if we have data informations, data informations are\
                  usefull
                #to localize the item position
                set file [lindex ${line} ${file1_pos}]
                if {${file} != ""} {
                    set fl [list "=${file}"]
                    #get the line number from format (ll.cc ==> ll)
                    set from [lindex ${line} ${range1_from}]
                    if {${from} != -1} {
                        set from [string trimleft [lindex [split ${from} .] 0]\
                          0]
                    }
                    set to [lindex ${line} ${range1_to}]
                    if {${to} != -1} {
                        set to [string trimleft [lindex [split ${to} .] 0] 0]
                    }
                    if {${from} == "" || ${from} < 0} {
                        set from 0
                    }
                    if {${to} == "" || ${to} < 0} {
                        set to 100000000
                    }
                    set FromTo [list "-${from}:${to}"]
                } else {
                    set fl [list "|"]
                    set FromTo "|"
                }
            } else {
                set fl [list "|"]
                set FromTo "|"
            }
        } else {
            set fl [list "|"]
            set FromTo "|"
            set prm [list "|"]
        }

        set symbol "[lindex ${line}\
          ${class1_pos}]${sn_sep}${name}${sn_sep}${scope}${sn_sep}"

        #fetch the references from the database.
        #format:
        #0: class or "#" by no class members
        #1: symbol
        #2: what
        #3: Parameter
        #4: reference art (r, w, p, u)
        #5: file
        #6: File position (line number)

        if {[info commands paf_db_${ref}] == ""} {
            return ""
        }
        set total [paf_db_${ref} seq -uniq -updatecommand\
          "${this} update_db_fetching" -col [list 4 3 5 10 6 "8 ${fl}"\
          "7 ${FromTo}" "9 ${prm}"] ${symbol}]

        #by 'have', we don't need to sort the readed data
        if {${have}} {
            return [cross_services "" filter ${total} ${ref} ${line} ${uniq}\
              ${have} ${accept_param} ${accept_static} ${cross_shown_scopes}\
              ${cross_ref_access}]
        } else {
            return [cross_services "" filter [::lsort -command sn_compare\
              ${total}] ${ref} ${line} ${uniq} ${have} ${accept_param}\
              ${accept_static} ${cross_shown_scopes} ${cross_ref_access}]
        }
    }

    method explore_calls {{id ""}} {
        upvar #0 ${this}-MaxLevels MaxLevels

	# Check that MaxLevels is a valid
	# numeric expression. (It still might
	# not be a valid level value.)

	if {[catch {expr $MaxLevels - 1}] == 1} {
	    set MaxLevels 1
	}

        if {[sn_processes_running]} {
            bell
            return
        }

        if {${id} == ""} {
            set id [${can} select item]
            if {${id} == ""} {
                return
            }
        }

        # Process is already running.
        if {![cancel_Button_State normal]} {
            bell
            return
        }

        #remove old entries
        remove ${id}

        #add references to
        set to [${can} find withtag to%${id}]
        set have [read_references to $xinfos(${id}) 1 1]
        if {${have} != "" && ${to} == ""} {
            show_calls to ${id} ${MaxLevels}
        }
        #add references by
        set by [${can} find withtag by%${id}]
        if {${by} == ""} {
            set have [read_references by $xinfos(${id}) 1 1]
            if {${have} != ""} {
                show_calls by ${id} ${MaxLevels}
            }
        }

        graph_new_layout 1

        cancel_Button_State disabled
    }

    method show_calls {ref id {level 0}} {
        global sn_options
        upvar #0 ${this}-MaxLevels MaxLevels

        if {[sn_processes_running]} {
            bell
            return
        }

        #displaying Xref is canceled by user
        update
        if {${fetching_canceled}} {
            return
        }

        set line $xinfos(${id})

        #get range and file name of the item name
        if {${ref} != "by" && [lindex ${line} ${what1_pos}] != "ud" &&\
          [lindex ${line} ${range1_from}] == ""} {
            set line [get_item_range ${ref} ${id} ${level}]
            if {${line} == ""} {
                return "-1"
            }
            bind_text_for_balloon ${id} rebind
            if {${line} == ""} {
                set line $xinfos(${id})
            }
        }

        set total [read_references ${ref} ${line}]
        set edges ""
        foreach ent ${total} {
            #merge equivalent lines
            set scope [lindex ${ent} ${what1_pos}]
            set class [lindex ${ent} ${class1_pos}]
            set item [lindex ${ent} ${item1_pos}]
            set rart [lindex ${ent} ${refart_pos}]

            if {${class} != "#"} {
                set tx " [string trim "${rart} ${item}(${scope}) ${class}"]"
            } else {
                set tx " [string trim "${rart} ${item}(${scope})"]"
            }

            if {${disp_param}} {
                if {[lsearch -exact ${scopes_with_parameters} ${scope}] != -1} {
                    set prm "([lindex ${ent} ${param1_pos}])"
                }\
                elseif {${scope} == "ud"} {
                    set prm "([lindex ${ent} ${param1_pos}])"
                    if {${prm} == "()"} {
                        set prm ""
                    }
                } else {
                    set prm ""
                }
                set tx " [string trim "[lindex ${ent}\
                  ${type1_pos}]${tx}${prm}"]"
            }

            #verify if the function has references
            #set font $sn_options(def,xref-branch-font)
            #set fill "-fill $sn_options(def,xref-branch-fg)"
            set font $sn_options(def,xref-font)

            #create the texts so that the text is not shown
            #in the canvas, because the texts are then shown
            #over each other
            set tid [${can} create text -50 -50 -text ${tx} -anchor nw\
              -font ${font}]

            ${can} itemconfig ${tid} -tags "sym ${ref}% ${ref}%${id}"

            #draw text and edges
            if {${ref} == "to"} {
                set eid [${can} create edge -1m -1m -1m -1m -tag\
                  "edge_to to%${id} edge%${tid}" -from ${id} -to ${tid}\
                  -arrow last -fill $sn_options(def,canv-line-fg)]
            } else {
                set eid [${can} create edge -1m -1m -1m -1m -tag\
                  "edge_by by%${id} edge%${tid}" -from ${id} -to ${tid}\
                  -arrow first -fill $sn_options(def,xref-used-by-fg)]
            }

            set xinfos(${tid}) ${ent}
            bind_text_for_balloon ${tid}

            lappend edges ${tid} ${eid}

            #if the symbol have references to "ref" then view it's references
            #when the levels are more than one.
            if {${level} > 1} {
                if {(${ref} == "to" && [read_references to ${ent} 0 1] !=\
                  "" || ${ref} == "by" && [read_references by ${ent} 0 1] !=\
                  "")} {
                    show_calls ${ref} ${tid} [expr ${level} - 1]
                }
            }
        }
        if {${edges} != ""} {
            graph ${can} add ${edges}
        }
        return ${edges}
    }

    method edit_location {w y} {
        set line [${w} get [${w} nearest ${y}]]
        set len [llength ${line}]
        incr len -1
        set file [lindex ${line} ${len}]
        incr len -1
        set lnum [string trimleft [lindex ${line} ${len}] "0"]
        if {$itk_option(-selectcommand) != ""} {
            eval $itk_option(-selectcommand) [list "" "" "" ${file} ${lnum}]
        } else {
            sn_edit_file dummy ${file} ${lnum} 0
        }
    }

    method values {} {
        return ${base_root}
    }

    method mark_item {{item ""} {exec 1}} {
        if {[sn_processes_running]} {
            bell
            return
        }

        if {[string compare ${item} ""] == 0} {
            set id [${can} find withtag current]
            set item [${can} itemcget ${id} -text]
        } else {
            set id [${can} find withtag ${item}]
        }

        if {${id} == ""} {
            return
        }

        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} " "

        control_buttons

        #handle select command
        if {${exec} && $itk_option(-selectcommand) != ""} {
            eval $itk_option(-selectcommand) [Selection]
        }

        if {$itk_option(-symbols) != ""} {
            if {[string first " " ${item}] == 0} {
                $itk_option(-symbols) selecttext [string trim ${item}]
            } else {
                $itk_option(-symbols) selecttext [lrange ${item} 1 end]
            }
        }

        return [list ${item} ${id}]
    }

    method control_buttons {{id ""}} {
        if {[::info commands paf