xrefpane.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.
# 
# multixref.tcl - Cross-referencing view that can be opened in any subwindow.
# Copyright (C) 1998 Cygnus Solutions.

itcl::class XRef& {

    inherit sourcenav::MultiChild

    constructor {args} {
        global sn_options

        set class [${this} info class]
        set bg [$itk_component(hull) cget -background]

        set can $itk_component(hull).can


	eval itk_initialize $args
# FIXME: global variable hacks need to be removed!
        #order & layout
        global ${this}-order
        global ${this}-layoutstyle
        set ${this}-order $sn_options(def,xref-disp-order)
        set ${this}-layoutstyle $sn_options(def,xref-layout)

        #init cross reference scopes, as example 'mi' not 'md', 'fu' not 'fd'
        set cross_scopes "cl ec fd fu gv iv ma mi t ud"
        foreach sc {con cov su} {
            if {[::info commands paf_db_${sc}] != ""} {
                lappend cross_scopes con cov su
                break

            }
        }
        if {${cross_shown_scopes} == ""} {
            set cross_shown_scopes [paf_db_proj get -key cross_shown_scopes]
            set cross_ref_access [paf_db_proj get -key cross_ref_access]
        }
        if {${cross_shown_scopes} == ""} {
            set cross_shown_scopes "cl con cov ec e fu fd gv iv ma mi md lv su\
              t ud p r u w"
            set cross_ref_access "p r u w"
        }

        set topw [winfo toplevel $itk_component(hull)]

        #when the cross reference is called without toolbar, MaxLevels
        #will be not defined.
        uplevel #0 "set ${this}-MaxLevels 1"

        #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 TakeRoot]\
              -state disabled -underline [get_indep Pos TakeRoot] -command "${this} make_selection_to_root"
            $itk_option(-menu) add command -label [get_indep String PafCrossToDetail]\
              -state disabled -underline [get_indep Pos PafCrossToDetail]\
              -command "${this} xbrowse to"
            $itk_option(-menu) add command -label [get_indep String PafCrossByDetail]\
              -state disabled -underline [get_indep Pos PafCrossByDetail]\
              -command "${this} xbrowse by"
            $itk_option(-menu) add command -label [get_indep String CrfRefTo]\
              -underline [get_indep Pos CrfRefTo] -state disabled -command\
              " ${this} references to "
            $itk_option(-menu) add command -label [get_indep String CrfRefBy]\
              -underline [get_indep Pos CrfRefBy] -command " ${this}\
              references by " -state disabled
            $itk_option(-menu) add command -label [get_indep String CrfRemSubN]\
              -underline [get_indep Pos CrfRemSubN] -command "${this} remove" -state disabled
            $itk_option(-menu) add separator
            $itk_option(-menu) add command -label [get_indep String XRefFilter]\
              -underline [get_indep Pos XRefFilter] -command "[info class]::xref_filter"
            $itk_option(-menu) add separator
            $itk_option(-menu) add checkbutton -label [get_indep String CrossAcceptParam]\
              -underline [get_indep Pos CrossAcceptParam]\
              -variable ${this}-accept_param -command " ${this} toggle_param m "
            $itk_option(-menu) add checkbutton -label [get_indep String\
              CrossAcceptStatic] -underline [get_indep Pos CrossAcceptStatic]\
              -variable ${this}-accept_static -command " ${this} toggle_static\
              m "
            $itk_option(-menu) add checkbutton -label [get_indep String CrossDispParam]\
              -underline [get_indep Pos CrossDispParam]\
              -variable ${this}-disp_param -command " ${this}\
              toggle_disp_param m "
            $itk_option(-menu) add checkbutton -label [get_indep String CrossBoxes]\
              -underline [get_indep Pos CrossBoxes]\
              -variable ${this}-draw_rectangles -command " ${this}\
              toggle_boxes m "
        }

        if {$itk_option(-toolbar) != ""} {
            set exp $itk_option(-toolbar).xref
            frame ${exp}
            button ${exp}.ref_to -takefocus 0 -image right_image -command\
              " ${this} references to " -state disabled
            balloon_bind_info ${exp}.ref_to [get_indep String CrfRefToINFO]
            pack ${exp}.ref_to -side left

            button ${exp}.ref_by -takefocus 0 -image left_image -command\
              " ${this} references by " -state disabled
            balloon_bind_info ${exp}.ref_by [get_indep String CrfRefByINFO]
            pack ${exp}.ref_by -side left

            if {0} {
                #DO WE NEED THIS BUTTONS IN THE TOOLBAR????????

                button ${exp}.xbrowse_to -takefocus 0\
                  -image cross_browse_to_image -command "  " -state disabled
                bind ${exp}.xbrowse_to <Any-ButtonPress> "if {%b == 1}\
                  {${this} xbrowse to}"
                balloon_bind_info ${exp}.xbrowse_to [get_indep String\
                  PafCrossToDetail]
                pack ${exp}.xbrowse_to -side left

                button ${exp}.xbrowse_by -takefocus 0\
                  -image cross_browse_by_image -command "  " -state disabled
                bind ${exp}.xbrowse_by <Any-ButtonPress> "if {%b == 1}\
                  {${this} xbrowse by}"
                balloon_bind_info ${exp}.xbrowse_by [get_indep String\
                  PafCrossByDetail]
                pack ${exp}.xbrowse_by -side left
            }

            button ${exp}.remove -image waste_image -takefocus 0 -command "${this} remove" -state disabled
            balloon_bind_info ${exp}.remove [get_indep String CrfRemSubN]
            pack ${exp}.remove -side left

            #WE NEED A FILTER BUTTON IN THE TOOLBAR
            button ${exp}.filter -image filter_image -takefocus 0 -command "\
              [info class]::xref_filter "
            balloon_bind_info ${exp}.filter [get_indep String XRefFilterINFO]
            pack ${exp}.filter -side left

            #we want to support levels by viewing references
            frame ${exp}.space -width 5
            pack ${exp}.space -side left
            label ${exp}.lbl -relief groove -text [get_indep String\
              IncLevelTit] -underline [get_indep Pos IncLevelTit]
            entry ${exp}.txt -relief groove -textvar ${this}-MaxLevels -width 3
            bind ${exp}.txt <Return> "${this} explore_calls"
            pack ${exp}.lbl -side left -fill y
            pack ${exp}.txt -side left -fill y

            #cancel button to cancel fetching, especialy when
            #more than one level is given
            button ${exp}.cancel -takefocus 0 -text [get_indep String Cancel]\
              -command " ${this} cancel_fetching " -pady 0 -state disabled
            balloon_bind_info ${exp}.cancel [get_indep String XRefCancelINFO]
            pack ${exp}.cancel -side left -fill y -expand n

            if {0} {
                #DO WE NEED THIS BUTTONS IN THE TOOLBAR????????

                #button to enable/disable parameter differences
                button ${exp}.param -takefocus 0 -text [get_indep String\
                  CrossAcceptParam] -relief sunken -image cross_param_image\
                  -command "  "
                bind ${exp}.param <Any-ButtonPress> "if {%b == 1} {${this} toggle_param ${exp}.param}"
                balloon_bind_info ${exp}.param [get_indep String\
                  CrossAcceptParamINFO]
                pack ${exp}.param -side left

                #button to enable/disable static references
                button ${exp}.static -takefocus 0 -text [get_indep String\
                  CrossAcceptStatic] -relief raised -image cross_static_image\
                  -command "  "
                bind ${exp}.static <Any-ButtonPress> "if {%b == 1} {${this} toggle_static ${exp}.static}"
                balloon_bind_info ${exp}.static [get_indep String\
                  CrossAcceptStaticINFO]
                pack ${exp}.static -side left

                #button to enable/disable displaying parameters on the canvas
                button ${exp}.disp_param -takefocus 0 -text [get_indep String\
                  CrossDispParam] -relief raised -image cross_disp_param_image\
                  -command "  "
                bind ${exp}.disp_param <Any-ButtonPress> "if {%b == 1}\
		 {${this} toggle_disp_param ${exp}.disp_param}"
                balloon_bind_info ${exp}.disp_param [get_indep String\
                  CrossDispParamINFO]
                pack ${exp}.disp_param -side left
                pack ${exp} -side left -fill x

                #button to enable boxes or to disable it
                button ${exp}.boxes -takefocus 0 -text [get_indep String\
                  CrossBoxes] -relief raised -image cross_boxes_image\
                  -command "  "
                bind ${exp}.boxes <Any-ButtonPress> "if {%b == 1} {${this} toggle_boxes ${exp}.boxes}"
                balloon_bind_info ${exp}.boxes [get_indep String CrossBoxesINFO]
                pack ${exp}.boxes -side left
            }
        }

        canvas ${can} -xscrollcommand "$itk_component(hull).scrollx set"\
          -yscrollcommand "$itk_component(hull).scrolly set" -xscrollincrement 20\
          -yscrollincrement 20 -closeenough 0

        ${can} bind sym <1> "${this} mark_item"
        ${can} bind sym <Double-1> "${this} handle_doubleclick ${can}"
        ${can} bind sym <ButtonPress-3> "${this} mark_item current 0; tk_popup\
          ${can}.menu %X %Y"

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

        #Option menu for XRef items
        menu ${can}.menu -tearoff 0 -background ${bg} -postcommand\
          "${this} update_post_menu"
        wm overrideredirect ${can}.menu 1
        #References To/By
        ${can}.menu add command -label [get_indep String CrfRefTo]\
          -state disabled -underline [get_indep Pos CrfRefTo] -command\
          " ${this} references to "
        ${can}.menu add command -label [get_indep String CrfRefBy]\
          -state disabled -underline [get_indep Pos CrfRefBy] -command\
          " ${this} references by "
        #Details To/By
        ${can}.menu add command -label [get_indep String PafCrossToDetail]\
          -state disabled -underline [get_indep Pos PafCrossToDetail] -command "${this} xbrowse to"
        ${can}.menu add command -label [get_indep String PafCrossByDetail]\
          -state disabled -underline [get_indep Pos PafCrossByDetail] -command "${this} xbrowse by"
        ${can}.menu add command -label [get_indep String CrfRemSubN]\
          -state disabled -underline [get_indep Pos CrfRemSubN] -command "${this} remove"
        ${can}.menu add separator
        ${can}.menu add command -label [get_indep String TakeRoot]\
          -state disabled -underline [get_indep Pos TakeRoot] -command "${this} make_selection_to_root"
        ${can}.menu add separator

        ${can}.menu add checkbutton -label [get_indep String CrossAcceptParam]\
          -underline [get_indep Pos CrossAcceptParam]\
          -variable ${this}-accept_param -command " ${this} toggle_param m "
        ${can}.menu add checkbutton -label [get_indep String\
          CrossAcceptStatic] -underline [get_indep Pos CrossAcceptStatic]\
          -variable ${this}-accept_static -command " ${this} toggle_static m "

        grid ${can} -row 0 -column 0 -sticky news
        grid $itk_component(hull).scrollx -row 1 -column 0 -sticky ew
        grid $itk_component(hull).scrolly -row 0 -column 1 -sticky ns

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

        #Set colors and fonts
        Update_Layout

        #something is selected, goto the selection
        if {${goto} != ""} {
            goto "" ${goto}
        }

        #call the user defined procedure
        catch {sn_rc_xref $itk_component(hull) ${can}}
    }
    destructor {
        foreach v [::info globals "${this}-*"] {
            catch {uplevel #0 unset ${v}}
        }
    }

    method build_text {id} {
        global sn_sep
        set class [lindex $xinfos(${id}) ${class1_pos}]
        if {${class} == "#"} {
            set class ""
        }
        set key [lindex $xinfos(${id}) ${item1_pos}]
        set what [lindex $xinfos(${id}) ${what1_pos}]
        set text [string trim "${key}(${what}) ${class}"]

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

        return ${text}
    }

    method toggle_boxes {{w ""}} {
        global sn_options
        upvar #0 ${this}-draw_rectangles draw
        if {${w} != "m"} {
            if {${draw}} {
                if {${w} != ""} {
                    ${w} config -relief raised
                }
                set draw 0
            } else {
                if {${w} != ""} {
                    ${w} config -relief sunken
                }
                set draw 1
            }
        }
        set draw_rectangles ${draw}
        set sn_options(both,xref-draw-rect) ${draw}

        ${can} delete %boxes%

        draw_rectangles ${can} ${draw_rectangles}
    }

    method toggle_disp_param {{w ""}} {
        global sn_options
        upvar #0 ${this}-disp_param dsp_prm

        if {[sn_processes_running]} {
            bell
            return
        }
        if {${w} != "m"} {
            if {${disp_param}} {
                if {${w} != ""} {
                    ${w} config -relief raised
                }
                set dsp_prm 0
            } else {
                if {${w} != ""} {
                    ${w} config -relief sunken
                }
                set dsp_prm 1
            }
        }
        set disp_param ${dsp_prm}
        set sn_options(both,xref-disp-param) ${dsp_prm}

        foreach id [${can} find withtag sym] {
            ${can} itemconfig ${id} -text [build_text ${id}]
        }
        graph_new_layout 1

        ${can} delete %boxes%
        draw_rectangles ${can} ${draw_rectangles}

        #reselect the selected item
        set id [${can} select item]
        if {${id} != ""} {
            ${can} select from ${id} 0
            ${can} select to ${id} end
        }
    }

    method toggle_param {{w ""}} {
        global sn_options
        upvar #0 ${this}-accept_param param

        if {[sn_processes_running]} {
            bell
            return
        }

        if {${w} != "m"} {
            if {${param}} {
                if {${w} != ""} {
                    ${w} config -relief raised
                }
                set param 0