projmng.tcl

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

    global sn_arguments
    global ProcessingCancelled

    sn_log "try to create project..."

    if {${t} != ""} {
        ${t} withdraw
    }

    if {![info exists sn_arguments(import-file)]} {
        set sn_arguments(import-file) ""
    }

    #create the project
    set ret [sn_create_new_project $sn_arguments(import-file)]
    if {${ret} == 0 || ${ProcessingCancelled}} {
        if {${ret} == 0 && ![sn_batch_mode]} {
            # If a half-created project is sitting around, delete it!
            if {[file exists $sn_options(sys,project-file)]} {
                sn_delete_project $sn_options(sys,project-file)
            }
        }
    
        if {${t} != ""} {
            window_configure ${t} deiconify
        }
        update idletasks
        set ProcessingCancelled 0
        return 0
    }

    if {${t} != ""} {
        global proj_selector_status
        destroy ${t}
        set proj_selector_status "open"
    }

    sn_log "new project has been created <1>"

    return 1
}

#opens a project, given by project name
proc sn_open_project_cb {pfile} {
    global ProcessingCancelled

    sn_log "open project <${pfile}>"

    sn_loading_message

    set ret [sn_read_project ${pfile}]
    if {${ret} != 1} {
        #error, close all db files
        db_close_files
        set ProcessingCancelled 0
        set ret 0
    } else {
        set ret 1
    }

    hide_loading_message

    return ${ret}
}

proc Open_Project {t} {
    global tcl_platform proj_selector_status

    set listbox $t.scrolllistbox.projs

    set p [$listbox curselection]
    if {${p} == ""} {
        return 0
    }
    set prj [$listbox get ${p}]
    if {[string compare ${prj} ""] == 0} {
        set prj [$listbox get active]
    }
    if {${prj} == ""} {
        return 0
    }

    ${t} withdraw

    if {$tcl_platform(platform) == "windows"} {
        regsub -all {\\} ${prj} {/} prj
    }

    sn_log "open project <${prj}>..."

    if {[sn_open_project_cb ${prj}]} {
        set proj_selector_status "open"
        destroy ${t}
        return 1
    } else {
        ${t} deiconify
    }
    return 0
}

proc Browse_For_Project {t} {
    global proj_selector_status

    ${t} withdraw
    set prjname [sn_choose_project ${t}]
    if {${prjname} == ""} {
        ${t} deiconify
        return 0
    }
    if {[sn_open_project_cb ${prjname}]} {
        set proj_selector_status "open"
        itcl::delete object ${t}
    } else {
        ${t} deiconify
        set ProcessingCancelled 1
        return 0
    }
    return 1
}

proc Close_Project_List_cb {{waiting "wait"}} {
    global ProcessingCancelled proj_selector_status
    if {${waiting} == "nowait"} {
        delete_interp
    } else {
        set ProcessingCancelled 1
        set proj_selector_status "cancel"
    }
}

# listbox scroll handling for sn_select_project.
proc scrollListbox {wid first last} {
    $wid set $first $last
    # TODO: When Tk supports enabled/disabled
    # scrollbars, we should enable and disable
    # our scrollbars when they ain't needed.
}

#Displays the projects to select one of them
proc sn_select_project {{waiting "wait"}} {
    global proj_selector_status
    global ProcessingCancelled
    global sn_history
    global tcl_platform

    #read project list
    set proj_list [sn_read_exist_projects]

    set t .sn_open_proj
    if {[winfo exists ${t}]} {
        sn_log "Raising existing project selection widget"
        ${t} raise
        return ${ProcessingCancelled}
    }

    # Hide the toplevel window until it is ready to be displayed
    sourcenav::Window ${t}
    ${t} withdraw
 
    ${t} on_close [list Close_Project_List_cb ${waiting}]
    ${t} configure -title [sn_title [get_indep String PafOpenProj] 1]
    ${t} configure -iconname [get_indep String ProductName]

    set open_str [get_indep String Open]
    set off [string first "." ${open_str}]
    if {${off} != -1} {
        set open_str [string range ${open_str} 0 [expr ${off} -1]]
    }
    pack [frame ${t}.btns] -side right -fill y -padx 5 -pady 5
    #new project
    button ${t}.btns.new -text [get_indep String NewProj]\
      -underline [get_indep Pos NewProj] -command " sn_new_project_cb ${t} "
    # Open existing
    button ${t}.btns.browse -text [get_indep String BrowseProj]\
      -underline [get_indep Pos BrowseProj] -command " Browse_For_Project\
      ${t} "
    # Open project
    button ${t}.btns.open -text [get_indep String Open] -underline\
      [get_indep Pos Open] -command " Open_Project ${t} "
    #Delete project
    button ${t}.btns.delete -text [get_indep String Delete]\
      -underline [get_indep Pos Delete] -command\
      " sn_delete_project_cb ${t}.btns $t.scrolllistbox.projs "
    # Cancel
    button ${t}.btns.exit -text [get_indep String Cancel]\
      -underline [get_indep Pos Cancel] -command [list Close_Project_List_cb\
      ${waiting}]
# FIXME: this should all be gridded
    pack ${t}.btns.new ${t}.btns.browse ${t}.btns.open ${t}.btns.delete\
      ${t}.btns.exit -side top -fill x -pady 5

    set len [llength ${proj_list}]
    if {[catch {set max_len $sn_history(project_size)}]} {
        set max_len 50
    }
    if {${max_len} < ${len}} {
        set height $sn_history(project_size)
    } else {
        set height ${len}
    }
    if {${height} <= 0} {
        set height 6
    }

    sn_log "project list <${proj_list}>"

    if {$tcl_platform(platform) == "windows"} {
        set prjlst ${proj_list}
        set proj_list ""
        foreach prj ${prjlst} {
            sn_log "add project <${prj}, [file nativename ${prj}]>"
            lappend proj_list [file nativename ${prj}]
        }

        sn_log "windows project list <${proj_list}>"
    }

    # Use this frame to hold listbox and scrollbars.

    set f [frame $t.scrolllistbox -relief sunken\
	    -borderwidth 2]

    scrollbar $f.vertsb -orient vertical \
	    -relief flat -borderwidth 1 -highlightthickness 0
    scrollbar $f.horizsb -orient horizontal \
	    -relief flat -borderwidth 1 -highlightthickness 0

    listbox $f.projs -width 55 -relief flat -height $height \
	    -borderwidth 0 \
	    -xscrollcommand "scrollListbox $f.horizsb" \
	    -yscrollcommand "scrollListbox $f.vertsb"

    foreach prj ${proj_list} {
        ${f}.projs insert end ${prj}
    }

    $f.vertsb configure -command "$f.projs yview"
    $f.horizsb configure -command "$f.projs xview"

    bind ${f}.projs <ButtonRelease-1> "+
						${t}.btns.open config -state normal
						${t}.btns.delete config -state normal"

    set return_binding "
				${f}.projs selection clear 0 end
				${f}.projs selection set active
				${t}.btns.open config -state normal
				update idletasks
				${t}.btns.open invoke
				break"

    bind ${f}.projs <Return> $return_binding
    bind ${f}.projs <space> $return_binding

    # Wait for ButtonRelease before invoking the open button.
    # Otherwise the ButtonRelease event will be lost and it will appear
    # as if Button-1 is being held down once the project is opened.
 
    bind ${f}.projs <Double-1> "bind $f.projs <ButtonRelease-1>\
                                \"${t}.btns.open invoke; break\";update; break"
    bind ${f}.projs <Escape> "${t}.btns.exit invoke; break"

    grid $f.projs -row 1 -column 1 -sticky news
    grid $f.vertsb -row 1 -column 2 -sticky ns
    grid $f.horizsb -row 2 -column 1 -sticky ew
    grid [frame $f.dummyframe -relief groove -borderwidth 2] -row 2 -column 2 -sticky news
    grid columnconfigure $f 1 -weight 1
    grid rowconfigure $f 1 -weight 1

    focus ${f}.projs

    pack $f -fill both -expand 1 -side left -padx 5 -pady 5

    # Make sure the first item (if any) is selected.
    $f.projs selection set 0

    # Bring up the window to the top and make it visible
    update idletasks
    ${t} centerOnScreen
    ${t} deiconify
    ${t} take_focus ${f}.projs

    # It must be here, otherwise we might
    # get problems on W-95.
    hide_loading_message

    catch {sn_rc_project_list ${t} ${f}.projs}

    set proj_selector_status ""
    #when a new interpreter is created, don't wait to
    #continue proceeding with the CALLING interpreter
    #VERY IMPORTANT
    if {${waiting} != "nowait"} {
        vwait proj_selector_status
        if {${proj_selector_status} == "cancel"} {
            set ProcessingCancelled 1
        }
        if {${ProcessingCancelled}} {
            return 0
        } else {
            return 1
        }
    } else {
        return 1
    }
}