misc.tcl

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

    pack ${newdir} -side top -anchor nw -fill x
}

proc add_checkbuttons_to_fastcreate_dialog {w} {
    global sn_options
    global tkeWinNumber
    global sn_newargs

    set dirfr ${w}.dirs
    set lblwidth 20

    #Checkbuttons for recursive scan and creating xref
    #when -import is enabled, no recursive flag is editable
    if {$sn_newargs(have-import-file) == "normal"} {
        set labels [list [get_indep String ScanRecursive] [get_indep String\
          GenerateXRef]]
        set balloons [list [get_indep String ScanRecursiveINFO]\
          [get_indep String GenerateXRefINFO]]
        set values [list {-1 1} {-x ""}]
        set variables [list sn_options(def,scan-recursive)\
          sn_options(both,xref-create)]
    } else {
        set labels [list [get_indep String GenerateXRef]]
        set balloons [list [get_indep String GenerateXRefINFO]]
        set values [list {-x ""}]
        set variables [list sn_options(both,xref-create)]
    }

    frame ${w}.dirs

    #Projectname with full path (save dialog)
    set obj ${dirfr}.prjname
    if {[itcl::find object $obj] == $obj} {
        itcl::delete object $obj
    }
    LabelEntryButton& $obj -text [get_indep String ProjectName]\
      -labelwidth ${lblwidth} -save_open "save"\
      -extensions $sn_options(project_extensions) -defaultextension ".proj"\
      -anchor nw -width 40 -variable sn_newargs(path) -native 1\
      -buttonballoon [get_indep String ChooseINFO]
    pack ${dirfr}.prjname -side top -anchor nw -fill x

    #no adding directories, when -import is specified.
    if {$sn_newargs(have-import-file) == "normal"} {
        add_more_cb ${dirfr}
    }

    #initialize the first directory with the base directory of the project file
    set sn_newargs(add,${tkeWinNumber}) [file nativename [file dirname\
      $sn_newargs(path)]]
    set sn_newargs(old-dir) $sn_newargs(add,${tkeWinNumber})

    #no "more" button, when -import is specified
    if {$sn_newargs(have-import-file) == "normal"} {
        frame ${w}.more
        button ${w}.more.more -text [get_indep String more] -command\
          " add_more_cb ${w}.dirs " -state $sn_newargs(have-import-file)
    }

    if {[itcl::find object ${w}.checkbtns] == "${w}.checkbtns"} {
        itcl::delete object ${w}.checkbtns
    }
    CheckButton& ${w}.checkbtns -labels ${labels} -balloons ${balloons}\
      -values ${values} -variables ${variables} -label ""

    pack ${w}.checkbtns -in ${w}.top -side bottom -fill x -padx 10m -pady 3m
    if {$sn_newargs(have-import-file) == "normal"} {
        pack ${w}.more.more -side top -anchor nw
        pack ${w}.more -in ${w}.top -fill x -side bottom -padx 10m -pady 3m
    }
    pack ${dirfr} -in ${w}.top -side bottom -fill x -padx 10m -pady 3m
}

proc sn_constructe_name {{path ""}} {
    global sn_options
    if {${path} == ""} {
        set path $sn_options(sys,project-file)
    }
    set name [file tail ${path}]
    if {[file extension ${name}] == ".proj"} {
        set name [file root ${name}]
    }
    if {${name} == ""} {
        set name "noname"
    }
    return ${name}
}

proc user_new_directories {} {
    global sn_options
    global sn_newargs
    set dirs ""
    foreach aname [array names sn_newargs "add,*"] {
        set dname $sn_newargs(${aname})
        if {${dname} == "" || ![file isdirectory ${dname}]} {
            #skip unusable directories
            continue
        }
        lappend dirs [realpath -pwd $sn_options(sys,project-dir) ${dname}]
    }
    return ${dirs}
}

#command could be "init", "close", "dir", "file", "message", ..
proc sn_glob_updatecommand {cmd {dir ""}} {
    global SN_glob_Cancel_Flag

    if {![info exists SN_glob_Cancel_Flag]} {
        set SN_glob_Cancel_Flag 0
    }

    if {${cmd} == "init"} {
        #init global variable
        #make sure that the window is created
        sn_loading_message
        set SN_glob_Cancel_Flag 0
        sn_loading_enable_cancel SN_glob_Cancel_Flag
        return "0"
    }\
    elseif {${cmd} == "close"} {
        #disable cancel button
        sn_loading_disable_cancel
        return "0"
    }

    #display current scanned directory
    sn_loading_message ${dir} [get_indep String Scanning]

    #return status to (continue/break) process
    if {[info exists SN_glob_Cancel_Flag]} {
        return ${SN_glob_Cancel_Flag}
    } else {
        return "0"
    }
}

proc sn_create_new_project {{import_file ""}} {
    global sn_options sn_arguments
    global tcl_platform
    global sn_newargs
    global ProcessingCancelled
    global Avail_Parsers Parser_Info
    global xref_termometer

    if {$tcl_platform(platform) == "windows"} {
        set sn_options(include-source-directories) "."
    } else {
        if {[file isdirectory /usr/include]} {
            set sn_options(include-source-directories) [list /usr/include .]
        }
    }

    # Concatenate the known file extensions!
    # to pass it to the glob command
    set glob_expr [list]
    foreach p ${Avail_Parsers} {
        foreach e $Parser_Info(${p},SUF) {
            if {[string index ${e} 0] != "*"} {
                set e "*${e}"
            }
            lappend glob_expr [list ${e}]
        }
    }
    set glob_expr [lunique [lsort [join ${glob_expr}]]]
    set glob_expr [join ${glob_expr}]

    #init some variables
    #initialize the project variables for the actual directory
    set sn_options(sys,project-dir) [pwd]
    set sn_options(sys,project-file)\
      [sn_build_project_filename $sn_options(sys,project-dir)]

    #now we have to overrite the above settings with the command
    #line parameters
    if {[info exists sn_arguments(projectfile)]} {
        set sn_arguments(projectfile) [realpath\
          -pwd $sn_options(sys,project-dir) $sn_arguments(projectfile)]
        if {$sn_arguments(projectfile) != "" && ! [file isdirectory\
          $sn_arguments(projectfile)]} {
            set sn_options(sys,project-dir) [file dirname\
              $sn_arguments(projectfile)]
            #make sure that ".proj" is an extension of the project name
            set sn_options(sys,project-file)\
              [sn_build_project_filename $sn_options(sys,project-dir)\
              $sn_arguments(projectfile)]
        } else {
            sn_error_dialog [format [get_indep String WrongProjectName]\
              $sn_arguments(projectfile)]
            return 0
        }
    }
    #user has specified the database directory in the command line
    if {[info exists sn_arguments(databasedir)]} {
        if {![file exists $sn_arguments(databasedir)]} {
            set ret [catch {file mkdir $sn_arguments(databasedir)}]
        } else {
            set ret 0
        }
        if {[file isdirectory $sn_arguments(databasedir)] || ${ret}} {
            set sn_options(both,db-directory) $sn_arguments(databasedir)
        } else {
            sn_error_dialog [format [get_indep String WrongDatabaseDirectory]\
              $sn_arguments(databasedir)]
            return 0
        }
    }

    #set the correct project name to a global variable
    set sn_options(sys,project-name)\
      [sn_constructe_name $sn_options(sys,project-file)]
    set sn_newargs(path) [file nativename $sn_options(sys,project-file)]

    #import entries from a file
    set fil_list [list]
    if {${import_file} != ""} {
        if {![file exists $import_file]} {
	    sn_error_dialog [format \
		    [get_indep String ErrorImportFileDoesNotExists] \
		    $import_file]
            sn_exit
	}

	if {[file isdirectory $import_file]} {
	    sn_error_dialog [format \
		   [get_indep String ErrorImportFileIsADirectory] $import_file]
	    sn_exit
	}

	set fd [open ${import_file}]
        fconfigure ${fd} \
            -encoding $sn_options(def,system-encoding) \
            -blocking 0
        set files [split [read -nonewline ${fd}] "\n"]
        close ${fd}

        foreach f [sn_copy_with_relative_paths $sn_options(sys,project-dir)\
          ${files}] {
            if {![file exists ${f}] || ![file readable ${f}]} {
                continue
            }

            if {[file isdirectory ${f}]} {
                #set contents [glob -nocomplain -- [file join $f "*"]]
                set contents [sn_glob -nocomplain -match ${glob_expr}\
                  -ignore $sn_options(def,ignored-directories) -dirlevel 0\
                  -dirvar ignore_dirs -updatecommand "sn_glob_updatecommand"\
                  -- ${f}]
                #add only regular files
                foreach subfile ${contents} {
                    if {! [file isfile ${subfile}]} {
                        continue
                    }
                    lappend fil_list ${subfile}
                }
            }\
            elseif {[file type ${f}] == "file"} {
                lappend fil_list ${f}
            }
        }
        set answer 1
        set sn_newargs(have-import-file) disabled
    } else {
        set sn_newargs(have-import-file) normal
    }

    sn_log -l 2 "Source files:\n[join ${fil_list} "\n"]"

    hide_loading_message

    #call fast-create window, when "-import" isn't specified
    #Generate file list for the new created project
    #First ask the user if he wants to fast-create the project
    #based on the actual directory
    #default scan recursive
    set sn_options(def,scan-recursive) -1
    if {! [sn_batch_mode]} {
        foreach obj [itcl::find objects .newprj-dlg.*] {
# FIXME : We need to turn this mess into an itk component!!!!
            itcl::delete object $obj
        }
        foreach aname [array names sn_newargs "add,*"] {
            catch {unset sn_newargs(${aname})}
        }
        set answer [tk_dialog_with_widgets .newprj-dlg [get_indep String\
          FastCreateProject] "[get_indep String FastCreateProjectQuestion]"\
          question_image 0 add_checkbuttons_to_fastcreate_dialog\
          [get_indep String Ok] [get_indep String ProjectEditor]\
          [get_indep String Cancel]]

        if {${answer} == 2} {
            set ProcessingCancelled 1
            return 0
        }
    } else {
        set sn_newargs(add,1) $sn_options(sys,project-dir)
        set answer 0
    }

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

    #directory doesn't exist
    if {![file exists $sn_options(sys,project-dir)] || ![file isdirectory\
      $sn_options(sys,project-dir)]} {
        sn_error_dialog [format [get_indep String UnknownDir]\
          $sn_options(sys,project-dir)]
        set ProcessingCancelled 1
        return 0
    }

    # Bail out if an import directory does not exist
    foreach aname [array names sn_newargs "add,*"] {
        if {$sn_newargs(${aname}) == ""} {
            continue
        }
	# Bail out if import dir does not exist!
	if {![file isdirectory $sn_newargs(${aname})]} {		     
	    sn_error_dialog [format [get_indep String UnknownDir]\
	        $sn_newargs(${aname})]
	    set ProcessingCancelled 1
	    return 0
	}
    }

    #the files are already predefined
    if {$sn_newargs(have-import-file) == "disabled"} {
        if {${answer} == 0} {
            set answer 2
        } else {
            set answer 3
        }
    }

    switch -- ${answer} {
        "0" {
                #verify if the file exists or is being used
                if {! [Project&::can_create_project [file dirname\
                  $sn_newargs(path)] [file tail $sn_newargs(path)]]} {
                    return 0
                }

                #read the files from the selected directories
                sn_loading_message

                set i 0
                set ff ""
                foreach aname [array names sn_newargs "add,*"] {
                    if {$sn_newargs(${aname}) == ""} {
                        continue
                    }
                    set dir [realpath -pwd $sn_options(sys,project-dir)\
                      $sn_newargs(${aname})]
                    set ffiles [sn_glob -match ${glob_expr}\
                      -dirlevel $sn_options(def,scan-recursive)\
                      -ignore $sn_options(def,ignored-directories)\
                      -dirvar ignore_dirs\
                      -updatecommand "sn_glob_updatecommand" -- ${dir}]

                    eval lappend ff ${ffiles}
                    incr i
                }

                # If there is more than one directory specified,
                # make a unique list.
                if {${i} > 1} {
                    set ff [lunique [lsort ${ff}]]
                }
            }
        "2" {
                set ff [lunique [lsort ${fil_list}]]
            }
        "3" {
                #call project editor
                #use the new project editor to add new files to the project
                set t .project_editor
                if {[winfo exist ${t}]} {
                    catch {destroy ${t}}
                }
# FIXME: This variable set stuff is a major hack, we need a generic sort
# of window that supports waiting until the window is closed. This also
# needs to be cleaned up inside the Project& class.
                global wait_for_projecteditor
                # This next line is a hack because
                # wait_for_projecteditor might not be set.
                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]
            }
        default {
                #verify if the user has specified some directories,
                #if this is the case ask the user if he wants to
                #initialize the project editor with this directories.
                set dirs [user_new_directories]
                set dirname [lindex [array names sn_newargs "add,*"] end]

                if {[llength ${dirs}] > 1 || $sn_newargs(old-dir) !=\
                  $sn_newargs(${dirname})} {
                    set answer [tk_dialog .ask-info [get_indep String\
                      ProjectEditor] "[get_indep String\
                      YouHaveAddedSomeDirectories]:\n[join ${dirs}\
                      \n]\n[get_indep String DoYouWantToInitProjEditor]"\
                      question_image 0 [get_indep String Yes]\
                      [get_indep String No]]
                    if {${answer} == 0} {

                        sn_loading_message

                        set fil_list ""
                        set i 0
                        foreach dir ${dirs} {
                            set ffiles [sn_glob -match ${glob_expr}\
                              -dirlevel $sn_options(def,scan-recursive)\
                              -dirvar ignore_dirs\
                              -ignore $sn_options(def,ignored-directories)\
                              -updatecommand "sn_glob_updatecommand" -- ${dir}]
                            eval lappend fil_list ${ffiles}
                            incr i
                        }