Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
Postgres FD Implementation
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Abuhujair Javed
Postgres FD Implementation
Commits
4a226f0a
Commit
4a226f0a
authored
27 years ago
by
Bruce Momjian
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update to 0.4 version.
parent
1d3290e7
REL_14_STABLE
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
297 additions
and
28 deletions
+297
-28
src/bin/pgaccess/pgaccess.tcl
src/bin/pgaccess/pgaccess.tcl
+297
-28
No files found.
src/bin/pgaccess/pgaccess.tcl
View file @
4a226f0a
#!/usr/bin/wish
#############################################################################
# Visual Tcl v1.10 Project
#
...
...
@@ -48,7 +49,7 @@ switch $activetab {
}
}
Views
{
if
{[
tk_messageBox -title
"FINAL WARNING"
-message
"You
a
re going to delete view:
\n\n
$objtodelete
\n\n
Proceed ?"
-type yesno -default no
]
==
"yes"
}
{
if
{[
tk_messageBox -title
"FINAL WARNING"
-message
"You
a
re going to delete view:
\n\n
$objtodelete
\n\n
Proceed ?"
-type yesno -default no
]
==
"yes"
}
{
sql_exec noquiet
"drop view
$objtodelete
"
sql_exec quiet
"delete from pga_layout where tablename='
$objtodelete
'"
cmd_Views
...
...
@@ -67,10 +68,30 @@ switch $activetab {
cmd_Sequences
}
}
Functions
{
if
{[
tk_messageBox -title
"FINAL WARNING"
-message
"You are going to delete function:
\n\n
$objtodelete
\n\n
Proceed ?"
-type yesno -default no
]
==
"yes"
}
{
delete_function $objtodelete
cmd_Functions
}
}
}
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
{}
{
global dbc activetab tablename
if
{
$dbc
==
""
}
return
;
...
...
@@ -83,6 +104,25 @@ switch $activetab {
proc cmd_Functions
{}
{
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
}
{
...
...
@@ -101,15 +141,20 @@ if {$activetab=="Tables"} {
}
proc cmd_New
{}
{
global dbc activetab queryname queryoid cbv
global dbc activetab queryname queryoid cbv
funcpar funcname funcret
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
}
Views
{
set queryoid 0
set queryname
{}
Window show .qb
set cbv 1
.qb.cbv configure -state disabled
...
...
@@ -118,6 +163,17 @@ switch $activetab {
Window show .sqf
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 {
Queries
{
open_query view
}
Views
{
open_view
}
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
{}
{
global dbc
...
...
@@ -150,6 +236,7 @@ global dbc oldobjname activetab
if
{
$dbc
==
""
}
return
;
if
{
$activetab
==
"Views"
}
return
;
if
{
$activetab
==
"Sequences"
}
return
;
if
{
$activetab
==
"Functions"
}
return
;
set temp
[
get_dwlb_Selection
]
if
{
$temp
==
""
}
{
tk_messageBox -title Warning -message
"Please select first an object!"
...
...
@@ -328,25 +415,70 @@ set thetag [lindex $taglist $i]
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
{}
{
global dirty dbc msg fldval itemid colname tablename
global newrec_fields newrec_values
if
{
$dirty
}
{
cursor_watch .mw
set msg
"Saving record ..."
after 1000
{
set msg
""
}
set oid
[
get_tag_info $itemid o
]
set fld
[
lindex $colname
[
get_tag_info $itemid c
]]
set retval
[
catch
{
set pgr
[
pg_exec $dbc
"update
$tablename
set
$fld
='
$fldval
' where oid=
$oid
"
]
pg_result $pgr -clear
}
errmsg
]
set fldval
[
string trim $fldval
]
set fillcolor black
if
{
$oid
==0
}
{
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
if
{
$retval
}
{
show_error
"Error updating record:
\n
$errmsg
"
return
if
{
!
$retval
}
{
set msg
"
"
return
}
.mw.c itemconfigure $itemid -text $fldval
.mw.c itemconfigure $itemid -text $fldval
-fill $fillcolor
}
catch
{
destroy .mw.entf
}
set dirty false
...
...
@@ -359,29 +491,34 @@ cursor_watch .mw
set layout_name $tablename
catch
{
unset colcount colname colwidth
}
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
}
{
# 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 quiet
"grant ALL on pga_layout to PUBLIC"
}
else
{
if
{[
pg_result $pgres -numTuples
]
==1
}
{
set nrlay
[
pg_result $pgres -numTuples
]
if
{
$nrlay
>=1
}
{
set layoutinfo
[
pg_result $pgres -getTuple 0
]
set colcount
[
lindex $layoutinfo 1
]
set colname
[
lindex $layoutinfo 2
]
set colwidth
[
lindex $layoutinfo 3
]
set goodoid
[
lindex $layoutinfo 4
]
set layout_found true
}
elseif
{[
pg_result $pgres -numTuples
]
>1
}
{
}
if
{
$nrlay
>1
}
{
show_error
"Multiple (
[
pg_result $pgres -numTuples
]
) layout info found
\n\n
Please report the bug!"
sql_exec quiet
"delete from pga_layout where (tablename='
$tablename
') and (oid<>
$goodoid
)"
}
}
catch
{
pg_result $pgres -clear
}
}
proc load_table
{
tablename
}
{
global ds_query ds_updatable ds_isaquery sortfield filter
load_layout $tablename
set ds_query
"select oid,
$tablename.
* from
$tablename
"
proc load_table
{
objname
}
{
global ds_query ds_updatable ds_isaquery sortfield filter tablename
set tablename $objname
load_layout $objname
set ds_query
"select oid,
$tablename.
* from
$objname
"
set ds_updatable true
set ds_isaquery false
select_records $ds_query
...
...
@@ -544,6 +681,10 @@ set_scrollbar
proc select_records
{
sql
}
{
global dbc field dirty nrecs toprec colwidth colname colcount ds_updatable
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
.mw.c delete rows
.mw.c delete header
...
...
@@ -597,9 +738,13 @@ for {set i 0} {$i<$nrecs} {incr i} {
set fldtext
[
lindex $curtup
[
expr $j+$shift
]]
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 -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
incr posx
[
expr
[
lindex $colwidth $j
]
+2
]
}
}
set last_rownum $i
# Defining position for input data
draw_new_record
pg_result $pgres -clear
set toprec 0
set_scrollbar
...
...
@@ -613,6 +758,16 @@ draw_headers
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
{}
{
global nrecs toprec
...
...
@@ -626,7 +781,13 @@ global dirty fldval msg itemid colname colwidth
hide_entry
set itemid $id
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 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-*-*-*-*-*
;
...
...
@@ -660,6 +821,7 @@ global dbc tablist activetab
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 -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
...
...
@@ -668,6 +830,10 @@ $w configure -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
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 $activetab
[
list Queries
]]
!=-1
}
{
.dw.btndesign configure -state normal
}
.dw.lb delete 0 end
cmd_$curtab
}
...
...
@@ -761,7 +927,7 @@ by Constantin Teodorescu}
label $base.l3
\
-borderwidth 0
\
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
\
-relief sunken -text
{
vers 0.3
}
-relief sunken -text
{
vers 0.3
4
}
label $base.l4
\
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
\
-relief groove
\
...
...
@@ -884,6 +1050,7 @@ proc vTclWindow.dw {base} {
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
\
-highlightthickness 0 -selectborderwidth 0
\
-yscrollcommand
{
.dw.sb set
}
bind $base.lb <Double-Button-1>
{
cmd_Open
}
button $base.btnnew
\
-borderwidth 1 -command cmd_New
\
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9
\
...
...
@@ -1140,21 +1307,27 @@ if {($ds_isaquery=="true") && ("$filter$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
\
-pady 3 -text Reload
button $base.exitbtn
\
-borderwidth 1
\
-command
{
.mw.c delete rows
.mw.c delete header
set sortfield
{}
set filter
{}
Window hide .mw
}
\
-command
{
if
{[
save_new_record
]}
{
.mw.c delete rows
.mw.c delete header
set sortfield
{}
set filter
{}
Window hide .mw
}
}
\
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9
\
-pady 3 -text Close
canvas $base.c
\
-background #fefefe -borderwidth 2 -height 207 -relief ridge
\
-width 295
bind .mw.c <Button-3>
{
hide_entry
;
save_new_record
}
label $base.msglbl
\
-anchor w -borderwidth 1
\
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
\
...
...
@@ -1293,7 +1466,8 @@ proc vTclWindow.nt {base} {
show_error
"You must specify field size!"
}
else
{
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
]
focus .nt.e2
set fldname
{}
...
...
@@ -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
}
}
\
-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
\
\
-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
-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 .dw
...
...
This diff is collapsed.
Click to expand it.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment