# QCad
# (c) Q Solutions 1998
#
# Database back end server
#
# Flat File Backend
#



# dbGetPart partno  - gets part data as a list
# dbPutPart partno list - writes part data with list
# dbPetDecal decal - reads decal returns two lists {header} {item list}
# dbPutDecal decal header itemlist - saves decal info
# dbGetVisual - as dbGetDecal
# dbPut Visual - as dbPutDecal

proc dbGetPart { partno } {

	global GBL

	set file [fileFind $GBL(LibraryPath) $partno .p]

	if {! [file exists $file]} {
		Log dbGetPart: $partno not found
		return ""
	}
	set f [open $file r]
#	set h [gets $f]
	set h ""
	while { ! [eof $f] } {
		set l [gets $f]
		lappend h $l
	}
	close $f
	Log dbGetPart: $partno $h

	return [join $h]
}

proc dbPutPart { partno data} {

	global GBL

	set file [fileFind $GBL(LibraryPath) $partno .p]

	#set GBL(vSelTop) [file dirname $file]
	set GBL(vNewFile) $partno
	set GBL(vFile) $partno 
	dbSetPath $file
	set partno [dbBrowse Part Save]
	if {$partno == "" } { bell ; return ""}
	set file [file join $GBL(vSelTopDir) $GBL(vSelSubDir) $partno.p] 
	set f [open $file w]
#	puts $f $data
	foreach {n d} $data {
		puts $f "$n [list $d]"
	}
	close $f
	Log "dbPutPart: $partno $data"
	return 1
}


proc dbGet { type partno } {

	global GBL

	set file [fileFind $GBL(LibraryPath) $partno [dbExt $type]]
	if {! [file exists $file]} {
		Log "dbGet:$type $partno not found ($file)"
		return ""
	}

	set f [open $file r]
	set h [gets $f]
	set c [list]
	while { ! [eof $f] } {
		set l [gets $f]
		regsub {[\\]n} $l "\n" l
		lappend c $l
	}
	close $f
	Log "dbGet:$type $partno ($h)"
	return [list $h $c]
}


proc dbPut { type partno head data} {

	global GBL

	if { $partno == "" } { set partno UNKNOWN }
	set file [fileFind $GBL(LibraryPath) $partno [dbExt $type]]

	#set GBL(vSelTop) [file dirname $file]
	set GBL(vNewFile) $partno

	set GBL(vFile) $partno 
	dbSetPath $file
	set partno [dbBrowse $type Save]
	if {$partno == "" } { bell ; return ""}
	set file [file join $GBL(vSelTopDir) $GBL(vSelSubDir) $partno[dbExt $type]] 
	set f [open $file w]
	puts $f "$type $head"
	foreach c $data {
		regsub "\n" $c "\\n" c
		puts $f $c
	}
	close $f
	Log "dbPut:$type $partno ($head)"
	return $partno
}

proc dbSetPath {file} {

	global GBL

	set p [file dirname $file]
	catch {unset GBL(vSelTopDir}
	catch {unset GBL(vSelSubDir}
	set top [file dirname $p]
	set sub [file tail $p]
	if { $top == "." } {
		set top $sub
		set sub "."
	}
	catch {	set GBL(vSelTopDir) $top}
	catch {	set GBL(vSelSubDir) $sub}
}

proc dbGetDecal  { partno}  { return [dbGet Decal  $partno]}
proc dbGetVisual { partno}  { return [dbGet Visual $partno]}
proc dbPutDecal { partno head data  } { return [dbPut Decal $partno $head $data]}
proc dbPutVisual { partno head data  } { return [dbPut Visual $partno $head $data]}

proc dbBrowse { type {mode Load} {new 1}} {

	global GBL

	set w .dbBrowse
	global $w.file
	upvar #0 $w.file var
	set var ""
	set of [focus]
	
	#catch {unset GBL(vSelTopDir)}
	#catch {unset GBL(vSelSubDir)}

	set GBL(vTopDirs) {}
	set GBL(vSubDirs) {}
	set GBL(vType) [dbExt $type]
	set GBL(vFile) {}

	foreach p $GBL(LibraryPath) {
		if { [file isdir $p] } { lappend GBL(vTopDirs) $p }
	}
	
	destroy $w
	toplevel $w
	pack [frame $w.top] -side top
	pack [frame $w.bottom -bd 1 -relief solid] -side bottom
	pack [frame $w.right  -bd 1 -relief solid] -side right -anc n -fill y -expand 1
	pack [frame $w.left  -bd 1 -relief solid] -side left -anc n -fill y

	pack [label $w.top.l1 -text "Files: $type"] -pady 10
	pack [frame $w.right.e -bd 1 -relief solid] -anc nw -fill x
	if {$new } {
	 if { $mode == "Load" } {
		pack [label $w.right.e.l1 -text "New File ..."] -side left
		set GBL(vNewFile) {}
	 } else {
		pack [label $w.right.e.l1 -text "Save as ..."] -side left
	 }
  	 pack [entry $w.file -width 20 -textvariable GBL(vNewFile)] -in $w.right.e -side left -expand 1
     bind $w.file <Key-Return> "set GBL(vFile) \$GBL(vNewFile) ; destroy $w"
 	 focus $w.file	
	}
	set m [eval tk_optionMenu $w.left.top GBL(vSelTopDir) $GBL(vTopDirs)]
	pack $w.left.top  -side top -anc nw -fill x
	pack [listbox $w.left.list -height 0] -anc nw -fill y
	pack [listbox $w.right.filelist -height 10 -yscrollcommand "$w.right.sb set"] -anc nw -fill both -side left -expand 1
	pack [scrollbar $w.right.sb -command "$w.right.filelist yview"] -anc nw -fill y -side left

	pack [button $w.bottom.ca -text "Cancel" -command "set GBL(vFile) {}"] -fill x -side left
	pack [button $w.bottom.ok -text "Ok" -command "set GBL(vFile) \$GBL(vNewFile)" ] -fill x -side right

	trace variable GBL(vSelTopDir) w "dbFillDirs $w.left.list ;#"
	trace variable GBL(vSelSubDir) w "dbFillFiles $w.right.filelist ;#"
#	set GBL(vSelTopDir) [lindex $GBL(vTopDirs) 0]
	dbFillDirs $w.left.list
	set p [lsearch -exact $GBL(vSubDirs) $GBL(vSelSubDir)]
	#puts "Sel $p $GBL(vSelSubDir)"
	$w.left.list selection set $p $p
	bind $w.left.list <1> "set GBL(vSelSubDir) \[%W get @%x,%y]"
	bind $w.right.filelist <Double-1> "set GBL(vFile) \[%W get @%x,%y]"
	bind $w.right.filelist <1> "set GBL(vNewFile) \[%W get @%x,%y]"
	vwait GBL(vFile)
	trace vdelete GBL(vSelTopDir) w "dbFillDirs $w.left.list ;#"
	trace vdelete GBL(vSelSubDir) w "dbFillDirs $w.right.filelist ;#"
	destroy $w
	focus -force $of
	return $GBL(vFile)
}

proc dbFillDirs {w} {
	global GBL


	set d $GBL(vSelTopDir)
	set GBL(vSubDirs) {}
	$w delete 0 end
	foreach p [concat $GBL(SubPath) ] {
		if { [file isdir [file join $d $p]] } { lappend GBL(vSubDirs) $p }
	}

	set GBL(vSubDirs)  [lsort $GBL(vSubDirs)]
	eval $w insert end $GBL(vSubDirs)
	if { ! [info exists GBL(vSelSubDir)] || [lsearch -exact $GBL(vSubDirs) $GBL(vSelSubDir)] == -1 } {
		set GBL(vSelSubDir) [lindex $GBL(vSubDirs) 0]
	} else {
		set GBL(vSelSubDir) $GBL(vSelSubDir)
	}

}

proc dbFillFiles {w} {
	global GBL

	$w delete 0 end
	foreach f [lsort -dictionary [glob -nocomplain [file join $GBL(vSelTopDir) $GBL(vSelSubDir) *$GBL(vType)]]] {
		$w insert end [file tail [file rootname $f]]
	}
	focus $w
}


proc dbBrowseExist { type {w ""}} {

	return [dbBrowse $type Load 0]
}


proc dbExt { type } {
	switch $type {
		Visual { return .v }
		Decal	{ return .d }
		Part	{ return .p }
		Pe		{ return .pe}
		De		{ return .d }
		Sch		{ return .sch}
		Pcb		{ return .pcb}
		Net		{ return .net}
		Flow	{ return .flw}
		decal	{ return .d }
		visual	{ return .v }
		part	{ return .p }
		sch		{ return .sch}
		pcb		{ return .pcb}
		flow	{ return .flw}
	}
	return ""
}


proc fileFind { path name ext } {
	set file ${name}$ext
	global GBL

	set sub $GBL(SubPath)

	foreach p $path {
		if { ! [file isdir $p] } { continue }
		foreach s "$sub {}" {
			if { ! [file isdir [file join $p $s]] } { continue }
			set file [file join $p $s ${name}$ext]
			if { [file exists $file] } { 
				regsub -all "//" $file "/" file
				return $file
			}
		}
	}
	
	return "[file join [lindex $path 0] $name$ext]"
}


proc dbGetHelp { key } {

	global Help
	global GBL

	set okey $key
	unset Help ; global Help
	if { ! [array exists Help] } {
		set file [fileFind $GBL(LibraryPath) QSCad .hlp]
		if { [file exists $file] } {
			set f [open $file r]
			array set Help [read $f]
			close $f
		}
	}
	if { [array exists Help] } {
		while { $key != "" } {
			if { [info exists Help($key)] } { return [list $key $Help($key)] }
			set len [llength $key]
			set key [lrange $key 0 end-1]
		}
		return [list $okey  {}]
	}
}










