utilities.tcl

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

        set name [lindex ${sym} 0]
        set scope [lindex ${sym} 1]
    }

    if {[lsearch -exact ${sn_all_scopes} ${scope}] == -1} {
        return ""
    }
    return [list ${name} ${scope}]
}

proc sn_external_editor {file} {
    global Parser_Info
    # Use always file extensions
    set type [sn_get_file_type ${file}]
    return $Parser_Info(${type},EDIT)
}

#return the highlight browser command
proc sn_highlight_browser {file {cmd "b"}} {
    global Parser_Info Avail_Parsers
    set type [paf_db_f get -key -col {0} ${file}]
    if {${type} == ""} {
        set type [sn_get_file_type ${file}]
    }
    set exe_cmd ""
    set cmd_swi ""
    if {${cmd} == "h"} {
        set exe_cmd $Parser_Info(${type},HIGH)
        set cmd_swi $Parser_Info(${type},HIGH_SWITCH)
    } else {
        set exe_cmd $Parser_Info(${type},BROW)
        set cmd_swi $Parser_Info(${type},BROW_SWITCH)
    }
    #no highlighter
    if {${exe_cmd} == ""} {
        return ""
    }
    #make sure that the hightlighter is given as a list item,
    #to avoid conflicts when the command contains blanks.
    set browcmd [list ${exe_cmd}]
    if {${cmd_swi} != ""} {
        eval lappend browcmd ${cmd_swi}
    }
    return ${browcmd}
}

# This function returns the file type given a file name.
# A file type is a descriptive string like "java", "asm",
# "m4" and so on. If a specific match can not be found
# then the catch all type "others" is returned.
proc sn_get_file_type {file} {
    global sn_options
    global Avail_Parsers Parser_Info

    set tail [file tail $file]

    #test "others" extension matching as last possibility
    #the user can add "*" to others to include all
    #file that don't match another languages.
    foreach p ${Avail_Parsers} {
        if {$Parser_Info(${p},TYPE) != "others"} {
            foreach pattern $Parser_Info(${p},SUF) {
                if {[string equal $pattern $tail] ||
                        [string match $pattern $tail]} {
                    sn_log "$tail file type is $p"
                    return ${p}
                }
            }
        }
    }
    return "others"
}

proc sn_check_browsers_path {} {
    global sn_path tcl_platform
    global Avail_Parsers Parser_Info

    foreach type ${Avail_Parsers} {
        # Parser command.
        set cmd [file rootname [file tail $Parser_Info(${type},BROW)]]
        if {${cmd} != ""} {
            set cmd [file join $sn_path(bindir) ${cmd}]
            if {$tcl_platform(platform) == "windows" && ! [file exists\
              ${cmd}]} {
                append cmd ".exe"
            }
            set Parser_Info(${type},BROW) ${cmd}
        }

        # Highlighting command.
        set cmd [file rootname [file tail $Parser_Info(${type},HIGH)]]
        if {${cmd} != ""} {
            set cmd [file join $sn_path(bindir) ${cmd}]
            if {$tcl_platform(platform) == "windows" && ! [file exists\
              ${cmd}]} {
                append cmd ".exe"
            }
            set Parser_Info(${type},HIGH) ${cmd}
        }
    }

    return 1
}

#add new parsers into SN
proc sn_add_parser {type args} {
    global sn_options tcl_platform
    global Avail_Parsers Parser_Info

    # Do not add a parser twice. 

    if {[info exists Avail_Parsers] && [lsearch -exact ${Avail_Parsers}\
      ${type}] != -1} {
        return
    }

    set suf "*"
    set brow_cmd ""
    set high_cmd ""
    set editor ""
    set brow_switch ""
    set high_switch ""
    set case 1
    #parser understand macros??
    set macros ""

    set len [llength ${args}]
    for {set i 0} {${i} < ${len}} {incr i} {
        set arg [lindex ${args} ${i}]
        incr i
        set val [lindex ${args} ${i}]
        switch -- ${arg} {
            "-suffix" {
                    set suf ${val}
                }
            "-brow_cmd" {
                    set brow_cmd ${val}
                }
            "-high_cmd" {
                    set high_cmd ${val}
                }
            "-editor" {
                    set editor ${val}
                }
            "-brow_switch" {
                    set brow_switch ${val}
                }
            "-high_switch" {
                    set high_switch ${val}
                }
            "-case" {
                    set case ${val}
                }
            "-macros" {
                    #parser understand macros
                    set macros ${val}
                }
            default {
                    puts stderr "sn_add_parser: unknow argument <${arg}>"
                }
        }
    }

    if {$tcl_platform(platform) == "windows"} {
        if {${brow_cmd} != "" && [string first "." ${brow_cmd}] == -1} {
            append brow_cmd ".exe"
        }
        if {${high_cmd} != "" && [string first "." ${high_cmd}] == -1} {
            append high_cmd ".exe"
        }
    }

    if {![info exists Avail_Parsers]} {
        set Avail_Parsers ""
    }

    #add type to the availiable list
    if {[lsearch -exact ${Avail_Parsers} ${type}] == -1} {
        lappend Avail_Parsers ${type}
    }

    #add related data to the parser array
    set Parser_Info(${type},TYPE) ${type}
    set Parser_Info(${type},SUF) ${suf}
    set Parser_Info(${type},BROW) ${brow_cmd}
    set Parser_Info(${type},BROW_SWITCH) ${brow_switch}
    set Parser_Info(${type},HIGH) ${high_cmd}
    set Parser_Info(${type},HIGH_SWITCH) ${high_switch}
    set Parser_Info(${type},CASE) ${case}
    set Parser_Info(${type},MACRO) ${macros}
    set Parser_Info(${type},EDIT) ""
}

#executed when user specifies parser extensions on the
#command line or in his profile
#format "parser-ext=<language>,<Extension list>"
#as example: parser-ext=tcl,"*.tk *.tcl"
proc sn_parser_extension_trigger {var value} {
    global sn_user_specified
    global Avail_Parsers Parser_Info

    set wrong "wrong format for parser extension, usage:\
      parser-ext=TYPE,<extension list>
	as example use
		-D \"parser-ext=c++,*.c *.cpp *.h *.hpp\"
	to change the default extension list for the c++ parser."

    set i [string first "," ${value}]
    if {${i} <= 0} {
        sn_log -stderr ${wrong}
        return 0
    }
    set lng [string range ${value} 0 [expr {${i} - 1}]]

    #is the type correct?
    if {[lsearch -exact ${Avail_Parsers} ${lng}] == -1} {
        sn_log -stderr "unknown parser type <${lng}>, availiable types are\
          <${Avail_Parsers}>"
    }

    #get the extension list
    set ext [string range ${value} [expr {${i} + 1}] end]
    if {${ext} == ""} {
        sn_log -stderr ${wrong}
        return 0
    }

    #correct.
    set Parser_Info(${lng},SUF) ${ext}

    #mark the option as overriden using the command line
    #don't load it from stored prefernces settings
    set sn_user_specified(sys,parser,${lng},SUF) yes

    sn_log "Parser extension \"${lng}=${ext}\" accepted."

    return 0
}

#this function is called to add macrofiles into the c/c++ parser
proc sn_macrofiles_trigger {var value} {
    global sn_options
    global sn_user_specified

    if {[lsearch -exact $sn_options(macrofiles) ${value}] == -1} {
        if {[file isfile ${value}]} {
            lappend sn_options(macrofiles) ${value}
            sn_log "macro file \"${value}\" added to the macro list."
        } else {
            sn_log -stderr "macro file \"${value}\" doesn't exist."
            return 0
        }
    } else {
        sn_log -stderr "file \"${value}\" is already added as macro file."
        return 0
    }
    set sn_user_specified(macrofiles) yes
    return 1
}
proc sn_rep_macrofiles_trigger {var value} {
    global sn_options
    global sn_user_specified

    if {[file isfile ${value}]} {
        set sn_options(macrofiles) ${value}
        sn_log "replaced macro file list with \"${value}\"."
    } else {
        sn_log -stderr "macro file \"${value}\" doesn't exist."
        return 0
    }
    set sn_user_specified(macrofiles) yes
    return 1
}

proc sn_tmpFileName {{prefix "tmp_"}} {
    global tcl_platform env

    #see if temp files have a temp directory
    #they should be in and put them there - [irox:12.12.97]
    if {[info exists env(TEMP)]} {
        set temp_dir $env(TEMP)
    } else {
        if {[info exists env(TMP)]} {
            set temp_dir $env(TMP)
        } else {
            set temp_dir ""
        }
    }
    #be sure that the temporary directory exists
    if {${temp_dir} == "" || ! [file isdirectory ${temp_dir}]} {
        if {$tcl_platform(platform) == "windows"} {
            if {[file isdirectory "C:\\TEMP"]} {
                set dir "C:\\TEMP"
            }\
            elseif {[file isdirectory "C:\\TMP"]} {
                set dir "C:\\TMP"
            } else {
                set dir "C:\\"
            }
        } else {
            set dir "/tmp"
        }
        if {[file isdirectory ${dir}]} {
            set temp_dir ${dir}
        } else {
            set temp_dir ""
        }
    }
    sn_log "temp_dir = ${temp_dir}"
    return [tempnam ${temp_dir} ${prefix}]
}

# FIXME: this method does not seem to get called any where (should be find makepane?)
proc cancel_make {w cancel_str fd} {
    global PafMakeCancelled

    set PafMakeCancelled 1

    ${w}.cancel config -command "itcl::delete object ${w}" -text ${cancel_str}\
      -width [expr [string length ${cancel_str}] + 1]
    ${w}.mk config -cursor {}

    ${w}.mk insert end "\n[get_indep String MakeKilled]"
    ${w}.mk see "end"
    catch {exec kill [pid ${fd}]}
}

# FIXME: this method does not seem to get called anywhere (should be in makepane?)
proc event_handle_make_input {makefd w} {
    global sn_options
    global PafMakeCancelled

    set end [gets ${makefd} line]

    if {${PafMakeCancelled} || ${end} < 0} {
        catch {close ${makefd}}
        if {![winfo exists ${w}]} {
            return
        }
        set cancel_str [get_indep String Cancel]
        ${w}.cancel config -command " ${w} delete " -text ${cancel_str}\
          -width [expr [string length ${cancel_str}] + 1]
        ${w}.mk config -cursor {}

        if {!${PafMakeCancelled}} {
            ${w}.mk config -state normal
            ${w}.mk insert end "\n[get_indep String MakeEnd]"
            ${w}.mk config -state disabled
            ${w}.mk see end

            if {[catch {set ra $sn_options(def,make-raise)}]} {
                set ra 1
            }
            if {${ra}} {
                ${w} raise
            }

            bell -displayof ${w}
            bind ${w} <Escape> "${w}.cancel invoke"
        }
    } else {
        ${w}.mk config -state normal
        if {[${w}.mk index insert] != 1.0} {
            set line "\n${line}"
        }
        ${w}.mk insert end ${line}
        ${w}.mk config -state disabled
        ${w}.mk see end
        update idletasks
    }
}

#this procedure gets a file name and look if this file name
#is availiable in the project list by cutting the prefix or
#looking for the filename only or building the realpath
#of the file name
proc sn_convert_FileName {orig_name {any ""}} {
    global sn_options
    global tcl_platform
    global sn_root

    if {[catch {set name [join [realpath -pwd $sn_options(sys,project-dir)\
      ${orig_name}]]}]} {
        set name ${orig_name}
    }\
    elseif {![file exists ${name}]} {
        set name ${orig_name}
    }

    #Project directory is a prefix of the file looked for. Truncate it!
    if {[sn_filecmd begins $sn_options(sys,project-dir)${sn_root} ${name}]} {
        set nn [string range ${name} [expr [string length\
          $sn_options(sys,project-dir)] + 1] end]

        #WINDOWS: We have to look in the database to see if the file exists
        #         Because of upper/lower case, so "Foo.c" is equal "foo.c"
        if {$tcl_platform(platform) == "windows" && [info commands paf_db_f]\
          != ""} {
            set f [paf_db_f get -col 0 -first ${nn}]