xrefpane.tcl

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

        if {$tcl_platform(platform)=="windows"} {

            ide_print_canvas ${can}
        } else {

            if {${print_dialog} == "" || [itcl_info objects ${print_dialog}]\
              == ""} {
                set print_dialog [PrintDialog $itk_component(hull).printdialog \
                  -leader ${topw} \
                  -modality application \
                  -canvas ${can} \
                  -file [file join $sn_options(profile_dir) xref.ps]]
	        $print_dialog transient ${topw}
	        $print_dialog activate
	        itcl::delete object $print_dialog
            } else {
                ${print_dialog} raise
            }
        }
    }

    # This proc takes the name of the scope from the input name.
    # There are two possibilities: 'symbol(scope)' or 'scope symbol'.
    # If the input is a canvas item, the scope is the first element in the name.
    method XRefEdit {} {
        upvar #0 ${this}-MaxLevels MaxLevels

        set id [${can} select item]
        if {${id} == "" || ![info exists xinfos(${id})]} {
            return
        }

        #if we have information about the localization of the
        #item to edit it, goto it's localization, otherwise
        #search for function with the KNOWN type and parameters
        set line $xinfos(${id})

        #get range and file name of the item name
        if {[lindex ${line} ${range1_from}] == ""} {
            set line [get_item_range "" ${id} ${MaxLevels}]
            if {${line} == ""} {
                set line $xinfos(${id})
            }
            bind_text_for_balloon ${id} rebind
        }

        set key [lindex ${line} ${item1_pos}]
        set class [lindex ${line} ${class1_pos}]
        set scope [lindex ${line} ${what1_pos}]
        set file [lindex ${line} ${file1_pos}]
        set from [lindex ${line} ${range1_from}]
        if {${class} == "#"} {
            set class ""
        }
        set name [string trim "${class} ${key}"]

        #goto the file directly, without searching
        if {${file} != ""} {
            sn_edit_file [list 0 ${name} ${scope}] ${file} ${from} 0
            #sn_add_history $scope  [list $scope $name 0 $file] \
              [sn_make_history_title edit $scope "$class $key"]
        } else {
            bell
        }
    }

    method handle_doubleclick {can} {
        if {[sn_processes_running]} {
            bell
            return
        }
        if {$itk_option(-doubleclickcommand) != ""} {
            eval $itk_option(-doubleclickcommand) [Selection]
        } else {
            XRefEdit
        }
    }

    method convert_data_to_line {id} {
        set data $xinfos(${id})
        set class [lindex ${data} ${class1_pos}]
        if {${class} == "#"} {
            set class ""
        }
        set line "[lindex ${data} ${item1_pos}]([lindex ${data}\
          ${what1_pos}])\t${class}\t[lindex ${data} ${type1_pos}]\t([lindex\
          ${data} ${param1_pos}])\t[lindex ${data} ${file1_pos}]\t[lindex\
          ${data} ${range1_from}]\t[lindex ${data} ${range1_to}]"
        return ${line}
    }

    method make_line_to_info {id} {
        set to_num [expr [llength [${can} find withtag to%${id}]] / 2]
        set by_num [expr [llength [${can} find withtag by%${id}]] / 2]

        set ent $xinfos(${id})
        set scope [lindex ${ent} ${what1_pos}]
        set class [lindex ${ent} ${class1_pos}]
        set item [lindex ${ent} ${item1_pos}]

        if {${class} != "#"} {
            set txt " [string trim "${class}\:\:${item}(${scope})"]"
        } else {
            set txt " [string trim ${item}(${scope})]"
        }
        if {${scope} == "ud"} {
            set prm "[lindex ${ent} ${param1_pos}]"
        } else {
            set prm ""
        }
        if {[lsearch -exact ${scopes_with_parameters} ${scope}] != -1} {
            set prm "([lindex ${ent} ${param1_pos}])"
        }\
        elseif {${scope} == "ud" && ${prm} != ""} {
            set prm "(${prm})"
        }
        set txt [string trim "[lindex ${ent} ${type1_pos}] ${txt} ${prm}"]
        return "[get_indep String XReferences]: \[${to_num}, ${by_num}\],\
          ${txt}"
    }

    method convert_line_to_data {line data} {
        set ll [split ${line} \t]
        set item [lindex ${ll} 0]
        set class [lindex ${ll} 1]
        set type [lindex ${ll} 2]
        set param [lindex ${ll} 3]
        set file [lindex ${ll} 4]
        set from [lindex ${ll} 5]
        set to [lindex ${ll} 6]

        if {${class} == ""} {
            set class "#"
        }

        get_key_and_scope ${item} item scope

        set param [string range ${param} 1 end]
        if {${param} != ""} {
            set len [string length ${param}]
            set param [string range ${param} 0 [expr ${len} - 2]]
        }

        if {${data} != ""} {
            set data [split ${data} \t]
            set file [lindex ${data} 0]
            set from [lindex ${data} 1]
            set to [lindex ${data} 2]
        }

        #init linfo with empty strings
        for {set i 0} {${i} < ${line_arg_count}} {incr i} {
            lappend linfo ""
        }
        set linfo [lreplace ${linfo} ${class1_pos} ${class1_pos} ${class}]
        set linfo [lreplace ${linfo} ${item1_pos} ${item1_pos} ${item}]
        set linfo [lreplace ${linfo} ${what1_pos} ${what1_pos} ${scope}]
        #root haven't ref. file
        set linfo [lreplace ${linfo} ${file_pos} ${file_pos} ""]
        set linfo [lreplace ${linfo} ${param1_pos} ${param1_pos} ${param}]
        set linfo [lreplace ${linfo} ${range1_from} ${range1_from} ${from}]
        set linfo [lreplace ${linfo} ${range1_to} ${range1_to} ${to}]
        set linfo [lreplace ${linfo} ${file1_pos} ${file1_pos} ${file}]
        set linfo [lreplace ${linfo} ${type1_pos} ${type1_pos} ${type}]
        return ${linfo}
    }

    protected variable fetching_canceled 0
    common fetching_active 0
    protected variable this_fetching 0
    #this pocedure is called from the db-process to
    #verify if the user has canceled the process.
    #is db-fetching canceled??
    method update_db_fetching {} {
        #dispatch events
        update
        update idletasks
        update
        if {${fetching_canceled}} {
            return 0
        } else {
            return 1
        }
    }

    protected variable Cancel_Dialog_Id 0
    method Delete_Cancel_Dialog {} {
        catch {after cancel ${Cancel_Dialog_Id}}
        catch {destroy ${this}.wait_dlg}
        update idletasks
    }

    method Display_Cancel_Dialog {} {
        catch {sn_wait_dialog ${this} [get_indep String WaitOrCancelXRef]\
          [Title 0] "${this} cancel_fetching"}
        update idletasks
    }

    method enable_cancel {state} {
        catch {$itk_option(-toolbar).xref.cancel config -state ${state}}
    }

    #two functions:
    #A. cancel displaying the Xref information, also db-fetching
    #B. cancel xref-generation
    method cancel_fetching {} {
        #cancel xref-generation
        if {[sn_processes_running]} {
            xref_cancel
            return
        }
        set fetching_canceled 1
        update
        update idletasks
        update
    }

    method cancel_Button_State {state} {

        if {${state} == "normal"} {

            if {${fetching_active}} {
                # Fetch-process is active (project wide)!!
                sn_error_dialog [get_indep String CannotProceed] [Title 0]
                return 0
            }

            # Disable fetching for the hole project.
            incr fetching_active

            # We will block the GUI until processing is over.
            tixBusy $itk_component(hull) on

            # Current window busy.
            incr this_fetching

            # Display a wait-cancel dialog box.
            set Cancel_Dialog_Id [after 500 "${this} Display_Cancel_Dialog"]
        } else {
            # Reenable fetching for cross-reference.
            incr fetching_active -1

            # Where finished, release the GUI back to the user.
            tixBusy $itk_component(hull) off

            # Current window is idle.
            incr this_fetching -1

            # Delete dialog window, if active.
            Delete_Cancel_Dialog
        }

        set fetching_canceled 0

        if {[winfo exists $itk_option(-toolbar).xref.cancel]} {
            catch {${toolbar}.xref.cancel config -state ${state}}
            update idletasks
        }

        # We can continue with fetching.
        return 1
    }

    method references {type {id ""} {line ""} {data ""}} {
        global sn_options
        upvar #0 ${this}-layoutstyle layoutstyle
        upvar #0 ${this}-MaxLevels MaxLevels

        # If dbimp active, cancel
        if {[sn_processes_running]} {
            bell
            return
        }

        # No cross reference availiable.
        if {[::info commands paf_db_to] == ""} {
            return
        }

        # 'both' <==> 'to' and 'by'
        if {${type} == "both"} {
            set type [list to by]
        }

        switch -glob ${id} {
            {[0-9]*} {
                    set sym [${can} itemcget ${id} -text]
                    set sym [lindex ${sym} end]
                }
            {} {
                    set id [${can} select item]
                    if {${id} == ""} {
                        return
                    }
                }
            default {

                    # Delete OLD ENTRIES.
                    ${this} clear

                    # It doesn't exist we create it.

                    set info [convert_line_to_data ${line} ${data}]

                    set class [lindex ${info} ${class1_pos}]
                    if {${class} == "#"} {
                        set class ""
                    }
                    set key [lindex ${info} ${item1_pos}]
                    set what [lindex ${info} ${what1_pos}]
                    set rart [lindex ${info} ${refart_pos}]
                    set text [string trim "${rart} ${key}(${what}) ${class}"]
                    set lbl ${text}

                    if {${what} == ""} {
                        set what "?"
                    }

                    if {${disp_param} && [lsearch\
                      -exact ${scopes_with_parameters} ${what}] != -1} {
                        set text " [string trim "[lindex ${info} ${type1_pos}]\
                          ${text}([lindex ${info} ${param1_pos}])"]"
                    }

                    set fill ""
                    set font $sn_options(def,xref-font)

                    set id [eval [list ${can} create text -1000 -1000 -text\
                      " ${text}" -anchor nw -font ${font}] ${fill}]

                    # Set tags for the ID and NOT for symbol name.
                    ${can} itemconfig ${id} -tags "sym %root% root%${id} to%"

                    # Store information about the item from the given line
                    # information.
                    set xinfos(${id}) ${info}
                    bind_text_for_balloon ${id}

                    ${can} delete %boxes%
                    graph ${can} add ${id}

                    set root ${id}

                    # Add item to history
                    #set ref_root_sym $text
                    #regsub -all {[ ]+} $ref_root_sym {} ref_root_sym
                    if {${class} != ""} {
                        set member "${class}\:\:${key}"
                    } else {
                        set member ${key}
                    }
                    #set data [list $type $member $what [lindex $info\
                      $file1_pos] [lindex $info $range1_from] [lindex $info\
                      $range1_to]]
                    #sn_add_history xref $data [sn_make_history_title xref\
                      $what "$class $key"]

                    upvar #0 ${this}-root_symbol_entry root_symbol_entry
                    set root_symbol_entry ${lbl}
                }
        }

        # Enable cancel button, be sure that no other
        # process is already running.
        if {![cancel_Button_State normal]} {
            bell
            return
        }

        set ret ""
        # Show referencies by.
        if {[lsearch ${type} "by"] != -1} {
            set ret [show_calls by ${id} ${MaxLevels}]