Skip to content

P
Postgres FD Implementation
Commit 4a226f0a authored by Bruce Momjian's avatar Bruce Momjian
Browse files
Options

Update to 0.4 version.

parent 1d3290e7
Hide whitespace changes
Inline Side-by-side
Showing with 297 additions and 28 deletions
src/bin/pgaccess/pgaccess.tcl
View file @ 4a226f0a
#!/usr/bin/wish
############################################################################# #############################################################################
# Visual Tcl v1.10 Project # Visual Tcl v1.10 Project
# #
...@@ -48,7 +49,7 @@ switch $activetab { ...@@ -48,7 +49,7 @@ switch $activetab {
} }
} }
Views { Views {
if {[tk_messageBox -title "FINAL WARNING" -message "Youa re going to delete view:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} { if {[tk_messageBox -title "FINAL WARNING" -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 noquiet "drop view $objtodelete"
sql_exec quiet "delete from pga_layout where tablename='$objtodelete'" sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
cmd_Views cmd_Views
...@@ -67,10 +68,30 @@ switch $activetab { ...@@ -67,10 +68,30 @@ switch $activetab {
cmd_Sequences cmd_Sequences
} }
} }
Functions {
if {[tk_messageBox -title "FINAL WARNING" -message "You are going to delete function:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
delete_function $objtodelete
cmd_Functions
}
}
} }
if {$temp==""} return; if {$temp==""} return;
} }
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 cmd_Design {} { proc cmd_Design {} {
global dbc activetab tablename global dbc activetab tablename
if {$dbc==""} return; if {$dbc==""} return;
...@@ -83,6 +104,25 @@ switch $activetab { ...@@ -83,6 +104,25 @@ switch $activetab {
proc cmd_Functions {} { proc cmd_Functions {} {
global dbc global dbc
set maxim 0
set pgid 0
cursor_watch .dw
catch {
pg_select $dbc "select proowner,count(*) from pg_proc group by proowner" rec {
if {$rec(count)>$maxim} {
set maxim $rec(count)
set pgid $rec(proowner)
}
}
.dw.lb delete 0 end
catch {
pg_select $dbc "select proname from pg_proc where prolang=14 and proowner<>$pgid order by proname" rec {
.dw.lb insert end $rec(proname)
}
}
cursor_arrow .dw
}
} }
proc cmd_Import_Export {how} { proc cmd_Import_Export {how} {
...@@ -101,15 +141,20 @@ if {$activetab=="Tables"} { ...@@ -101,15 +141,20 @@ if {$activetab=="Tables"} {
} }
proc cmd_New {} { proc cmd_New {} {
global dbc activetab queryname queryoid cbv global dbc activetab queryname queryoid cbv funcpar funcname funcret
if {$dbc==""} return; if {$dbc==""} return;
switch $activetab { switch $activetab {
Tables {Window show .nt; focus .nt.etabn} Tables {Window show .nt; focus .nt.etabn}
Queries { Queries {
Window show .qb Window show .qb
set queryoid 0
set queryname {}
set cbv 0 set cbv 0
.qb.cbv configure -state normal
} }
Views { Views {
set queryoid 0
set queryname {}
Window show .qb Window show .qb
set cbv 1 set cbv 1
.qb.cbv configure -state disabled .qb.cbv configure -state disabled
...@@ -118,6 +163,17 @@ switch $activetab { ...@@ -118,6 +163,17 @@ switch $activetab {
Window show .sqf Window show .sqf
focus .sqf.e1 focus .sqf.e1
} }
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
}
} }
} }
...@@ -131,9 +187,39 @@ switch $activetab { ...@@ -131,9 +187,39 @@ switch $activetab {
Queries {open_query view} Queries {open_query view}
Views {open_view} Views {open_view}
Sequences {open_sequence $objname} Sequences {open_sequence $objname}
Functions {open_function $objname}
} }
} }
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 {} { proc cmd_Queries {} {
global dbc global dbc
...@@ -150,6 +236,7 @@ global dbc oldobjname activetab ...@@ -150,6 +236,7 @@ global dbc oldobjname activetab
if {$dbc==""} return; if {$dbc==""} return;
if {$activetab=="Views"} return; if {$activetab=="Views"} return;
if {$activetab=="Sequences"} return; if {$activetab=="Sequences"} return;
if {$activetab=="Functions"} return;
set temp [get_dwlb_Selection] set temp [get_dwlb_Selection]
if {$temp==""} { if {$temp==""} {
tk_messageBox -title Warning -message "Please select first an object!" tk_messageBox -title Warning -message "Please select first an object!"
...@@ -328,25 +415,70 @@ set thetag [lindex $taglist $i] ...@@ -328,25 +415,70 @@ set thetag [lindex $taglist $i]
return [string range $thetag 1 end] return [string range $thetag 1 end]
} }
proc save_new_record {} {
global dbc newrec_fields newrec_values tablename msg last_rownum
if {$newrec_fields==""} {return 1}
set msg "Saving new record ..."
after 1000 {set msg ""}
set retval [catch {
set sqlcmd "insert into $tablename ([join $newrec_fields ,]) values ([join $newrec_values ,])"
set pgres [pg_exec $dbc $sqlcmd]
} errmsg]
if {$retval} {
show_error "Error inserting new record\n\n$errmsg"
return 0
}
set oid [pg_result $pgres -oid]
pg_result $pgres -clear
.mw.c itemconfigure new -fill black
.mw.c addtag o$oid withtag new
.mw.c dtag new o0
.mw.c dtag rows new
# Replace * from untouched new row elements with " "
foreach item [.mw.c find withtag unt] {
.mw.c itemconfigure $item -text " "
}
.mw.c dtag rows unt
incr last_rownum
draw_new_record
set newrec_fields {}
set newrec_values {}
return 1
}
proc hide_entry {} { proc hide_entry {} {
global dirty dbc msg fldval itemid colname tablename global dirty dbc msg fldval itemid colname tablename
global newrec_fields newrec_values
if {$dirty} { if {$dirty} {
cursor_watch .mw cursor_watch .mw
set msg "Saving record ..."
after 1000 {set msg ""}
set oid [get_tag_info $itemid o] set oid [get_tag_info $itemid o]
set fld [lindex $colname [get_tag_info $itemid c]] set fld [lindex $colname [get_tag_info $itemid c]]
set retval [catch { set fldval [string trim $fldval]
set pgr [pg_exec $dbc "update $tablename set $fld='$fldval' where oid=$oid"] set fillcolor black
pg_result $pgr -clear if {$oid==0} {
} errmsg ] set fillcolor red
set sfp [lsearch $newrec_fields $fld]
if {$sfp>-1} {
set newrec_fields [lreplace $newrec_fields $sfp $sfp]
set newrec_values [lreplace $newrec_values $sfp $sfp]
}
lappend newrec_fields $fld
lappend newrec_values '$fldval'
# Remove the untouched tag from the object
.mw.c dtag $itemid unt
set retval 1
} else {
set msg "Updating record ..."
after 1000 {set msg ""}
set retval [sql_exec noquiet "update $tablename set $fld='$fldval' where oid=$oid"]
}
cursor_arrow .mw cursor_arrow .mw
if {$retval} { if {!$retval} {
show_error "Error updating record:\n$errmsg" set msg ""
return return
} }
.mw.c itemconfigure $itemid -text $fldval .mw.c itemconfigure $itemid -text $fldval -fill $fillcolor
} }
catch {destroy .mw.entf} catch {destroy .mw.entf}
set dirty false set dirty false
...@@ -359,29 +491,34 @@ cursor_watch .mw ...@@ -359,29 +491,34 @@ cursor_watch .mw
set layout_name $tablename set layout_name $tablename
catch {unset colcount colname colwidth} catch {unset colcount colname colwidth}
set layout_found false set layout_found false
set retval [catch {set pgres [pg_exec $dbc "select * from pga_layout where tablename='$tablename'"]}] set retval [catch {set pgres [pg_exec $dbc "select *,oid from pga_layout where tablename='$tablename' order by oid desc"]}]
if {$retval} { if {$retval} {
# Probably table pga_layout isn't yet defined # Probably table pga_layout isn't yet defined
sql_exec noquiet "create table pga_layout (tablename varchar(64),nrcols int2,colname text,colwidth text)" sql_exec noquiet "create table pga_layout (tablename varchar(64),nrcols int2,colname text,colwidth text)"
sql_exec quiet "grant ALL on pga_layout to PUBLIC" sql_exec quiet "grant ALL on pga_layout to PUBLIC"
} else { } else {
if {[pg_result $pgres -numTuples]==1} { set nrlay [pg_result $pgres -numTuples]
if {$nrlay>=1} {
set layoutinfo [pg_result $pgres -getTuple 0] set layoutinfo [pg_result $pgres -getTuple 0]
set colcount [lindex $layoutinfo 1] set colcount [lindex $layoutinfo 1]
set colname [lindex $layoutinfo 2] set colname [lindex $layoutinfo 2]
set colwidth [lindex $layoutinfo 3] set colwidth [lindex $layoutinfo 3]
set goodoid [lindex $layoutinfo 4]
set layout_found true set layout_found true
} elseif {[pg_result $pgres -numTuples]>1} { }
if {$nrlay>1} {
show_error "Multiple ([pg_result $pgres -numTuples]) layout info found\n\nPlease report the bug!" show_error "Multiple ([pg_result $pgres -numTuples]) layout info found\n\nPlease report the bug!"
sql_exec quiet "delete from pga_layout where (tablename='$tablename') and (oid<>$goodoid)"
} }
} }
catch {pg_result $pgres -clear} catch {pg_result $pgres -clear}
} }
proc load_table {tablename} { proc load_table {objname} {
global ds_query ds_updatable ds_isaquery sortfield filter global ds_query ds_updatable ds_isaquery sortfield filter tablename
load_layout $tablename set tablename $objname
set ds_query "select oid,$tablename.* from $tablename" load_layout $objname
set ds_query "select oid,$tablename.* from $objname"
set ds_updatable true set ds_updatable true
set ds_isaquery false set ds_isaquery false
select_records $ds_query select_records $ds_query
...@@ -544,6 +681,10 @@ set_scrollbar ...@@ -544,6 +681,10 @@ set_scrollbar
proc select_records {sql} { proc select_records {sql} {
global dbc field dirty nrecs toprec colwidth colname colcount ds_updatable global dbc field dirty nrecs toprec colwidth colname colcount ds_updatable
global layout_found layout_name tablename leftcol leftoffset msg global layout_found layout_name tablename leftcol leftoffset msg
global newrec_fields newrec_values
global last_rownum
set newrec_fields {}
set newrec_values {}
hide_entry hide_entry
.mw.c delete rows .mw.c delete rows
.mw.c delete header .mw.c delete header
...@@ -597,9 +738,13 @@ for {set i 0} {$i<$nrecs} {incr i} { ...@@ -597,9 +738,13 @@ for {set i 0} {$i<$nrecs} {incr i} {
set fldtext [lindex $curtup [expr $j+$shift]] set fldtext [lindex $curtup [expr $j+$shift]]
if {$fldtext==""} {set fldtext " "}; if {$fldtext==""} {set fldtext " "};
.mw.c create text $posx [expr 30+$i*14] -text $fldtext -tags [subst {$tagoid c$j rows}] -anchor w -font -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-* .mw.c create text $posx [expr 30+$i*14] -text $fldtext -tags [subst {$tagoid c$j rows}] -anchor w -font -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-*
# .mw.c create text $posx [expr 30+$i*14] -text $fldtext -tags [subst {$tagoid c$j rows}] -anchor w -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
incr posx [expr [lindex $colwidth $j]+2] incr posx [expr [lindex $colwidth $j]+2]
} }
} }
set last_rownum $i
# Defining position for input data
draw_new_record
pg_result $pgres -clear pg_result $pgres -clear
set toprec 0 set toprec 0
set_scrollbar set_scrollbar
...@@ -613,6 +758,16 @@ draw_headers ...@@ -613,6 +758,16 @@ draw_headers
cursor_arrow .mw cursor_arrow .mw
} }
proc draw_new_record {} {
global ds_updatable last_rownum colwidth colcount
set posx 10
if {$ds_updatable} {for {set j 0} {$j<$colcount} {incr j} {
.mw.c create text $posx [expr 30+$last_rownum*14] -text * -tags [subst {o0 c$j rows new unt}] -anchor w -font -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-*
incr posx [expr [lindex $colwidth $j]+2]
}
}
}
proc set_scrollbar {} { proc set_scrollbar {} {
global nrecs toprec global nrecs toprec
...@@ -626,7 +781,13 @@ global dirty fldval msg itemid colname colwidth ...@@ -626,7 +781,13 @@ global dirty fldval msg itemid colname colwidth
hide_entry hide_entry
set itemid $id set itemid $id
set colidx [get_tag_info $id c] set colidx [get_tag_info $id c]
set fldval [.mw.c itemcget $id -text] set fldval [string trim [.mw.c itemcget $id -text]]
# It's a new record tag ?
if {[get_tag_info $id n]=="ew"} {
set fldval ""
} else {
if {![save_new_record]} return;
}
set dirty false set dirty false
set coord [.mw.c coords $id] set coord [.mw.c coords $id]
entry .mw.entf -textvar fldval -width [expr int(([lindex $colwidth $colidx]-5)/6.2)] -borderwidth 0 -background #ddfefe -highlightthickness 0 -selectborderwidth 0 -font -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-*; entry .mw.entf -textvar fldval -width [expr int(([lindex $colwidth $colidx]-5)/6.2)] -borderwidth 0 -background #ddfefe -highlightthickness 0 -selectborderwidth 0 -font -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-*;
...@@ -660,6 +821,7 @@ global dbc tablist activetab ...@@ -660,6 +821,7 @@ global dbc tablist activetab
if {$dbc==""} return; if {$dbc==""} return;
set curtab [$w cget -text] set curtab [$w cget -text]
#if {$activetab==$curtab} return; #if {$activetab==$curtab} return;
.dw.btndesign configure -state disabled
if {$activetab!=""} { if {$activetab!=""} {
place .dw.tab$activetab -x 10 place .dw.tab$activetab -x 10
.dw.tab$activetab configure -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* .dw.tab$activetab configure -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
...@@ -668,6 +830,10 @@ $w configure -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-* ...@@ -668,6 +830,10 @@ $w configure -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
place $w -x 7 place $w -x 7
place .dw.lmask -x 80 -y [expr 86+25*[lsearch -exact $tablist $curtab]] place .dw.lmask -x 80 -y [expr 86+25*[lsearch -exact $tablist $curtab]]
set activetab $curtab set activetab $curtab
# Tabs where button Design is enabled
if {[lsearch $activetab [list Queries]]!=-1} {
.dw.btndesign configure -state normal
}
.dw.lb delete 0 end .dw.lb delete 0 end
cmd_$curtab cmd_$curtab
} }
...@@ -761,7 +927,7 @@ by Constantin Teodorescu} ...@@ -761,7 +927,7 @@ by Constantin Teodorescu}
label $base.l3 \ label $base.l3 \
-borderwidth 0 \ -borderwidth 0 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
-relief sunken -text {vers 0.3} -relief sunken -text {vers 0.34}
label $base.l4 \ label $base.l4 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
-relief groove \ -relief groove \
...@@ -884,6 +1050,7 @@ proc vTclWindow.dw {base} { ...@@ -884,6 +1050,7 @@ proc vTclWindow.dw {base} {
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
-highlightthickness 0 -selectborderwidth 0 \ -highlightthickness 0 -selectborderwidth 0 \
-yscrollcommand {.dw.sb set} -yscrollcommand {.dw.sb set}
bind $base.lb <Double-Button-1> {cmd_Open}
button $base.btnnew \ button $base.btnnew \
-borderwidth 1 -command cmd_New \ -borderwidth 1 -command cmd_New \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
...@@ -1140,21 +1307,27 @@ if {($ds_isaquery=="true") && ("$filter$sortfield"!="")} { ...@@ -1140,21 +1307,27 @@ if {($ds_isaquery=="true") && ("$filter$sortfield"!="")} {
set nq "$nq order by $sortfield" set nq "$nq order by $sortfield"
} }
} }
select_records $nq} \ if {[save_new_record]} {select_records $nq}
} \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
-pady 3 -text Reload -pady 3 -text Reload
button $base.exitbtn \ button $base.exitbtn \
-borderwidth 1 \ -borderwidth 1 \
-command {.mw.c delete rows -command {
.mw.c delete header if {[save_new_record]} {
set sortfield {} .mw.c delete rows
set filter {} .mw.c delete header
Window hide .mw} \ set sortfield {}
set filter {}
Window hide .mw
}
} \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
-pady 3 -text Close -pady 3 -text Close
canvas $base.c \ canvas $base.c \
-background #fefefe -borderwidth 2 -height 207 -relief ridge \ -background #fefefe -borderwidth 2 -height 207 -relief ridge \
-width 295 -width 295
bind .mw.c <Button-3> {hide_entry;save_new_record}
label $base.msglbl \ label $base.msglbl \
-anchor w -borderwidth 1 \ -anchor w -borderwidth 1 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
...@@ -1293,7 +1466,8 @@ proc vTclWindow.nt {base} { ...@@ -1293,7 +1466,8 @@ proc vTclWindow.nt {base} {
show_error "You must specify field size!" show_error "You must specify field size!"
} else { } else {
if {$fldsize==""} then {set sup ""} else {set sup "($fldsize)"} if {$fldsize==""} then {set sup ""} else {set sup "($fldsize)"}
if {$defaultval==""} then {set sup2 ""} else {set sup2 " DEFAULT '$defaultval'"} if {[regexp $fldtype "varchar2char4char8char16textdatetime"]} {set supc "'"} else {set supc ""}
if {$defaultval==""} then {set sup2 ""} else {set sup2 " DEFAULT $supc$defaultval$supc"}
.nt.lb insert end [format "%-17s%-14s%-16s" $fldname $fldtype$sup $sup2$notnull] .nt.lb insert end [format "%-17s%-14s%-16s" $fldname $fldtype$sup $sup2$notnull]
focus .nt.e2 focus .nt.e2
set fldname {} set fldname {}
...@@ -1367,6 +1541,11 @@ proc vTclWindow.nt {base} { ...@@ -1367,6 +1541,11 @@ proc vTclWindow.nt {base} {
\ \
-command {set fldtype char; if {("char"=="varchar")||("char"=="char")} then {.nt.e3 configure -state normal;focus .nt.e3} else {.nt.e3 configure -state disabled;focus .nt.e5} } \ -command {set fldtype char; if {("char"=="varchar")||("char"=="char")} then {.nt.e3 configure -state normal;focus .nt.e3} else {.nt.e3 configure -state disabled;focus .nt.e5} } \
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -label char -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -label char
$base.pop add command \
\
-command {set fldtype char2; if {("char2"=="varchar")||("char2"=="char")} then {.nt.e3 configure -state normal;focus .nt.e3} else {.nt.e3 configure -state disabled;focus .nt.e5} } \
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
-label char2
$base.pop add command \ $base.pop add command \
\ \
-command {set fldtype char4; if {("char4"=="varchar")||("char4"=="char")} then {.nt.e3 configure -state normal;focus .nt.e3} else {.nt.e3 configure -state disabled;focus .nt.e5} } \ -command {set fldtype char4; if {("char4"=="varchar")||("char4"=="char")} then {.nt.e3 configure -state normal;focus .nt.e3} else {.nt.e3 configure -state disabled;focus .nt.e5} } \
...@@ -1769,6 +1948,96 @@ Window hide .sqf ...@@ -1769,6 +1948,96 @@ Window hide .sqf
-x 195 -y 175 -anchor nw -bordermode ignore -x 195 -y 175 -anchor nw -bordermode ignore
} }
proc vTclWindow.fw {base} {
if {$base == ""} {
set base .fw
}
if {[winfo exists $base]} {
wm deiconify $base; return
}
###################
# CREATING WIDGETS
###################
toplevel $base -class Toplevel
wm focusmodel $base passive
wm geometry $base 306x288+298+290
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 "Function"
label $base.l1 \
-borderwidth 0 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
-relief raised -text Name
entry $base.e1 \
-background #fefefe -borderwidth 1 -highlightthickness 1 \
-selectborderwidth 0 -textvariable funcname
label $base.l2 \
-borderwidth 0 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
-relief raised -text Parameters
entry $base.e2 \
-background #fefefe -borderwidth 1 -highlightthickness 1 \
-selectborderwidth 0 -textvariable funcpar
label $base.l3 \
-borderwidth 0 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
-relief raised -text Returns
entry $base.e3 \
-background #fefefe -borderwidth 1 -highlightthickness 1 \
-selectborderwidth 0 -textvariable funcret
text $base.text1 \
-background #fefefe -borderwidth 1 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
-highlightthickness 1 -selectborderwidth 0
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 hide .fw
tk_messageBox -title PostgreSQL -message "Function created!"
tab_click .dw.tabFunctions
}
}
} \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
-pady 3 -text Define
button $base.cancelbtn \
-borderwidth 1 -command {Window hide .fw} \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
-pady 3 -text Close
###################
# SETTING GEOMETRY
###################
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 255 -anchor nw -bordermode ignore
place $base.cancelbtn \
-x 160 -y 255 -anchor nw -bordermode ignore
}
Window show . Window show .
Window show .dw Window show .dw
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment