misc.tcl

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

            }\
          [get_indep String Defines] {
                return "ma"
            }\
          [get_indep String Subr] {
                return "su"
            }\
          [get_indep String Const] {
                return "con"
            }\
          [get_indep String Unions] {
                return "un"
            }\
          [get_indep String PafLocVars] {
                return "lv"
            }\
          [get_indep String Friends] {
                return "fr"
            }\
          [get_indep String Includes] {
                return "iu"
            }\
          [get_indep String Files] {
                return "f"
            }\
          [get_indep String Undefined] {
                return "ud"
            }\
          [get_indep String All] {
                return "all"
            }

    return ""
}

# Update our display
proc sn_get_windows {{pat ""}} {
    set brws [lmatch [winfo children "."] ".sn-${pat}*"]
}


#This function is called after updating project
#like file save, reparse, ...
proc SN_Refresh_Windows {} {
    global sn_statistic_run
    global SN_Refresh_Windows_active

    if {! [info exists SN_Refresh_Windows_active]} {
        set SN_Refresh_Windows_active 0
    }
    if {${SN_Refresh_Windows_active}} {
        return
    }
    if {[info commands paf_db_f] == ""} {
        return
    }
    incr SN_Refresh_Windows_active 1

    #update the scope list
    sn_update_scope_list

    #refresh project editors
    Project&::Refresh_YourSelf

    #refresh statistic windows
    if {${sn_statistic_run}} {
        sn_update_statistic
    }

    #refresh the availiable Multi Views
    MultiWindow&::Refresh_YourSelf

    incr SN_Refresh_Windows_active -1
}

#This function is called when XRef process (dbimp) is finished
proc SN_Refresh_XRef_Windows {} {
    global SN_Refresh_XRef_Windows_active
    if {[info exists SN_Refresh_XRef_Windows_active] &&\
      ${SN_Refresh_XRef_Windows_active}} {
        return
    }
    set SN_Refresh_XRef_Windows_active 1

    #refresh the availiable Multi Views
    MultiWindow&::Refresh_YourSelf_After_XRef

    set SN_Refresh_XRef_Windows_active 0
}

proc sn_hide_show_project {cmd {mainw ""}} {
    global sn_options
    global sn_HideShowParams sn_debug
    global iconize_old_close_command

    if {${sn_debug}} {
        sn_log "HideShow: ${cmd}"
        catch {sn_log "  called from [info level -1]"}
    }

    #if toplevel is not specified, use any window
    if {${mainw} == ""} {
        set mainw [lindex [itcl::find objects "*" -class SymBr&] 0]
    }
    if {${mainw} == ""} {
        set mainw [lindex [itcl::find objects "*" -class MultiWindow&] 0]
    }

    if {${cmd} == "withdraw"} {
        catch {unset sn_HideShowParams}
        set foc [focus]

        if {${foc} != ""} {
            set active [winfo toplevel ${foc}]
        } else {
            set active ${mainw}
        }
        foreach win [winfo children .] {
            if {${win} == ".loading" || ${win} == ".sn_pop_menu_listbox"} {
                continue
            }

            if {[catch {set win [winfo toplevel ${win}]}]} {
                continue
            }
            set geo [wm geometry ${win}]
            if {${win} == ${active}} {
                set act 1
            } else {
                set act 0
            }

            set sn_HideShowParams(${win},EXISTS) 1
            set sn_HideShowParams(${win},WIN) ${win}
            set sn_HideShowParams(${win},GEOM) ${geo}
            set sn_HideShowParams(${win},STATE) [wm state ${win}]
            set sn_HideShowParams(${win},ACTIVE) ${act}

            if {${mainw} == ${win}} {
                #icon window
                wm iconify ${win}

                #save close command and replace it to close the project
                set iconize_old_close_command [wm protocol ${mainw}\
                  WM_DELETE_WINDOW]
                wm protocol ${mainw} WM_DELETE_WINDOW "MultiWindow& ::\
                  file_close_project"
            } else {
                if {$sn_options(def,wm-deiconify-withdraw)} {
                    wm deiconify ${win}
                }
                #hide window
                wm withdraw ${win}
            }
        }
        #use the same window to deiconify
        bind ${mainw} <Map> "sn_hide_show_project deiconify ${mainw}"
    }\
    elseif {${cmd} == "deiconify"} {
        bind ${mainw} <Map> " "
        if {[info exists iconize_old_close_command]} {
            wm protocol ${mainw} WM_DELETE_WINDOW ${iconize_old_close_command}
        }
        set act_geom ""
        foreach c [array names sn_HideShowParams "*,EXISTS"] {
            set p [lindex [split ${c} ","] 0]
            set win $sn_HideShowParams(${p},WIN)
            set geo $sn_HideShowParams(${p},GEOM)
            set sta $sn_HideShowParams(${p},STATE)
            set act $sn_HideShowParams(${p},ACTIVE)

            catch {
                if {${act} == 0} {
                    if {$sn_options(def,wm_geometry) && [string range ${geo} 0\
                      2] != "1x1"} {
                        if {[itcl::find objects -isa sourcenav::Window ${win}] != ""} {
                            ${win} configure -geometry ${geo}
                        } else {
                            wm geometry ${win} ${geo}
                        }
                    }
                    switch ${sta} {
                        "normal" {
                                wm deiconify ${win}
                            }
                        "iconic" {
                                wm iconify ${win}
                            }
                    }
                } else {
                    set act_geom ${geo}
                    set active ${win}
                }
            }

        }
        catch {unset sn_HideShowParams}

        if {$sn_options(def,wm_geometry)} {
            if {[itcl::find objects -isa sourcenav::Window ${active}] != ""} {
                ${active} configure -geometry ${act_geom}
            } else {
                wm geom ${active} ${act_geom}
            }
        }
        catch {wm deiconify ${active}}
    }
}

proc wait_xref_end {procfd varb} {
    set end [gets ${procfd} line]
    if {${end} < 0} {
        #give the info that the process has been terminated
        upvar #0 ${varb} var
        set var "end"
        catch {close ${procfd}}

        #delete termometers from views
        xref_delete_termometers
    } else {
        #display xref info

        set scanning "Status: Scanning: "
        if {[string first $scanning ${line}] == 0} {
            set file [string range $line [string length $scanning] end]
            xref_termometer_disp $file 0
        }

        set deleting "Status: Deleting: "
        if {[string first $deleting ${line}] == 0} {
            set file [string range $line [string length $deleting] end]
            xref_termometer_disp $file 1
        }

        sn_log "wait_xref_end: ${line}"
    }
    update idletasks
}

# This function returns the location of a symbol checking duplications too.
proc sn_db_get_symbol {scope sym {qry_exp ""} {off_var ""}} {
    global sn_options sn_debug sn_sep

    if {${off_var} != ""} {
        upvar ${off_var} off
        set off 0
    } else {
        set off 0
    }
    sn_log "Query: scope: ${scope}, symbol: ${sym}, query: ${qry_exp}"

    #command not availiable
    if {[info commands paf_db_${scope}] == ""} {
        return ""
    }

    if {${qry_exp} != ""} {
        set lst [paf_db_${scope} seq -col ${qry_exp} "${sym}${sn_sep}"]
    } else {
        set lst [paf_db_${scope} seq "${sym}${sn_sep}"]
    }

    # Check whether we are searching for a class with a non existing template.
    if {${scope} == "cl" && ${lst} == ""} {
        set broff [string first {<} ${sym}]
        if {${broff} > -1} {
            set sym [string range ${sym} 0 [expr ${broff} - 1]]

            sn_log "Query2: scope: ${scope}, symbol: ${sym}, query: ${qry_exp}"

            if {${qry_exp} != ""} {
                set lst [paf_db_${scope} seq -col ${qry_exp} "${sym}${sn_sep}"]
            } else {
                set lst [paf_db_${scope} seq "${sym}${sn_sep}"]
            }
        }
    }

    sn_log "Query result <${lst}>"

    set lst [lindex ${lst} ${off}]

    set begpos_off [lsearch -regexp ${lst} {[0-9]+\.[0-9]+}]
    set beg_pos [lindex ${lst} ${begpos_off}]
    set file [lindex ${lst} [expr ${begpos_off} + 1]]
    set end_pos [lindex ${lst} [expr ${begpos_off} + 2]]

    return [list ${file} ${beg_pos} ${end_pos} ${sym}]
}

#       w:      If not empty the name of the text widget containing the symbol
#               to search for.
#       scope:  a known scope such as: gv, mi, cl etc.
#       qry:    a expression (it can be empty too) such as -regexp {.*ab.*}
proc sn_get_detailed_for_selection {scope {name ""} {qry ""}} {
    set sym [sn_get_symbol_and_scope ${name}]
    if {${sym} != ""} {
        set name [lindex ${sym} 0]
        set scope [lindex ${sym} 1]
    }
    set pos [sn_db_get_symbol ${scope} ${name} ${qry} off]
    set name [lindex ${pos} end]
    set file [lindex ${pos} 0]
    set line [lindex ${pos} 1]
    set pos [lrange ${pos} 0 2]
    if {${file} == "" || ${line} == ""} {
        return ""
    }
    return [list ${scope} ${name} ${off} ${pos}]
}

#       w:      If not empty the name of the text widget containing the symbol
#               to search for.
#       scope:  a known scope such as: gv, mi, cl etc.
#       qry:    a expression (it can be empty too) such as -regexp {.*ab.*}
proc sn_display_object {scope {name ""} {qry ""}} {
    if {${scope} == "f"} {
        if {${name} == ""} {
            return
        }
        set exch_name [split ${name} "\t"]
        if {[llength ${exch_name}] > 1} {
            set name [file join [lindex ${exch_name} 1] [lindex ${exch_name} 0]]
        } else {
            set name [lindex ${exch_name} 0]
        }
        sn_edit_file dummy ${name}
        #sn_add_history "f" $name [sn_make_history_title edit f $name]
        return
    }
    set pars [sn_get_detailed_for_selection ${scope} ${name} ${qry}]
    if {${pars} == ""} {
        bell
        return
    }

    set scope [lindex ${pars} 0]
    set name [lindex ${pars} 1]
    set off [lindex ${pars} 2]
    set pos [lindex ${pars} 3]

    eval sn_edit_file [list "${off} ${name} ${scope}"] ${pos}

    #sn_add_history $scope [list $scope $name $off]\
      [sn_make_history_title edit $scope $name]
}

##
## Starts SN application.
## It's the script called from "etc/navigato"
proc sn_session {} {
    global sn_options
    global argv errorInfo sn_debug HOME tcl_platform

    if {[catch {wm withdraw .}]} {
        return
    }
    set appname [tk appname]

    #register by IDE
    maybe_ide_property set project-root $sn_options(sys,project-dir) project

    #this is the correct place to show the splash screen.
    #show the splash screen, only when no batch_mode
    # Also allow a nosplash arg. 
    if {(![sn_batch_mode]) && (![sn_nosplash])} {
        sn_show_splash_screen
    }

    #start project manager or directly open a project.
    sn_start_new_session
}



# This function is even called when a new interpreter is created
# to open a project or to create a new project.
proc sn_start_new_session {{opts ""}} {
    global sn_options
    global sn_arguments
    global tkeWinNumber
    global env sn_debug sn_path tcl_platform sn_statistic_run
    global argv argc

    sn_log "sn_start_new_session (${opts}, argc=${argc}, argv=${argv})"

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

    # Read command line arguments, if this is simulated by
    # calling this procedure from a new interpreter.
    if {${opts} != ""} {
        set argv ${opts}
        set argc [llength ${argv}]
        catch {unset sn_arguments}
        sn_read_commandline_arguments
    }

    maybe_ide_property set project-root $sn_options(sys,project-dir) project

    sn_log "calling sn_process_gui"
    # Open project, if a project is given on the command line
    set ret [sn_process_gui]

    sn_log "calling hide_loading_message"
    # Make sure that the loading message is put away.
    hide_loading_message

    if {!${ret}} {
        sn_log "deleteing interp in sn_start_new_session"

        # Note that once we delete this interp, we can not invoke
	# any commands or an error will be raised
        delete_interp
    }
}

proc sn_batch_mode {} {
    global sn_arguments
    if {[info exists sn_arguments(batchmode)] && $sn_arguments(batchmode)} {
        return 1
    }
    return 0
}

proc sn_nosplash {} {