projedit.tcl

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

        #scanning window
        sn_loading_message

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

        #read the files from the directory
        set fil_list [sn_glob -dirvar dirnames -match ${glob_expr} -dirlevel\
          -1 -ignore $sn_options(def,ignored-directories)\
          -updatecommand "sn_glob_updatecommand" ${dir}]

        add_files_cb ${fil_list}

        #hide scanning window
        hide_loading_message
    }

    method add_directory {} {
        Editor&::DirDialog ${this} -script "${this} add_dir_cb"\
          -initialdir ${last_dir}
    }

    #load files from other existing projects
    method add_from_project_cb {f} {
        global sn_options
        if {[catch {set fd [dbopen db_proj ${f} RDONLY [sn_db_perms] hash]}\
          err]} {
            sn_error_dialog ${err}
            return 0
        }
        set ProjectDir [file dirname ${f}]
        catch {cd ${ProjectDir}}
        set files_prefix [sn_project_database_prefix db_proj]

        if {[catch {set f_fd [dbopen db_f ${files_prefix}.f RDONLY\
          [sn_db_perms] btree]} err]} {
            ${fd} close
            sn_error_dialog ${err}
            return 0
        }
        set files [db_f seq -col 0]
        ${fd} close
        ${f_fd} close

        #add directory name to files if they haven't any prefix
        set nfiles ""
        foreach f ${files} {
            if {[file pathtype ${f}] != "absolute"} {
                set f [file join ${ProjectDir} ${f}]
            }
            lappend nfiles ${f}
        }

        add_files_cb ${nfiles}
    }

    method add_from_project {} {
        global sn_options

        Editor&::FileDialog ${this} -title [get_indep String Open]\
          -script "${this} add_from_project_cb" -initialdir ${last_dir}\
          -extensions $sn_options(project_extensions) -defaultextension ".proj"
    }

    method contents {} {
        return $itk_option(-new_ProjectFiles)
    }
    method hidden {} {
        return ${new_HiddenFiles}
    }

    method windows_close {} {
        if {[Close]} {
            if {$itk_option(-variable) != ""} {
                global $itk_option(-variable)
                set $itk_option(-variable) "cancel"
            } else {
                itcl::delete object ${this}
            }
        }
    }

    method Update_Layout {} {
        global sn_options
        ${tree} config -font $sn_options(def,default-font)\
          -selectforeground $sn_options(def,select-fg)\
          -selectbackground $sn_options(def,select-bg)
    }

    method Refresh_Display {} {
        ReadProjectFiles 1
        Refresh
    }

    #verify if all buffers can be reverted.
    proc CloseAll {} {
# FIXME: ugly itcl::find hack
        foreach win [itcl::find objects -class Project&] {
            if {[${win} Close] == 0} {
                return 0
            }
        }
        return 1
    }
# FIXME: This is a terrible name, what is this "Close" and "CloseAll" stuff for?
    method Close {} {
        #window can be closed
        return 1
    }

    #This function saves the status of all opened sym. br.
    #in the project file.
    proc SaveYourSelf {} {
    }

    #This function restores all the windows saved in the
    #project file
    proc RestoreYourSelf {} {
    }

    #refresh the project windows (max. one !!)
    proc Refresh_YourSelf {} {
        foreach prj [itcl::find objects -class Project&] {
            ${prj} Refresh_Display
        }
    }

    protected variable Toolbar ""
    protected variable Statusbar ""
    protected variable Reuse ""
    protected variable tree "."
    protected variable treew "."
    protected variable prjname_Entry "."
    protected variable prjdir_Entry "."

    protected variable Views_Combo "never exists"

    protected variable view_state normal
    protected variable unload_state normal
    protected variable hide_state normal

    protected variable btnsfr
    protected variable filefr
    protected variable can_apply 0

    protected variable Undo_HiddenFiles ""
    protected variable Undo_files_to_unload ""
    protected variable Undo_ProjectFiles ""

    common ProjectFiles ""
    common orig_ProjectFiles ""
    #with db filenames
    common ProjectViews ""
    #without db filenames
    common Views ""
    common CurrentView ""
    common HiddenFiles ""
    common files_to_unload ""

#    public variable new_ProjectFiles ""
    itk_option define -new_ProjectFiles new_ProjectFiles New_ProjectFiles "" 
    public variable new_HiddenFiles ""

    #can be
    #tree: display file names as tree
    #categorie: display file names as categories
    #list: display filenames as easy list
    public variable Tree_Mode "tree"
    public variable x ""
    public variable y ""
#    public variable new_project 0
    itk_option define -new_project new_Project New_Project "0"
    itk_option define -variable variable Variable ""
}

proc build_filepath {treew Tree_Mode y {upto 0}} {
    set file [${treew} get ${y}]
    switch -- ${Tree_Mode} {
        "tree" {
                set parent [${treew} itemcget ${y} -parent]
                for {set i ${parent}} {[${treew} level ${i}] > ${upto} && ${i}\
                  >= 0} {set i [${treew} itemcget ${i} -parent]} {
                    set file [file join [${treew} get ${i}] ${file}]
                }
                return ${file}
            }
        "cat" {
                #nothing to do
            }
        "list" {
                #nothing to do
            }
    }
    #/
    #  view-mode has the format "<file>\t<dir>"
    #/
    if {[string first "\t" ${file}] != -1} {
        set x [split ${file} \t]
        set d [lindex ${x} end]
        if {${d} != ""} {
            set file [file join ${d} [lindex ${x} 0]]
        } else {
            set file [lindex ${x} 0]
        }
        set file [sn_convert_FileName ${file}]
    }
    return ${file}
}

#build file names of the selected entries, including
#tree sub items
proc build_file_list {treew treemode sels} {
    set files ""
    foreach y ${sels} {
        set children [${treew} children ${y}]
        if {${children} != ""} {
            foreach ch ${children} {
                set ff [build_file_list ${treew} ${treemode} ${ch}]
                if {${ff} != ""} {
                    foreach f ${ff} {
                        if {[lsearch -exact ${files} ${f}] == -1} {
                            lappend files ${f}
                        }
                    }
                }
            }
        }\
        elseif {[${treew} levels ${y}] > 0} {
            set f [build_filepath ${treew} ${treemode} ${y}]
            if {[lsearch -exact ${files} ${f}] == -1} {
                lappend files ${f}
            }
        }
    }
    return ${files}
}

proc add_list_to_project {treew parent image basedir cnt} {
    global sn_options
    global sn_root
    if {! ${basedir}} {
        ${treew} insert end list ${cnt} -parent ${parent} -image ${image}
    } else {
        global tcl_platform
        if {$tcl_platform(platform) == "windows"} {
            set from 1
            set to 2
            set cmp ":${sn_root}"
        } else {
            set from 0
            set to 0
            set cmp ${sn_root}
        }
        set ff ""
        foreach f ${cnt} {
            set d [file dirname ${f}]
            if {${d} == "."} {
                set d $sn_options(sys,project-dir)
            }
            if {[string range ${d} ${from} ${to}] != ${cmp}} {
                set d "\t[file join $sn_options(sys,project-dir) ${d}]"
            } else {
                set d "\t${d}"
            }
            lappend ff "[file tail ${f}]${d}"
        }
        #we must resort files again, because "array names" does
        #unsort a sorted list!!
        ${treew} insert end list [lsort -dictionary ${ff}] -parent ${parent}\
          -image ${image}
    }
}

proc AddFilesAsCategorie {treew types parent cnt image basedir} {
    global sn_options
    global sn_root
    #add files as categories
    foreach f ${cnt} {
        set fnd 0
        #find categorie
        foreach l ${types} {
            set type [lindex ${l} 0]
            set ext [lindex ${l} end]
            foreach e ${ext} {
                if {[string match ${e} ${f}]} {
                    lappend files(${type}) ${f}
                    set fnd 1
                    break
                }
            }
            if {${fnd}} {
                break
            }
        }
        #no categorie
        if {! ${fnd}} {
            lappend files(uncategorized) ${f}
        }
    }

    #add found categories
    foreach nm [lsort -dictionary [array names files]] {
        set ni [${treew} insert end -text ${nm} -image dir_image\
          -parent ${parent}]
        if {${basedir}} {
            global tcl_platform
            if {$tcl_platform(platform) == "windows"} {
                set from 1
                set to 2
                set cmp ":${sn_root}"
            } else {
                set from 0
                set to 0
                set cmp ${sn_root}
            }
            set ff ""
            foreach f $files(${nm}) {
                set d [file dirname ${f}]
                if {${d} == "."} {
                    set d $sn_options(sys,project-dir)
                }
                if {[string range ${d} ${from} ${to}] != ${cmp}} {
                    set d "\t[file join $sn_options(sys,project-dir) ${d}]"
                } else {
                    set d "\t${d}"
                }
                lappend ff "[file tail ${f}]${d}"
            }
            #we must resort files again, because "array names" does
            #unsort a sorted list!!
            ${treew} insert end list [lsort -dictionary ${ff}] -parent ${ni}\
              -image ${image}
        } else {
            ${treew} insert end list $files(${nm}) -parent ${ni} -image ${image}
        }
    }
}

#look for the from user alreay hidden subtrees and hide thim before
#displaying the tree on the screen, this helps the user adding
#his files comfortable
proc project_CloseAlreayClosed {treew Tree_Mode} {
    global projtree sn_root
    set size [${treew} size]
    if {${size} == 0} {
        catch {unset projtree}
        return
    }
    set names [lsort -dictionary [array names projtree "${Tree_Mode}/*"]]
    if {${names} == ""} {
        return
    }
    foreach name ${names} {
        set start 0
        set basename [file tail ${name}]
        while {1} {
            set idx [${treew} search -realindex -exact -- ${basename} ${start}\
              end]
            if {${idx} == ""} {
                #rootnames with full path contain "/" on there name
                set f [file nativename [file join / ${basename}]]
                set idx [${treew} search -realindex -exact -- ${f} ${start} end]
            }
            if {${idx} == ""} {
                break
            }
            if {"${Tree_Mode}/[build_filepath ${treew} ${Tree_Mode} ${idx}\
              -1]" == ${name}} {
                #hide this sub tree
                ${treew} toggle ${idx} hide
                break
            }
            set start [expr ${idx} + 1]
            if {${start} >= ${size}} {
                break
            }
        }
    }
}

proc project_editor {} {
    set t .project_editor
    if {[winfo exists ${t}]} {
        ${t} raise
    } else {
        Project& ${t}
    }
}