# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# projmng.tcl - Implement several operations on projects.
# Copyright (C) 1998 Cygnus Solutions.

# FIXME: these procs ought to become methods of a Project class.

# This function reads the name of the used and still existing
# project file names.
proc sn_read_exist_projects {{truncate 0}} {
	global sn_history
	global sn_projects_list
	global sn_options
	global tcl_platform
	
	if {![info exists sn_history(project_size)]} {
		set sn_history(project_size) 10
	}

	set pf $sn_projects_list(filename)
	
	if {[info exists sn_projects_list(mtime)] &&
		$sn_projects_list(mtime) == [file mtime $pf]} {
			if {$truncate} {
				return [lrange $sn_projects_list(names) 0 $sn_history(project_size)]
			}
			return $sn_projects_list(names)
	}

	#read projects from the project file
	if {[catch {set prjfd [open $pf]}]} {
		return ""
	}
	fconfigure $prjfd -encoding $sn_options(def,system-encoding)
	set projs [split [read -nonewline $prjfd] "\n"]
	close $prjfd

	set sn_projects_list(mtime) [file mtime $pf]

	set exist_projs ""
	catch {unset scaned}
	foreach pr $projs {
		if {[file isfile $pr] && [file readable $pr]} {
			#make sure that the project file hasn't been added to the list,
			#this could happen, when files are stored with different roots
			#on windows  "C:/foo" and "C:\foo"
			set f [file nativename $pr]
			
			if {$tcl_platform(platform) == "windows"} {
				set scanf [string tolower $f]
			} else {
				set scanf $f
			}
			if {[info exists scaned($scanf)]} {
				continue
			}
			#append original file
			lappend exist_projs $f
			set scaned($scanf) 1
		}
	}
	catch {unset scaned}
	
	set sn_projects_list(names) $exist_projs

	# Truncate if neceassary!
	if {$truncate} {
		set exist_projs [lrange $exist_projs 0 $sn_history(project_size)]
	}

	return $exist_projs
}


#delete a SN project, given by project name
proc sn_delete_project {prjname {ask ""}} {
	global sn_options
	
	if {$ask != ""} {
		set answer [tk_dialog auto \
						[get_indep String ProjectDelete] \
						"[get_indep String DeleteProjectQuestion] \"$prjname\" ?" \
						question_image 0 \
						[get_indep String Yes] [get_indep String No]]
		if {$answer != 0} {
			return -1
		}
	}

	sn_log "delete project <$prjname>"

	#open the project file
	set prj_error [catch {set prj_descr [dbopen prj_db $prjname RDONLY [sn_db_perms] hash]}]
	
	#init some error/debug routines
	set delerr 0
	set err ""
	
	#change to the project directory
	if {! $prj_error} {
		set prjDir [file dirname $prjname]
		catch {cd $prjDir}
	
		#read database filename prefix
		set db_prefix [sn_project_database_prefix prj_db]
		
		sn_log "database prefix <$db_prefix>"
		
		#read symbol database directory
		set wd [sn_project_database_dir prj_db]
		
		if {$wd == "" || $db_prefix == "" || [file pathtype $wd] != "absolute"} {
			set wd ""
		}
		
		#check wether the database is locked
		set ret [sn_is_project_busy $prjname in user host port]
		set ret 0
		switch -- $ret {
			"me" -
			"busy" {
				sn_error_dialog [format [get_indep String PafProjBusy] $prjname $user]
				set ret 1
			  }
			"error" {
				#ignore error
			  }
		}
		
		#project can't be deleted
		if {$ret} {
			sn_log "project can't be deleted"
			return 0
		}
		
		#open db files
		set prj_db_error [catch {set prj_f_descr [dbopen prj_db_f $db_prefix.f RDONLY [sn_db_perms] btree]}]
		if {!$prj_db_error} {
			#delete highlighting files
			if {![catch {set fls [prj_db_f seq -col 3 -result {*[a-zA-Z0-9_]*}]}]} {
				sn_log "delete related files <$fls>"
				catch {eval file delete -- $fls}
			} else {
				sn_log "no database files found"
			}
			
			#close filenames database
			$prj_f_descr close
		}
		
		#delete temporary files
		if {$wd != ""} {
			set fls [glob -nocomplain [file join $wd *.html] [file join $wd dbimp_*] [file join $wd tmp_*]]
			if {$fls != ""} {
				sn_log "delete temporary files <$fls>"
				catch {eval file delete -- $fls}
			}
		}
		
		#delete all project related files (database files)
		set del_fls [glob -nocomplain $db_prefix.*]
		if {$del_fls != ""} {
			sn_log "delete project database files <$del_fls>"
			set delerr [catch {eval file delete -- $del_fls} err]
		} else {
			sn_log "no project database files found!"
			set delerr 0
		}
		
		if {$wd != ""} {
			sn_log "try to delete database directory (if empty) <$wd>"
			catch {file delete -- $wd};	# It might not be empty.
		}
	
		#close the project file
		$prj_descr close
		
		#change to the current project directory
		catch {cd $sn_options(sys,project-dir)}
	}
	
	sn_log "delete project file <$prjname>"
	
	#delete the project file itself.
	set prjdelerr [catch {file delete -- $prjname} prjerr]
	
	if {$delerr} {
		sn_error_dialog $err
	} elseif {$prjdelerr} {
		sn_error_dialog $prjerr
	}
	
	sn_log "project <$prjname> deleted"
	
	return 1
}

proc sn_delete_project_cb {btns t} {
	set idx [$t curselection]
	if {$idx == ""} {
		return
	}
	set prj [$t get $idx]
	if {$prj == ""} {
		bell; return
	}
	set ret [sn_delete_project $prj ask_to_delete]
	if {$ret == -1} {
		return
	}
	if {$ret == 0} {
		sn_error_dialog [get_indep String CannotDeleteProject]
		return
	}
	
	#delete entry from the list
	$t.tree delete $idx
	
	$btns.open config -state disabled
	$btns.delete config -state disabled
}

proc sn_new_project {} {
	create_interp -app navigator -e "wm withdraw . ; sn_start_new_session --create"
}

#starts the project selector in a new interpreter, the
#interpreter is deleted, when the user cancels selection
#the selector is only called, when no other interp. are
#started.
proc sn_projectmanager {} {
	global tkeWinNumber
	global proj_selector_status
	if {[number_interp] <= 1} {
		#create an interpreter and return immediatly to proceed
		#with the existing interpreter
		create_interp -app navigator-$tkeWinNumber -e "
				wm withdraw .
				if {\[sn_select_project nowait\] == 0} {
					delete_interp
				}
				"
	}
}

#waits for xref to be built
proc sn_is_waiting_for_xref {} {
	global sn_wait_xref_flag
	
	if {! [sn_processes_running]} {
		set sn_wait_xref_flag "finished"
		return
	}
	update idletasks
	
	after 1000 sn_is_waiting_for_xref
}

#create a new project
proc sn_new_project_cb {{t ""}} {
	global sn_options
	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} {
		if {$t != ""} {
			window_configure $t deiconify
		}
		update idletasks
		set ProcessingCancelled 0
		return 0
	}

	if {$ProcessingCancelled} {
		if {$t != ""} {
			window_configure $t deiconify
		}
		update idletasks
		set ProcessingCancelled 0
		return 0
	}
	
	if {$t != ""} {
		global proj_selector_status
		$t delete
		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 p [$t.projs curselection]
	if {$p == ""} {
		return 0
	}
	set prj [$t.projs get $p]
	if {[string compare $prj ""] == 0} {
		set prj [$t.projs 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"
		$t delete
		return 1
	} else {
		$t deiconify
	}
	return 0
}

proc Open_Existing_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"
		$t delete
	} 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"
	}
}

#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]
	
	#verify witch project files are not used to list into the project
	set plst $proj_list
	set proj_list ""
	foreach f $plst {
		if {![isfileused $f]} {
			lappend proj_list $f
		}
	}
	
	set t .sn_open_proj
	if {[winfo exists $t]} {
		$t raise
		return $ProcessingCancelled
	}
	Toplevel& $t
	$t on_close [list Close_Project_List_cb $waiting]
	$t title [sn_title [get_indep String PafOpenProj] 1]
	$t 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.openexists \
			-text [get_indep String OpenProj] \
			-underline [get_indep Pos OpenProj] \
			-command "Open_Existing_Project $t"
	#open project
	button $t.btns.open \
			-text [get_indep String Open] \
			-underline [get_indep Pos Open] \
			-state disabled \
			-command "Open_Project $t"
	#Delete project
	button $t.btns.delete \
			-text [get_indep String Delete] \
			-underline [get_indep Pos Delete] \
			-state disabled \
			-command "sn_delete_project_cb $t.btns $t.projs"
	#Cancel
	button $t.btns.exit \
			-text [get_indep String Cancel] \
			-underline [get_indep Pos Cancel] \
			-command [list Close_Project_List_cb $waiting]
	pack $t.btns.new $t.btns.openexists $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>"
	}
	
	Tree& $t.projs \
			-width 55 \
			-height $height \
			-filter "" \
			-sort ""
	# \
			-contents $proj_list
	foreach prj $proj_list {
		[$t.projs tree] insert end -text $prj
	}
	
	$t.projs activate 0
	$t.projs bind <ButtonRelease-1> "+
						$t.btns.open config -state normal
						$t.btns.delete config -state normal"
	$t.projs bind <Return> "
				$t.projs selection clear 0 end
				$t.projs selection set active
				$t.btns.open config -state normal
				update idletasks
				$t.btns.open invoke
				break"
	$t.projs bind <space> [$t.projs bind <Return>]
	$t.projs bind <Double-1> "$t.btns.open invoke; break"
	$t.projs bind <Escape> "$t.btns.exit invoke; break"

	pack $t.projs -fill both -expand 1 -side left -padx 5 -pady 5
	focus [$t.projs tree]

	$t move_to_mouse

	#brin up the window to the top and make it visible
	$t take_focus [$t.projs tree]
	
	# It must be here, otherwise we might
	# get problems on W-95.
	hide_loading_message

	catch {sn_rc_project_list $t $t.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"} {
		tkwait variable proj_selector_status
		if {$proj_selector_status == "cancel"} {
			set ProcessingCancelled 1
		}
		if {$ProcessingCancelled} {
			return 0
		} else {
			return 1
		}
	} else {
		return 1
	}
}



