pg_select $dbc "select * 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 cmd_Design {}{
global dbc activetab tablename
if {$dbc==""} return;
...
...
@@ -122,7 +108,6 @@ catch {
}
cursor_arrow .dw
}
}
proc cmd_Import_Export {how}{
...
...
@@ -140,6 +125,28 @@ if {$activetab=="Tables"} {
.iew.expbtn configure -text $how
}
proc cmd_Information {}{
global dbc tiw activetab
if {$dbc==""} return;
if {$activetab!="Tables"} return;
set tiw(tablename)[get_dwlb_Selection]
if {$tiw(tablename)==""} return;
Window show .tiw
.tiw.lb delete 0 end
pg_select $dbc "select attnum,attname,typname,attlen,usename 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) and (attnum>0) order by attnum" rec {
set fsize $rec(attlen)
set ftype $rec(typname)
if {$ftype=="varchar"}{
incr fsize -4
}
if {$ftype=="text"}{
set fsize ""
}
.tiw.lb insert end [format "%-32s %-14s %-4s" $rec(attname) $ftype $fsize]
set tiw(owner) $rec(usename)
}
}
proc cmd_New {}{
global dbc activetab queryname queryoid cbv funcpar funcname funcret
if {$dbc==""} return;
...
...
@@ -191,35 +198,6 @@ switch $activetab {
}
}
proc get_pgtype {oid}{
global dbc
set temp "unknown"
pg_select $dbc "select typname from pg_type where oid=$oid" rec {
set temp $rec(typname)
}
return $temp
}
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
pg_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 cmd_Queries {}{
global dbc
...
...
@@ -311,6 +289,22 @@ catch {
cursor_arrow .dw
}
proc color_record {obj}{
global newrec_fields
set oid [get_tag_info $obj o]
if {![hide_entry]} return;
if {$newrec_fields!=""}{
if {[get_tag_info $obj n]!="ew"}{
if {![save_new_record]} return;
}
}
.mw.c itemconfigure hili -fill black
if {$oid==0} return;
.mw.c dtag hili hili
.mw.c addtag hili withtag o$oid
.mw.c itemconfigure hili -fill blue
}
proc cursor_arrow {w}{
$w configure -cursor top_left_arrow
update idletasks
...
...
@@ -321,12 +315,42 @@ $w configure -cursor watch
update idletasks
}
proc delete_function {objname}{
global dbc
pg_select $dbc "select * 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 delete_record {}{
global dbc ds_updatable tablename
if {$ds_updatable=="false"} return;
if {![hide_entry]} return;
set taglist [.mw.c gettags hili]
if {[llength $taglist]==0} return;
set oidtag [lindex $taglist [lsearch -regexp $taglist "^o"]]
set oid [string range $oidtag 1 end]
if {[tk_messageBox -title "FINAL WARNING" -icon question -message "Delete current record ?" -type yesno -default no]=="no"} return
if {[sql_exec noquiet "delete from $tablename where oid=$oid"]}{
.mw.c delete hili
}
}
proc drag_it {w x y}{
global draglocation
if {"$draglocation(obj)" != ""}{
set dlo ""
catch { set dlo $draglocation(obj)}
if {$dlo != ""}{
set dx [expr $x - $draglocation(x)]
set dy [expr $y - $draglocation(y)]
$w move $draglocation(obj) $dx $dy
$w move $dlo $dx $dy
set draglocation(x) $x
set draglocation(y) $y
}
...
...
@@ -335,7 +359,10 @@ global draglocation
proc drag_start {w x y}{
global draglocation
catch {unset draglocation}
set draglocation(obj)[$w find closest $x $y]
set object [$w find closest $x $y]
if {[lsearch [.mw.c gettags $object] movable]==-1} return;
.mw.c bind movable <Leave> {}
set draglocation(obj) $object
set draglocation(x) $x
set draglocation(y) $y
set draglocation(start) $x
...
...
@@ -343,7 +370,11 @@ set draglocation(start) $x
proc drag_stop {w x y}{
global draglocation colcount colwidth layout_name dbc
