#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

global widget;

image create bitmap dnarw -data  {
#define down_arrow_width 15
#define down_arrow_height 15
static char down_arrow_bits[] = {
	0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80,
	0x00,0x80,0xf8,0x8f,0xf0,0x87,0xe0,0x83,
	0xc0,0x81,0x80,0x80,0x00,0x80,0x00,0x80,
	0x00,0x80,0x00,0x80,0x00,0x80
	}
}

proc {set_default_fonts} {} {
global pref tcl_platform
if {[string toupper $tcl_platform(platform)]=="WINDOWS"} {
	set pref(font_normal) {"MS Sans Serif" 8}
	set pref(font_bold) {"MS Sans Serif" 8 bold}
	set pref(font_fix) {Terminal 8}
	set pref(font_italic) {"MS Sans Serif" 8 italic}
} else {
	set pref(font_normal) -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
	set pref(font_bold) -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
	set pref(font_italic) -Adobe-Helvetica-Medium-O-Normal-*-*-120-*-*-*-*-*
	set pref(font_fix) -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-*
}
}

proc {set_gui_pref} {} {
global pref
foreach wid {Label Text Button Listbox Checkbutton Radiobutton} {
	option add *$wid.font $pref(font_normal)
}
option add *Entry.background #fefefe
option add *Entry.foreground #000000
}

proc {load_pref} {} {
global pref
set_default_fonts
set_gui_pref
set retval [catch {set fid [open "~/.pgaccessrc" r]}]
if {$retval} {
	set pref(rows) 200
	set pref(tvfont) clean
	set pref(autoload) 1
	set pref(lastdb) {}
	set pref(lasthost) localhost
	set pref(lastport) 5432
	set pref(username) {}
	set pref(password) {}
} else {
	while {![eof $fid]} {
		set pair [gets $fid]
		set pref([lindex $pair 0]) [lindex $pair 1]
	}
	close $fid
	set_gui_pref
}
}

proc init {argc argv} {
global dbc host pport tablist mw fldval activetab qlvar mwcount pref
load_pref
set host localhost
set pport 5432
set dbc {}
set tablist [list Tables Queries Views Sequences Functions Reports Forms Scripts Users]
set activetab {}
set qlvar(yoffs) 360
set qlvar(xoffs) 50
set qlvar(reswidth) 150
set qlvar(resfields) {}
set qlvar(ressort) {}
set qlvar(resreturn) {}
set qlvar(rescriteria) {}
set qlvar(restables) {}
set qlvar(critedit) 0
set qlvar(links) {}
set qlvar(ntables) 0
set qlvar(newtablename) {}
set mwcount 0
}

init $argc $argv

proc {sqlw_display} {msg} {
	if {![winfo exists .sqlw]} {return}
	.sqlw.f.t insert end "$msg\n\n"
	.sqlw.f.t see end
	set nrlines [lindex [split [.sqlw.f.t index end] .] 0]
	if {$nrlines>50} {
		.sqlw.f.t delete 1.0 3.0
	}
}

proc {wpg_exec} {db cmd} {
global pgsql
	set pgsql(cmd) "never executed"
	set pgsql(status) "no status yet"
	set pgsql(errmsg) "no error message yet"
	if {[catch {
		sqlw_display $cmd
		set pgsql(cmd) $cmd
		set pgsql(res) [pg_exec $db $cmd]
		set pgsql(status) [pg_result $pgsql(res) -status]
		set pgsql(errmsg) [pg_result $pgsql(res) -error]
	} tclerrmsg]} {
		show_error "Tcl error executing pg_exec $cmd\n\n$tclerrmsg"
		return 0
	}
	return $pgsql(res)
}

proc {wpg_select} {args} {
	sqlw_display "[lindex $args 1]"
	uplevel pg_select $args
}

proc {anfw:add} {} {
global anfw pgsql tiw
	if {$anfw(name)==""} {
		show_error "Empty field name ?"
		focus .anfw.e1
		return
	}		
	if {$anfw(type)==""} {
		show_error "No field type ?"
		focus .anfw.e2
		return
	}
	if {![sql_exec quiet "alter table \"$tiw(tablename)\" add column \"$anfw(name)\" $anfw(type)"]} {
		show_error "Cannot add column\n\nPostgreSQL error: $pgsql(errmsg)"
		return
	}
	Window destroy .anfw
	sql_exec quiet "update pga_layout set colnames=colnames || ' {$anfw(name)}', colwidth=colwidth || ' 150',nrcols=nrcols+1 where tablename='$tiw(tablename)'"
	show_table_information $tiw(tablename)
}

proc {add_new_field} {} {
global ntw
if {$ntw(fldname)==""} {
	show_error "Enter a field name"
	focus .nt.e2
	return
}
if {$ntw(fldtype)==""} {
	show_error "The field type is not specified!"
	return
}
if {($ntw(fldtype)=="varchar")&&($ntw(fldsize)=="")} {
	focus .nt.e3
	show_error "You must specify field size!"
	return
}
if {$ntw(fldsize)==""} then {set sup ""} else {set sup "($ntw(fldsize))"}
if {[regexp $ntw(fldtype) "varchartextdatetime"]} {set supc "'"} else {set supc ""}
if {$ntw(defaultval)==""} then {set sup2 ""} else {set sup2 " DEFAULT $supc$ntw(defaultval)$supc"}
# Checking for field name collision
set inspos end
for {set i 0} {$i<[.nt.lb size]} {incr i} {
	set linie [.nt.lb get $i]
	if {$ntw(fldname)==[string trim [string range $linie 2 33]]} {
		if {[tk_messageBox -title Warning -parent .nt -message "There is another field with the same name: \"$ntw(fldname)\"!\n\nReplace it ?" -type yesno -default yes]=="no"} return
		.nt.lb delete $i
		set inspos $i
		break
	}	 
  }
.nt.lb insert $inspos [format "%1s %-32.32s %-14s%-16s" $ntw(pk) $ntw(fldname) $ntw(fldtype)$sup $sup2$ntw(notnull)]
focus .nt.e2
set ntw(fldname) {}
set ntw(fldsize) {}
set ntw(defaultval) {}
set ntw(pk) " "
}

proc {create_table} {} {
global dbc ntw
if {$ntw(newtablename)==""} then {
	show_error "You must supply a name for your table!"
	focus .nt.etabn
	return
}
if {[.nt.lb size]==0} then {
	show_error "Your table has no fields!"
	focus .nt.e2
	return
}
set fl {}
set pkf {}
foreach line [.nt.lb get 0 end] {
	set fldname "\"[string trim [string range $line 2 33]]\""
	lappend fl "$fldname [string trim [string range $line 35 end]]"
	if {[string range $line 0 0]=="*"} {
		lappend pkf "$fldname"
	}
}
set temp "create table \"$ntw(newtablename)\" ([join $fl ,]"
if {$ntw(constraint)!=""} then {set temp "$temp, constraint \"$ntw(constraint)\""}
if {$ntw(check)!=""} then {set temp "$temp check ($ntw(check))"}
if {[llength $pkf]>0} then {set temp "$temp, primary key([join $pkf ,])"}
set temp "$temp)"
if {$ntw(fathername)!=""} then {set temp "$temp inherits ($ntw(fathername))"}
cursor_clock
if {[sql_exec noquiet $temp]} {
	Window destroy .nt
	cmd_Tables
}
cursor_normal
}

proc {cmd_Delete} {} {
global dbc activetab
if {$dbc==""} return;
set objtodelete [get_dwlb_Selection]
if {$objtodelete==""} return;
set temp {}
switch $activetab {
	Tables {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete table:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec noquiet "drop table \"$objtodelete\""
			sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
			cmd_Tables
		}
	}
	Views {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete view:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec noquiet "drop view \"$objtodelete\""
			sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
			cmd_Views
		}
	}
	Queries {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete query:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec quiet "delete from pga_queries where queryname='$objtodelete'"
			sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
			cmd_Queries
		}
	}
	Scripts {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete script:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec quiet "delete from pga_scripts where scriptname='$objtodelete'"
			cmd_Scripts
		}
	}
	Forms {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete form:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec quiet "delete from pga_forms where formname='$objtodelete'"
			cmd_Forms
		}
	}
	Sequences {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete sequence:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec quiet "drop sequence \"$objtodelete\""
			cmd_Sequences
		}
	}
	Functions {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete function:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			delete_function $objtodelete
			cmd_Functions
		}
	}
	Reports {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete report:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec noquiet "delete from pga_reports where reportname='$objtodelete'"
			cmd_Reports
		}
	}
	Users {
		if {[tk_messageBox -title "FINAL WARNING" -parent .dw -message "You are going to delete user:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
			sql_exec noquiet "drop user \"$objtodelete\""
			cmd_Users
		}
	}
}
if {$temp==""} return;
}

proc {cmd_Design} {} {
global dbc activetab rbvar uw
if {$dbc==""} return;
if {[.dw.lb curselection]==""} return;
set objname [.dw.lb get [.dw.lb curselection]]
set tablename $objname
switch $activetab {
	Queries {open_query design}
	Views {open_view_design}
	Scripts {design_script $objname}
	Forms {fd_load_form $objname design}
	Reports {
		Window show .rb
		tkwait visibility .rb
		rb_init
		set rbvar(reportname) $objname
		rb_load_report
		set rbvar(justpreview) 0
	}
	Users {
		Window show .uw
		tkwait visibility .uw
		wm transient .uw .dw
		wm title .uw "Design user"
		set uw(username) $objname
		set uw(password) {} ; set uw(verify) {}
		pg_select $dbc "select *,date(valuntil) as valdata from pg_user where usename='$objname'" tup {
			if {$tup(usesuper)=="t"} {
				set uw(createuser) CREATEUSER
			} else {
				set uw(createuser) NOCREATEUSER
			}
			if {$tup(usecreatedb)=="t"} {
				set uw(createdb) CREATEDB
			} else {
				set uw(createdb) NOCREATEDB
			}
			if {$tup(valuntil)!=""} {
				set uw(valid) $tup(valdata)
			} else {
				set uw(valid) {}
			}
		}
		.uw.e1 configure -state disabled
		.uw.b1 configure -text Alter
		focus .uw.e2
	}
}
}

proc {cmd_Forms} {} {
global dbc
cursor_clock
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select formname from pga_forms order by formname" rec {
		.dw.lb insert end $rec(formname)
	}
}
cursor_normal
}

proc {cmd_Functions} {} {
global dbc
set maxim 16384
cursor_clock
catch {
	wpg_select $dbc "select oid from pg_database where datname='template1'" rec {
		set maxim $rec(oid)
	}
}
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select proname from pg_proc where prolang=14 and oid>$maxim order by proname" rec {
		.dw.lb insert end $rec(proname)
	}	
}
cursor_normal
}

proc {cmd_Import_Export} {how} {
global dbc ie_tablename ie_filename activetab
if {$dbc==""} return;
Window show .iew
set ie_tablename {}
set ie_filename {}
set ie_delimiter {}
if {$activetab=="Tables"} {
	set tn [get_dwlb_Selection]
	set ie_tablename $tn
	if {$tn!=""} {set ie_filename "$tn.txt"}
}
.iew.expbtn configure -text $how
}

proc {cmd_Information} {} {
global dbc tiw activetab
if {$dbc==""} return;
if {$activetab!="Tables"} return;
show_table_information [get_dwlb_Selection]
}

proc {cmd_New} {} {
global dbc activetab queryname queryoid cbv funcpar funcname funcret rbvar uw
if {$dbc==""} return;
switch $activetab {
	Tables {
		Window show .nt
		focus .nt.etabn
	}
	Queries {
		Window show .qb
		set queryoid 0
		set queryname {}
		set cbv 0
		.qb.cbv configure -state normal
	}
	Users {
		Window show .uw
		wm transient .uw .dw
		set uw(username) {}
		set uw(password) {}
		set uw(createdb) NOCREATEDB
		set uw(createuser) NOCREATEUSER
		set uw(verify) {}
		set uw(valid) {}
		focus .uw.e1
	}
	Views {
	set queryoid 0
	set queryname {}
		Window show .qb
		set cbv 1
		.qb.cbv configure -state disabled
	}
	Sequences {
	Window show .sqf
	focus .sqf.e1
	}
	Reports {
	Window show .rb ; tkwait visibility .rb ; rb_init ; set rbvar(reportname) {} ; set rbvar(justpreview) 0
	focus .rb.e2
	}
	Forms {
		Window show .fd
		Window show .fdtb
		Window show .fdmenu
		Window show .fda
		fd_init
	}
	Scripts {
		design_script {}
	}
	Functions {
	Window show .fw
	set funcname {}
	set funcpar {}
	set funcret {}
	place .fw.okbtn -y 255
	.fw.okbtn configure -state normal
	.fw.okbtn configure -text Define
	.fw.text1 delete 1.0 end
	focus .fw.e1
	}
}
}

proc {cmd_Open} {} {
global dbc activetab
if {$dbc==""} return;
set objname [get_dwlb_Selection]
if {$objname==""} return;
switch $activetab {
	Tables {open_table $objname}
	Forms {open_form $objname}
	Scripts {execute_script $objname}
	Queries {open_query view}
	Views {open_view}
	Sequences {open_sequence $objname}
	Functions {open_function $objname}
	Reports {open_report $objname}
}
}

proc {cmd_Preferences} {} {
Window show .pw
}

proc {cmd_Queries} {} {
global dbc
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select queryname from pga_queries order by queryname" rec {
		.dw.lb insert end $rec(queryname)
	}
}
}

proc {uw:create_user} {} {
global dbc uw
set uw(username) [string trim $uw(username)]
set uw(password) [string trim $uw(password)]
set uw(verify) [string trim $uw(verify)]
if {$uw(username)==""} {
	show_error "User without name!"
	focus .uw.e1
	return
}
if {$uw(password)!=$uw(verify)} {
	show_error "Passwords do not match!"
	set uw(password) {} ; set uw(verify) {}
	focus .uw.e2
	return
}
set cmd "[.uw.b1 cget -text] user \"$uw(username)\""
if {$uw(password)!=""} {
	set cmd "$cmd WITH PASSWORD \"$uw(password)\" "
}
set cmd "$cmd $uw(createdb) $uw(createuser)"
if {$uw(valid)!=""} {
	set cmd "$cmd VALID UNTIL '$uw(valid)'"
}
if {[sql_exec noquiet $cmd]} {
	Window destroy .uw
	cmd_Users
}
}

proc {cmd_Rename} {} {
global dbc oldobjname activetab
if {$dbc==""} return;
if {$activetab=="Views"} return;
if {$activetab=="Sequences"} return;
if {$activetab=="Functions"} return;
if {$activetab=="Users"} return;
set temp [get_dwlb_Selection]
if {$temp==""} {
	tk_messageBox -title Warning -parent .dw -message "Please select an object first !"
	return;
}
set oldobjname $temp
Window show .rf
}

proc {cmd_Reports} {} {
global dbc
cursor_clock
catch {
	wpg_select $dbc "select reportname from pga_reports order by reportname" rec {
	.dw.lb insert end "$rec(reportname)"
	}
}
cursor_normal
}

proc {cmd_Users} {} {
global dbc
cursor_clock
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select * from pg_user order by usename" rec {
		.dw.lb insert end $rec(usename)
	}
}
cursor_normal
}

proc {cmd_Scripts} {} {
global dbc
cursor_clock
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select scriptname from pga_scripts order by scriptname" rec {
	.dw.lb insert end $rec(scriptname)
	}
}
cursor_normal
}

proc {cmd_Sequences} {} {
global dbc

cursor_clock
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select relname from pg_class where (relname not like 'pg_%') and (relkind='S') order by relname" rec {
		.dw.lb insert end $rec(relname)
	}
}
cursor_normal
}

proc {cmd_Tables} {} {
global dbc
cursor_clock
.dw.lb delete 0 end
foreach tbl [get_tables] {.dw.lb insert end $tbl}
cursor_normal
}

proc {cmd_Views} {} {
global dbc
cursor_clock
.dw.lb delete 0 end
catch {
	wpg_select $dbc "select c.relname,count(c.relname) from pg_class C, pg_rewrite R where (relname !~ '^pg_') and (r.ev_class = C.oid) and (r.ev_type = '1') group by relname" rec {
		if {$rec(count)!=0} {
			set itsaview($rec(relname)) 1
		}
	}
	wpg_select $dbc "select relname from pg_class where (relname !~ '^pg_') and (relkind='r') and (relhasrules) order by relname" rec {
		if {[info exists itsaview($rec(relname))]} {
			.dw.lb insert end $rec(relname)
		}
	}
}
cursor_normal
}

proc {create_drop_down} {base x y w} {
global pref
if {[winfo exists $base.ddf]} {
    return
}
frame $base.ddf -borderwidth 1 -height 75 -relief raised -width 55
listbox $base.ddf.lb -background #fefefe -foreground #000000 -selectbackground #c3c3c3 -borderwidth 1  -font $pref(font_normal)  -highlightthickness 0 -selectborderwidth 0 -yscrollcommand [subst {$base.ddf.sb set}]
scrollbar $base.ddf.sb -borderwidth 1 -command [subst {$base.ddf.lb yview}] -highlightthickness 0 -orient vert
place $base.ddf -x $x -y $y -width $w -height 185 -anchor nw -bordermode ignore
place $base.ddf.lb -x 1 -y 1 -width [expr $w-18] -height 182 -anchor nw -bordermode ignore
place $base.ddf.sb -x [expr $w-15] -y 1 -width 14 -height 183 -anchor nw -bordermode ignore
}

proc {cursor_normal} {} {
	foreach wn [winfo children .] {
		catch {$wn configure -cursor left_ptr}
	}
	update ; update idletasks 
}

proc {cursor_clock} {} {
	foreach wn [winfo children .] {
		catch {$wn configure -cursor watch}
	}
	update ; update idletasks 
}

proc {delete_function} {objname} {
global dbc
wpg_select $dbc "select proargtypes,pronargs from pg_proc where proname='$objname'" rec {
	set funcpar $rec(proargtypes)
	set nrpar $rec(pronargs)
}
set lispar {}
for {set i 0} {$i<$nrpar} {incr i} {
	lappend lispar [get_pgtype [lindex $funcpar $i]]
}
set lispar [join $lispar ,]
sql_exec noquiet "drop function $objname ($lispar)"
}

proc {design_script} {sname} {
global dbc scriptname
Window show .sw
set scriptname $sname
.sw.src delete 1.0 end
if {[string length $sname]==0} return;
wpg_select $dbc "select * from pga_scripts where scriptname='$sname'" rec {
	.sw.src insert end $rec(scriptsource)    
}
}

proc {drag_it} {w x y} {
global draglocation
	set dlo ""
	catch { set dlo $draglocation(obj) }
	if {$dlo != ""} {
		set dx [expr $x - $draglocation(x)]
		set dy [expr $y - $draglocation(y)]
		$w move $dlo $dx $dy
		set draglocation(x) $x
		set draglocation(y) $y
	}
}

proc {drag_start} {wn w x y} {
global draglocation
catch {unset draglocation}
set object [$w find closest $x $y]
if {[lsearch [$wn.c gettags $object] movable]==-1} return;
$wn.c bind movable <Leave> {}
set draglocation(obj) $object
set draglocation(x) $x
set draglocation(y) $y
set draglocation(start) $x
}

proc {drag_stop} {wn w x y} {
global draglocation mw dbc
	set dlo ""
	catch { set dlo $draglocation(obj) }
	if {$dlo != ""} {
		$wn.c bind movable <Leave> "$wn configure -cursor left_ptr"
		$wn configure -cursor left_ptr
		set ctr [get_tag_info $wn $draglocation(obj) v]
		set diff [expr $x-$draglocation(start)]
		if {$diff==0} return;
		set newcw {}
		for {set i 0} {$i<$mw($wn,colcount)} {incr i} {
			if {$i==$ctr} {
				lappend newcw [expr [lindex $mw($wn,colwidth) $i]+$diff]
			} else {
				lappend newcw [lindex $mw($wn,colwidth) $i]
			}
		}
		set mw($wn,colwidth) $newcw
		$wn.c itemconfigure c$ctr -width [expr [lindex $mw($wn,colwidth) $ctr]-5]
		mw_draw_headers $wn
		mw_draw_hgrid $wn
		if {$mw($wn,crtrow)!=""} {mw_show_record $wn $mw($wn,crtrow)}
		for {set i [expr $ctr+1]} {$i<$mw($wn,colcount)} {incr i} {
			$wn.c move c$i $diff 0
		}
		cursor_clock
		sql_exec quiet "update pga_layout set colwidth='$mw($wn,colwidth)' where tablename='$mw($wn,layout_name)'"
		cursor_normal
	}
}

proc {draw_tabs} {} {
global tablist activetab
set ypos 85
foreach tab $tablist {
	label .dw.tab$tab -borderwidth 1  -anchor w -relief raised -text $tab
	place .dw.tab$tab -x 10 -y $ypos -height 25 -width 82 -anchor nw -bordermode ignore
	lower .dw.tab$tab
	bind .dw.tab$tab <Button-1> {tab_click %W}
	incr ypos 25
}
set activetab ""
}

proc {execute_script} {scriptname} {
global dbc
	set ss {}
	wpg_select $dbc "select * from pga_scripts where scriptname='$scriptname'" rec {
		set ss $rec(scriptsource)
	}
    if {[string length $ss] > 0} {
		eval $ss
    }
}

proc {fd_change_coord} {} {
global fdvar fdobj
set i $fdvar(moveitemobj)
set c $fdobj($i,c)
set c [list $fdvar(c_left) $fdvar(c_top) [expr $fdvar(c_left)+$fdvar(c_width)] [expr $fdvar(c_top)+$fdvar(c_height)]]
set fdobj($i,c) $c
.fd.c delete o$i
fd_draw_object $i
fd_draw_hookers $i
}

proc {fd_delete_object} {} {
global fdvar
set i $fdvar(moveitemobj)
.fd.c delete o$i
.fd.c delete hook
set j [lsearch $fdvar(objlist) $i]
set fdvar(objlist) [lreplace $fdvar(objlist) $j $j]
}

proc {fd_draw_hook} {x y} {
.fd.c create rectangle [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] -fill black -tags hook
}

proc {fd_draw_hookers} {i} {
global fdobj
foreach {x1 y1 x2 y2} $fdobj($i,c) {}
.fd.c delete hook
fd_draw_hook $x1 $y1
fd_draw_hook $x1 $y2
fd_draw_hook $x2 $y1
fd_draw_hook $x2 $y2
}

proc {fd_draw_object} {i} {
global fdvar fdobj pref
set c $fdobj($i,c)
foreach {x1 y1 x2 y2} $c {}
.fd.c delete o$i
switch $fdobj($i,t) {
	button {
		fd_draw_rectangle $x1 $y1 $x2 $y2 raised #a0a0a0 o$i
		.fd.c create text [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] -text $fdobj($i,l) -font $pref(font_normal) -tags o$i
	}
	text {
		fd_draw_rectangle $x1 $y1 $x2 $y2 sunken #a0a0a0 o$i
	}
	entry {
		fd_draw_rectangle $x1 $y1 $x2 $y2 sunken white o$i
	}
	label {
		.fd.c create text $x1 $y1 -text $fdobj($i,l) -font $pref(font_normal) -anchor nw -tags o$i
	}
	checkbox {
		fd_draw_rectangle [expr $x1+2] [expr $y1+5] [expr $x1+12] [expr $y1+15] raised #a0a0a0 o$i
		.fd.c create text [expr $x1+20] [expr $y1+3] -text $fdobj($i,l) -anchor nw -font $pref(font_normal) -tags o$i
	}
	radio {
		.fd.c create oval [expr $x1+4] [expr $y1+5] [expr $x1+14] [expr $y1+15] -fill white -tags o$i
		.fd.c create text [expr $x1+24] [expr $y1+3] -text $fdobj($i,l) -anchor nw -font $pref(font_normal) -tags o$i
	}
	query {
		.fd.c create oval $x1 $y1 [expr $x1+20] [expr $y1+20] -fill white -tags o$i
		.fd.c create text [expr $x1+5] [expr $y1+4] -text Q  -anchor nw -font $pref(font_normal) -tags o$i
	}
	listbox {
		fd_draw_rectangle $x1 $y1 [expr $x2-12] $y2 sunken white o$i
		fd_draw_rectangle [expr $x2-11] $y1 $x2 $y2 sunken gray o$i
		.fd.c create line [expr $x2-5] $y1 $x2 [expr $y1+10] -fill #808080 -tags o$i
		.fd.c create line [expr $x2-10] [expr $y1+9] $x2 [expr $y1+9] -fill #808080 -tags o$i
		.fd.c create line [expr $x2-10] [expr $y1+9] [expr $x2-5] $y1 -fill white -tags o$i
		.fd.c create line [expr $x2-5] $y2 $x2 [expr $y2-10] -fill #808080 -tags o$i
		.fd.c create line [expr $x2-10] [expr $y2-9] $x2 [expr $y2-9] -fill white -tags o$i
		.fd.c create line [expr $x2-10] [expr $y2-9] [expr $x2-5] $y2 -fill white -tags o$i
	}
}
.fd.c raise hook
}

proc {fd_draw_rectangle} {x1 y1 x2 y2 relief color tag} {
if {$relief=="raised"} {
	set c1 white
	set c2 #606060
} else {
	set c1 #606060
	set c2 white
}
if {$color != "none"} {
	.fd.c create rectangle $x1 $y1 $x2 $y2 -outline "" -fill $color -tags $tag
}
.fd.c create line $x1 $y1 $x2 $y1 -fill $c1 -tags $tag
.fd.c create line $x1 $y1 $x1 $y2 -fill $c1 -tags $tag
.fd.c create line $x1 $y2 $x2 $y2 -fill $c2 -tags $tag
.fd.c create line $x2 $y1 $x2 [expr 1+$y2] -fill $c2 -tags $tag
}

proc {fd_init} {} {
global fdvar fdobj
catch {unset fdvar}
catch {unset fdobj}
catch {.fd.c delete all}
set fdvar(forminame) {udf0}
set fdvar(formname) "New form"
set fdvar(objnum) 0
set fdvar(objlist) {}
set fdvar(oper) none
set fdvar(tool) point
}

proc {fd_item_click} {x y} {
global fdvar fdobj
set fdvar(oper) none
set fdvar(moveitemobj) {}
set il [.fd.c find overlapping $x $y $x $y]
if {[llength $il]==0} return
set tl [.fd.c gettags [lindex $il 0]]
set i [lsearch -glob $tl o*]
if {$i==-1} return
set objnum [string range [lindex $tl $i] 1 end]
set fdvar(moveitemobj) $objnum
set fdvar(moveitemx) $x
set fdvar(moveitemy) $y
set fdvar(oper) move
fd_show_attributes $objnum
fd_draw_hookers $objnum
}

proc {fd_load_form} {name mode} {
global fdvar fdobj dbc
fd_init
set fdvar(formname) $name
if {$mode=="design"} {
	Window show .fd
	Window show .fdmenu
	Window show .fda
	Window show .fdtb
}
#set fid [open "$name.form" r]
#set info [gets $fid]
#close $fid
set res [wpg_exec $dbc "select * from pga_forms where formname='$fdvar(formname)'"]
set info [lindex [pg_result $res -getTuple 0] 1]
pg_result $res -clear
set fdvar(forminame) [lindex $info 0]
set fdvar(objnum) [lindex $info 1]
set fdvar(objlist) [lindex $info 2]
set fdvar(geometry) [lindex $info 3]
set j 0
foreach objinfo [lrange $info 4 end] {
	foreach {t n c x l v} $objinfo {}
	set i [lindex $fdvar(objlist) $j]
	set fdobj($i,t) $t
	set fdobj($i,n) $n
	set fdobj($i,c) $c
	set fdobj($i,l) $l
	set fdobj($i,x) $x
	set fdobj($i,v) $v
	if {$mode=="design"} {fd_draw_object $i}
	incr j
}
if {$mode=="design"} {wm geometry .fd $fdvar(geometry)}
}

proc {fd_mouse_down} {x y} {
global fdvar
set x [expr 3*int($x/3)]
set y [expr 3*int($y/3)]
set fdvar(xstart) $x
set fdvar(ystart) $y
if {$fdvar(tool)=="point"} {
	fd_item_click $x $y
	return
}
set fdvar(oper) draw
}

proc {fd_mouse_move} {x y} {
global fdvar
#set fdvar(msg) "x=$x y=$y"
set x [expr 3*int($x/3)]
set y [expr 3*int($y/3)]
set oper ""
catch {set oper $fdvar(oper)}
if {$oper=="draw"} {
	catch {.fd.c delete curdraw}
	.fd.c create rectangle $fdvar(xstart) $fdvar(ystart) $x $y -tags curdraw
	return
}
if {$oper=="move"} {
	set dx [expr $x-$fdvar(moveitemx)]
	set dy [expr $y-$fdvar(moveitemy)]
	.fd.c move o$fdvar(moveitemobj) $dx $dy
	.fd.c move hook $dx $dy
	set fdvar(moveitemx) $x
	set fdvar(moveitemy) $y
}
}

proc {fd_mouse_up} {x y} {
global fdvar fdobj
set x [expr 3*int($x/3)]
set y [expr 3*int($y/3)]
if {$fdvar(oper)=="move"} {
	set fdvar(moveitem) {}
	set fdvar(oper) none
	set oc $fdobj($fdvar(moveitemobj),c)
	set dx [expr $x - $fdvar(xstart)]
	set dy [expr $y - $fdvar(ystart)]
	set newcoord [list [expr $dx+[lindex $oc 0]] [expr $dy+[lindex $oc 1]] [expr $dx+[lindex $oc 2]] [expr $dy+[lindex $oc 3]]]
	set fdobj($fdvar(moveitemobj),c) $newcoord
	fd_show_attributes $fdvar(moveitemobj)
	fd_draw_hookers $fdvar(moveitemobj)
	return
}
if {$fdvar(oper)!="draw"} return
set fdvar(oper) none
.fd.c delete curdraw
# Check for x2<x1 or y2<y1
if {$x<$fdvar(xstart)} {set temp $x ; set x $fdvar(xstart) ; set fdvar(xstart) $temp}
if {$y<$fdvar(ystart)} {set temp $y ; set y $fdvar(ystart) ; set fdvar(ystart) $temp}
# Check for too small sizes
if {[expr $x-$fdvar(xstart)]<20} {set x [expr $fdvar(xstart)+20]}
if {[expr $y-$fdvar(ystart)]<10} {set y [expr $fdvar(ystart)+10]}
incr fdvar(objnum)
set i $fdvar(objnum)
lappend fdvar(objlist) $i
# t=type , c=coords , n=name , l=label
set fdobj($i,t) $fdvar(tool)
set fdobj($i,c) [list $fdvar(xstart) $fdvar(ystart) $x $y]
set fdobj($i,n) $fdvar(tool)$i
set fdobj($i,l) $fdvar(tool)$i
set fdobj($i,x) {}
set fdobj($i,v) {}
fd_draw_object $i
fd_show_attributes $i
set fdvar(moveitemobj) $i
fd_draw_hookers $i
set fdvar(tool) point
}

proc {fd_save_form} {name} {
global fdvar fdobj dbc
if {[tk_messageBox -title Warning -message "Do you want to save the form into the database ?" -type yesno -default yes]=="no"} {return 1}
if {[string length $fdvar(forminame)]==0} {
	tk_messageBox -title Warning -message "Forms need an internal name, only literals, low case"
	return 0
}
if {[string length $fdvar(formname)]==0} {
	tk_messageBox -title Warning -message "Form must have a name"
	return 0
}
set info [list $fdvar(forminame) $fdvar(objnum) $fdvar(objlist) [wm geometry .fd]]
foreach i $fdvar(objlist) {
	lappend info [list $fdobj($i,t) $fdobj($i,n) $fdobj($i,c) $fdobj($i,x) $fdobj($i,l) $fdobj($i,v)]
}
sql_exec noquiet "delete from pga_forms where formname='$fdvar(formname)'"
regsub -all "'" $info "''" info
sql_exec noquiet "insert into pga_forms values ('$fdvar(formname)','$info')"
cmd_Forms
return 1
}

proc {fd_set_command} {} {
global fdobj fdvar
set i $fdvar(moveitemobj)
set fdobj($i,x) $fdvar(c_cmd)
}

proc {fd_set_name} {} {
global fdvar fdobj
set i $fdvar(moveitemobj)
foreach k $fdvar(objlist) {
	if {($fdobj($k,n)==$fdvar(c_name)) && ($i!=$k)} {
		tk_messageBox -title Warning -message "There is another object (a $fdobj($k,t)) with the same name. Please change it!"
		return
	}
}
set fdobj($i,n) $fdvar(c_name)
fd_show_attributes $i
}

proc {fd_set_text} {} {
global fdvar fdobj
set fdobj($fdvar(moveitemobj),l) $fdvar(c_text)
fd_draw_object $fdvar(moveitemobj)
}

proc {fd_show_attributes} {i} {
global fdvar fdobj
set fdvar(c_info) "$fdobj($i,t) .$fdvar(forminame).$fdobj($i,n)"
set fdvar(c_name) $fdobj($i,n)
set c $fdobj($i,c)
set fdvar(c_top) [lindex $c 1]
set fdvar(c_left) [lindex $c 0]
set fdvar(c_width) [expr [lindex $c 2]-[lindex $c 0]]
set fdvar(c_height) [expr [lindex $c 3]-[lindex $c 1]]
set fdvar(c_cmd) {}
catch {set fdvar(c_cmd) $fdobj($i,x)}
set fdvar(c_var) {}
catch {set fdvar(c_var) $fdobj($i,v)}
set fdvar(c_text) {}
catch {set fdvar(c_text) $fdobj($i,l)}
}

proc {fd_test} {} {
global fdvar fdobj dbc datasets pref
set basewp $fdvar(forminame)
set base .$fdvar(forminame)
if {[winfo exists $base]} {
   wm deiconify $base; return
}
toplevel $base -class Toplevel
wm focusmodel $base passive
wm geometry $base $fdvar(geometry)
wm maxsize $base 785 570
wm minsize $base 1 1
wm overrideredirect $base 0
wm resizable $base 1 1
wm deiconify $base
wm title $base $fdvar(formname)
foreach item $fdvar(objlist) {
set coord $fdobj($item,c)
set name $fdobj($item,n)
set wh "-width [expr 3+[lindex $coord 2]-[lindex $coord 0]]  -height [expr 3+[lindex $coord 3]-[lindex $coord 1]]"
set visual 1
switch $fdobj($item,t) {
	button {
		set cmd {}
		catch {set cmd $fdobj($item,x)}
		button $base.$name  -borderwidth 1 -padx 0 -pady 0 -text "$fdobj($item,l)" -font $pref(font_normal) -command [subst {$cmd}]
	}
	checkbox {
		checkbutton  $base.$name -onvalue t -offvalue f -font $pref(font_normal) -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1
		set wh {}
	}
	query {
		set visual 0
	set datasets($base.$name,sql) $fdobj($item,x)
		eval "proc $base.$name:open {} {\
			global dbc datasets tup$basewp$name ;\
			catch {unset tup$basewp$name} ;\
			set wn \[focus\] ; cursor_clock ;\
			set res \[wpg_exec \$dbc \"\$datasets($base.$name,sql)\"\] ;\
			pg_result \$res -assign tup$basewp$name ;\
			set fl {} ;\
			foreach fd \[pg_result \$res -lAttributes\] {lappend fl \[lindex \$fd 0\]} ;\
			set datasets($base.$name,fields) \$fl ;\
			set datasets($base.$name,recno) 0 ;\
			set datasets($base.$name,nrecs) \[pg_result \$res -numTuples\] ;\
			cursor_normal ;\
		}"
		eval "proc $base.$name:setsql {sqlcmd} {\
			global datasets ;\
			set datasets($base.$name,sql) \$sqlcmd ;\
		}"
		eval "proc $base.$name:nrecords {} {\
			global datasets ;\
			return \$datasets($base.$name,nrecs) ;\
		}"
		eval "proc $base.$name:crtrecord {} {\
			global datasets ;\
			return \$datasets($base.$name,recno) ;\
		}"
		eval "proc $base.$name:moveto {newrecno} {\
			global datasets ;\
			set datasets($base.$name,recno) \$newrecno ;\
		}"
		eval "proc $base.$name:close {} {
			global tup$basewp$name ;\
			catch {unset tup$basewp$name };\
		}"
		eval "proc $base.$name:fields {} {\
			global datasets ;\
			return \$datasets($base.$name,fields) ;\
		}"
		eval "proc $base.$name:fill {lb fld} {\
			global datasets tup$basewp$name ;\
			\$lb delete 0 end ;\
			for {set i 0} {\$i<\$datasets($base.$name,nrecs)} {incr i} {\
				\$lb insert end \$tup$basewp$name\(\$i,\$fld\) ;\
			}
		}"
		eval "proc $base.$name:movefirst {} {global datasets ; set datasets($base.$name,recno) 0}"
		eval "proc $base.$name:movenext {} {global datasets ; incr datasets($base.$name,recno) ; if {\$datasets($base.$name,recno)==\[$base.$name:nrecords\]} {$base.$name:movelast}}"
		eval "proc $base.$name:moveprevious {} {global datasets ; incr datasets($base.$name,recno) -1 ; if {\$datasets($base.$name,recno)==-1} {$base.$name:movefirst}}"
		eval "proc $base.$name:movelast {} {global datasets ; set datasets($base.$name,recno) \[expr \[$base.$name:nrecords\] -1\]}"
		eval "proc $base.$name:updatecontrols {} {\
			global datasets tup$basewp$name ;\
			set i \$datasets($base.$name,recno) ;\
			foreach fld \$datasets($base.$name,fields) {\
				catch {\
					upvar $basewp$name\(\$fld\) dbvar ;\
					set dbvar \$tup$basewp$name\(\$i,\$fld\) ;\
				}\
			}\
		}"
		eval "proc $base.$name:clearcontrols {} {\
			global datasets ;\
			catch { foreach fld \$datasets($base.$name,fields) {\
				catch {\
					upvar $basewp$name\(\$fld\) dbvar ;\
					set dbvar {} ;\
				}\
			}}\
		}"
	}
	radio {
		radiobutton  $base.$name -font $pref(font_normal) -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -value "$name" -borderwidth 1
		set wh {}
	}
	entry {
		set var {} ; catch {set var $fdobj($item,v)}
		entry $base.$name -bo 1 -ba white -selectborderwidth 0  -highlightthickness 0 
		if {$var!=""} {$base.$name configure -textvar $var}
	}
	text {
		text $base.$name -font $pref(font_normal) -borderwidth 1
	}
	label {
		set wh {}
		label $base.$name -font $pref(font_normal) -anchor nw -padx 0 -pady 0 -text $fdobj($item,l)
	set var {} ; catch {set var $fdobj($item,v)}
	if {$var!=""} {$base.$name configure -textvar $var}
	}
	listbox {
		listbox $base.$name -borderwidth 1 -background white  -highlightthickness 0 -selectborderwidth 0 -font $pref(font_normal) -yscrollcommand [subst {$base.sb$name set}]
	scrollbar $base.sb$name -borderwidth 1 -command [subst {$base.$name yview}] -orient vert  -highlightthickness 0
	eval [subst "place $base.sb$name -x [expr [lindex $coord 2]-14] -y [expr [lindex $coord 1]-1] -width 16 -height [expr 3+[lindex $coord 3]-[lindex $coord 1]] -anchor nw -bordermode ignore"]
	}
}
if $visual {eval [subst "place $base.$name  -x [expr [lindex $coord 0]-1] -y [expr [lindex $coord 1]-1] -anchor nw $wh -bordermode ignore"]}
}
}



proc {get_dwlb_Selection} {} {
set temp [.dw.lb curselection]
if {$temp==""} return "";
return [.dw.lb get $temp]
}

proc {get_pgtype} {oid} {
global dbc
set temp "unknown"
wpg_select $dbc "select typname from pg_type where oid=$oid" rec {
	set temp $rec(typname)
}
return $temp
}

proc {get_tables} {} {
global dbc
set tbl {}
if {[catch {
	wpg_select $dbc "select c.relname,count(c.relname) from pg_class C, pg_rewrite R where (relname !~ '^pg_') and (r.ev_class = C.oid) and (r.ev_type = '1') group by relname" rec {
		if {$rec(count)!=0} {
			set itsaview($rec(relname)) 1
		}
	}
	wpg_select $dbc "select relname from pg_class where (relname !~ '^pg_') and (relkind='r') order by relname" rec {
		if {![regexp "^pga_" $rec(relname)]} then {
			if {![info exists itsaview($rec(relname))]} {
				lappend tbl $rec(relname)
			}
		}
	}
} gterrmsg]} {
	show_error $gterrmsg
}
return $tbl
}

proc {get_tag_info} {wn itemid prefix} {
set taglist [$wn.c itemcget $itemid -tags]
set i [lsearch -glob $taglist $prefix*]
set thetag [lindex $taglist $i]
return [string range $thetag 1 end]
}

proc {mw_canvas_click} {wn x y} {
global mw
if {![mw_exit_edit $wn]} return
# Determining row
for {set row 0} {$row<$mw($wn,nrecs)} {incr row} {
	if {[lindex $mw($wn,rowy) $row]>$y} break
}
incr row -1
if {$y>[lindex $mw($wn,rowy) $mw($wn,last_rownum)]} {set row $mw($wn,last_rownum)}
if {$row<0} return
set mw($wn,row_edited) $row
set mw($wn,crtrow) $row
mw_show_record $wn $row
if {$mw($wn,errorsavingnew)} return
# Determining column
set posx [expr -$mw($wn,leftoffset)]
set col 0
foreach cw $mw($wn,colwidth) {
	incr posx [expr $cw+2]
	if {$x<$posx} break
	incr col
}
set itlist [$wn.c find withtag r$row]
foreach item $itlist {
	if {[get_tag_info $wn $item c]==$col} {
		mw_start_edit $wn $item $x $y
		break
	}
}
}

proc {mw_delete_record} {wn} {
global dbc mw
if {!$mw($wn,updatable)} return;
if {![mw_exit_edit $wn]} return;
set taglist [$wn.c gettags hili]
if {[llength $taglist]==0} return;
set rowtag [lindex $taglist [lsearch -regexp $taglist "^r"]]
set row [string range $rowtag 1 end]
set oid [lindex $mw($wn,keylist) $row]
if {[tk_messageBox -title "FINAL WARNING" -icon question -parent $wn -message "Delete current record ?" -type yesno -default no]=="no"} return
if {[sql_exec noquiet "delete from \"$mw($wn,tablename)\" where oid=$oid"]} {
	$wn.c delete hili
}
}

proc {mw_draw_headers} {wn} {
global mw pref
$wn.c delete header
set posx [expr 5-$mw($wn,leftoffset)]
for {set i 0} {$i<$mw($wn,colcount)} {incr i} {
	set xf [expr $posx+[lindex $mw($wn,colwidth) $i]]
	$wn.c create rectangle $posx 1 $xf 22 -fill #CCCCCC -outline "" -width 0 -tags header
	$wn.c create text [expr $posx+[lindex $mw($wn,colwidth) $i]*1.0/2] 14 -text [lindex $mw($wn,colnames) $i] -tags header -fill navy -font $pref(font_normal)
	$wn.c create line $posx 22 [expr $xf-1] 22 -fill #AAAAAA -tags header
	$wn.c create line [expr $xf-1] 5 [expr $xf-1] 22 -fill #AAAAAA -tags header
	$wn.c create line [expr $xf+1] 5 [expr $xf+1] 22 -fill white -tags header
	$wn.c create line $xf -15000 $xf 15000 -fill #CCCCCC -tags [subst {header movable v$i}]
	set posx [expr $xf+2]
}
set mw($wn,r_edge) $posx
$wn.c bind movable <Button-1> "drag_start $wn %W %x %y"
$wn.c bind movable <B1-Motion> {drag_it %W %x %y}
$wn.c bind movable <ButtonRelease-1> "drag_stop $wn %W %x %y"
$wn.c bind movable <Enter> "$wn configure -cursor left_side"
$wn.c bind movable <Leave> "$wn configure -cursor left_ptr"
}

proc {mw_draw_hgrid} {wn} {
global mw
$wn.c delete hgrid
set posx 10
for {set j 0} {$j<$mw($wn,colcount)} {incr j} {
	set ledge($j) $posx
	incr posx [expr [lindex $mw($wn,colwidth) $j]+2]
	set textwidth($j) [expr [lindex $mw($wn,colwidth) $j]-5]
}
incr posx -6
for {set i 0} {$i<$mw($wn,nrecs)} {incr i} {
	$wn.c create line [expr -$mw($wn,leftoffset)] [lindex $mw($wn,rowy) [expr $i+1]] [expr $posx-$mw($wn,leftoffset)] [lindex $mw($wn,rowy) [expr $i+1]] -fill gray -tags [subst {hgrid g$i}]
}
if {$mw($wn,updatable)} {
	set i $mw($wn,nrecs)
	set posy [expr 14+[lindex $mw($wn,rowy) $mw($wn,nrecs)]]
	$wn.c create line [expr -$mw($wn,leftoffset)] $posy [expr $posx-$mw($wn,leftoffset)] $posy -fill gray -tags [subst {hgrid g$i}]
}
}

proc {mw_draw_new_record} {wn} {
global mw pref
set posx [expr 10-$mw($wn,leftoffset)]
set posy [lindex $mw($wn,rowy) $mw($wn,last_rownum)]
if {$pref(tvfont)=="helv"} {
	set tvfont $pref(font_normal)
} else {
	set tvfont $pref(font_fix)
}
if {$mw($wn,updatable)} {
  for {set j 0} {$j<$mw($wn,colcount)} {incr j} {
	$wn.c create text $posx $posy -text * -tags [subst {r$mw($wn,nrecs) c$j q new unt}]  -anchor nw -font $tvfont -width [expr [lindex $mw($wn,colwidth) $j]-5]
	incr posx [expr [lindex $mw($wn,colwidth) $j]+2]
  }
  incr posy 14
  $wn.c create line [expr -$mw($wn,leftoffset)] $posy [expr $mw($wn,r_edge)-$mw($wn,leftoffset)] $posy -fill gray -tags [subst {hgrid g$mw($wn,nrecs)}]
}
}

proc {mw_edit_text} {wn c k} {
global mw
set bbin [$wn.c bbox r$mw($wn,row_edited)]
switch $k {
	BackSpace { set dp [expr [$wn.c index $mw($wn,id_edited) insert]-1];if {$dp>=0} {$wn.c dchars $mw($wn,id_edited) $dp $dp; set mw($wn,dirtyrec) 1}}
	Home {$wn.c icursor $mw($wn,id_edited) 0}
	End {$wn.c icursor $mw($wn,id_edited) end}
	Left {$wn.c icursor $mw($wn,id_edited) [expr [$wn.c index $mw($wn,id_edited) insert]-1]}
	Delete {}
	Right {$wn.c icursor $mw($wn,id_edited) [expr [$wn.c index $mw($wn,id_edited) insert]+1]}
	Return {if {[mw_exit_edit $wn]} {$wn.c focus {}}}
	Escape {set mw($wn,dirtyrec) 0; $wn.c itemconfigure $mw($wn,id_edited) -text $mw($wn,text_initial_value); $wn.c focus {}}
	default {if {[string compare $c " "]>-1} {$wn.c insert $mw($wn,id_edited) insert $c;set mw($wn,dirtyrec) 1}}
}
set bbout [$wn.c bbox r$mw($wn,row_edited)]
set dy [expr [lindex $bbout 3]-[lindex $bbin 3]]
if {$dy==0} return
set re $mw($wn,row_edited)
$wn.c move g$re 0 $dy
for {set i [expr 1+$re]} {$i<=$mw($wn,nrecs)} {incr i} {
	$wn.c move r$i 0 $dy
	$wn.c move g$i 0 $dy
	set rh [lindex $mw($wn,rowy) $i]
	incr rh $dy
	set mw($wn,rowy) [lreplace $mw($wn,rowy) $i $i $rh]
}
mw_show_record $wn $mw($wn,row_edited)
# Delete is trapped by window interpreted as record delete
#    Delete {$wn.c dchars $mw($wn,id_edited) insert insert; set mw($wn,dirtyrec) 1}
}

proc {mw_exit_edit} {wn} {
global mw dbc
# User has edited the text ?
if {!$mw($wn,dirtyrec)} {
	# No, unfocus text
	$wn.c focus {}
	# For restoring * to the new record position
	if {$mw($wn,id_edited)!=""} {
		if {[lsearch [$wn.c gettags $mw($wn,id_edited)] new]!=-1} {
			$wn.c itemconfigure $mw($wn,id_edited) -text $mw($wn,text_initial_value)
		}
	}
	set mw($wn,id_edited) {};set mw($wn,text_initial_value) {}
	return 1
}
# Trimming the spaces
set fldval [string trim [$wn.c itemcget $mw($wn,id_edited) -text]]
$wn.c itemconfigure $mw($wn,id_edited) -text $fldval
if {[string compare $mw($wn,text_initial_value) $fldval]==0} {
	set mw($wn,dirtyrec) 0
	$wn.c focus {}
	set mw($wn,id_edited) {};set mw($wn,text_initial_value) {}
	return 1
}
cursor_clock
set oid [lindex $mw($wn,keylist) $mw($wn,row_edited)]
set fld [lindex $mw($wn,colnames) [get_tag_info $wn $mw($wn,id_edited) c]]
set fillcolor black
if {$mw($wn,row_edited)==$mw($wn,last_rownum)} {
	set fillcolor red
	set sfp [lsearch $mw($wn,newrec_fields) "\"$fld\""]
	if {$sfp>-1} {
		set mw($wn,newrec_fields) [lreplace $mw($wn,newrec_fields) $sfp $sfp]
		set mw($wn,newrec_values) [lreplace $mw($wn,newrec_values) $sfp $sfp]
	}			
	lappend mw($wn,newrec_fields) "\"$fld\""
	lappend mw($wn,newrec_values) '$fldval'
	# Remove the untouched tag from the object
	$wn.c dtag $mw($wn,id_edited) unt
		$wn.c itemconfigure $mw($wn,id_edited) -fill red
	set retval 1
} else {
	set mw($wn,msg) "Updating record ..."
	after 1000 "set mw($wn,msg) {}"
	regsub -all ' $fldval  \\' sqlfldval
	set retval [sql_exec noquiet "update \"$mw($wn,tablename)\" set \"$fld\"='$sqlfldval' where oid=$oid"]
}
cursor_normal
if {!$retval} {
	set mw($wn,msg) ""
	focus $wn.c
	return 0
}
set mw($wn,dirtyrec) 0
$wn.c focus {}
set mw($wn,id_edited) {};set mw($wn,text_initial_value) {}
return 1
}

proc {mw_load_layout} {wn layoutname} {
global dbc mw
cursor_clock
set mw($wn,layout_name) $layoutname
catch {unset mw($wn,colcount) mw($wn,colnames) mw($wn,colwidth)}
set mw($wn,layout_found) 0
set pgres [wpg_exec $dbc "select *,oid from pga_layout where tablename='$layoutname' order by oid desc"]
set pgs [pg_result $pgres -status]
if {$pgs!="PGRES_TUPLES_OK"} {
	# Probably table pga_layout isn't yet defined
	sql_exec noquiet "create table pga_layout (tablename varchar(64),nrcols int2,colnames text,colwidth text)"
	sql_exec quiet "grant ALL on pga_layout to PUBLIC"
} else {
	set nrlay [pg_result $pgres -numTuples]
	if {$nrlay>=1} {
		set layoutinfo [pg_result $pgres -getTuple 0]
		set mw($wn,colcount) [lindex $layoutinfo 1]
		set mw($wn,colnames)  [lindex $layoutinfo 2]
		set mw($wn,colwidth) [lindex $layoutinfo 3]
		set goodoid [lindex $layoutinfo 4]
		set mw($wn,layout_found) 1
	}
	if {$nrlay>1} {
		show_error "Multiple ($nrlay) layout info found\n\nPlease report the bug!"
		sql_exec quiet "delete from pga_layout where (tablename='$mw($wn,tablename)') and (oid<>$goodoid)"
	}
}
pg_result $pgres -clear
}

proc {mw_pan_left} {wn } {
global mw
if {![mw_exit_edit $wn]} return;
if {$mw($wn,leftcol)==[expr $mw($wn,colcount)-1]} return;
set diff [expr 2+[lindex $mw($wn,colwidth) $mw($wn,leftcol)]]
incr mw($wn,leftcol)
incr mw($wn,leftoffset) $diff
$wn.c move header -$diff 0
$wn.c move q -$diff 0
$wn.c move hgrid -$diff 0
}

proc {mw_pan_right} {wn} {
global mw
if {![mw_exit_edit $wn]} return;
if {$mw($wn,leftcol)==0} return;
incr mw($wn,leftcol) -1
set diff [expr 2+[lindex $mw($wn,colwidth) $mw($wn,leftcol)]]
incr mw($wn,leftoffset) -$diff
$wn.c move header $diff 0
$wn.c move q $diff 0
$wn.c move hgrid $diff 0
}

proc {mw_save_new_record} {wn} {
global dbc mw
if {![mw_exit_edit $wn]} {return 0}
if {$mw($wn,newrec_fields)==""} {return 1}
set mw($wn,msg) "Saving new record ..."
after 1000 "set mw($wn,msg) {}"
set pgres [wpg_exec $dbc "insert into \"$mw($wn,tablename)\" ([join $mw($wn,newrec_fields) ,]) values ([join $mw($wn,newrec_values) ,])" ]
if {[pg_result $pgres -status]!="PGRES_COMMAND_OK"} {
	set errmsg [pg_result $pgres -error]
	show_error "Error inserting new record\n\n$errmsg"
	return 0
}
set oid [pg_result $pgres -oid]
lappend mw($wn,keylist) $oid
pg_result $pgres -clear
# Get bounds of the last record
set lrbb [$wn.c bbox new]
lappend mw($wn,rowy) [lindex $lrbb 3]
$wn.c itemconfigure new -fill black
$wn.c dtag q new
# Replace * from untouched new row elements with "  "
foreach item [$wn.c find withtag unt] {
	$wn.c itemconfigure $item -text "  "
}
$wn.c dtag q unt
incr mw($wn,last_rownum)
incr mw($wn,nrecs)
mw_draw_new_record $wn
set mw($wn,newrec_fields) {}
set mw($wn,newrec_values) {}
return 1
}

proc {mw_scroll_window} {wn par1 args} {
global mw
if {![mw_exit_edit $wn]} return;
if {$par1=="scroll"} {
	set newtop $mw($wn,toprec)
	if {[lindex $args 1]=="units"} {
		incr newtop [lindex $args 0]
	} else {
		incr newtop [expr [lindex $args 0]*25]
		if {$newtop<0} {set newtop 0}
		if {$newtop>=[expr $mw($wn,nrecs)-1]} {set newtop [expr $mw($wn,nrecs)-1]}
	}
} elseif {$par1=="moveto"} {
	set newtop [expr int([lindex $args 0]*$mw($wn,nrecs))]
} else {
	return
}
if {$newtop<0} return;
if {$newtop>=[expr $mw($wn,nrecs)-1]} return;
set dy [expr [lindex $mw($wn,rowy) $mw($wn,toprec)]-[lindex $mw($wn,rowy) $newtop]]
$wn.c move q 0 $dy
$wn.c move hgrid 0 $dy
set newrowy {}
foreach y $mw($wn,rowy) {lappend newrowy [expr $y+$dy]}
set mw($wn,rowy) $newrowy
set mw($wn,toprec) $newtop
mw_set_scrollbar $wn
}

proc {mw_select_records} {wn sql} {
global dbc field mw pgsql pref
set mw($wn,newrec_fields) {}
set mw($wn,newrec_values) {}
if {![mw_exit_edit $wn]} return;
$wn.c delete q
$wn.c delete header
$wn.c delete hgrid
$wn.c delete new
set mw($wn,leftcol) 0
set mw($wn,leftoffset) 0
set mw($wn,crtrow) {}
set mw($wn,msg) "Accessing data. Please wait ..."
$wn.f1.b1 configure -state disabled
cursor_clock
set is_error 1
if {[sql_exec noquiet "BEGIN"]} {
	if {[sql_exec noquiet "declare mycursor cursor for $sql"]} {
		set pgres [wpg_exec $dbc "fetch $pref(rows) in mycursor"]
		if {$pgsql(status)=="PGRES_TUPLES_OK"} {
			set is_error 0
		}
	}
}
if {$is_error} {
	sql_exec quiet "END"
	set mw($wn,msg) {}
	$wn.f1.b1 configure -state normal
	cursor_normal
	set mw($wn,msg) "Error executing : $sql"
	return
}
if {$mw($wn,updatable)} then {set shift 1} else {set shift 0}
#
# checking at least the numer of fields
set attrlist [pg_result $pgres -lAttributes]
if {$mw($wn,layout_found)} then {
	if {  ($mw($wn,colcount) != [expr [llength $attrlist]-$shift]) ||
		  ($mw($wn,colcount) != [llength $mw($wn,colnames)]) ||
		  ($mw($wn,colcount) != [llength $mw($wn,colwidth)]) } then {
		# No. of columns don't match, something is wrong
		# tk_messageBox -title Information -message "Layout info changed !\nRescanning..."
		set mw($wn,layout_found) 0
		sql_exec quiet "delete from pga_layout where tablename='$mw($wn,layout_name)'"
	}
}
# Always take the col. names from the result
set mw($wn,colcount) [llength $attrlist]
if {$mw($wn,updatable)} then {incr mw($wn,colcount) -1}
set mw($wn,colnames) {}
# In defmw($wn,colwidth) prepare mw($wn,colwidth) (in case that not layout_found)
set defmw($wn,colwidth) {}
for {set i 0} {$i<$mw($wn,colcount)} {incr i} {
	lappend mw($wn,colnames) [lindex [lindex $attrlist [expr {$i+$shift}]] 0]
	lappend defmw($wn,colwidth) 150
}
if {!$mw($wn,layout_found)} {
	set mw($wn,colwidth) $defmw($wn,colwidth)
	sql_exec quiet "insert into pga_layout values ('$mw($wn,layout_name)',$mw($wn,colcount),'$mw($wn,colnames)','$mw($wn,colwidth)')"
	set mw($wn,layout_found) 1
}
set mw($wn,nrecs) [pg_result $pgres -numTuples]
if {$mw($wn,nrecs)>$pref(rows)} {
	set mw($wn,msg) "Only first $pref(rows) records from $mw($wn,nrecs) have been loaded"
	set mw($wn,nrecs) $pref(rows)
}
set tagoid {}
if {$pref(tvfont)=="helv"} {
	set tvfont $pref(font_normal)
} else {
	set tvfont $pref(font_fix)
}
# Computing column's left edge
set posx 10
for {set j 0} {$j<$mw($wn,colcount)} {incr j} {
	set ledge($j) $posx
	incr posx [expr {[lindex $mw($wn,colwidth) $j]+2}]
	set textwidth($j) [expr {[lindex $mw($wn,colwidth) $j]-5}]
}
incr posx -6
set posy 24
mw_draw_headers $wn
set mw($wn,updatekey) oid
set mw($wn,keylist) {}
set mw($wn,rowy) {24}
set mw($wn,msg) "Loading maximum $pref(rows) records ..."
set wupdatable $mw($wn,updatable)
for {set i 0} {$i<$mw($wn,nrecs)} {incr i} {
	set curtup [pg_result $pgres -getTuple $i]
	if {$wupdatable} then {lappend mw($wn,keylist) [lindex $curtup 0]}
	for {set j 0} {$j<$mw($wn,colcount)} {incr j} {
		$wn.c create text $ledge($j) $posy -text [lindex $curtup [expr {$j+$shift}]] -tags [subst {r$i c$j q}] -anchor nw -font $tvfont -width $textwidth($j) -fill black
	}
	set bb [$wn.c bbox r$i]
	incr posy [expr {[lindex $bb 3]-[lindex $bb 1]}]
	lappend mw($wn,rowy) $posy
	$wn.c create line 0 [lindex $bb 3] $posx [lindex $bb 3] -fill gray -tags [subst {hgrid g$i}]
	if {$i==25} {update; update idletasks}
}
after 3000 "set mw($wn,msg) {}"
set mw($wn,last_rownum) $i
# Defining position for input data
mw_draw_new_record $wn
pg_result $pgres -clear
sql_exec quiet "END"
set mw($wn,toprec) 0
mw_set_scrollbar $wn
if {$mw($wn,updatable)} then {
	$wn.c bind q <Key> "mw_edit_text $wn %A %K"
} else {
	$wn.c bind q <Key> {}
}
set mw($wn,dirtyrec) 0
$wn.c raise header
$wn.f1.b1 configure -state normal
cursor_normal
}

proc {mw_set_scrollbar} {wn} {
global mw
if {$mw($wn,nrecs)==0} return;
$wn.sb set [expr $mw($wn,toprec)*1.0/$mw($wn,nrecs)] [expr ($mw($wn,toprec)+27.0)/$mw($wn,nrecs)]
}

proc {mw_reload} {wn} {
global mw
set nq $mw($wn,query)
if {($mw($wn,isaquery)) && ("$mw($wn,filter)$mw($wn,sortfield)"!="")} {
	show_error "Sorting and filtering not (yet) available from queries!\n\nPlease enter them in the query definition!"
	set mw($wn,sortfield) {}
	set mw($wn,filter) {}
} else {
	if {$mw($wn,filter)!=""} {
		set nq "$mw($wn,query) where ($mw($wn,filter))"
	} else {
		set nq $mw($wn,query)
	}
	if {$mw($wn,sortfield)!=""} {
		set nq "$nq order by $mw($wn,sortfield)"
	}
}
if {[mw_save_new_record $wn]} {mw_select_records $wn $nq}
}

proc {mw_show_record} {wn row} {
global mw
set mw($wn,errorsavingnew) 0
if {$mw($wn,newrec_fields)!=""} {
	if {$row!=$mw($wn,last_rownum)} {
		if {![mw_save_new_record $wn]} {
					set mw($wn,errorsavingnew) 1
					return
				}
	}
}
set y1 [lindex $mw($wn,rowy) $row]
set y2 [lindex $mw($wn,rowy) [expr $row+1]]
if {$y2==""} {set y2 [expr $y1+14]}
$wn.c dtag hili hili
$wn.c addtag hili withtag r$row
# Making a rectangle arround the record
set x 3
foreach wi $mw($wn,colwidth) {incr x [expr $wi+2]}
$wn.c delete crtrec
$wn.c create rectangle [expr -1-$mw($wn,leftoffset)] $y1 [expr $x-$mw($wn,leftoffset)] $y2 -fill #EEEEEE -outline {} -tags {q crtrec}
$wn.c lower crtrec
}

proc {mw_start_edit} {wn id x y} {
global mw
if {!$mw($wn,updatable)} return
set mw($wn,id_edited) $id
set mw($wn,dirtyrec) 0
set mw($wn,text_initial_value) [$wn.c itemcget $id -text]
focus $wn.c
$wn.c focus $id
$wn.c icursor $id @$x,$y
if {$mw($wn,row_edited)==$mw($wn,nrecs)} {
	if {[$wn.c itemcget $id -text]=="*"} {
		$wn.c itemconfigure $id -text ""
		$wn.c icursor $id 0
	}
}
}

proc {open_database} {} {
global dbc host pport dbname username password newusername newpassword sdbname newdbname newhost newpport pref pgsql
cursor_clock
if {$newusername!=""} {
	set connres [catch {set newdbc [pg_connect -conninfo "host=$newhost port=$newpport dbname=$newdbname user=$newusername password=$newpassword"]} msg]
} else {
	set connres [catch {set newdbc [pg_connect $newdbname -host $newhost -port $newpport]} msg]
}
if {$connres} {
	cursor_normal
	show_error "Error trying to connect to database \"$newdbname\" on host $newhost\n\nPostgreSQL error message: $msg"
	return $msg
} else {
	catch {pg_disconnect $dbc}
	set dbc $newdbc
	set host $newhost
	set pport $newpport
	set dbname $newdbname
	set username $newusername
	set password $newpassword
	set sdbname $dbname
	set pref(lastdb) $dbname
	set pref(lasthost) $host
	set pref(lastport) $pport
	set pref(lastusername) $username
	save_pref
	catch {cursor_normal ; Window hide .dbod}
	tab_click .dw.tabTables
	# Check for pga_ tables
	foreach {table structure} { pga_queries {queryname varchar(64),querytype char(1),querycommand text} pga_forms {formname varchar(64),formsource text} pga_scripts {scriptname varchar(64),scriptsource text} pga_reports {reportname varchar(64),reportsource text,reportbody text,reportprocs text,reportoptions text}} {
		set pgres [wpg_exec $dbc "select relname from pg_class where relname='$table'"]
		if {$pgsql(status)!="PGRES_TUPLES_OK"} {
			show_error "FATAL ERROR searching for PgAccess system tables : $pgsql(errmsg)\nStatus:$pgsql(status)"
			catch {pg_disconnect $dbc}
			exit
		} elseif {[pg_result $pgres -numTuples]==0} {
			pg_result $pgres -clear
			sql_exec quiet "create table $table ($structure)"
			sql_exec quiet "grant ALL on $table to PUBLIC"
		}
		catch {pg_result $pgres -clear}
	}
	# searching for autoexec script
	wpg_select $dbc "select * from pga_scripts where scriptname ~* '^autoexec$'" recd {
		eval $recd(scriptsource)
	}
	return ""
}
}

proc {open_form} {formname} {
	 fd_load_form $formname run
	 fd_test
}

proc {open_function} {objname} {
global dbc funcname funcpar funcret
Window show .fw
place .fw.okbtn -y 400
.fw.okbtn configure -state disabled
.fw.text1 delete 1.0 end
wpg_select $dbc "select * from pg_proc where proname='$objname'" rec {
	set funcname $objname
	set temppar $rec(proargtypes)
	set funcret [get_pgtype $rec(prorettype)]
	set funcnrp $rec(pronargs)
	.fw.text1 insert end $rec(prosrc)
}
set funcpar {}
for {set i 0} {$i<$funcnrp} {incr i} {
	lappend funcpar [get_pgtype [lindex $temppar $i]]
}
set funcpar [join $funcpar ,]
}

proc {open_report} {objname} {
global dbc rbvar
Window show .rb
#tkwait visibility .rb
Window hide .rb
Window show .rpv
rb_init
set rbvar(reportname) $objname
rb_load_report
tkwait visibility .rpv
set rbvar(justpreview) 1
rb_preview
}

proc {open_view_design} {} {
global dbc cbv queryname
set viewname [.dw.lb get [.dw.lb curselection]]
set vd {}
wpg_select $dbc "select pg_get_viewdef('$viewname')as vd" tup {
	set vd $tup(vd)
}
if {$vd==""} {
	show_error "Error retrieving view definition for '$viewname'!"
	return
}
Window show .qb
.qb.text1 delete 0.0 end
.qb.text1 insert end $vd
set cbv 1
.qb.cbv configure -state disabled
set queryname $viewname
}

proc {open_query} {how} {
global dbc queryname mw queryoid

if {[.dw.lb curselection]==""} return;
set queryname [.dw.lb get [.dw.lb curselection]]
if {[set pgres [wpg_exec $dbc "select querycommand,querytype,oid from pga_queries where queryname='$queryname'"]]==0} then {
	show_error "Error retrieving query definition"
	return
}
if {[pg_result $pgres -numTuples]==0} {
	show_error "Query $queryname was not found!"
	pg_result $pgres -clear
	return
}
set tuple [pg_result $pgres -getTuple 0]
set qcmd [lindex $tuple 0]
set qtype [lindex $tuple 1]
set queryoid [lindex $tuple 2]
pg_result $pgres -clear
if {$how=="design"} {
	Window show .qb
	.qb.text1 delete 0.0 end
	.qb.text1 insert end $qcmd
} else {
	if {$qtype=="S"} then {
		set wn [mw_get_new_name]
		set mw($wn,query) [subst $qcmd]
		set mw($wn,updatable) 0
		set mw($wn,isaquery) 1
		mw_create_window
		wm title $wn "Query result: $queryname"
		mw_load_layout $wn $queryname
		mw_select_records $wn $mw($wn,query)
	} else {
		set answ [tk_messageBox -title Warning -type yesno -message "This query is an action query!\n\n[string range $qcmd 0 30] ...\n\nDo you want to execute it?"]
		if {$answ} {
			if {[sql_exec noquiet $qcmd]} {
				tk_messageBox -title Information -message "Your query has been executed without error!"
			}
		}
	}
}
}

proc {mw_free_variables} {wn} {
global mw
	foreach varname [array names mw $wn,*] {
		unset mw($varname)
	}
}

proc {mw_get_new_name} {} {
global mw mwcount
incr mwcount
set wn .mw$mwcount
set mw($wn,dirtyrec) 0
set mw($wn,id_edited) {}
set mw($wn,filter) {}
set mw($wn,sortfield) {}
return .mw$mwcount
}

proc {open_sequence} {objname} {
global dbc seq_name seq_inc seq_start seq_minval seq_maxval
Window show .sqf
set flag 1
wpg_select $dbc "select * from \"$objname\"" rec {
	set flag 0
	set seq_name $objname
	set seq_inc $rec(increment_by)
	set seq_start $rec(last_value)
	.sqf.l3 configure -text "Last value"
	set seq_minval $rec(min_value)
	set seq_maxval $rec(max_value)
	.sqf.defbtn configure -state disabled
	place .sqf.defbtn -x 40 -y 300
}
if {$flag} {
	show_error "Sequence $objname not found!"
} else {
	for {set i 1} {$i<6} {incr i} {
		.sqf.e$i configure -state disabled
	}
	focus .sqf.closebtn
}
}

proc {open_table} {objname} {
global mw sortfield filter
set sortfield {}
set filter {}
set wn [mw_get_new_name]
mw_create_window
set mw($wn,tablename) $objname
mw_load_layout $wn $objname
set mw($wn,query) "select oid,\"$objname\".* from \"$objname\""
set mw($wn,updatable) 1
set mw($wn,isaquery) 0
mw_select_records $wn $mw($wn,query)
catch {wm title $wn "Table viewer : $objname"}
}

proc {open_view} {} {
global mw
set vn [get_dwlb_Selection]
if {$vn==""} return;
set wn [mw_get_new_name]
mw_create_window
set mw($wn,query) "select * from \"$vn\""
set mw($wn,isaquery) 0
set mw($wn,updatable) 0
mw_load_layout $wn $vn
mw_select_records $wn $mw($wn,query)
}

proc {rename_column} {} {
global dbc tiw
	if {[string length [string trim $tiw(new_cn)]]==0} {
		show_error "Field name not entered!"
		return
	}
	set old_name [string trim [string range $tiw(old_cn) 0 31]]
	set tiw(new_cn) [string trim $tiw(new_cn)]
	if {$old_name == $tiw(new_cn)} {
		show_error "New name is the same as the old one !"
		return
	}
	foreach line [.tiw.lb get 0 end] {
		if {[string trim [string range $line 0 31]]==$tiw(new_cn)} {
			show_error "Colum name \"$tiw(new_cn)\" already exists in this table!"
			return
		}
	}
	if {[sql_exec noquiet "alter table \"$tiw(tablename)\" rename column \"$old_name\" to \"$tiw(new_cn)\""]} {
		set temp $tiw(col_id)
		.tiw.lb delete $temp $temp
		.tiw.lb insert $temp "[format %-32.32s $tiw(new_cn)] [string range $tiw(old_cn) 33 end]"
		Window destroy .rcw
	}
}

proc {parameter} {msg} {
global gpw
Window show .gpw
focus .gpw.e1
set gpw(var) ""
set gpw(flag) 0
set gpw(msg) $msg
bind .gpw <Destroy> "set gpw(flag) 1"
grab .gpw
tkwait variable gpw(flag)
if {$gpw(result)} {
	return $gpw(var)
} else {
	return ""
}
}

proc {ql_add_new_table} {} {
global qlvar dbc

if {$qlvar(newtablename)==""} return
set fldlist {}
cursor_clock
wpg_select $dbc "select attnum,attname from pg_class,pg_attribute where (pg_class.relname='$qlvar(newtablename)') and (pg_class.oid=pg_attribute.attrelid) and (attnum>0) order by attnum" rec {
		lappend fldlist $rec(attname)
}
cursor_normal
if {$fldlist==""} {
	show_error "Table $qlvar(newtablename) not found!"
	return
}
set qlvar(tablename$qlvar(ntables)) $qlvar(newtablename)
set qlvar(tablestruct$qlvar(ntables)) $fldlist
set qlvar(tablealias$qlvar(ntables)) "t$qlvar(ntables)"
set qlvar(ali_t$qlvar(ntables)) $qlvar(newtablename)
incr qlvar(ntables)
if {$qlvar(ntables)==1} {
   ql_draw_lizzard
} else {
   ql_draw_table [expr $qlvar(ntables)-1]
}
set qlvar(newtablename) {}
focus .ql.entt
}

proc {ql_compute_sql} {} {
global qlvar
set sqlcmd "select "
#rjr 8Mar1999 added logical return state for results
for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
	if {[lindex $qlvar(resreturn) $i]} {
	if {$sqlcmd!="select "} {set sqlcmd "$sqlcmd, "}
	set sqlcmd "$sqlcmd[lindex $qlvar(restables) $i].\"[lindex $qlvar(resfields) $i]\""
}
}
set tables {}
for {set i 0} {$i<$qlvar(ntables)} {incr i} {
	set thename {}
	catch {set thename $qlvar(tablename$i)}
	if {$thename!=""} {lappend tables "\"$qlvar(tablename$i)\" $qlvar(tablealias$i)"}
}
set sqlcmd "$sqlcmd from [join $tables ,] "
set sup1 {}
if {[llength $qlvar(links)]>0} {
	set sup1 "where "
	foreach link $qlvar(links) {
		if {$sup1!="where "} {set sup1 "$sup1 and "}
		set sup1 "$sup1 ([lindex $link 0].\"[lindex $link 1]\"=[lindex $link 2].\"[lindex $link 3]\")"
	}
}
for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
	set crit [lindex $qlvar(rescriteria) $i]
	if {$crit!=""} {
		if {$sup1==""} {set sup1 "where "}
		if {[string length $sup1]>6} {set sup1 "$sup1 and "}
		set sup1 "$sup1 ([lindex $qlvar(restables) $i].\"[lindex $qlvar(resfields) $i]\" $crit) "        
	}        
}
set sqlcmd "$sqlcmd $sup1"
set sup2 {}
for {set i 0} {$i<[llength $qlvar(ressort)]} {incr i} {
	set how [lindex $qlvar(ressort) $i]
	if {$how!="unsorted"} {
		if {$how=="Ascending"} {set how asc} else {set how desc}
		if {$sup2==""} {set sup2 " order by "} else {set sup2 "$sup2,"}
		set sup2 "$sup2 [lindex $qlvar(restables) $i].\"[lindex $qlvar(resfields) $i]\" $how "
	}
}
set sqlcmd "$sqlcmd $sup2"
set qlvar(sql) $sqlcmd
#tk_messageBox -message $sqlcmd
return $sqlcmd
}

proc {ql_delete_object} {} {
global qlvar
# Checking if there 
set obj [.ql.c find withtag hili]
if {$obj==""} return
# Is object a link ?
if {[ql_get_tag_info $obj link]=="s"} {
	if {[tk_messageBox -title WARNING -icon question -parent .ql -message "Remove link ?" -type yesno -default no]=="no"} return
	set linkid [ql_get_tag_info $obj lkid]
	set qlvar(links) [lreplace $qlvar(links) $linkid $linkid]
	.ql.c delete links
	ql_draw_links
	return
}
# Is object a result field ?
if {[ql_get_tag_info $obj res]=="f"} {
	set col [ql_get_tag_info $obj col]
	if {$col==""} return
	if {[tk_messageBox -title WARNING -icon question -parent .ql -message "Remove field from result ?" -type yesno -default no]=="no"} return
	set qlvar(resfields) [lreplace $qlvar(resfields) $col $col]
	set qlvar(ressort) [lreplace $qlvar(ressort) $col $col]
	set qlvar(resreturn) [lreplace $qlvar(resreturn) $col $col]
	set qlvar(restables) [lreplace $qlvar(restables) $col $col]
	set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $col $col]
	ql_draw_res_panel
	return
}
# Is object a table ?
set tablealias [ql_get_tag_info $obj tab]
set tablename $qlvar(ali_$tablealias)
if {"$tablename"==""} return
if {[tk_messageBox -title WARNING -icon question -parent .ql -message "Remove table $tablename from query ?" -type yesno -default no]=="no"} return
for {set i [expr [llength $qlvar(restables)]-1]} {$i>=0} {incr i -1} {
	if {"$tablename"==[lindex $qlvar(restables) $i]} {
	   set qlvar(resfields) [lreplace $qlvar(resfields) $i $i]
	   set qlvar(ressort) [lreplace $qlvar(ressort) $i $i]
	   set qlvar(resreturn) [lreplace $qlvar(resreturn) $i $i]
	   set qlvar(restables) [lreplace $qlvar(restables) $i $i]
	   set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $i $i]
	}
}
for {set i [expr [llength $qlvar(links)]-1]} {$i>=0} {incr i -1} {
	set thelink [lindex $qlvar(links) $i]
	if {($tablealias==[lindex $thelink 0]) || ($tablealias==[lindex $thelink 2])} {
		set qlvar(links) [lreplace $qlvar(links) $i $i]
	}
}
for {set i 0} {$i<$qlvar(ntables)} {incr i} {
	set temp {}
	catch {set temp $qlvar(tablename$i)}
	if {"$temp"=="$tablename"} {
		unset qlvar(tablename$i)
		unset qlvar(tablestruct$i)
		unset qlvar(tablealias$i)
		break
	}
}
#incr qlvar(ntables) -1
.ql.c delete tab$tablealias
.ql.c delete links
ql_draw_links
ql_draw_res_panel
}

proc {ql_dragit} {w x y} {
global draginfo
if {"$draginfo(obj)" != ""} {
	set dx [expr $x - $draginfo(x)]
	set dy [expr $y - $draginfo(y)]
	if {$draginfo(is_a_table)} {
		set taglist [.ql.c gettags $draginfo(obj)]
		set tabletag [lindex $taglist [lsearch -regexp $taglist "^tab"]]
		$w move $tabletag $dx $dy
		ql_draw_links
	} else {
		$w move $draginfo(obj) $dx $dy
	}
	set draginfo(x) $x
	set draginfo(y) $y
}
}

proc {ql_dragstart} {w x y} {
global draginfo
catch {unset draginfo}
set draginfo(obj) [$w find closest $x $y]
if {[ql_get_tag_info $draginfo(obj) r]=="ect"} {
	# If it'a a rectangle, exit
	set draginfo(obj) {}
	return
}
.ql configure -cursor hand1
.ql.c raise $draginfo(obj)
set draginfo(table) 0
if {[ql_get_tag_info $draginfo(obj) table]=="header"} {
	set draginfo(is_a_table) 1
	.ql.c itemconfigure [.ql.c find withtag hili] -fill black
	.ql.c dtag [.ql.c find withtag hili] hili
	.ql.c addtag hili withtag $draginfo(obj)
	.ql.c itemconfigure hili -fill blue
} else {
	set draginfo(is_a_table) 0
}
set draginfo(x) $x
set draginfo(y) $y
set draginfo(sx) $x
set draginfo(sy) $y
}

proc {ql_dragstop} {x y} {
global draginfo qlvar
# when click Close, ql window is destroyed but event ButtonRelease-1 is fired
if {![winfo exists .ql]} return;
.ql configure -cursor left_ptr
set este {}
catch {set este $draginfo(obj)}
if {$este==""} return
# Re-establish the normal paint order so
# information won't be overlapped by table rectangles
# or link linkes
.ql.c lower $draginfo(obj)
.ql.c lower rect
.ql.c lower links
set qlvar(panstarted) 0
if {$draginfo(is_a_table)} {
	set draginfo(obj) {}
	.ql.c delete links
	ql_draw_links
	return
}
.ql.c move $draginfo(obj) [expr $draginfo(sx)-$x] [expr $draginfo(sy)-$y]
if {($y>$qlvar(yoffs)) && ($x>$qlvar(xoffs))} {
	# Drop position : inside the result panel
	# Compute the offset of the result panel due to panning
	set resoffset [expr [lindex [.ql.c bbox resmarker] 0]-$qlvar(xoffs)]
	set newfld [.ql.c itemcget $draginfo(obj) -text]
	set tabtag [ql_get_tag_info $draginfo(obj) tab]
	set col [expr int(($x-$qlvar(xoffs)-$resoffset)/$qlvar(reswidth))]
	set qlvar(resfields) [linsert $qlvar(resfields) $col $newfld]
	set qlvar(ressort) [linsert $qlvar(ressort) $col unsorted]
	set qlvar(rescriteria) [linsert $qlvar(rescriteria) $col {}]
	set qlvar(restables) [linsert $qlvar(restables) $col $tabtag]
	set qlvar(resreturn) [linsert $qlvar(resreturn) $col yes]
	ql_draw_res_panel    
} else {
	# Drop position : in the table panel
	set droptarget [.ql.c find overlapping $x $y $x $y]
	set targettable {}
	foreach item $droptarget {
		set targettable [ql_get_tag_info $item tab]
		set targetfield [ql_get_tag_info $item f-]
		if {($targettable!="") && ($targetfield!="")} {
			set droptarget $item
			break
		}
	}
	# check if target object isn't a rectangle
	if {[ql_get_tag_info $droptarget rec]=="t"} {set targettable {}}
	if {$targettable!=""} {
		# Target has a table
		# See about originate table
		set sourcetable [ql_get_tag_info $draginfo(obj) tab]
		if {$sourcetable!=""} {
			# Source has also a tab .. tag
			set sourcefield [ql_get_tag_info $draginfo(obj) f-]
			if {$sourcetable!=$targettable} {
				lappend qlvar(links) [list $sourcetable $sourcefield $targettable $targetfield $draginfo(obj) $droptarget]
				ql_draw_links
			}
		}
	}
}
# Erase information about onbject beeing dragged
set draginfo(obj) {}
}

proc {ql_draw_links} {} {
global qlvar
.ql.c delete links
set i 0
foreach link $qlvar(links) {
	# Compute the source and destination right edge
	set sre [lindex [.ql.c bbox tab[lindex $link 0]] 2]
	set dre [lindex [.ql.c bbox tab[lindex $link 2]] 2]
	# Compute field bound boxes
	set sbbox [.ql.c bbox [lindex $link 4]]
	set dbbox [.ql.c bbox [lindex $link 5]]
	# Compute the auxiliary lines
	if {[lindex $sbbox 2] < [lindex $dbbox 0]} {
		# Source object is on the left of target object
		set x1 $sre
		set y1 [expr ([lindex $sbbox 1]+[lindex $sbbox 3])/2]
		.ql.c create line $x1 $y1 [expr $x1+10] $y1 -tags [subst {links lkid$i}] -width 3
		set x2 [lindex $dbbox 0]
		set y2 [expr ([lindex $dbbox 1]+[lindex $dbbox 3])/2]
		.ql.c create line [expr $x2-10] $y2 $x2 $y2 -tags [subst {links lkid$i}] -width 3
		.ql.c create line [expr $x1+10] $y1 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 2
	} else {
		# source object is on the right of target object
		set x1 [lindex $sbbox 0]
		set y1 [expr ([lindex $sbbox 1]+[lindex $sbbox 3])/2]
		.ql.c create line $x1 $y1 [expr $x1-10] $y1 -tags [subst {links lkid$i}] -width 3
		set x2 $dre
		set y2 [expr ([lindex $dbbox 1]+[lindex $dbbox 3])/2]
		.ql.c create line $x2 $y2 [expr $x2+10] $y2 -width 3 -tags [subst {links lkid$i}]
		.ql.c create line [expr $x1-10] $y1 [expr $x2+10] $y2 -tags [subst {links lkid$i}] -width 2
	}
	incr i
}
.ql.c lower links
.ql.c bind links <Button-1> {ql_link_click %x %y}
}

proc {ql_draw_lizzard} {} {
global qlvar pref
.ql.c delete all
set posx 20
for {set it 0} {$it<$qlvar(ntables)} {incr it} {
	ql_draw_table $it
}
.ql.c lower rect
.ql.c create line 0 $qlvar(yoffs) 10000 $qlvar(yoffs) -width 3
.ql.c create rectangle 0 $qlvar(yoffs) 10000 5000 -fill #FFFFFF
for {set i [expr 15+$qlvar(yoffs)]} {$i<500} {incr i 15} {
	.ql.c create line $qlvar(xoffs) $i 10000 $i -fill #CCCCCC -tags {resgrid}
}    
for {set i $qlvar(xoffs)} {$i<10000} {incr i $qlvar(reswidth)} {
	.ql.c create line $i [expr 1+$qlvar(yoffs)] $i 10000 -fill #cccccc -tags {resgrid}
}
# Make a marker for result panel offset calculations (due to panning)
.ql.c create line $qlvar(xoffs) $qlvar(yoffs) $qlvar(xoffs) 500 -tags {resmarker resgrid}
.ql.c create rectangle 0 $qlvar(yoffs) $qlvar(xoffs) 5000 -fill #EEEEEE -tags {reshdr}
.ql.c create text 5 [expr 1+$qlvar(yoffs)] -text Field: -anchor nw -font $pref(font_normal) -tags {reshdr}
.ql.c create text 5 [expr 16+$qlvar(yoffs)] -text Table: -anchor nw -font $pref(font_normal) -tags {reshdr}
.ql.c create text 5 [expr 31+$qlvar(yoffs)] -text Sort: -anchor nw -font $pref(font_normal) -tags {reshdr}
.ql.c create text 5 [expr 46+$qlvar(yoffs)] -text Criteria: -anchor nw -font $pref(font_normal) -tags {reshdr}
.ql.c create text 5 [expr 61+$qlvar(yoffs)] -text Return: -anchor nw -font $pref(font_normal) -tags {reshdr}
.ql.c bind mov <Button-1> {ql_dragstart %W %x %y}
.ql.c bind mov <B1-Motion> {ql_dragit %W %x %y}
bind .ql <ButtonRelease-1> {ql_dragstop %x %y}
bind .ql <Button-1> {qlc_click %x %y %W}
bind .ql <B1-Motion> {ql_pan %x %y}
bind .ql <Key-Delete> {ql_delete_object}
}

proc {ql_draw_res_panel} {} {
global qlvar pref
# Compute the offset of the result panel due to panning
set resoffset [expr [lindex [.ql.c bbox resmarker] 0]-$qlvar(xoffs)]
.ql.c delete resp
for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
	.ql.c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)] [expr 1+$qlvar(yoffs)] -text [lindex $qlvar(resfields) $i] -anchor nw -tags [subst {resf resp col$i}] -font $pref(font_normal)
	.ql.c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)] [expr 16+$qlvar(yoffs)] -text $qlvar(ali_[lindex $qlvar(restables) $i]) -anchor nw -tags {resp rest} -font $pref(font_normal)
	.ql.c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)] [expr 31+$qlvar(yoffs)] -text [lindex $qlvar(ressort) $i] -anchor nw -tags {resp sort} -font $pref(font_normal)
	if {[lindex $qlvar(rescriteria) $i]!=""} {
		.ql.c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)]  [expr $qlvar(yoffs)+46+15*0] -anchor nw -text [lindex $qlvar(rescriteria) $i]  -font $pref(font_normal) -tags [subst {resp cr-c$i-r0}]
	}
	.ql.c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)] [expr 61+$qlvar(yoffs)] -text [lindex $qlvar(resreturn) $i] -anchor nw -tags {resp retval} -font $pref(font_normal)
}
.ql.c raise reshdr
.ql.c bind resf <Button-1> {ql_resfield_click %x %y}
.ql.c bind sort <Button-1> {ql_swap_sort %W %x %y}
.ql.c bind retval <Button-1> {ql_toggle_return %W %x %y}
}

proc {ql_draw_table} {it} {
global qlvar pref

set posy 10
set allbox [.ql.c bbox rect]
if {$allbox==""} {set posx 10} else {set posx [expr 20+[lindex $allbox 2]]}
set tablename $qlvar(tablename$it)
set tablealias $qlvar(tablealias$it)
.ql.c create text $posx $posy -text "$tablename" -anchor nw -tags [subst {tab$tablealias f-oid mov tableheader}] -font $pref(font_bold)
incr posy 16
foreach fld $qlvar(tablestruct$it) {
   .ql.c create text $posx $posy -text $fld -fill #010101 -anchor nw -tags [subst {f-$fld tab$tablealias mov}] -font $pref(font_normal)
   incr posy 14
}
set reg [.ql.c bbox tab$tablealias]
.ql.c create rectangle [lindex $reg 0] [lindex $reg 1] [lindex $reg 2] [lindex $reg 3] -fill #EEEEEE -tags [subst {rect tab$tablealias}]
.ql.c create line [lindex $reg 0] [expr [lindex $reg 1]+15] [lindex $reg 2] [expr [lindex $reg 1]+15] -tags [subst {rect tab$tablealias}]
.ql.c lower tab$tablealias
.ql.c lower rect
}

proc {ql_get_tag_info} {obj prefix} {
set taglist [.ql.c gettags $obj]
set tagpos [lsearch -regexp $taglist "^$prefix"]
if {$tagpos==-1} {return ""}
set thattag [lindex $taglist $tagpos]
return [string range $thattag [string length $prefix] end]
}

proc {ql_init} {} {
global qlvar
catch {unset qlvar}
set qlvar(yoffs) 360
set qlvar(xoffs) 50
set qlvar(reswidth) 150
set qlvar(resfields) {}
set qlvar(resreturn) {}
set qlvar(ressort) {}
set qlvar(rescriteria) {}
set qlvar(restables) {}
set qlvar(critedit) 0
set qlvar(links) {}
set qlvar(ntables) 0
set qlvar(newtablename) {}
}

proc {ql_link_click} {x y} {
global qlvar

set obj [.ql.c find closest $x $y 1 links]
if {[ql_get_tag_info $obj link]!="s"} return
.ql.c itemconfigure [.ql.c find withtag hili] -fill black
.ql.c dtag [.ql.c find withtag hili] hili
.ql.c addtag hili withtag $obj
.ql.c itemconfigure $obj -fill blue
}

proc {ql_pan} {x y} {
global qlvar
set panstarted 0
catch {set panstarted $qlvar(panstarted) }
if {!$panstarted} return
set dx [expr $x-$qlvar(panstartx)]
set dy [expr $y-$qlvar(panstarty)]
set qlvar(panstartx) $x
set qlvar(panstarty) $y
if {$qlvar(panobject)=="tables"} {
	.ql.c move mov $dx $dy
	.ql.c move links $dx $dy
	.ql.c move rect $dx $dy
} else {
	.ql.c move resp $dx 0
	.ql.c move resgrid $dx 0
	.ql.c raise reshdr
}
}

proc {ql_resfield_click} {x y} {
global qlvar

set obj [.ql.c find closest $x $y]
if {[ql_get_tag_info $obj res]!="f"} return
.ql.c itemconfigure [.ql.c find withtag hili] -fill black
.ql.c dtag [.ql.c find withtag hili] hili
.ql.c addtag hili withtag $obj
.ql.c itemconfigure $obj -fill blue
}

proc {ql_show_sql} {} {
global qlvar pref

set sqlcmd [ql_compute_sql]
.ql.c delete sqlpage
.ql.c create rectangle 0 0 2000 [expr $qlvar(yoffs)-1] -fill #ffffff -tags {sqlpage}
.ql.c create text 10 10 -text $sqlcmd -anchor nw -width 550 -tags {sqlpage} -font $pref(font_normal)
.ql.c bind sqlpage <Button-1> {.ql.c delete sqlpage}
}

proc {ql_swap_sort} {w x y} {
global qlvar
set obj [$w find closest $x $y]
set taglist [.ql.c gettags $obj]
if {[lsearch $taglist sort]==-1} return
set cum [.ql.c itemcget $obj -text]
if {$cum=="unsorted"} {
	set cum Ascending
} elseif {$cum=="Ascending"} {
	set cum Descending
} else {
	set cum unsorted
}
set col [expr int(($x-$qlvar(xoffs))/$qlvar(reswidth))]
set qlvar(ressort) [lreplace $qlvar(ressort) $col $col $cum]
.ql.c itemconfigure $obj -text $cum
}

#rjr 8Mar1999 toggle logical return state for result
proc {ql_toggle_return} {w x y} {
global qlvar
set obj [$w find closest $x $y]
set taglist [.ql.c gettags $obj]
if {[lsearch $taglist retval]==-1} return
set cum [.ql.c itemcget $obj -text]
if {$cum} {
	set cum no
} else {
	set cum yes
} 
set col [expr int(($x-$qlvar(xoffs))/$qlvar(reswidth))]
set qlvar(resreturn) [lreplace $qlvar(resreturn) $col $col $cum]
.ql.c itemconfigure $obj -text $cum
}

proc {qlc_click} {x y w} {
global qlvar pref
set qlvar(panstarted) 0
if {$w==".ql.c"} {
	set canpan 1
	if {$y<$qlvar(yoffs)} {
		if {[llength [.ql.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
			set qlvar(panobject) tables
	} else {
		set qlvar(panobject) result
	}
	if {$canpan} {
		.ql configure -cursor hand1
		set qlvar(panstartx) $x
		set qlvar(panstarty) $y
		set qlvar(panstarted) 1
	}
}
set isedit 0
catch {set isedit $qlvar(critedit)}
# Compute the offset of the result panel due to panning
set resoffset [expr [lindex [.ql.c bbox resmarker] 0]-$qlvar(xoffs)]
if {$isedit} {
	set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $qlvar(critcol) $qlvar(critcol) $qlvar(critval)]
	.ql.c delete cr-c$qlvar(critcol)-r$qlvar(critrow)
	.ql.c create text [expr $resoffset+4+$qlvar(xoffs)+$qlvar(critcol)*$qlvar(reswidth)] [expr $qlvar(yoffs)+46+15*$qlvar(critrow)] -anchor nw -text $qlvar(critval) -font $pref(font_normal) -tags [subst {resp cr-c$qlvar(critcol)-r$qlvar(critrow)}]
	set qlvar(critedit) 0
}
catch {destroy .ql.entc}
if {$y<[expr $qlvar(yoffs)+46]} return
if {$x<[expr $qlvar(xoffs)+5]} return
set col [expr int(($x-$qlvar(xoffs)-$resoffset)/$qlvar(reswidth))]
if {$col>=[llength $qlvar(resfields)]} return
set nx [expr $col*$qlvar(reswidth)+8+$qlvar(xoffs)+$resoffset]
set ny [expr $qlvar(yoffs)+76]
# Get the old criteria value
set qlvar(critval) [lindex $qlvar(rescriteria) $col]
entry .ql.entc -textvar qlvar(critval) -borderwidth 0 -background #FFFFFF -highlightthickness 0 -selectborderwidth 0  -font $pref(font_normal)
place .ql.entc -x $nx -y $ny -height 14
focus .ql.entc
bind .ql.entc <Button-1> {set qlvar(panstarted) 0}
set qlvar(critcol) $col
set qlvar(critrow) 0
set qlvar(critedit) 1
}

proc {rb_add_field} {} {
global rbvar pref
set fldname [.rb.lb get [.rb.lb curselection]]
set newid [.rb.c create text $rbvar(xf_auto) [expr $rbvar(y_rpthdr)+5] -text $fldname -tags [subst {t_l mov ro}] -anchor nw -font $pref(font_normal)]
.rb.c create text $rbvar(xf_auto) [expr $rbvar(y_pghdr)+5] -text $fldname -tags [subst {f-$fldname t_f rg_detail mov ro}] -anchor nw -font $pref(font_normal)
set bb [.rb.c bbox $newid]
incr rbvar(xf_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
}

proc {rb_add_label} {} {
global rbvar pref
set fldname $rbvar(labeltext)
set newid [.rb.c create text $rbvar(xl_auto) [expr $rbvar(y_rpthdr)+5] -text $fldname -tags [subst {t_l mov ro}] -anchor nw -font $pref(font_normal)]
set bb [.rb.c bbox $newid]
incr rbvar(xl_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
}

proc {rb_change_object_font} {} {
global rbvar
.rb.c itemconfigure hili -font -Adobe-[.rb.bfont cget -text]-[rb_get_bold]-[rb_get_italic]-Normal--*-$rbvar(pointsize)-*-*-*-*-*-*
}

proc {rb_delete_object} {} {
if {[tk_messageBox -title Warning -parent .rb -message "Delete current report object?" -type yesno -default no]=="no"} return;
.rb.c delete hili
}

proc {rb_dragit} {w x y} {
global draginfo rbvar
# Showing current region
foreach rg $rbvar(regions) {
	set rbvar(msg) $rbvar(e_$rg)
	if {$rbvar(y_$rg)>$y} break;
}
set temp {}
catch {set temp $draginfo(obj)}
if {"$temp" != ""} {
	set dx [expr $x - $draginfo(x)]
	set dy [expr $y - $draginfo(y)]
	if {$draginfo(region)!=""} {
		set x $draginfo(x) ; $w move bg_$draginfo(region) 0 $dy
	} else {
		$w move $draginfo(obj) $dx $dy
	}
	set draginfo(x) $x
	set draginfo(y) $y
}
}

proc {rb_dragstart} {w x y} {
global draginfo rbvar
focus .rb.c
catch {unset draginfo}
set obj {}
# Only movable objects start dragging
foreach id [$w find overlapping $x $y $x $y] {
	if {[rb_has_tag $id mov]} {
		set obj $id
		break
	}
}
if {$obj==""} return;
set draginfo(obj) $obj
set taglist [.rb.c itemcget $obj -tags]
set i [lsearch -glob $taglist bg_*]
if {$i==-1} {
	set draginfo(region) {}
} else {
	set draginfo(region) [string range [lindex $taglist $i] 3 64]
} 
.rb configure -cursor hand1
.rb.c itemconfigure [.rb.c find withtag hili] -fill black
.rb.c dtag [.rb.c find withtag hili] hili
.rb.c addtag hili withtag $draginfo(obj)
.rb.c itemconfigure hili -fill blue
set draginfo(x) $x
set draginfo(y) $y
set draginfo(sx) $x
set draginfo(sy) $y
# Setting font information
if {[.rb.c type hili]=="text"} {
	set fnta [split [.rb.c itemcget hili -font] -]
	.rb.bfont configure -text [lindex $fnta 2]
	if {[lindex $fnta 3]=="Medium"} then {.rb.lbold configure -relief raised} else {.rb.lbold configure -relief sunken}
	if {[lindex $fnta 4]=="R"} then {.rb.lita configure -relief raised} else {.rb.lita configure -relief sunken}
	set rbvar(pointsize) [lindex $fnta 8]
	if {[rb_has_tag $obj t_f]} {set rbvar(info) "Database field"}
	if {[rb_has_tag $obj t_l]} {set rbvar(info) "Label"}
	if {[.rb.c itemcget $obj -anchor]=="nw"} then {.rb.balign configure -text left} else {.rb.balign configure -text right}
}
}

proc {rb_dragstop} {x y} {
global draginfo rbvar
# when click Close, ql window is destroyed but event ButtonRelease-1 is fired
if {![winfo exists .rb]} return;
.rb configure -cursor left_ptr
set este {}
catch {set este $draginfo(obj)}
if {$este==""} return
# Erase information about object beeing dragged
if {$draginfo(region)!=""} {
	set dy 0
	foreach rg $rbvar(regions) {
		.rb.c move rg_$rg 0 $dy
		if {$rg==$draginfo(region)} {
			set dy [expr $y-$rbvar(y_$draginfo(region))]
		}
		incr rbvar(y_$rg) $dy
	}
#    .rb.c move det 0 [expr $y-$rbvar(y_$draginfo(region))]
	set rbvar(y_$draginfo(region)) $y
	rb_draw_regions
} else {
	# Check if object beeing dragged is inside the canvas
	set bb [.rb.c bbox $draginfo(obj)]
	if {[lindex $bb 0] < 5} {
		.rb.c move $draginfo(obj) [expr 5-[lindex $bb 0]] 0
	}
}
set draginfo(obj) {}
unset draginfo
}

proc {rb_draw_regions} {} {
global rbvar
foreach rg $rbvar(regions) {
	.rb.c delete bg_$rg
	.rb.c create line 0 $rbvar(y_$rg) 5000 $rbvar(y_$rg) -tags [subst {bg_$rg}]
	.rb.c create rectangle 6 [expr $rbvar(y_$rg)-3] 12 [expr $rbvar(y_$rg)+3] -fill black -tags [subst {bg_$rg mov reg}]
	.rb.c lower bg_$rg
}
}

proc {rb_flip_align} {} {
set bb [.rb.c bbox hili]
if {[.rb.balign cget -text]=="left"} then {
	.rb.balign configure -text right
	.rb.c itemconfigure hili -anchor ne
	.rb.c move hili [expr [lindex $bb 2]-[lindex $bb 0]-3] 0
} else {
	.rb.balign configure -text left
	.rb.c itemconfigure hili -anchor nw
	.rb.c move hili [expr [lindex $bb 0]-[lindex $bb 2]+3] 0
}
}

proc {rb_get_bold} {} {
if {[.rb.lbold cget -relief]=="raised"} then {return Medium} else {return Bold}
}

proc {rb_get_italic} {} {
if {[.rb.lita cget -relief]=="raised"} then {return R} else {return O}
}

proc {rb_get_report_fields} {} {
global dbc rbvar
.rb.lb delete 0 end
if {$rbvar(tablename)==""} return ;
#cursor_clock
wpg_select $dbc "select attnum,attname from pg_class,pg_attribute where (pg_class.relname='$rbvar(tablename)') and (pg_class.oid=pg_attribute.attrelid) and (attnum>0) order by attnum" rec {
	.rb.lb insert end $rec(attname)
}
#cursor_normal
}

proc {rb_has_tag} {id tg} {
if {[lsearch [.rb.c itemcget $id -tags] $tg]==-1} then {return 0 } else {return 1}
}

proc {rb_init} {} {
global rbvar
set rbvar(xl_auto) 10
set rbvar(xf_auto) 10
set rbvar(regions) {rpthdr pghdr detail pgfoo rptfoo}
set rbvar(y_rpthdr) 30
set rbvar(y_pghdr) 60
set rbvar(y_detail) 90
set rbvar(y_pgfoo) 120
set rbvar(y_rptfoo) 150
set rbvar(e_rpthdr) {Report header}
set rbvar(e_pghdr) {Page header}
set rbvar(e_detail) {Detail record}
set rbvar(e_pgfoo) {Page footer}
set rbvar(e_rptfoo) {Report footer}
rb_draw_regions
}

proc {rb_load_report} {} {
global rbvar dbc
.rb.c delete all
wpg_select $dbc "select * from pga_reports where reportname='$rbvar(reportname)'" rcd {
	eval $rcd(reportbody)
}
rb_get_report_fields
rb_draw_regions
}

proc {rb_preview} {} {
global dbc rbvar
Window show .rpv
.rpv.fr.c delete all
set ol [.rb.c find withtag ro]
set fields {}
foreach objid $ol {
	set tags [.rb.c itemcget $objid -tags]
	lappend fields [string range [lindex $tags [lsearch -glob $tags f-*]] 2 64]
	lappend fields [lindex [.rb.c coords $objid] 0]
	lappend fields [lindex [.rb.c coords $objid] 1]
	lappend fields $objid
	lappend fields [lindex $tags [lsearch -glob $tags t_*]]
}
# Parsing page header
set py 10
foreach {field x y objid objtype} $fields {
	if {$objtype=="t_l"} {
		.rpv.fr.c create text $x [expr $py+$y] -text [.rb.c itemcget $objid -text]  -font [.rb.c itemcget $objid -font] -anchor nw
	}
}
incr py [expr $rbvar(y_pghdr)-$rbvar(y_rpthdr)]
# Parsing detail group
set di [lsearch $rbvar(regions) detail]
set y_hi $rbvar(y_detail)
set y_lo $rbvar(y_[lindex $rbvar(regions) [expr $di-1]])
wpg_select $dbc "select * from \"$rbvar(tablename)\"" rec {
	foreach {field x y objid objtype} $fields {
		if {($y>=$y_lo) && ($y<=$y_hi)} then {
		if {$objtype=="t_f"} {
			.rpv.fr.c create text $x [expr $py+$y] -text $rec($field) -font [.rb.c itemcget $objid -font] -anchor [.rb.c itemcget $objid -anchor]
		}
		if {$objtype=="t_l"} {
			.rpv.fr.c create text $x [expr $py+$y] -text [.rb.c itemcget $objid -text]  -font [.rb.c itemcget $objid -font] -anchor nw
		}
		}
	}
	incr py [expr $rbvar(y_detail)-$rbvar(y_pghdr)]
}
.rpv.fr.c configure -scrollregion [subst {0 0 1000 $py}]
}

proc {rb_print_report} {} {
set bb [.rpv.fr.c bbox all]
.rpv.fr.c postscript -file "pgaccess-report.ps" -width [expr 10+[lindex $bb 2]-[lindex $bb 0]] -height [expr 10+[lindex $bb 3]-[lindex $bb 1]]
tk_messageBox -title Information -parent .rb -message "The printed image in Postscript is in the file pgaccess-report.ps"
}

proc {rb_save_report} {} {
global rbvar
set prog "set rbvar(tablename) \"$rbvar(tablename)\""
foreach region $rbvar(regions) {
	set prog "$prog ; set rbvar(y_$region) $rbvar(y_$region)"
}
foreach obj [.rb.c find all] {
	if {[.rb.c type $obj]=="text"} {
		set bb [.rb.c bbox $obj]
		if {[.rb.c itemcget $obj -anchor]=="nw"} then {set x [expr [lindex $bb 0]+1]} else {set x [expr [lindex $bb 2]-2]}
		set prog "$prog ; .rb.c create text $x [lindex $bb 1] -font [.rb.c itemcget $obj -font] -anchor [.rb.c itemcget $obj -anchor] -text {[.rb.c itemcget $obj -text]} -tags {[.rb.c itemcget $obj -tags]}"
	}
}
sql_exec noquiet "delete from pga_reports where reportname='$rbvar(reportname)'"
sql_exec noquiet "insert into pga_reports (reportname,reportsource,reportbody) values ('$rbvar(reportname)','$rbvar(tablename)','$prog')"
}

proc {save_pref} {} {
global pref
catch {
	set fid [open "~/.pgaccessrc" w]
	foreach {opt val} [array get pref] { puts $fid "$opt {$val}" }
	close $fid
}
}

proc {show_error} {emsg} {
   bell ; tk_messageBox -title Error -icon error -message $emsg
}

proc {show_table_information} {tblname} {
global dbc tiw activetab indexlist
set tiw(tablename) $tblname
if {$tiw(tablename)==""} return;
Window show .tiw
.tiw.lb delete 0 end
.tiw.ilb delete 0 end
set tiw(isunique) {}
set tiw(isclustered) {}
set tiw(indexfields) {}
wpg_select $dbc "select attnum,attname,typname,attlen,atttypmod,usename,pg_class.oid from pg_class,pg_user,pg_attribute,pg_type where (pg_class.relname='$tiw(tablename)') and (pg_class.oid=pg_attribute.attrelid) and (pg_class.relowner=pg_user.usesysid) and (pg_attribute.atttypid=pg_type.oid) order by attnum" rec {
	set fsize $rec(attlen)
	set fsize1 $rec(atttypmod)
	set ftype $rec(typname)
	if { $fsize=="-1" && $fsize1!="-1" } {
		set fsize $rec(atttypmod)
		incr fsize -4
	}
	if { $fsize1=="-1" && $fsize=="-1" } {
		set fsize ""
	}
	if {$rec(attnum)>0} {.tiw.lb insert end [format "%-33s %-14s %-4s" $rec(attname) $ftype $fsize]}
	set tiw(owner) $rec(usename)
	set tiw(tableoid) $rec(oid)
	set tiw(f$rec(attnum)) $rec(attname)
}
set tiw(indexlist) {}
wpg_select $dbc "select oid,indexrelid from pg_index where (pg_class.relname='$tiw(tablename)') and (pg_class.oid=pg_index.indrelid)" rec {
	lappend tiw(indexlist) $rec(oid)
	wpg_select $dbc "select relname from pg_class where oid=$rec(indexrelid)" rec1 {
		.tiw.ilb insert end $rec1(relname)
	}
}
}

proc {sql_exec} {how cmd} {
global dbc pgsql
if {[set pgr [wpg_exec $dbc $cmd]]==0} {
	return 0
}
if {($pgsql(status)=="PGRES_COMMAND_OK") || ($pgsql(status)=="PGRES_TUPLES_OK")} {
	pg_result $pgr -clear
	return 1
}	
if {$how != "quiet"} {
	show_error "Error executing query\n\n$cmd\n\nPostgreSQL error message:\n$pgsql(errmsg)\nPostgreSQL status:$pgsql(status)"
}
pg_result $pgr -clear
return 0
}

proc {tab_click} {w} {
global dbc tablist activetab pref
if {$dbc==""} return;
set curtab [$w cget -text]
#if {$activetab==$curtab} return;
.dw.btndesign configure -state disabled
if {$activetab!=""} {
	place .dw.tab$activetab -x 10
	.dw.tab$activetab configure -font $pref(font_normal)
}
$w configure -font $pref(font_bold)
place $w -x 7
place .dw.lmask -x 80 -y [expr 86+25*[lsearch -exact $tablist $curtab]]
set activetab $curtab
# Tabs where button Design is enabled
if {[lsearch {Scripts Queries Views Reports Forms Users} $activetab]!=-1} {
	.dw.btndesign configure -state normal
}
.dw.lb delete 0 end
cmd_$curtab
}

proc {tiw_show_index} {} {
global tiw dbc
set cs [.tiw.ilb curselection]
if {$cs==""} return
set idxname [.tiw.ilb get $cs]
wpg_select $dbc "select pg_index.*,pg_class.oid from pg_index,pg_class where pg_class.relname='$idxname' and pg_class.oid=pg_index.indexrelid" rec {
	if {$rec(indisunique)=="t"} {
		set tiw(isunique) Yes
	} else {
		set tiw(isunique) No
	}
	if {$rec(indisclustered)=="t"} {
		set tiw(isclustered) Yes
	} else {
		set tiw(isclustered) No
	}
	set tiw(indexfields) {}
	foreach field $rec(indkey) {
		if {$field!=0} {
#            wpg_select $dbc "select attname from pg_attribute where attrelid=$tiw(tableoid) and attnum=$field" rec1 {
#                set tiw(indexfields) "$tiw(indexfields) $rec1(attname)"
#            }
		set tiw(indexfields) "$tiw(indexfields) $tiw(f$field)"
		}

	}
}
set tiw(indexfields) [string trim $tiw(indexfields)]
}

proc {vacuum} {} {
global dbc dbname sdbname pgsql
if {$dbc==""} return;
set sdbname "vacuuming database $dbname ..."
cursor_clock
set pgres [wpg_exec $dbc "vacuum;"]
catch {pg_result $pgres -clear}
cursor_normal
set sdbname $dbname
}

proc {main} {argc argv} {
global pref newdbname newpport newhost newusername newpassword dbc tcl_platform
if {[string toupper $tcl_platform(platform)]=="WINDOWS"} {
	load libpgtcl.dll
} else {
	load libpgtcl.so
}
catch {draw_tabs}
set newusername {}
set newpassword {}
if {$argc>0} {
	set newdbname [lindex $argv 0]
	set newhost localhost
	set newpport 5432
	open_database
} elseif {$pref(autoload) && ($pref(lastdb)!="")} {
	set newdbname $pref(lastdb)
	set newhost $pref(lasthost)
	set newpport $pref(lastport)
	catch {set newusername $pref(lastusername)}
	if {[set openmsg [open_database]]!=""} {
		if {[regexp "no password supplied" $openmsg]} {
			Window show .dbod
			focus .dbod.epassword
			wm transient .dbod .dw
		}
	}
	
}
wm protocol .dw WM_DELETE_WINDOW {
	catch {pg_disconnect $dbc}
	exit }
}

proc {Window} {args} {
global vTcl
	set cmd [lindex $args 0]
	set name [lindex $args 1]
	set newname [lindex $args 2]
	set rest [lrange $args 3 end]
	if {$name == "" || $cmd == ""} {return}
	if {$newname == ""} {
		set newname $name
	}
	set exists [winfo exists $newname]
	switch $cmd {
		show {
			if {$exists == "1" && $name != "."} {wm deiconify $name; return}
			if {[info procs vTclWindow(pre)$name] != ""} {
				eval "vTclWindow(pre)$name $newname $rest"
			}
			if {[info procs vTclWindow$name] != ""} {
				eval "vTclWindow$name $newname $rest"
			}
			if {[info procs vTclWindow(post)$name] != ""} {
				eval "vTclWindow(post)$name $newname $rest"
			}
		}
		hide    { if $exists {wm withdraw $newname; return} }
		iconify { if $exists {wm iconify $newname; return} }
		destroy { if $exists {destroy $newname; return} }
	}
}

proc vTclWindow. {base} {
	if {$base == ""} {
		set base .
	}
	wm focusmodel $base passive
	wm geometry $base 1x1+0+0
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm withdraw $base
	wm title $base "vt.tcl"
}

proc vTclWindow.about {base} {
	if {$base == ""} {
		set base .about
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 471x177+168+243
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm title $base "About"
	label $base.l1  -borderwidth 3 -font -Adobe-Helvetica-Bold-R-Normal-*-*-180-*-*-*-*-*  -relief ridge -text PgAccess 
	label $base.l2  -relief groove  -text {A Tcl/Tk interface to
PostgreSQL
by Constantin Teodorescu} 
	label $base.l3  -borderwidth 0 -relief sunken -text {v 0.96}
	label $base.l4  -relief groove  -text {You will always get the latest version at:
http://www.flex.ro/pgaccess

Suggestions : teo@flex.ro} 
	button $base.b1  -borderwidth 1 -command {Window destroy .about} -text Ok 
	place $base.l1  -x 10 -y 10 -width 196 -height 103 -anchor nw -bordermode ignore 
	place $base.l2  -x 10 -y 115 -width 198 -height 55 -anchor nw -bordermode ignore 
	place $base.l3  -x 145 -y 80 -anchor nw -bordermode ignore 
	place $base.l4  -x 215 -y 10 -width 246 -height 103 -anchor nw -bordermode ignore 
	place $base.b1  -x 295 -y 130 -width 105 -height 28 -anchor nw -bordermode ignore
}

proc vTclWindow.dbod {base} {
	if {$base == ""} {
		set base .dbod
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel \
		-cursor left_ptr
	wm focusmodel $base passive
	wm geometry $base 282x180+358+333
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm deiconify $base
	wm title $base "Open database"
	label $base.lhost \
		-borderwidth 0 -text Host 
	entry $base.ehost \
		-background #fefefe -borderwidth 1 -highlightthickness 1 \
		-selectborderwidth 0 -textvariable newhost 
	bind $base.ehost <Key-Return> {
		focus .dbod.epport
	}
	label $base.lport \
		-borderwidth 0 -text Port 
	entry $base.epport \
		-background #fefefe -borderwidth 1 -highlightthickness 1 \
		-selectborderwidth 0 -textvariable newpport 
	bind $base.epport <Key-Return> {
		focus .dbod.edbname
	}
	label $base.ldbname \
		-borderwidth 0 -text Database 
	entry $base.edbname \
		-background #fefefe -borderwidth 1 -highlightthickness 1 \
		-selectborderwidth 0 -textvariable newdbname 
	bind $base.edbname <Key-Return> {
		focus .dbod.eusername
	.dbod.eusername selection range 0 end
	}
	label $base.lusername \
		-borderwidth 0 -text Username 
	entry $base.eusername \
		-background #fefefe -borderwidth 1 -highlightthickness 1 \
		-selectborderwidth 0 -textvariable newusername 
	bind $base.eusername <Key-Return> {
		focus .dbod.epassword
	}
	label $base.lpassword \
		-borderwidth 0 -text Password 
	entry $base.epassword \
		-background #fefefe -borderwidth 1 -highlightthickness 1 \
		-selectborderwidth 0 -textvariable newpassword -show "*"
	bind $base.epassword <Key-Return> {
		focus .dbod.opbtu
	}
	button $base.opbtu \
		-borderwidth 1 -command open_database -text Open 
	bind $base.opbtu <Key-Return> {
		open_database
	}
	button $base.canbut \
		-borderwidth 1 -command {Window hide .dbod} -text Cancel 
	place $base.lhost \
		-x 35 -y 7 -anchor nw -bordermode ignore 
	place $base.ehost \
		-x 100 -y 5 -anchor nw -bordermode ignore 
	place $base.lport \
		-x 35 -y 32 -anchor nw -bordermode ignore 
	place $base.epport \
		-x 100 -y 30 -anchor nw -bordermode ignore 
	place $base.ldbname \
		-x 35 -y 57 -anchor nw -bordermode ignore 
	place $base.edbname \
		-x 100 -y 55 -anchor nw -bordermode ignore 
	place $base.lusername \
		-x 35 -y 82 -anchor nw -bordermode ignore 
	place $base.eusername \
		-x 100 -y 80 -anchor nw -bordermode ignore 
	place $base.lpassword \
		-x 35 -y 107 -anchor nw -bordermode ignore 
	place $base.epassword \
		-x 100 -y 105 -anchor nw -bordermode ignore 
	place $base.opbtu \
		-x 70 -y 140 -width 60 -height 26 -anchor nw -bordermode ignore 
	place $base.canbut \
		-x 150 -y 140 -width 60 -height 26 -anchor nw -bordermode ignore 
}

proc vTclWindow.dw {base} {
global pref
	if {$base == ""} {
		set base .dw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel \
		-background #efefef -cursor left_ptr
	wm focusmodel $base passive
	wm geometry $base 322x355+96+172
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm deiconify $base
	wm title $base "PostgreSQL access"
	label $base.labframe \
		-relief raised 
	listbox $base.lb \
		-background #fefefe \
		-selectbackground #c3c3c3 \
		-foreground black -highlightthickness 0 -selectborderwidth 0 \
		-yscrollcommand {.dw.sb set} 
	bind $base.lb <Double-Button-1> {
		cmd_Open
	}
	button $base.btnnew \
		-borderwidth 1 -command cmd_New -text New 
	button $base.btnopen \
		-borderwidth 1 -command cmd_Open -text Open 
	button $base.btndesign \
		-borderwidth 1 -command cmd_Design -text Design 
	label $base.lmask \
		-borderwidth 0 \
		-text {  } 
	label $base.label22 \
		-borderwidth 1 \
		-relief raised 
	menubutton $base.menubutton23 \
		-borderwidth 1 -font $pref(font_normal) \
		-menu .dw.menubutton23.01 -padx 4 -pady 3 -text Database 
	menu $base.menubutton23.01 \
		-borderwidth 1 -font $pref(font_normal) \
		-tearoff 0 
	$base.menubutton23.01 add command \
		\
		-command {
Window show .dbod
set newhost $host
set newpport $pport
focus .dbod.edbname
.dbod.edbname selection range 0 end} \
		-label Open -font $pref(font_normal)
	$base.menubutton23.01 add command \
		\
		-command {.dw.lb delete 0 end
set dbc {}
set dbname {}
set sdbname {}} \
		-label Close 
	$base.menubutton23.01 add command \
		-command vacuum -label Vacuum 
	$base.menubutton23.01 add separator
	$base.menubutton23.01 add command \
		-command {cmd_Import_Export Import} -label {Import table} 
	$base.menubutton23.01 add command \
		-command {cmd_Import_Export Export} -label {Export table} 
	$base.menubutton23.01 add separator
	$base.menubutton23.01 add command \
		-command cmd_Preferences -label Preferences 
	$base.menubutton23.01 add command \
		-command "Window show .sqlw" -label "SQL window" 
	$base.menubutton23.01 add separator
	$base.menubutton23.01 add command \
		-command {catch {pg_disconnect $dbc}
save_pref
exit} -label Exit 
	label $base.lshost \
		-relief groove -text localhost -textvariable host 
	label $base.lsdbname \
		-anchor w \
		-relief groove -textvariable sdbname 
	scrollbar $base.sb \
		-borderwidth 1 -command {.dw.lb yview} -orient vert 
	menubutton $base.mnob \
		-borderwidth 1 \
		-menu .dw.mnob.m -font $pref(font_normal) -text Object 
	menu $base.mnob.m \
		-borderwidth 1 -font $pref(font_normal) \
		-tearoff 0 
	$base.mnob.m add command \
		-command cmd_New -font $pref(font_normal) -label New 
	$base.mnob.m add command \
		-command {cmd_Delete } -label Delete 
	$base.mnob.m add command \
		-command {cmd_Rename } -label Rename 
	$base.mnob.m add command \
		-command cmd_Information -label Information 
	menubutton $base.mhelp \
		-borderwidth 1 \
		-menu .dw.mhelp.m -font $pref(font_normal) -text Help 
	menu $base.mhelp.m \
		-borderwidth 1 -font $pref(font_normal) \
		-tearoff 0 
	$base.mhelp.m add command \
		-label Contents 
	$base.mhelp.m add command \
		-label PostgreSQL 
	$base.mhelp.m add separator
	$base.mhelp.m add command \
		-command {Window show .about} -label About 
	place $base.labframe \
		-x 80 -y 30 -width 236 -height 300 -anchor nw -bordermode ignore 
	place $base.lb \
		-x 90 -y 75 -width 205 -height 243 -anchor nw -bordermode ignore 
	place $base.btnnew \
		-x 90 -y 40 -width 60 -height 25 -anchor nw -bordermode ignore 
	place $base.btnopen \
		-x 165 -y 40 -width 60 -height 25 -anchor nw -bordermode ignore 
	place $base.btndesign \
		-x 235 -y 40 -width 60 -height 25 -anchor nw -bordermode ignore 
	place $base.lmask \
		-x 155 -y 45 -width 10 -height 23 -anchor nw -bordermode ignore 
	place $base.label22 \
		-x 0 -y 0 -width 396 -height 23 -anchor nw -bordermode ignore 
	place $base.menubutton23 \
		-x 0 -y 3 -width 63 -height 17 -anchor nw -bordermode ignore 
	place $base.lshost \
		-x 3 -y 335 -width 91 -height 20 -anchor nw -bordermode ignore 
	place $base.lsdbname \
		-x 95 -y 335 -width 223 -height 20 -anchor nw -bordermode ignore 
	place $base.sb \
		-x 295 -y 74 -width 18 -height 245 -anchor nw -bordermode ignore 
	place $base.mnob \
		-x 70 -y 2 -width 44 -height 19 -anchor nw -bordermode ignore 
	place $base.mhelp \
		-x 280 -y 1 -height 20 -anchor nw -bordermode ignore 
}

proc vTclWindow.fw {base} {
	if {$base == ""} {
		set base .fw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 306x288+233+130
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm title $base "Function"
	label $base.l1  -borderwidth 0 -text Name 
	entry $base.e1  -background #fefefe -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable funcname 
	label $base.l2  -borderwidth 0 -text Parameters 
	entry $base.e2  -background #fefefe -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable funcpar 
	label $base.l3  -borderwidth 0 -text Returns 
	entry $base.e3  -background #fefefe -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable funcret 
	text $base.text1  -background #fefefe -borderwidth 1  -highlightthickness 1 -selectborderwidth 0 -wrap word 
	button $base.okbtn  -borderwidth 1  -command {
			if {$funcname==""} {
				show_error "You must supply a name for this function!"
			} elseif {$funcret==""} {
				show_error "You must supply a return type!"
			} else {
				set funcbody [.fw.text1 get 1.0 end]
				regsub -all "\n" $funcbody " " funcbody
				if {[sql_exec noquiet "create function $funcname ($funcpar) returns $funcret as '$funcbody' language 'sql'"]} {
					Window destroy .fw
					tk_messageBox -title PostgreSQL -message "Function created!"
					tab_click .dw.tabFunctions
				}
								
			}
		}  -state disabled -text Define 
	button $base.cancelbtn  -borderwidth 1 -command {Window destroy .fw} -text Close 
	place $base.l1  -x 15 -y 18 -anchor nw -bordermode ignore 
	place $base.e1  -x 95 -y 15 -width 198 -height 22 -anchor nw -bordermode ignore 
	place $base.l2  -x 15 -y 48 -anchor nw -bordermode ignore 
	place $base.e2  -x 95 -y 45 -width 198 -height 22 -anchor nw -bordermode ignore 
	place $base.l3  -x 15 -y 78 -anchor nw -bordermode ignore 
	place $base.e3  -x 95 -y 75 -width 198 -height 22 -anchor nw -bordermode ignore 
	place $base.text1  -x 15 -y 105 -width 275 -height 141 -anchor nw -bordermode ignore 
	place $base.okbtn  -x 90 -y 400 -anchor nw -bordermode ignore 
	place $base.cancelbtn  -x 160 -y 255 -anchor nw -bordermode ignore
}

proc vTclWindow.iew {base} {
	if {$base == ""} {
		set base .iew
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 287x151+259+304
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm title $base "Import-Export table"
	label $base.l1  -borderwidth 0 -text {Table name} 
	entry $base.e1  -background #fefefe -borderwidth 1 -textvariable ie_tablename 
	label $base.l2  -borderwidth 0 -text {File name} 
	entry $base.e2  -background #fefefe -borderwidth 1 -textvariable ie_filename 
	label $base.l3  -borderwidth 0 -text {Field delimiter} 
	entry $base.e3  -background #fefefe -borderwidth 1 -textvariable ie_delimiter 
	button $base.expbtn  -borderwidth 1  -command {if {$ie_tablename==""} {
	show_error "You have to supply a table name!"
} elseif {$ie_filename==""} {
	show_error "You have to supply a external file name!"
} else {
	if {$ie_delimiter==""} {
		set sup ""
	} else {
		set sup " USING DELIMITERS '$ie_delimiter'"
	}
	if {[.iew.expbtn cget -text]=="Import"} {
		set oper "FROM"
	} else {
		set oper "TO"
	}
		if {$oicb} {
				set sup2 " WITH OIDS "
		} else {
				set sup2 ""
		}
	set sqlcmd "COPY $ie_tablename $sup2 $oper '$ie_filename'$sup"
	cursor_clock
	if {[sql_exec noquiet $sqlcmd]} {
		tk_messageBox -title Information -parent .iew -message "Operation completed!"
		Window destroy .iew
	}
	cursor_normal
}}  -text Export 
	button $base.cancelbtn  -borderwidth 1 -command {Window destroy .iew} -text Cancel 
	checkbutton $base.oicb  -borderwidth 1  -text {with OIDs} -variable oicb 
	place $base.l1  -x 25 -y 15 -anchor nw -bordermode ignore 
	place $base.e1  -x 115 -y 10 -height 22 -anchor nw -bordermode ignore 
	place $base.l2  -x 25 -y 45 -anchor nw -bordermode ignore 
	place $base.e2  -x 115 -y 40 -height 22 -anchor nw -bordermode ignore 
	place $base.l3  -x 25 -y 75 -height 18 -anchor nw -bordermode ignore 
	place $base.e3  -x 115 -y 74 -width 33 -height 22 -anchor nw -bordermode ignore 
	place $base.expbtn  -x 60 -y 110 -height 25 -width 75 -anchor nw -bordermode ignore 
	place $base.cancelbtn  -x 155 -y 110 -height 25 -width 75 -anchor nw -bordermode ignore 
	place $base.oicb  -x 170 -y 75 -anchor nw -bordermode ignore
}

proc {mw_canvas_paste} {wn x y} {
	   global mw
	   $wn.c insert $mw($wn,id_edited) insert [selection get]
	   set mw($wn,dirtyrec) 1
}

proc {mw_create_window} {} {
global mwcount
	set base .mw$mwcount
	set wn .mw$mwcount
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 550x400
	wm maxsize $base 1009 738
	wm minsize $base 550 400
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm deiconify $base
	wm title $base "Table browser"
	bind $base <Key-Delete> "mw_delete_record $wn"
	frame $base.f1  -borderwidth 2 -height 75 -relief groove -width 125 
	label $base.f1.l1  -borderwidth 0 -text {Sort field} 
	entry $base.f1.e1  -background #fefefe -borderwidth 1 -width 14  -highlightthickness 1 -textvariable mw($wn,sortfield)
	bind $base.f1.e1 <Key-Return> "mw_reload $wn"	
	bind $base.f1.e1 <Key-KP_Enter> "mw_reload $wn"	
	label $base.f1.lb1  -borderwidth 0 -text {     } 
	label $base.f1.l2  -borderwidth 0 -text {Filter conditions} 
	entry $base.f1.e2  -background #fefefe -borderwidth 1  -highlightthickness 1 -textvariable mw($wn,filter)
	bind $base.f1.e2 <Key-Return> "mw_reload $wn"	
	bind $base.f1.e2 <Key-KP_Enter> "mw_reload $wn"	
	button $base.f1.b1  -borderwidth 1 -text Close -command "
if {\[mw_save_new_record $wn\]} {
	$wn.c delete rows
	$wn.c delete header
	set sortfield {}
	set filter {}
	Window destroy $wn
	mw_free_variables $wn
}
	"
	button $base.f1.b2  -borderwidth 1 -text Reload -command "mw_reload $wn"
	frame $base.frame20  -borderwidth 2 -height 75 -relief groove -width 125 
	button $base.frame20.01  -borderwidth 1 -text < -command "mw_pan_right $wn"
	label $base.frame20.02  -anchor w -borderwidth 1 -height 1  -relief sunken -text {} -textvariable mw($wn,msg) 
	button $base.frame20.03  -borderwidth 1 -text > -command "mw_pan_left $wn"
	canvas $base.c  -background #fefefe -borderwidth 2 -height 207 -highlightthickness 0  -relief ridge -selectborderwidth 0 -takefocus 1 -width 295 
	scrollbar $base.sb  -borderwidth 1 -orient vert -width 12  -command "mw_scroll_window $wn"
	bind $base.c <Button-1> "mw_canvas_click $wn %x %y"
	bind $base.c <Button-2> "mw_canvas_paste $wn %x %y"
	bind $base.c <Button-3> "if {[mw_exit_edit $wn]} \"mw_save_new_record $wn\""
	pack $base.f1  -in $wn -anchor center -expand 0 -fill x -side top 
	pack $base.f1.l1  -in $wn.f1 -anchor center -expand 0 -fill none -side left 
	pack $base.f1.e1  -in $wn.f1 -anchor center -expand 0 -fill none -side left 
	pack $base.f1.lb1  -in $wn.f1 -anchor center -expand 0 -fill none -side left 
	pack $base.f1.l2  -in $wn.f1 -anchor center -expand 0 -fill none -side left 
	pack $base.f1.e2  -in $wn.f1 -anchor center -expand 0 -fill none -side left 
	pack $base.f1.b1  -in $wn.f1 -anchor center -expand 0 -fill none -side right 
	pack $base.f1.b2  -in $wn.f1 -anchor center -expand 0 -fill none -side right 
	pack $base.frame20  -in $wn -anchor s -expand 0 -fill x -side bottom 
	pack $base.frame20.01  -in $wn.frame20 -anchor center -expand 0 -fill none -side left 
	pack $base.frame20.02  -in $wn.frame20 -anchor center -expand 1 -fill x -side left 
	pack $base.frame20.03  -in $wn.frame20 -anchor center -expand 0 -fill none -side right 
	pack $base.c -in $wn -anchor w -expand 1 -fill both -side left 
	pack $base.sb -in $wn -anchor e -expand 0 -fill y -side right
}

proc vTclWindow.nt {base} {
global pref
    if {$base == ""} {
        set base .nt
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 614x392+78+181
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 0 0
    wm deiconify $base
    wm title $base "Create new table"
    entry $base.etabn \
        -background #fefefe -borderwidth 1 -selectborderwidth 0 \
        -textvariable ntw(newtablename) 
    bind $base.etabn <Key-Return> {
        focus .nt.einh
    }
    label $base.li \
        -anchor w -borderwidth 0 -text Inherits 
    entry $base.einh \
        -background #fefefe -borderwidth 1 -selectborderwidth 0 \
        -textvariable ntw(fathername) 
    bind $base.einh <Key-Return> {
        focus .nt.e2
    }
    button $base.binh \
        -borderwidth 1 \
        -command {if {[winfo exists .nt.ddf]} {
	destroy .nt.ddf
} else {
	create_drop_down .nt 386 23 220
	focus .nt.ddf.sb
	foreach tbl [get_tables] {.nt.ddf.lb insert end $tbl}
	bind .nt.ddf.lb <ButtonRelease-1> {
		set i [.nt.ddf.lb curselection]
		if {$i!=""} {
			if {$ntw(fathername)==""} {
				set ntw(fathername) "\"[.nt.ddf.lb get $i]\""
			} else {
				set ntw(fathername) "$ntw(fathername),\"[.nt.ddf.lb get $i]\""
			}
		}
		if {$i!=""} {focus .nt.e2}
		destroy .nt.ddf
		break
	}
}} \
        -highlightthickness 0 -takefocus 0 -image dnarw
    entry $base.e2 \
        -background #fefefe -borderwidth 1 -selectborderwidth 0 \
        -textvariable ntw(fldname) 
    bind $base.e2 <Key-Return> {
        focus .nt.e1
    }
    entry $base.e1 \
        -background #fefefe -borderwidth 1 -selectborderwidth 0 \
        -textvariable ntw(fldtype) 
    bind $base.e1 <Key-Return> {
        focus .nt.e5
    }
    entry $base.e3 \
        -background #fefefe -borderwidth 1 -selectborderwidth 0 \
        -textvariable ntw(fldsize) 
    bind $base.e3 <Key-Return> {
        focus .nt.e5
    }
    entry $base.e5 \
        -background #fefefe -borderwidth 1 -selectborderwidth 0 \
        -textvariable ntw(defaultval) 
    bind $base.e5 <Key-Return> {
        focus .nt.cb1
    }
    checkbutton $base.cb1 \
        -borderwidth 1 \
        -offvalue { } -onvalue { NOT NULL} -text {field cannot be null} \
        -variable ntw(notnull) 
    label $base.lab1 \
        -borderwidth 0 -text type 
    label $base.lab2 \
        -borderwidth 0 -anchor w -text {Field name} 
    label $base.lab3 \
        -borderwidth 0 -text size 
    label $base.lab4 \
        -borderwidth 0 -anchor w -text {Default value} 
    button $base.addfld \
        -borderwidth 1 -command add_new_field \
        -text {Add field} 
    button $base.delfld \
        -borderwidth 1 -command {catch {.nt.lb delete [.nt.lb curselection]}} \
        -text {Delete field} 
    button $base.emptb \
        -borderwidth 1 -command {.nt.lb delete 0 [.nt.lb size]} \
        -text {Delete all} 
    button $base.maketbl \
        -borderwidth 1 -command create_table \
        -text Create 
    listbox $base.lb \
        -background #fefefe -borderwidth 1 \
	-selectbackground #c3c3c3 \
        -font $pref(font_fix) \
        -selectborderwidth 0 -yscrollcommand {.nt.sb set} 
    bind $base.lb <ButtonRelease-1> {
        if {[.nt.lb curselection]!=""} {
	set fldname [string trim [lindex [split [.nt.lb get [.nt.lb curselection]]] 0]]
}
    }
    button $base.exitbtn \
        -borderwidth 1 -command {Window destroy .nt} \
        -text Cancel 
    label $base.l1 \
        -anchor w -borderwidth 1 \
        -relief raised -text {       field name} 
    label $base.l2 \
        -borderwidth 1 \
        -relief raised -text type 
    label $base.l3 \
        -borderwidth 1 \
        -relief raised -text options 
    scrollbar $base.sb \
        -borderwidth 1 -command {.nt.lb yview} -orient vert 
    label $base.l93 \
        -anchor w -borderwidth 0 -text {Table name} 
    button $base.mvup \
        -borderwidth 1 \
        -command {if {[.nt.lb size]>1} {
	set i [.nt.lb curselection]
	if {($i!="")&&($i>0)} {
		.nt.lb insert [expr $i-1] [.nt.lb get $i]
		.nt.lb delete [expr $i+1]
		.nt.lb selection set [expr $i-1]
	}
}} \
        -text {Move up} 
    button $base.mvdn \
        -borderwidth 1 \
        -command {if {[.nt.lb size]>1} {
	set i [.nt.lb curselection]
	if {($i!="")&&($i<[expr [.nt.lb size]-1])} {
		.nt.lb insert [expr $i+2] [.nt.lb get $i]
		.nt.lb delete $i
		.nt.lb selection set [expr $i+1]
	}
}} \
        -text {Move down} 
    button $base.button17 \
        -borderwidth 1 \
        -command {
if {[winfo exists .nt.ddf]} {
	destroy .nt.ddf
} else {
	create_drop_down .nt 291 80 97
	focus .nt.ddf.sb
	.nt.ddf.lb insert end char varchar text int2 int4 serial float4 float8 money abstime date datetime interval reltime time timespan timestamp boolean box circle line lseg path point polygon
	bind .nt.ddf.lb <ButtonRelease-1> {
		set i [.nt.ddf.lb curselection]
		if {$i!=""} {set ntw(fldtype) [.nt.ddf.lb get $i]}
		destroy .nt.ddf
		if {$i!=""} {focus .nt.e3}
		break
	}
}} \
        -highlightthickness 0 -takefocus 0 -image dnarw 
    label $base.lco \
        -borderwidth 0 -anchor w -text Constraint 
    entry $base.eco \
        -background #fefefe -borderwidth 1 -textvariable ntw(constraint) 
    label $base.lch \
        -borderwidth 0 -text check 
    entry $base.ech \
        -background #fefefe -borderwidth 1 -textvariable ntw(check) 
    label $base.ll \
        -borderwidth 1 \
        -relief raised 
    checkbutton $base.pk \
        -borderwidth 1 \
        -offvalue { } -onvalue * -text {primary key} -variable ntw(pk) 
    label $base.lpk \
        -borderwidth 1 \
        -relief raised -text K 
    place $base.etabn \
        -x 85 -y 5 -width 156 -height 20 -anchor nw -bordermode ignore 
    place $base.li \
        -x 245 -y 7 -width 42 -height 16 -anchor nw -bordermode ignore 
    place $base.einh \
        -x 290 -y 5 -width 318 -height 20 -anchor nw -bordermode ignore 
    place $base.binh \
        -x 590 -y 7 -width 16 -height 16 -anchor nw -bordermode ignore 
    place $base.e2 \
        -x 85 -y 60 -width 156 -height 20 -anchor nw -bordermode ignore 
    place $base.e1 \
        -x 291 -y 60 -width 98 -height 20 -anchor nw -bordermode ignore 
    place $base.e3 \
        -x 445 -y 60 -width 46 -height 20 -anchor nw -bordermode ignore 
    place $base.e5 \
        -x 85 -y 82 -width 156 -height 20 -anchor nw -bordermode ignore 
    place $base.cb1 \
        -x 245 -y 83 -width 131 -height 20 -anchor nw -bordermode ignore 
    place $base.lab1 \
        -x 247 -y 62 -width 26 -height 16 -anchor nw -bordermode ignore 
    place $base.lab2 \
        -x 4 -y 62 -width 64 -height 16 -anchor nw -bordermode ignore 
    place $base.lab3 \
        -x 410 -y 62 -width 24 -height 16 -anchor nw -bordermode ignore 
    place $base.lab4 \
        -x 5 -y 83 -width 76 -height 16 -anchor nw -bordermode ignore 
    place $base.addfld \
        -x 534 -y 60 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.delfld \
        -x 534 -y 190 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.emptb \
        -x 534 -y 220 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.maketbl \
        -x 534 -y 365 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.lb \
        -x 4 -y 121 -width 506 -height 269 -anchor nw -bordermode ignore 
    place $base.exitbtn \
        -x 534 -y 335 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.l1 \
        -x 18 -y 105 -width 195 -height 18 -anchor nw -bordermode ignore 
    place $base.l2 \
        -x 213 -y 105 -width 88 -height 18 -anchor nw -bordermode ignore 
    place $base.l3 \
        -x 301 -y 105 -width 225 -height 18 -anchor nw -bordermode ignore 
    place $base.sb \
        -x 509 -y 121 -width 18 -height 269 -anchor nw -bordermode ignore 
    place $base.l93 \
        -x 4 -y 7 -width 67 -height 16 -anchor nw -bordermode ignore 
    place $base.mvup \
        -x 534 -y 120 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.mvdn \
        -x 534 -y 150 -width 75 -height 26 -anchor nw -bordermode ignore 
    place $base.button17 \
        -x 371 -y 62 -width 16 -height 16 -anchor nw -bordermode ignore 
    place $base.lco \
        -x 5 -y 28 -width 58 -height 16 -anchor nw -bordermode ignore 
    place $base.eco \
        -x 85 -y 27 -width 156 -height 20 -anchor nw -bordermode ignore 
    place $base.lch \
        -x 245 -y 30 -anchor nw -bordermode ignore 
    place $base.ech \
        -x 290 -y 27 -width 318 -height 22 -anchor nw -bordermode ignore 
    place $base.ll \
        -x 5 -y 53 -width 603 -height 2 -anchor nw -bordermode ignore 
    place $base.pk \
        -x 407 -y 83 -width 93 -height 20 -anchor nw -bordermode ignore 
    place $base.lpk \
        -x 4 -y 105 -width 14 -height 18 -anchor nw -bordermode ignore 
}

proc vTclWindow.pw {base} {
global pref
	if {$base == ""} {
		set base .pw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 322x227+210+219
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm title $base "Preferences"
	label $base.l1  -borderwidth 0 -text {Max rows displayed in table/query view} 
	entry $base.e1  -background #fefefe -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable pref(rows) 
	label $base.l2  -borderwidth 0 -text "Table viewer font"
	radiobutton $base.tvf  -borderwidth 1 -text {fixed width} -value clean -variable pref(tvfont)
	radiobutton $base.tvfv  -borderwidth 1 -text proportional -value helv -variable pref(tvfont)
	label $base.lfn -borderwidth 0 -anchor w -text "Font normal"
	label $base.lfb -borderwidth 0 -anchor w -text "Font bold"
	label $base.lfi -borderwidth 0 -anchor w -text "Font italic"
	label $base.lff -borderwidth 0 -anchor w -text "Font fixed"
	entry $base.efn -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable pref(font_normal)
	entry $base.efb -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable pref(font_bold)
	entry $base.efi -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable pref(font_italic)
	entry $base.eff -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable pref(font_fix)
	label $base.ll  -borderwidth 1 -relief sunken 
	checkbutton $base.alcb  -borderwidth 1 -text {Auto-load the last opened database at startup}  -variable pref(autoload) 
	button $base.okbtn  -borderwidth 1  -command {
if {$pref(rows)>200} {
	tk_messageBox -title Warning -parent .pw -message "A big number of rows displayed in table view will take a lot of memory!"
}
save_pref
Window destroy .pw
tk_messageBox -title Warning -message "Changed fonts may appear in the next working session!"
} -text Ok 
	place $base.l1  -x 10 -y 10 -anchor nw -bordermode ignore 
	place $base.e1  -x 240 -y 8 -width 65 -height 20 -anchor nw -bordermode ignore 
	place $base.l2  -x 10 -y 38 -anchor nw -bordermode ignore 
	place $base.tvf  -x 115 -y 34 -anchor nw -bordermode ignore 
	place $base.tvfv  -x 205 -y 34 -anchor nw -bordermode ignore 
	place $base.lfn -x 10 -y 65 -anchor nw
	place $base.lfb -x 10 -y 86 -anchor nw
	place $base.lfi -x 10 -y 107 -anchor nw
	place $base.lff -x 10 -y 128 -anchor nw
	place $base.efn -x 80 -y 63 -width 230 -height 20
	place $base.efb -x 80 -y 84 -width 230 -height 20
	place $base.efi -x 80 -y 105 -width 230 -height 20
	place $base.eff -x 80 -y 126 -width 230 -height 20
	place $base.ll  -x 10 -y 150 -width 301 -height 2 -anchor nw -bordermode ignore 
	place $base.alcb  -x 10 -y 155 -anchor nw -bordermode ignore 
	place $base.okbtn  -x 125 -y 195 -width 80 -height 26 -anchor nw -bordermode ignore
}

proc vTclWindow.qb {base} {
global pref
	if {$base == ""} {
		set base .qb
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 442x344+150+150
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm deiconify $base
	wm title $base "Query builder"
	label $base.lqn  -borderwidth 0 -text {Query name} 
	entry $base.eqn  -background #fefefe -borderwidth 1 -foreground #000000  -highlightthickness 1 -selectborderwidth 0 -textvariable queryname 
	button $base.savebtn  -borderwidth 1  -command {if {$queryname==""} then {
	show_error "You have to supply a name for this query!"
	focus .qb.eqn
} else {
	set qcmd [.qb.text1 get 1.0 end]
	regsub -all "\n" $qcmd " " qcmd
	if {$qcmd==""} then {
	show_error "This query has no commands ?"
	} else {
		if { [lindex [split [string toupper [string trim $qcmd]]] 0] == "SELECT" } {
			set qtype S
		} else {
			set qtype A
		}
		if {$cbv} {
			wpg_select $dbc "select pg_get_viewdef('$queryname') as vd" tup {
				if {$tup(vd)!="Not a view"} {
					if {[tk_messageBox -title Warning -message "View '$queryname' already exists! Delete ?" -type yesno -default no]=="yes"} {
						set pg_res [wpg_exec $dbc "drop view \"$queryname\""]
						if {$pgsql(status)!="PGRES_COMMAND_OK"} {
							show_error "Error deleting view '$queryname'"
						}
					}
				}
			}
			set pgres [wpg_exec $dbc "create view \"$queryname\" as $qcmd"]
			if {$pgsql(status)!="PGRES_COMMAND_OK"} {
				show_error "Error defining view\n\n$pgsql(errmsg)"
			} else {
				tab_click .dw.tabViews
				Window destroy .qb
			}
			catch {pg_result $pgres -clear}
		} else {
			regsub -all "'" $qcmd "''" qcmd
			cursor_clock
			if {$queryoid==0} then {
				set pgres [wpg_exec $dbc "insert into pga_queries values ('$queryname','$qtype','$qcmd')"]
			} else {
				set pgres [wpg_exec $dbc "update pga_queries set queryname='$queryname',querytype='$qtype',querycommand='$qcmd' where oid=$queryoid"]
			}
			cursor_normal
			if {$pgsql(status)!="PGRES_COMMAND_OK"} then {
				show_error "Error executing query\n$pgres(errmsg)"
			} else {
				tab_click .dw.tabQueries
				if {$queryoid==0} {set queryoid [pg_result $pgres -oid]}
			}
		}
		catch {pg_result $pgres -clear}
	}
}}  -text {Save query definition} 
	button $base.execbtn  -borderwidth 1  -command {
set qcmd [.qb.text1 get 0.0 end]
regsub -all "\n" [string trim $qcmd] " " qcmd
if {[lindex [split [string toupper $qcmd]] 0]!="SELECT"} {
	if {[tk_messageBox -title Warning -parent .qb -message "This is an action query!\n\nExecute it?" -type yesno -default no]=="yes"} {
		sql_exec noquiet $qcmd
	}
} else {
	set wn [mw_get_new_name]
	set mw($wn,query) [subst $qcmd]
	set mw($wn,updatable) 0
	set mw($wn,isaquery) 1
	mw_create_window
	mw_load_layout $wn $queryname
	mw_select_records $wn $mw($wn,query)
}
} -text {Execute query} 
	button $base.termbtn  -borderwidth 1  -command {.qb.cbv configure -state normal
set cbv 0
set queryname {}
.qb.text1 delete 1.0 end
Window destroy .qb} -text Close 
	text $base.text1  -background #fefefe -borderwidth 1  -font $pref(font_normal) -foreground #000000 -highlightthickness 1 -wrap word 
	checkbutton $base.cbv  -borderwidth 1  -text {Save this query as a view} -variable cbv 
	button $base.qlshow  -borderwidth 1  -command {Window show .ql
ql_draw_lizzard
focus .ql.entt} -text {Visual designer} 
	place $base.lqn  -x 5 -y 5 -anchor nw -bordermode ignore 
	place $base.eqn  -x 80 -y 1 -width 355 -height 24 -anchor nw -bordermode ignore 
	place $base.savebtn  -x 5 -y 60 -height 25 -anchor nw -bordermode ignore 
	place $base.execbtn  -x 150 -y 60 -height 25 -anchor nw -bordermode ignore 
	place $base.termbtn  -x 375 -y 60 -width 50 -height 25 -anchor nw -bordermode ignore 
	place $base.text1  -x 5 -y 90 -width 430 -height 246 -anchor nw -bordermode ignore 
	place $base.cbv  -x 5 -y 30 -height 25 -anchor nw -bordermode ignore 
	place $base.qlshow  -x 255 -y 60 -height 25 -anchor nw -bordermode ignore
}

proc vTclWindow.ql {base} {
global pref
	if {$base == ""} {
		set base .ql
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 759x530+10+13
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm deiconify $base
	wm title $base "Visual query designer"
	bind $base <B1-Motion> {
		ql_pan %x %y
	}
	bind $base <Button-1> {
		qlc_click %x %y %W
	}
	bind $base <ButtonRelease-1> {
		ql_dragstop %x %y
	}
	bind $base <Key-Delete> {
		ql_delete_object
	}
	canvas $base.c  -background #fefefe -borderwidth 2 -height 207 -relief ridge  -takefocus 0 -width 295 
	button $base.exitbtn  -borderwidth 1 -command {
ql_init
Window destroy .ql} -text Close 
	button $base.showbtn  -borderwidth 1 -command ql_show_sql -text {Show SQL} 
	label $base.l12  -borderwidth 0 -text {Add table} 
	entry $base.entt  -background #fefefe -borderwidth 1 -highlightthickness 1  -selectborderwidth 0 -textvariable qlvar(newtablename) 
	bind $base.entt <Key-Return> {
		ql_add_new_table
	}
	button $base.execbtn  -borderwidth 1  -command {
set qcmd [ql_compute_sql]
set wn [mw_get_new_name]
set mw($wn,query) [subst $qcmd]
set mw($wn,updatable) 0
set mw($wn,isaquery) 1
mw_create_window
mw_load_layout $wn nolayoutneeded
mw_select_records $wn $mw($wn,query)} -text {Execute SQL} 
	button $base.stoqb  -borderwidth 1  -command {Window show .qb
.qb.text1 delete 1.0 end
.qb.text1 insert end [ql_compute_sql]
focus .qb} -text {Save to query builder} 
	button $base.bdd  -borderwidth 1  -command {if {[winfo exists .ql.ddf]} {
	destroy .ql.ddf
} else {
	create_drop_down .ql 70 27 200
	focus .ql.ddf.sb
	foreach tbl [get_tables] {.ql.ddf.lb insert end $tbl}
	bind .ql.ddf.lb <ButtonRelease-1> {
		set i [.ql.ddf.lb curselection]
		if {$i!=""} {
			set qlvar(newtablename) [.ql.ddf.lb get $i]
			ql_add_new_table
		}
		destroy .ql.ddf
		break
	}
}}  -image dnarw 
	place $base.c  -x 5 -y 30 -width 748 -height 500 -anchor nw -bordermode ignore 
	place $base.exitbtn  -x 695 -y 5 -height 25 -anchor nw -bordermode ignore 
	place $base.showbtn  -x 367 -y 5 -height 25 -anchor nw -bordermode ignore 
	place $base.l12  -x 10 -y 8 -width 53 -height 16 -anchor nw -bordermode ignore 
	place $base.entt  -x 70 -y 7 -width 126 -height 20 -anchor nw -bordermode ignore 
	place $base.execbtn  -x 452 -y 5 -height 25 -anchor nw -bordermode ignore 
	place $base.stoqb  -x 550 -y 5 -height 25 -anchor nw -bordermode ignore 
	place $base.bdd  -x 200 -y 7 -width 17 -height 20 -anchor nw -bordermode ignore
}


proc vTclWindow.rf {base} {
	if {$base == ""} {
		set base .rf
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 272x105+294+262
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm title $base "Rename"
	label $base.l1  -borderwidth 0 -text {New name} 
	entry $base.e1  -background #fefefe -borderwidth 1 -textvariable newobjname 
	button $base.b1  -borderwidth 1  -command {
			if {$newobjname==""} {
				show_error "You must give object a new name!"
			} elseif {$activetab=="Tables"} {
				set retval [sql_exec noquiet "alter table \"$oldobjname\" rename to \"$newobjname\""]
				if {$retval} {
					sql_exec quiet "update pga_layout set tablename='$newobjname' where tablename='$oldobjname'"
					cmd_Tables
					Window destroy .rf
				}			
			} elseif {$activetab=="Queries"} {
				set pgres [wpg_exec $dbc "select * from pga_queries where queryname='$newobjname'"]
				if {$pgsql(status)!="PGRES_TUPLES_OK"} {
					show_error "Error retrieving from pga_queries\n$pgsql(errmsg)\n$pgsql(status)"
				} elseif {[pg_result $pgres -numTuples]>0} {
					show_error "Query \"$newobjname\" already exists!"
				} else {
					sql_exec noquiet "update pga_queries set queryname='$newobjname' where queryname='$oldobjname'"
					sql_exec noquiet "update pga_layout set tablename='$newobjname' where tablename='$oldobjname'"
					cmd_Queries
					Window destroy .rf
				}
				catch {pg_result $pgres -clear}
			}
	   } -text Rename 
	button $base.b2  -borderwidth 1 -command {Window destroy .rf} -text Cancel 
	place $base.l1  -x 15 -y 28 -anchor nw -bordermode ignore 
	place $base.e1  -x 100 -y 25 -anchor nw -bordermode ignore 
	place $base.b1  -x 65 -y 65 -width 70 -anchor nw -bordermode ignore 
	place $base.b2  -x 145 -y 65 -width 70 -anchor nw -bordermode ignore
}

proc vTclWindow.rb {base} {
global pref
	if {$base == ""} {
		set base .rb
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 652x426+96+120
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm deiconify $base
	wm title $base "Report builder"
	label $base.l1 \
		-borderwidth 1 \
		-relief raised -text {Report fields} 
	listbox $base.lb \
		-background #fefefe -borderwidth 1 \
		-selectbackground #c3c3c3 \
		-highlightthickness 1 -selectborderwidth 0 \
		-yscrollcommand {.rb.sb set} 
	bind $base.lb <ButtonRelease-1> {
		rb_add_field
	}
	canvas $base.c \
		-background #fffeff -borderwidth 2 -height 207 -highlightthickness 0 \
		-relief ridge -takefocus 1 -width 295 
	bind $base.c <Button-1> {
		rb_dragstart %W %x %y
	}
	bind $base.c <ButtonRelease-1> {
		rb_dragstop %x %y
	}
	bind $base.c <Key-Delete> {
		rb_delete_object
	}
	bind $base.c <Motion> {
		rb_dragit %W %x %y
	}
	button $base.bt2 \
		-borderwidth 1 \
		-command {if {[tk_messageBox -title Warning -parent .rb -message "All report information will be deleted.\n\nProceed ?" -type yesno -default no]=="yes"} then {
.rb.c delete all
rb_init
rb_draw_regions
}} \
		-text {Clear all} 
	button $base.bt4 \
		-borderwidth 1 -command rb_preview \
		-text Preview 
	button $base.bt5 \
		-borderwidth 1 -command {Window destroy .rb} \
		-text Quit 
	scrollbar $base.sb \
		-borderwidth 1 -command {.rb.lb yview} -orient vert 
	label $base.lmsg \
		-anchor w \
		-relief groove -text {Report header} -textvariable rbvar(msg) 
	entry $base.e2 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-textvariable rbvar(tablename) 
	bind $base.e2 <Key-Return> {
		rb_get_report_fields
	}
	entry $base.elab \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-textvariable rbvar(labeltext) 
	button $base.badl \
		-borderwidth 1 -command rb_add_label \
		-text {Add label} 
	label $base.lbold \
		-borderwidth 1 -relief raised -text B 
	bind $base.lbold <Button-1> {
		if {[rb_get_bold]=="Bold"} {
   .rb.lbold configure -relief raised
} else {
   .rb.lbold configure -relief sunken
}
rb_change_object_font
	}
	label $base.lita \
		-borderwidth 1 \
		-font $pref(font_italic) \
		-relief raised -text i 
	bind $base.lita <Button-1> {
		if {[rb_get_italic]=="O"} {
   .rb.lita configure -relief raised
} else {
   .rb.lita configure -relief sunken
}
rb_change_object_font
	}
	entry $base.eps \
		-background #fefefe -highlightthickness 0 -relief groove \
		-textvariable rbvar(pointsize) 
	bind $base.eps <Key-Return> {
		rb_change_object_font
	}
	label $base.linfo \
		-anchor w  \
		-relief groove -text {Database field} -textvariable rbvar(info) 
	label $base.llal \
		-borderwidth 0 -text Align 
	button $base.balign \
		-borderwidth 0 -command rb_flip_align \
		-relief groove -text right 
	button $base.savebtn \
		-borderwidth 1 -command rb_save_report \
		-text Save 
	label $base.lfn \
		-borderwidth 0 -text Font 
	button $base.bfont \
		-borderwidth 0 \
		-command {set temp [.rb.bfont cget -text]
if {$temp=="Courier"} then {
  .rb.bfont configure -text Helvetica
} else {
  .rb.bfont configure -text Courier
}
rb_change_object_font} \
		-relief groove -text Courier 
	button $base.bdd \
		-borderwidth 1 \
		-command {if {[winfo exists .rb.ddf]} {
	destroy .rb.ddf
} else {
	create_drop_down .rb 405 22 200
	focus .rb.ddf.sb
	foreach tbl [get_tables] {.rb.ddf.lb insert end $tbl}
	bind .rb.ddf.lb <ButtonRelease-1> {
		set i [.rb.ddf.lb curselection]
		if {$i!=""} {set rbvar(tablename) [.rb.ddf.lb get $i]}
		destroy .rb.ddf
		rb_get_report_fields
		break
	}
}} \
		-highlightthickness 0 -image dnarw 
	label $base.lrn \
		-borderwidth 0 -text {Report name} 
	entry $base.ern \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-textvariable rbvar(reportname) 
	bind $base.ern <Key-F5> {
		rb_load_report
	}
	label $base.lrs \
		-borderwidth 0 -text {Report source} 
	label $base.ls \
		-borderwidth 1 -relief raised 
	entry $base.ef \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-textvariable rbvar(formula) 
	button $base.baf \
		-borderwidth 1 \
		-text {Add formula} 
	place $base.l1 \
		-x 5 -y 55 -width 131 -height 18 -anchor nw -bordermode ignore 
	place $base.lb \
		-x 5 -y 70 -width 118 -height 121 -anchor nw -bordermode ignore 
	place $base.c \
		-x 140 -y 75 -width 508 -height 345 -anchor nw -bordermode ignore 
	place $base.bt2 \
		-x 5 -y 365 -width 64 -height 26 -anchor nw -bordermode ignore 
	place $base.bt4 \
		-x 70 -y 365 -width 66 -height 26 -anchor nw -bordermode ignore 
	place $base.bt5 \
		-x 70 -y 395 -width 66 -height 26 -anchor nw -bordermode ignore 
	place $base.sb \
		-x 120 -y 70 -width 18 -height 122 -anchor nw -bordermode ignore 
	place $base.lmsg \
		-x 142 -y 55 -width 151 -height 18 -anchor nw -bordermode ignore 
	place $base.e2 \
		-x 405 -y 4 -width 129 -height 18 -anchor nw -bordermode ignore 
	place $base.elab \
		-x 5 -y 225 -width 130 -height 18 -anchor nw -bordermode ignore 
	place $base.badl \
		-x 5 -y 243 -width 132 -height 26 -anchor nw -bordermode ignore 
	place $base.lbold \
		-x 535 -y 55 -width 18 -height 18 -anchor nw -bordermode ignore 
	place $base.lita \
		-x 555 -y 55 -width 18 -height 18 -anchor nw -bordermode ignore 
	place $base.eps \
		-x 500 -y 55 -width 30 -height 18 -anchor nw -bordermode ignore 
	place $base.linfo \
		-x 295 -y 55 -width 91 -height 18 -anchor nw -bordermode ignore 
	place $base.llal \
		-x 575 -y 56 -anchor nw -bordermode ignore 
	place $base.balign \
		-x 610 -y 54 -width 35 -height 21 -anchor nw -bordermode ignore 
	place $base.savebtn \
		-x 5 -y 395 -width 64 -height 26 -anchor nw -bordermode ignore 
	place $base.lfn \
		-x 405 -y 56 -anchor nw -bordermode ignore 
	place $base.bfont \
		-x 435 -y 54 -width 65 -height 21 -anchor nw -bordermode ignore 
	place $base.bdd \
		-x 535 -y 4 -width 15 -height 20 -anchor nw -bordermode ignore 
	place $base.lrn \
		-x 5 -y 5 -anchor nw -bordermode ignore 
	place $base.ern \
		-x 80 -y 4 -width 219 -height 18 -anchor nw -bordermode ignore 
	place $base.lrs \
		-x 320 -y 5 -anchor nw -bordermode ignore 
	place $base.ls \
		-x 5 -y 30 -width 641 -height 2 -anchor nw -bordermode ignore 
	place $base.ef \
		-x 5 -y 280 -width 130 -height 18 -anchor nw -bordermode ignore 
	place $base.baf \
		-x 5 -y 298 -width 132 -height 26 -anchor nw -bordermode ignore 
}

proc vTclWindow.rpv {base} {
	if {$base == ""} {
		set base .rpv
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 495x500+230+50
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm title $base "Report preview"
	frame $base.fr \
		-borderwidth 2 -height 75 -relief groove -width 125 
	canvas $base.fr.c \
		-background #fcfefe -borderwidth 2 -height 207 -relief ridge \
		-scrollregion {0 0 1000 824} -width 295 \
		-yscrollcommand {.rpv.fr.sb set} 
	scrollbar $base.fr.sb \
		-borderwidth 1 -command {.rpv.fr.c yview} -highlightthickness 0 \
		-orient vert -width 12 
	frame $base.f1 \
		-borderwidth 2 -height 75 -width 125 
	button $base.f1.button18 \
		-borderwidth 1 -command {if {$rbvar(justpreview)} then {Window destroy .rb} ; Window destroy .rpv} \
		-text Close 
	button $base.f1.button17 \
		-borderwidth 1 -command rb_print_report \
		-text Print 
	pack $base.fr \
		-in .rpv -anchor center -expand 1 -fill both -side top 
	pack $base.fr.c \
		-in .rpv.fr -anchor center -expand 1 -fill both -side left 
	pack $base.fr.sb \
		-in .rpv.fr -anchor center -expand 0 -fill y -side right 
	pack $base.f1 \
		-in .rpv -anchor center -expand 0 -fill none -side top 
	pack $base.f1.button18 \
		-in .rpv.f1 -anchor center -expand 0 -fill none -side right 
	pack $base.f1.button17 \
		-in .rpv.f1 -anchor center -expand 0 -fill none -side left 
}

proc vTclWindow.sqf {base} {
	if {$base == ""} {
		set base .sqf
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 310x223+245+158
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm title $base "Sequence"
	label $base.l1  -anchor w -borderwidth 0 -text {Sequence name} 
	entry $base.e1  -borderwidth 1 -highlightthickness 1 -textvariable seq_name 
	label $base.l2  -borderwidth 0 -text Increment 
	entry $base.e2  -borderwidth 1 -highlightthickness 1 -selectborderwidth 0  -textvariable seq_inc 
	label $base.l3  -borderwidth 0 -text {Start value} 
	entry $base.e3  -borderwidth 1 -highlightthickness 1 -selectborderwidth 0  -textvariable seq_start 
	label $base.l4  -borderwidth 0 -text Minvalue 
	entry $base.e4  -borderwidth 1 -highlightthickness 1 -selectborderwidth 0  -textvariable seq_minval 
	label $base.l5  -borderwidth 0 -text Maxvalue 
	entry $base.e5  -borderwidth 1 -highlightthickness 1 -selectborderwidth 0  -textvariable seq_maxval 
	button $base.defbtn  -borderwidth 1  -command {
		if {$seq_name==""} {
			show_error "You should supply a name for this sequence"
		} else {
			set s1 {};set s2 {};set s3 {};set s4 {};
			if {$seq_inc!=""} {set s1 "increment $seq_inc"};
			if {$seq_start!=""} {set s2 "start $seq_start"};
			if {$seq_minval!=""} {set s3 "minvalue $seq_minval"};
			if {$seq_maxval!=""} {set s4 "maxvalue $seq_maxval"};
			set sqlcmd "create sequence \"$seq_name\" $s1 $s2 $s3 $s4"
			if {[sql_exec noquiet $sqlcmd]} {
				cmd_Sequences
				tk_messageBox -title Information -parent .sqf -message "Sequence created!"
			}
		}
	} -text {Define sequence} 
	button $base.closebtn  -borderwidth 1  -command {for {set i 1} {$i<6} {incr i} {
	.sqf.e$i configure -state normal
	.sqf.e$i delete 0 end
	.sqf.defbtn configure -state normal
	.sqf.l3 configure -text {Start value}
}
place .sqf.defbtn -x 40 -y 175
Window destroy .sqf
} -text Close 
	place $base.l1  -x 20 -y 20 -width 111 -height 18 -anchor nw -bordermode ignore 
	place $base.e1  -x 135 -y 19 -anchor nw -bordermode ignore 
	place $base.l2  -x 20 -y 50 -anchor nw -bordermode ignore 
	place $base.e2  -x 135 -y 49 -anchor nw -bordermode ignore 
	place $base.l3  -x 20 -y 80 -anchor nw -bordermode ignore 
	place $base.e3  -x 135 -y 79 -anchor nw -bordermode ignore 
	place $base.l4  -x 20 -y 110 -anchor nw -bordermode ignore 
	place $base.e4  -x 135 -y 109 -anchor nw -bordermode ignore 
	place $base.l5  -x 20 -y 140 -anchor nw -bordermode ignore 
	place $base.e5  -x 135 -y 139 -anchor nw -bordermode ignore 
	place $base.defbtn  -x 40 -y 175 -anchor nw -bordermode ignore 
	place $base.closebtn  -x 195 -y 175 -anchor nw -bordermode ignore
}

proc vTclWindow.sw {base} {
global pref
	if {$base == ""} {
		set base .sw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 594x416+192+152
	wm maxsize $base 1009 738
	wm minsize $base 300 300
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm title $base "Design script"
	frame $base.f1  -height 55 -relief groove -width 125 
	label $base.f1.l1  -borderwidth 0 -text {Script name} 
	entry $base.f1.e1  -background #fefefe -borderwidth 1 -highlightthickness 0  -textvariable scriptname -width 32 
	text $base.src  -background #fefefe  -font $pref(font_normal) -height 2  -highlightthickness 1 -selectborderwidth 0 -width 2 
	frame $base.f2  -height 75 -relief groove -width 125 
	button $base.f2.b1  -borderwidth 1 -command {Window destroy .sw} -text Cancel 
	button $base.f2.b2  -borderwidth 1  -command {if {$scriptname==""} {
	tk_messageBox -title Warning -parent .sw -message "The script must have a name!"
} else {
   sql_exec noquiet "delete from pga_scripts where scriptname='$scriptname'"
   regsub -all {\\} [.sw.src get 1.0 end] {\\\\} scriptsource
   regsub -all ' $scriptsource  \\' scriptsource
   sql_exec noquiet "insert into pga_scripts values ('$scriptname','$scriptsource')"
   cmd_Scripts
}}  -text Save -width 6 
	pack $base.f1  -in .sw -anchor center -expand 0 -fill x -pady 2 -side top 
	pack $base.f1.l1  -in .sw.f1 -anchor center -expand 0 -fill none -ipadx 2 -side left 
	pack $base.f1.e1  -in .sw.f1 -anchor center -expand 0 -fill none -side left 
	pack $base.src  -in .sw -anchor center -expand 1 -fill both -padx 2 -side top 
	pack $base.f2  -in .sw -anchor center -expand 0 -fill none -side top 
	pack $base.f2.b1  -in .sw.f2 -anchor center -expand 0 -fill none -side right 
	pack $base.f2.b2  -in .sw.f2 -anchor center -expand 0 -fill none -side right
}

proc vTclWindow.tiw {base} {
global pref
	if {$base == ""} {
		set base .tiw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 390x460+243+20
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm title $base "Table information"
	label $base.l1  -borderwidth 0 -text {Table name} 
	label $base.l2  -anchor w -borderwidth 0 -text conturi -textvariable tiw(tablename) 
	label $base.l3  -borderwidth 0 -text Owner 
	label $base.l4  -anchor w -borderwidth 1  -textvariable tiw(owner) 
	listbox $base.lb  -background #fefefe -selectbackground #c3c3c3 -borderwidth 1  -font $pref(font_fix)  -highlightthickness 1 -selectborderwidth 0  -yscrollcommand {.tiw.sb set} 
	scrollbar $base.sb  -activebackground #d9d9d9 -activerelief sunken -borderwidth 1  -command {.tiw.lb yview} -orient vert 
	button $base.closebtn  -borderwidth 1 -command {Window destroy .tiw}  -pady 3 -text Close
	button $base.renbtn -borderwidth 1 -command {
	if {[set tiw(col_id) [.tiw.lb curselection]]==""} then {bell} else {set tiw(old_cn) [.tiw.lb get [.tiw.lb curselection]] ; set tiw(new_cn) {} ; Window show .rcw ; tkwait visibility .rcw ; wm transient .rcw .tiw ; focus .rcw.e1}} -text {Rename field}
	button $base.addbtn -borderwidth 1 -command "Window show .anfw ; set anfw(name) {} ; set anfw(type) {} ; wm transient .anfw .tiw ; focus .anfw.e1" -text "Add new field"
	label $base.l10  -borderwidth 1  -relief raised -text {field name}
	label $base.l11  -borderwidth 1  -relief raised -text {field type}
	label $base.l12  -borderwidth 1  -relief raised -text size
	label $base.lfi  -borderwidth 0 -text {Field information}
	label $base.lii  -borderwidth 1  -relief raised -text {Indexes defined}
	listbox $base.ilb  -background #fefefe -borderwidth 1  -highlightthickness 1 -selectborderwidth 0 -selectbackground #c3c3c3
	bind $base.ilb <ButtonRelease-1> {
		tiw_show_index
	}
	label $base.lip  -borderwidth 1  -relief raised -text {index properties}
	frame $base.fr11  -borderwidth 1 -height 75 -relief sunken -width 125
	label $base.fr11.l9  -borderwidth 0 -text {Is clustered ?} 
	label $base.fr11.l2  -borderwidth 0 -text {Is unique ?} 
	label $base.fr11.liu  -anchor nw -borderwidth 0 -text Yes -textvariable tiw(isunique) 
	label $base.fr11.lic  -anchor nw -borderwidth 0 -text No -textvariable tiw(isclustered) 
	label $base.fr11.l5  -borderwidth 0 -text {Fields :} 
	label $base.fr11.lif  -anchor nw -borderwidth 1  -justify left -relief sunken -text cont  -textvariable tiw(indexfields) -wraplength 170 
	place $base.l1  -x 20 -y 15 -anchor nw -bordermode ignore 
	place $base.l2  -x 100 -y 14 -width 161 -height 18 -anchor nw -bordermode ignore 
	place $base.l3  -x 20 -y 35 -anchor nw -bordermode ignore 
	place $base.l4  -x 100 -y 34 -width 226 -height 18 -anchor nw -bordermode ignore 
	place $base.lb  -x 20 -y 91 -width 338 -height 171 -anchor nw -bordermode ignore 
	place $base.renbtn -x 20 -y 263 -height 25
	place $base.addbtn -x 120 -y 263 -height 25
	place $base.sb  -x 355 -y 90 -width 18 -height 173 -anchor nw -bordermode ignore 
	place $base.closebtn  -x 325 -y 5 -height 25 -anchor nw -bordermode ignore 
	place $base.l10  -x 21 -y 75 -width 204 -height 18 -anchor nw -bordermode ignore 
	place $base.l11  -x 225 -y 75 -width 90 -height 18 -anchor nw -bordermode ignore 
	place $base.l12  -x 315 -y 75 -width 41 -height 18 -anchor nw -bordermode ignore 
	place $base.lfi  -x 20 -y 55 -anchor nw -bordermode ignore 
	place $base.lii  -x 20 -y 290 -width 151 -height 18 -anchor nw -bordermode ignore 
	place $base.ilb  -x 20 -y 306 -width 150 -height 148 -anchor nw -bordermode ignore 
	place $base.lip  -x 171 -y 290 -width 198 -height 18 -anchor nw -bordermode ignore 
	place $base.fr11  -x 170 -y 307 -width 199 -height 147 -anchor nw -bordermode ignore 
	place $base.fr11.l9  -x 10 -y 30 -anchor nw -bordermode ignore 
	place $base.fr11.l2  -x 10 -y 10 -anchor nw -bordermode ignore 
	place $base.fr11.liu  -x 95 -y 10 -width 27 -height 16 -anchor nw -bordermode ignore 
	place $base.fr11.lic  -x 95 -y 30 -width 32 -height 16 -anchor nw -bordermode ignore 
	place $base.fr11.l5  -x 10 -y 55 -anchor nw -bordermode ignore 
	place $base.fr11.lif  -x 10 -y 70 -width 178 -height 68 -anchor nw -bordermode ignore
}

proc vTclWindow.fd {base} {
	if {$base == ""} {
		set base .fd
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 377x315+103+101
	wm maxsize $base 785 570
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm deiconify $base
	wm title $base "Form design"
	bind $base <Key-Delete> {
		fd_delete_object
	}
	canvas $base.c \
		-background #828282 -height 207 -highlightthickness 0 -relief ridge \
		-selectborderwidth 0 -width 295 
	bind $base.c <Button-1> {
		fd_mouse_down %x %y
	}
	bind $base.c <ButtonRelease-1> {
		fd_mouse_up %x %y
	}
	bind $base.c <Motion> {
		fd_mouse_move %x %y
	}
	pack $base.c \
		-in .fd -anchor center -expand 1 -fill both -side top 
}

proc vTclWindow.fda {base} {
	if {$base == ""} {
		set base .fda
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 225x197+561+0
	wm maxsize $base 785 570
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm deiconify $base
	wm title $base "Attributes"
	label $base.l1 \
		-anchor nw -borderwidth 0 \
		-justify left -text Name -width 8 
	entry $base.e1 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_name) 
	bind $base.e1 <Key-Return> {
		fd_set_name
	}
	label $base.l2 \
		-anchor nw -borderwidth 0 \
		-justify left -text Top -width 8 
	entry $base.e2 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_top) 
	bind $base.e2 <Key-Return> {
		fd_change_coord
	}
	label $base.l3 \
		-anchor w -borderwidth 0 \
		-text Left -width 8 
	entry $base.e3 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_left) 
	bind $base.e3 <Key-Return> {
		fd_change_coord
	}
	label $base.l4 \
		-anchor w -borderwidth 0 \
		-text Width \
		-width 8 
	entry $base.e4 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_width) 
	bind $base.e4 <Key-Return> {
		fd_change_coord
	}
	label $base.l5 \
		-anchor w -borderwidth 0 -padx 0 -text Height -width 8 
	entry $base.e5 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_height) 
	bind $base.e5 <Key-Return> {
		fd_change_coord
	}
	label $base.l6 \
		-borderwidth 0 -text Command 
	entry $base.e6 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_cmd) 
	bind $base.e6 <Key-Return> {
		fd_set_command
	}
	button $base.bcmd \
		-borderwidth 1 \
		-command {Window show .fdcmd
.fdcmd.f.txt delete 1.0 end
.fdcmd.f.txt insert end $fdvar(c_cmd)} \
		-text ... -width 1 
	label $base.l7 \
		-anchor w -borderwidth 0 \
		-text Variable -width 8 
	entry $base.e7 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_var) 
	bind $base.e7 <Key-Return> {
		set fdobj($fdvar(moveitemobj),v) $fdvar(c_var)
	}
	label $base.l8 \
		-anchor w -borderwidth 0 \
		-text Text -width 8 
	entry $base.e8 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(c_text) 
	bind $base.e8 <Key-Return> {
		fd_set_text
	}
	label $base.l0 \
		-borderwidth 1 -relief raised -text {checkbox .udf0.checkbox17} \
		-textvariable fdvar(c_info) -width 28 
	grid $base.l1 \
		-in .fda -column 0 -row 1 -columnspan 1 -rowspan 1 
	grid $base.e1 \
		-in .fda -column 1 -row 1 -columnspan 1 -rowspan 1 -pady 2 
	grid $base.l2 \
		-in .fda -column 0 -row 2 -columnspan 1 -rowspan 1 
	grid $base.e2 \
		-in .fda -column 1 -row 2 -columnspan 1 -rowspan 1 
	grid $base.l3 \
		-in .fda -column 0 -row 3 -columnspan 1 -rowspan 1 
	grid $base.e3 \
		-in .fda -column 1 -row 3 -columnspan 1 -rowspan 1 -pady 2 
	grid $base.l4 \
		-in .fda -column 0 -row 4 -columnspan 1 -rowspan 1 
	grid $base.e4 \
		-in .fda -column 1 -row 4 -columnspan 1 -rowspan 1 
	grid $base.l5 \
		-in .fda -column 0 -row 5 -columnspan 1 -rowspan 1 
	grid $base.e5 \
		-in .fda -column 1 -row 5 -columnspan 1 -rowspan 1 -pady 2 
	grid $base.l6 \
		-in .fda -column 0 -row 6 -columnspan 1 -rowspan 1 
	grid $base.e6 \
		-in .fda -column 1 -row 6 -columnspan 1 -rowspan 1 
	grid $base.bcmd \
		-in .fda -column 2 -row 6 -columnspan 1 -rowspan 1 
	grid $base.l7 \
		-in .fda -column 0 -row 7 -columnspan 1 -rowspan 1 
	grid $base.e7 \
		-in .fda -column 1 -row 7 -columnspan 1 -rowspan 1 
	grid $base.l8 \
		-in .fda -column 0 -row 8 -columnspan 1 -rowspan 1 
	grid $base.e8 \
		-in .fda -column 1 -row 8 -columnspan 1 -rowspan 1 -pady 2 
	grid $base.l0 \
		-in .fda -column 0 -row 0 -columnspan 2 -rowspan 1 
}

proc vTclWindow.fdcmd {base} {
global pref
	if {$base == ""} {
		set base .fdcmd
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 282x274+504+229
	wm maxsize $base 785 570
	wm minsize $base 1 19
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm title $base "Command"
	frame $base.f \
		-borderwidth 2 -height 75 -relief groove -width 125 
	scrollbar $base.f.sb \
		-borderwidth 1 -command {.fdcmd.f.txt yview} -orient vert -width 12 
	text $base.f.txt \
		-font $pref(font_fix) -height 1 \
		-width 115 -yscrollcommand {.fdcmd.f.sb set} 
	frame $base.fb \
		-height 75 -width 125 
	button $base.fb.b1 \
		-borderwidth 1 \
		-command {set fdvar(c_cmd) [.fdcmd.f.txt get 1.0 "end - 1 chars"]
Window hide .fdcmd
fd_set_command} \
		-text Ok -width 5 
	button $base.fb.b2 \
		-borderwidth 1 -command {Window hide .fdcmd} \
		-text Cancel 
	pack $base.f \
		-in .fdcmd -anchor center -expand 1 -fill both -side top 
	pack $base.f.sb \
		-in .fdcmd.f -anchor e -expand 1 -fill y -side right 
	pack $base.f.txt \
		-in .fdcmd.f -anchor center -expand 1 -fill both -side top 
	pack $base.fb \
		-in .fdcmd -anchor center -expand 0 -fill none -side top 
	pack $base.fb.b1 \
		-in .fdcmd.fb -anchor center -expand 0 -fill none -side left 
	pack $base.fb.b2 \
		-in .fdcmd.fb -anchor center -expand 0 -fill none -side top 
}

proc vTclWindow.fdmenu {base} {
	if {$base == ""} {
		set base .fdmenu
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 288x70+103+0
	wm maxsize $base 785 570
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm deiconify $base
	wm title $base "Commands"
	button $base.but17 \
		-borderwidth 1 \
		-command {if {[tk_messageBox -title Warning -message "Delete all objects ?" -type yesno -default no]=="no"} return
fd_init} \
		-text {Delete all} 
	button $base.but18 \
		-borderwidth 1 -command {set fdvar(geometry) [wm geometry .fd] ; fd_test } \
		-text {Test form} 
	button $base.but19 \
		-borderwidth 1 -command {destroy .$fdvar(forminame)} \
		-text {Close test form} 
	button $base.bex \
		-borderwidth 1 \
		-command {if {[fd_save_form $fdvar(formname)]==1} {
catch {Window destroy .fd}
catch {Window destroy .fdtb}
catch {Window destroy .fdmenu}
catch {Window destroy .fda}
catch {Window destroy .fdcmd}
catch {Window destroy .$fdvar(forminame)}
}} \
		-text Close 
	button $base.bload \
		-borderwidth 1 -command {fd_load_form nimic design} \
		-text {Load from database} 
	button $base.button17 \
		-borderwidth 1 -command {fd_save_form nimic} \
		-text Save 
	label $base.l1 \
		-borderwidth 0 -text {Form name} 
	entry $base.e1 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(formname) 
	label $base.l2 \
		-borderwidth 0 \
		-text {Form's window internal name} 
	entry $base.e2 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-selectborderwidth 0 -textvariable fdvar(forminame) 
	place $base.but17 \
		-x 5 -y 80 -width 62 -height 24 -anchor nw -bordermode ignore 
	place $base.but18 \
		-x 5 -y 45 -width 62 -height 24 -anchor nw -bordermode ignore 
	place $base.but19 \
		-x 70 -y 45 -width 94 -height 24 -anchor nw -bordermode ignore 
	place $base.bex \
		-x 230 -y 45 -height 24 -anchor nw -bordermode ignore 
	place $base.bload \
		-x 75 -y 80 -width 114 -height 23 -anchor nw -bordermode ignore 
	place $base.button17 \
		-x 165 -y 45 -width 44 -height 24 -anchor nw -bordermode ignore 
	place $base.l1 \
		-x 5 -y 5 -anchor nw -bordermode ignore 
	place $base.e1 \
		-x 75 -y 5 -width 193 -height 17 -anchor nw -bordermode ignore 
	place $base.l2 \
		-x 5 -y 25 -anchor nw -bordermode ignore 
	place $base.e2 \
		-x 175 -y 25 -width 60 -height 17 -anchor nw -bordermode ignore 
}

proc vTclWindow.gpw {base} {
	if {$base == ""} {
		set base .gpw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	set sw [winfo screenwidth .]
	set sh [winfo screenheight .]
	set x [expr ($sw - 297)/2]
	set y [expr ($sh - 98)/2]
	wm geometry $base 297x98+$x+$y
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 0 0
	wm deiconify $base
	wm title $base "Input parameter"
	label $base.l1 \
		-anchor nw -borderwidth 1 \
		-justify left -relief sunken -textvariable gpw(msg) -wraplength 200 
	entry $base.e1 \
		-background #fefefe -borderwidth 1 -highlightthickness 0 \
		-textvariable gpw(var) 
	bind $base.e1 <Key-KP_Enter> {
		set gpw(result) 1
destroy .gpw
	}
	bind $base.e1 <Key-Return> {
		set gpw(result) 1
destroy .gpw
	}
	button $base.bok \
		-borderwidth 1 -command {set gpw(result) 1
destroy .gpw} -text Ok 
	button $base.bcanc \
		-borderwidth 1 -command {set gpw(result) 0
destroy .gpw} -text Cancel 
	place $base.l1 \
		-x 10 -y 5 -width 201 -height 53 -anchor nw -bordermode ignore 
	place $base.e1 \
		-x 10 -y 65 -width 200 -height 24 -anchor nw -bordermode ignore 
	place $base.bok \
		-x 225 -y 5 -width 61 -height 26 -anchor nw -bordermode ignore 
	place $base.bcanc \
		-x 225 -y 35 -width 61 -height 26 -anchor nw -bordermode ignore 
}

proc vTclWindow.fdtb {base} {
	if {$base == ""} {
		set base .fdtb
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 90x172+0+0
	wm maxsize $base 785 570
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm deiconify $base
	wm title $base "Toolbar"
	radiobutton $base.rb1 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text Point -value point -variable fdvar(tool) \
		-width 9 
	radiobutton $base.rb2 \
		-anchor w -borderwidth 1 \
		-foreground #000000 -highlightthickness 0 \
		-text Label -value label -variable fdvar(tool) -width 9 
	radiobutton $base.rb3 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text Entry -value entry -variable fdvar(tool) \
		-width 9 
	radiobutton $base.rb4 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text Button -value button \
		-variable fdvar(tool) -width 9 
	radiobutton $base.rb5 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text {List box} -value listbox \
		-variable fdvar(tool) -width 9 
	radiobutton $base.rb6 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text {Check box} -value checkbox \
		-variable fdvar(tool) -width 9 
	radiobutton $base.rb7 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text {Radio btn} -value radio \
		-variable fdvar(tool) -width 9 
	radiobutton $base.rb9 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text {Text} -value text \
		-variable fdvar(tool) -width 9 
	radiobutton $base.rb8 \
		-anchor w -borderwidth 1 \
		-highlightthickness 0 -text Query -value query -variable fdvar(tool) \
		-width 9 
	grid $base.rb1 \
		-in .fdtb -column 0 -row 0 -columnspan 1 -rowspan 1 
	grid $base.rb2 \
		-in .fdtb -column 0 -row 1 -columnspan 1 -rowspan 1 
	grid $base.rb3 \
		-in .fdtb -column 0 -row 2 -columnspan 1 -rowspan 1 
	grid $base.rb4 \
		-in .fdtb -column 0 -row 3 -columnspan 1 -rowspan 1 
	grid $base.rb5 \
		-in .fdtb -column 0 -row 4 -columnspan 1 -rowspan 1 
	grid $base.rb6 \
		-in .fdtb -column 0 -row 5 -columnspan 1 -rowspan 1 
	grid $base.rb7 \
		-in .fdtb -column 0 -row 6 -columnspan 1 -rowspan 1 
	grid $base.rb9 \
		-in .fdtb -column 0 -row 7 -columnspan 1 -rowspan 1 
	grid $base.rb8 \
		-in .fdtb -column 0 -row 8 -columnspan 1 -rowspan 1 
}

proc vTclWindow.sqlw {base} {
	if {$base == ""} {
		set base .sqlw
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}
	toplevel $base -class Toplevel
	wm focusmodel $base passive
	wm geometry $base 551x408+192+169
	wm maxsize $base 1009 738
	wm minsize $base 1 1
	wm overrideredirect $base 0
	wm resizable $base 1 1
	wm deiconify $base
	wm title $base "SQL commands"
	frame $base.f \
		-borderwidth 1 -height 392 -relief raised -width 396 
	scrollbar $base.f.01 \
		-borderwidth 1 -command {.sqlw.f.t xview} -orient horiz \
		-width 10 
	scrollbar $base.f.02 \
		-borderwidth 1 -command {.sqlw.f.t yview} -orient vert -width 10 
	text $base.f.t \
		-borderwidth 1 \
		-height 200 -width 200 -wrap word \
		-xscrollcommand {.sqlw.f.01 set} \
		-yscrollcommand {.sqlw.f.02 set} 
	button $base.b1 \
		-borderwidth 1 -command {.sqlw.f.t delete 1.0 end} -text Clean 
	button $base.b2 \
		-borderwidth 1 -command {destroy .sqlw} -text Close 
	grid columnconf $base 0 -weight 1
	grid columnconf $base 1 -weight 1
	grid rowconf $base 0 -weight 1
	grid $base.f \
		-in .sqlw -column 0 -row 0 -columnspan 2 -rowspan 1 
	grid columnconf $base.f 0 -weight 1
	grid rowconf $base.f 0 -weight 1
	grid $base.f.01 \
		-in .sqlw.f -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew 
	grid $base.f.02 \
		-in .sqlw.f -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky ns 
	grid $base.f.t \
		-in .sqlw.f -column 0 -row 0 -columnspan 1 -rowspan 1 \
		-sticky nesw 
	grid $base.b1 \
		-in .sqlw -column 0 -row 1 -columnspan 1 -rowspan 1 
	grid $base.b2 \
		-in .sqlw -column 1 -row 1 -columnspan 1 -rowspan 1 
}

proc vTclWindow.rcw {base} {
    if {$base == ""} {
        set base .rcw
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 215x75+258+213
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 0 0
    wm deiconify $base
    wm title $base "Rename field"
    label $base.l1 \
        -borderwidth 0 -text {New name} 
    entry $base.e1 \
        -background #fefefe -borderwidth 1 -textvariable tiw(new_cn)
	bind $base.e1 <Key-KP_Enter> "rename_column"
	bind $base.e1 <Key-Return> "rename_column"
    frame $base.f \
        -height 75 -relief groove -width 147 
    button $base.f.b1 \
        -borderwidth 1 -command rename_column -text Rename 
    button $base.f.b2 \
        -borderwidth 1 -command {Window destroy .rcw} -text Cancel 
    label $base.l2 -borderwidth 0 
    grid $base.l1 \
        -in .rcw -column 0 -row 0 -columnspan 1 -rowspan 1 
    grid $base.e1 \
        -in .rcw -column 1 -row 0 -columnspan 1 -rowspan 1 
    grid $base.f \
        -in .rcw -column 0 -row 4 -columnspan 2 -rowspan 1 
    grid $base.f.b1 \
        -in .rcw.f -column 0 -row 0 -columnspan 1 -rowspan 1 
    grid $base.f.b2 \
        -in .rcw.f -column 1 -row 0 -columnspan 1 -rowspan 1 
    grid $base.l2 \
        -in .rcw -column 0 -row 3 -columnspan 1 -rowspan 1 
}

proc vTclWindow.anfw {base} {
    if {$base == ""} {
        set base .anfw
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 302x114+195+175
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 0 0
    wm deiconify $base
    wm title $base "Add new field"
    label $base.l1 \
        -borderwidth 0 \
        -text {Field name} 
    entry $base.e1 \
        -background #fefefe -borderwidth 1 -textvariable anfw(name) 
    bind $base.e1 <Key-KP_Enter> {
        focus .anfw.e2
    }
    bind $base.e1 <Key-Return> {
        focus .anfw.e2
    }
    label $base.l2 \
        -borderwidth 0 \
        -text {Field type} 
    entry $base.e2 \
        -background #fefefe -borderwidth 1 -textvariable anfw(type) 
    bind $base.e2 <Key-KP_Enter> {
        anfw:add
    }
    bind $base.e2 <Key-Return> {
        anfw:add
    }
    button $base.b1 \
        -borderwidth 1 -command anfw:add -text {Add field} 
    button $base.b2 \
        -borderwidth 1 -command {Window destroy .anfw} -text Cancel 
    place $base.l1 \
        -x 25 -y 10 -anchor nw -bordermode ignore 
    place $base.e1 \
        -x 98 -y 7 -width 178 -height 22 -anchor nw -bordermode ignore 
    place $base.l2 \
        -x 25 -y 40 -anchor nw -bordermode ignore 
    place $base.e2 \
        -x 98 -y 37 -width 178 -height 22 -anchor nw -bordermode ignore 
    place $base.b1 \
        -x 70 -y 75 -anchor nw -bordermode ignore 
    place $base.b2 \
        -x 160 -y 75 -anchor nw -bordermode ignore 
}

proc vTclWindow.uw {base} {
    if {$base == ""} {
        set base .uw
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 263x220+233+165
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 0 0
    wm deiconify $base
    wm title $base "Define new user"
    label $base.l1 \
        -borderwidth 0 -anchor w -text "User name"
    entry $base.e1 \
        -background #fefefe -borderwidth 1 -textvariable uw(username) 
	bind $base.e1 <Key-Return> "focus .uw.e2"
	bind $base.e1 <Key-KP_Enter> "focus .uw.e2"
    label $base.l2 \
        -borderwidth 0 -text Password 
    entry $base.e2 \
        -background #fefefe -borderwidth 1 -show * -textvariable uw(password) 
	bind $base.e2 <Key-Return> "focus .uw.e3"
	bind $base.e2 <Key-KP_Enter> "focus .uw.e3"
    label $base.l3 \
        -borderwidth 0 -text {verify password} 
    entry $base.e3 \
        -background #fefefe -borderwidth 1 -show * -textvariable uw(verify) 
	bind $base.e3 <Key-Return> "focus .uw.cb1"
	bind $base.e3 <Key-KP_Enter> "focus .uw.cb1"
    checkbutton $base.cb1 \
        -borderwidth 1 -offvalue NOCREATEDB -onvalue CREATEDB \
        -text {Alow user to create databases } -variable uw(createdb) 
    checkbutton $base.cb2 \
        -borderwidth 1 -offvalue NOCREATEUSER -onvalue CREATEUSER \
        -text {Allow users to create other users} -variable uw(createuser) 
    label $base.l4 \
        -borderwidth 0 -anchor w -text {Valid until (date)} 
    entry $base.e4 \
        -background #fefefe -borderwidth 1 -textvariable uw(valid)
	bind $base.e4 <Key-Return> "focus .uw.b1"
	bind $base.e4 <Key-KP_Enter> "focus .uw.b1"
    button $base.b1 \
        -borderwidth 1 -command uw:create_user -text Create 
    button $base.b2 \
        -borderwidth 1 -command {Window destroy .uw} -text Cancel 
    place $base.l1 \
        -x 5 -y 7 -width 62 -height 16 -anchor nw -bordermode ignore 
    place $base.e1 \
        -x 109 -y 5 -width 146 -height 20 -anchor nw -bordermode ignore 
    place $base.l2 \
        -x 5 -y 35 -anchor nw -bordermode ignore 
    place $base.e2 \
        -x 109 -y 32 -width 146 -height 20 -anchor nw -bordermode ignore 
    place $base.l3 \
        -x 5 -y 60 -anchor nw -bordermode ignore 
    place $base.e3 \
        -x 109 -y 58 -width 146 -height 20 -anchor nw -bordermode ignore 
    place $base.cb1 \
        -x 5 -y 90 -anchor nw -bordermode ignore 
    place $base.cb2 \
        -x 5 -y 115 -anchor nw -bordermode ignore 
    place $base.l4 \
        -x 5 -y 145 -width 100 -height 16 -anchor nw -bordermode ignore 
    place $base.e4 \
        -x 110 -y 143 -width 146 -height 20 -anchor nw -bordermode ignore 
    place $base.b1 \
        -x 45 -y 185 -anchor nw -width 70 -height 25 -bordermode ignore 
    place $base.b2 \
        -x 140 -y 185 -anchor nw -width 70 -height 25 -bordermode ignore 
}

Window show .
Window show .dw

main $argc $argv