misc.tcl

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

                        if {${i} > 1} {
                            set fil_list [lunique [lsort ${fil_list}]]
                        }
                        hide_loading_message
                    }
                }

                #use the new project editor to add new files to the project
                set t .project_editor
                if {[winfo exist ${t}]} {
                    itcl::delete object ${t}
                }
# FIMXE: another example of the Project& wait hack
                global wait_for_projecteditor
		# hack, since wait_for_projecteditor might
		# not be set yet...
		#                set wait_for_projecteditor ""
                Project& ${t} -new_project 1 -new_ProjectFiles ${fil_list}\
		  -variable wait_for_projecteditor
		if {${wait_for_projecteditor} != "ok"} {
                    set ProcessingCancelled 1
                    itcl::delete object ${t}
                    return 0
                }
                set ff [${t} contents]
            }
    }

    #build project name based on directory name
    set sn_options(sys,project-name)\
      [sn_constructe_name $sn_options(sys,project-file)]
    set sn_options(sys,project-dir) [file dirname $sn_options(sys,project-file)]

    #now delete prefix for files in the project directory
    set fil_list ""
    set len [expr [string length $sn_options(sys,project-dir)] + 1]
    foreach f ${ff} {
        set f [sn_truncate_path $sn_options(sys,project-dir) ${f}]
        lappend fil_list ${f}
    }

    #delete the project editor window
    catch {destroy ${t}}

    sn_loading_message

    #change to choosen directory, if we could !!
    set ret [catch {cd $sn_options(sys,project-dir)} err]
    if {${ret}} {
        sn_error_dialog ${err}
        set ProcessingCancelled 1
        return 0
    }

    sn_log "create new project: project directory files..."

    #save settings into the proiect
    if {![sn_save_project 0 "new"]} {
        set ProcessingCancelled 1
        return 0
    }

    sn_loading_message [get_indep String Scanning]

    sn_log "create new project: project directory files..."

    #add all directory prefixes to the include path list and
    #store the directories of the project into a database (.icl)
    eval lappend sn_options(include-source-directories)\
      [generate_pathes ${fil_list}]
    set_project_dir_files ${fil_list}

    # Try to auto-detect the type of revision control they are using.
    # Loop through the list of version control systems we support looking for
    # a directory in the project-dir with the same name (like project/CVS)
    set matched_types [list]
    foreach pair $sn_options(sys,supported-vcsystems) {
        foreach {type desc} ${pair} break
        set search_dir [file join $sn_options(sys,project-dir) ${type}]
        if {[file isdirectory ${search_dir}]} {
            lappend matched_types [list ${type} ${desc}]
        }
    }

    # We only switch from the default version control system if we find a single
    # directory that matches the types from the search list, because if they
    # had both a CVS and a RCS directory we would not know which one to pick!

    if {[llength ${matched_types}] == 1} {
        set match [lindex [lindex ${matched_types} 0] 1]
        sn_log "auto switch to ${match} revision control system"
        set sn_options(both,rcs-type) ${match}
    }

    # Now we have to figure out which groups (files) have parsers,
    # and how many files will be parsed.
    set filenum 0
    set files_without_parser ""
    foreach file ${fil_list} {
        set type [sn_get_file_type ${file}]
        if {$Parser_Info(${type},BROW) == "" || $Parser_Info(${type},TYPE) ==\
          "others"} {
            lappend files_without_parser ${file}
        } else {
            lappend parserfiles(${type}) ${file}
            incr filenum
        }
    }

    # Make sure that the temporary files are created in the
    # symbol db directory! this because on some OS's the
    # temporary directory doesn't have alot of space
    sn_set_tmp_dir $sn_options(both,db-directory)

    #to store xref-info for dbimp
    set xfer_file [sn_tmpFileName]

    #create temp file so that sn_tmpFileName doesn't use
    # the same filename twice (itr - 12.12.97)
    set tmp_fd [open ${xfer_file} w]
    close ${tmp_fd}

    hide_loading_message

    #create a window with the scale widget to view the position
    #of parsing
    set scale_window [make_scale_window ${filenum} 1]

    #Now we can start parsers on the source code files
    #reset the project file list, it could be the case that
    #the user breaks parsing where not all files have been
    #added to the project
    set fil_list ""
    set file_types ""
    set cbrowser_xref 0
    foreach type [array names parserfiles] {
        set files [lsort -dictionary $parserfiles(${type})]

        set brow_exec $Parser_Info(${type},BROW)
        set brow_swi $Parser_Info(${type},BROW_SWITCH)

        lappend file_types ${type}

        eval lappend fil_list ${files}

        set brow_cmd [list ${brow_exec}]
        if {${brow_exec} != "" && ${files} != ""} {
            # If parsing c/c++ file with cbrowser, pass
            # a flag to sn_load_xref so that it knows to
            # use cbrowser2 in the xref gen stage.
            if {[string first cbrowser $brow_exec] != -1} {
                set cbrowser_xref 1
            }

            #append macro files to the parser
            set macroflag $Parser_Info(${type},MACRO)
            if {${macroflag} == "-m"} {
                foreach mf $sn_options(macrofiles) {
                    lappend brow_cmd -m ${mf}
                }
            }
            if {${brow_swi} != ""} {
                eval lappend brow_cmd ${brow_swi}
            }
            #'-t' means drop /... files.
            lappend brow_cmd -t

            #we must verify the exactly number of files to generate
            #xref-information for.
            if {[lsearch -exact $sn_options(sys,language-with-xref) ${type}]\
              != -1} {
                xref_termometer_files + ${files}
            }

            #now run the parser and add the files into the project
            if {![sn_load_files ${brow_cmd} ${files} ${xfer_file}\
              ${scale_window}] || ${ProcessingCancelled}} {
                # If there was a problem parsing the files
                # we give up trying to create this project.
                if {![sn_batch_mode]} {
                    delete_scale_window ${scale_window}
                }
                return 0
            }
        }
    }

    if {${files_without_parser} != ""} {
        load_files_without_parser ${files_without_parser}
        eval lappend fil_list ${files_without_parser}
    }

    #sort source files
    set fil_list [lsort -dictionary ${fil_list}]

    # It will be used only if the working directory
    # of the project will be sometime deleted.
    paf_db_proj put include-source-directories\
      $sn_options(include-source-directories)
    paf_db_proj put source_files ${fil_list}

    # Possibly notify the IDE of our file list.
    maybe_ide_property set project-files ${fil_list} project

    paf_db_proj sync
    
    if {![sn_batch_mode]} {
	delete_scale_window ${scale_window}
    }

    update idletasks
    update

    # Generate XRef information:
    #
    # Note that we delay starting the xref process in the
    # pipe for a moment so that the symbol browser can
    # be mapped. This avoids a problem under Windown 95/98
    # where there is a long pause between the time the
    # file scanning is done and the symbol browser shows up.
    if {${xfer_file} != "" && [file exists ${xfer_file}] && [file size\
      ${xfer_file}] > 0} {
        after 1000 [list sn_load_xref ${xfer_file} ${cbrowser_xref}]
    }

    catch {paf_db_proj sync}

    #by interactive mode, don't open the project, just exit
    if {[sn_batch_mode]} {
        if {[sn_processes_running]} {
            global sn_wait_xref_flag

            puts stdout [get_indep String WaitingForXref]
            flush stdout

            set sn_wait_xref_flag "waiting"

            sn_is_waiting_for_xref

            tkwait variable sn_wait_xref_flag
        }

        puts stdout [get_indep String ProjectBatchBuilt]
        flush stdout

        #exit program
        set ProcessingCancelled 0
        return 0
    }

    sn_log "verify database files..."
    if {[catch {set ret [sn_db_open_files 0 0]}] || ${ret} < 0} {
        sn_log "error by opening db files return status <${ret}>"
        set ProcessingCancelled 0
        return 0
    }

    sn_finalize_project new

    sn_log "create new project: project created."

    return 1
}

######################################################################
## This function initialize the database for the include directories
## that will be used to localize included files with the preprocessor
## routines like '#include <stdio>'
##
## Since we use a sn_options(source_files) variable to store the
## included directories is this file useless for SN.
######################################################################
proc set_project_dir_files {{files ""}} {
    global sn_options
    global sn_debug

    if {${files} == ""} {
        set files [sn_project_file_list]
    }
    if {${files} == ""} {
        return
    }
    set db_pref $sn_options(db_files_prefix)

    set file_list [sn_tmpFileName]
    if {[catch {set fd [open ${file_list} "w+"]}]} {
        return
    }
    fconfigure ${fd} \
        -encoding $sn_options(def,system-encoding) \
        -blocking 0
    puts ${fd} [join ${files} \n]
    close ${fd}

    sn_log "save project directories: ${db_pref}.icl,\
      $sn_options(def,db_cachesize), from: ${file_list}."

    if {[catch {sn_put_project_dir_files\
      "${db_pref}.icl" $sn_options(def,db_cachesize) ${file_list}}]} {
        sn_error_dialog [get_indep String CannotSaveIncludeDirectories]
    }

    if {!${sn_debug}} {
        catch {file delete -- ${file_list}}
    }
}

proc sn_browser_scope_menu_labels {} {
    global sn_browser_scope_menu_labels

    if {[info exists sn_browser_scope_menu_labels]} {
        return ${sn_browser_scope_menu_labels}
    }

    set options [list [get_indep String Files] [get_indep String Classes]\
      [get_indep String Methods] [get_indep String ClassVars]\
      [get_indep String Friends] [get_indep String Functions]\
      [get_indep String Typedefs] [get_indep String Variables]\
      [get_indep String Enums] [get_indep String EnumCons] [get_indep String\
      Unions] [get_indep String Defines] [get_indep String Const]]

    #add fortran scopes, when availiable
    foreach sc {su com cov} {
        if {[info commands paf_db_${sc}] != ""} {
            lappend options [get_indep String Subr] [get_indep String Commons]\
              [get_indep String CommonsVars]
            break

        }
    }

    set sn_browser_scope_menu_labels [lsort ${options}]

    return ${sn_browser_scope_menu_labels}
}

proc sn_init_rcs_variables {} {
    global sn_options

    set sn_options(both,rcs-type) [string tolower $sn_options(both,rcs-type)]

    # Choose the RCS Version:
    # Set the proper sn_rcs_xxx variables:
    # This works for ALL variables define above (because of the use of the\
      'info'
    # command). Clever ;-)
    set i [string length sn_rcs_$sn_options(both,rcs-type)]
    foreach item [info globals sn_rcs_$sn_options(both,rcs-type)*] {
        upvar #0 ${item} v
        set suf [string range ${item} ${i} end]
        uplevel #0 "set sn_rcs${suf} [list ${v}]"
    }
}

#given a view name, open the files assigned to this view
proc sn_db_open_exclude {{exclude ""}} {
    global sn_options
    global errorCode

    if {${exclude} == ""} {
        set exclude [paf_db_proj get -key db_exclude]
        if {${exclude} == ""} {
            set exclude "default"
        }
    }

    catch {paf_db_exclude close}

    set views [paf_db_proj get -key views]

    #see if the view exists
    set off -1
    set i 0
    foreach v ${views} {
        if {[lindex ${v} 0] == ${exclude}} {
            set off ${i}
            break

        }
        incr i
    }
    if {${off} == -1} {
        set proj_pref $sn_options(db_files_prefix)

        set len [expr [llength ${views}] + 1]
        set file ${proj_pref}.${len}
        lappend views [list ${exclude} ${file}]
        paf_db_proj put views ${views}

        sn_log "open_exclude view <${views}> pwd <[pwd]>"
    } else {
        set file [lindex [lindex ${views} ${off}] 1]
        sn_log "open_exclude file <${file}> pwd <[pwd]> ProjDir\
          <$sn_options(sys,project-dir)>"
    }

    set file [file join $sn_options(sys,project-dir) ${file}]
    sn_log "open_exclude file now <${file}>"

    #create database and reopen it in readonly mode.
    foreach of {{RDWR CREAT} RDONLY} {
        if {![catch {dbopen paf_db_exclude ${file} ${of} [sn_db_perms] btree}\
          err]} {
            set err ""
            break
        }
    }

    if {${err} != ""} {
        paf_db_proj sync
        sn_error_dialog ${err}

        return ""
    }
    paf_db_proj put db_exclude ${exclude}
    paf_db_proj sync

    return ${exclude}
}

proc sn_change_view {view} {

    sn_db_open_exclude ${vie