mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

From: Constantin Teodorescu <teo@flex.ro>

Browse Source 
UPgrade to 0.96 ..
This commit is contained in:
Marc G. Fournier 1999-03-09 14:17:51 +00:00
parent f34240de06
commit 1c264e68c5
4 changed files with 411 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

167
src/bin/pgaccess/README Normal file
View File

@ -0,0 +1,167 @@
---------------------------------------------------------------------------
Copyright (c) 1994-7 Regents of the University of California
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose, without fee, and without a written agreement
is hereby granted, provided that the above copyright notice and this
paragraph and the following two paragraphs appear in all copies.
IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING
LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS
DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO
PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
---------------------------------------------------------------------------
PGACCESS 0.96 9 March 1999
================================
I dedicate this program to my little daughters Ana-Maria and Emilia and to my
wife for their understanding. I hope they will forgive me for spending so many
time far from them.
1.Why PgAccess ?
First of all because PostgreSQL lacks a graphical interface where you
can manage your tables, edit them, define queries, sequences and
functions.
2.How to INSTALL ?
You will need Tcl/Tk package, I am using now Tcl 7.6 and Tk 4.2.
PgAccess is running fine also on Tcl/Tk 8.0
Also, you will need the PostgreSQL to Tcl interface library, lined as a
Tcl/Tk 'load'-able module. It is called libpgtcl and the source is
located in the PostgreSQL directory /src/interfaces/libpgtcl.
Specifically, you will need a libpgtcl library that is 'load'-able from
Tcl/Tk. This is technically different from an ordinary PostgreSQL
loadable object file, because libpgtcl is a collection of object files.
Under Linux, this is called libpgtcl.so. You will find a pre-compiled
copy of it for Linux i386 systems at : http://www.flex.ro/pgaccess.
Just copy libpgtcl.so into your system library directory /usr/lib or
/lib and go for it.
Under Windows, copy libpgtcl.dll and libpq.dll into C:\WINDOWS\SYSTEM directory.
Make sure you have Tcl/Tk at least version 8.0.0 for Microsoft Windows 95 & NT.
PgAccess has been checked with Tcl/Tk 8.0.4 version on Windows95 and Windows98
platforms.
Tcl/Tk 8.0.4 for Windows95 & NT can be downloaded from
ftp://ftp.scriptics.com/pub/tcl/tcl8_0/tcl804.exe
It is 1833712 bytes long.
3.How to run it?
You run it with the command:
wish -f pgaccess.tcl [database]
[database] is optional.
Another way of loading the PostgreSQL library is running it with pgwish.
It's a wish compiled with libpgtcl library so it could understand the
commands for working with PostgreSQL. For this, remove the line "load
libpgtcl.so" from the source. If your operating system has a different
library name or location, change the 'load libpgtcl.so' line in the
pgaccess.tcl file.
4.What does it now ?
- Opens any database on a specified host at the specified port, username and password
- Perform vacuum command.
- Saves preferences in ~/.pgaccessrc file
Tables
- opening multiple tables for viewing, max n records (configurable)
- column resizing by dragging the vertical grid lines
- text will wrap in cells now
- dynamic row height when editing
- table layout saved for every table
- import/export to external files (SDF,CSV)
- filter capabilities ,enter filter like price>3.14
- sort order capabilities ,enter manually the sort field(s)
- editing in place, double click the text you want to change
- record deleting , point the record, press Del key
- adding new records ,save new row with right-button-click on table for the moment
- table generator assistant
- table renaming and deleting (dropping)
- table information retrieving : owner, field information, indexes
Queries
- define, edit and store "user defined queries"
- save view layout
- can store queries as views
- execution of queries with optional user input parameters ( select * from invoices where year=[parameter "Year of selection"] )
- viewing of select type queries result
- running action queries (insert, update, delete)
- visual query builder with drag & drop support, table aliasing
Sequences
- define
- inspect
- delete
Views
- defining them saving queries as views
- view them , with filtering and sorting capabilities
- design views
- delete them
Functions
- define , inspect , delete
Reports
- simple reports from a table (beta stage)
- change font,size and style of fields and labels
- load and save reports from the database
- table previews, sample postscript print
Forms
- open user defined forms
- form design module available
- query widget allowing access to a record set
Scripts
- define, modify and call user defined scripts
5.What it should do in the future ?
- sequence and function renaming
- more powerful report generator and viewer
- help on line
6. How you should report the errors?
First of all : operating system, PostgreSQL version,Tcl/Tk version.
A more detailed story of what have you done when error had occurred.
Tcl/Tk stops usually with a error message and there is a button there
"Stack Trace" and if you press it, you will see a detailed information
about the place where it stuck. Please send it to me.
Some information about table structure, no. of fields, records would
be also good.
===========================================================================
You would find always the latest version at http://www.flex.ro/pgaccess
Please feel free to e-mail me with any suggestion or bug description
that will help to improve it.
Constantin Teodorescu <teo@flex.ro>

199
src/bin/pgaccess/index.html
View File

@ -1,109 +1,114 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<HTML> <html>
<HEAD> <head>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1"> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<META NAME="GENERATOR" CONTENT="Mozilla/4.07 [en] (X11; I; Linux 2.0.36 i586) [Netscape]"> <meta name="GENERATOR" content="Mozilla/4.5 [en] (X11; I; Linux 2.0.36 i586) [Netscape]">
<TITLE>PgAccess - a Tcl/Tk PostgreSQL interface</TITLE> <title>PgAccess - a Tcl/Tk PostgreSQL interface</title>
</HEAD> </head>
<BODY BGCOLOR="#FFFFFF"> <body bgcolor="#FFFFFF">
<H1> <h1>
PgAccess - a free database management tool for <A HREF="http://www.postgreSQL.org">PostgreSQL</A></H1> PgAccess - a free database management tool for <a href="http://www.postgreSQL.org">PostgreSQL</a></h1>
<HR> <hr>
<LI> <li>
Download the last version of PgAccess <A HREF="pgaccess-0.93.tar.gz">(press Download the last version of PgAccess <a href="pgaccess-0.96.tar.gz">(press
shift and click this link) (tar.gz file)</A>&nbsp; or&nbsp;&nbsp; <A HREF="pgaccess.zip">this shift and click this link) (tar.gz file)</a>&nbsp; or&nbsp;&nbsp; <a href="pgaccess.zip">this
one (zip file for Windows)</A></LI> one (zip file for Windows)</a></li>
<CENTER> <p><br>
<P><BR>Latest stable version of PgAccess is 0.93 , released 10 December <center>
1998 ! <p>Latest stable version of PgAccess is 0.96 , released 9 March 1999
<P><FONT SIZE=+2><B><FONT COLOR="#FF0000">NEW *</FONT></B> <B><FONT COLOR="#FF0000">NEW !
*</FONT></B></FONT><B><FONT COLOR="#FF0000">&nbsp;</FONT><FONT COLOR="#000000"><FONT SIZE=+1> <p><font size=+2>PgAccess 0.93 and higher will not work from the begining
==> </FONT><FONT SIZE=+2>Microsoft Windows compatible version</FONT></FONT></B> with PostgreSQL 6.3.x !!<br>
<P>&nbsp; <B><FONT COLOR="#FF0000">NEW *</FONT></B> ==== > <B>PostgreSQL Read <a href="pg93patch.html">here</a> how to apply a simple patch in order
user management, multiple table views</B>,. <B>Query parameters</B> (see to make it work !</font>
<br>&nbsp;
<p><font size=+2><b><font color="#FF0000">NEW *</font></b> <b><font color="#FF0000">NEW
*</font></b></font><b><font color="#FF0000">&nbsp;</font><font color="#000000"><font size=+1>
==> </font><font size=+2>Microsoft Windows compatible version</font></font></b>
<p>&nbsp; <b><font color="#FF0000">NEW *</font></b> ==== > <b>PostgreSQL
user management, multiple table views</b>,. <b>Query parameters</b> (see
section Queries below) section Queries below)
<P>Precompiled libpgtcl and libpq binaries and dll's for i386 are <A HREF="ftp://ftp.flex.ro/pub/pgaccess">here <p>Precompiled libpgtcl and libpq binaries and dll's for i386 are <a href="ftp://ftp.flex.ro/pub/pgaccess">here
</A>!!!</CENTER> </a>!!!</center>
<BR>&nbsp; <h3>
<H3> <font color="#000080">Installation problems</font></h3>
<FONT COLOR="#000080">Installation problems</FONT></H3>
<UL> <ul>
<LI> <li>
Some problems related with locale special characters could be solved by Some problems related with locale special characters could be solved by
this <A HREF="specialchars.html">simple patch</A></LI> this <a href="specialchars.html">simple patch</a></li>
<LI> <li>
I think that there were some problems loading libpgtcl library. I invite I think that there were some problems loading libpgtcl library. I invite
you to read a <A HREF="index.html#libpgtcl">special section concerning you to read a <a href="index.html#libpgtcl">special section concerning
libpgtcl</A></LI> libpgtcl</a></li>
<LI> <li>
For Silicon Graphics Indigo computers, Irix operating system, there is For Silicon Graphics Indigo computers, Irix operating system, there is
a <A HREF="irix.html">HOWTO make PgAccess to work</A></LI> a <a href="irix.html">HOWTO make PgAccess to work</a></li>
</UL> </ul>
<H3> <h3>
<FONT COLOR="#191970">What does PgAccess now!</FONT></H3> <font color="#191970">What does PgAccess now!</font></h3>
Here are some screenshots from PgAccess windows : <A HREF="pic-pga-1.gif">Main Here are some screenshots from PgAccess windows : <a href="pic-pga-1.gif">Main
window </A>, <A HREF="pic-pga-2.gif">table builder </A>, <A HREF="pic-pga-4.gif">table(query) window </a>, <a href="pic-pga-2.gif">table builder </a>, <a href="pic-pga-4.gif">table(query)
view </A>, <A HREF="pic-pga-3.gif">visual query builder </A>. view </a>, <a href="pic-pga-3.gif">visual query builder </a>.
<P><B>Tables</B> <p><b>Tables</b>
<BR>- opening multiple tables for viewing, max. n records (changed by preferences <br>- opening multiple tables for viewing, max. n records (changed by preferences
menu) menu)
<BR>- column resizing, dragging the vertical grid line (better in table <br>- column resizing, dragging the vertical grid line (better in table
space rather than in the table header) space rather than in the table header)
<BR>- text wrap in cells - layout saved for every table <br>- text wrap in cells - layout saved for every table
<BR>- import/export to external files (SDF,CSV) <br>- import/export to external files (SDF,CSV)
<BR>- filter capabilities (enter filter like (price>3.14) <br>- filter capabilities (enter filter like (price>3.14)
<BR>- sort order capabilities (enter manually the sort field(s)) <br>- sort order capabilities (enter manually the sort field(s))
<BR>- editing in place <br>- editing in place
<BR>- improved table generator assistant <br>- improved table generator assistant
<BR>- improved field editing <br>- improved field editing
<BR><B>Queries</B> <br><b>Queries</b>
<BR>- define , edit and stores "user defined queries" <br>- define , edit and stores "user defined queries"
<BR>- store queries as views <br>- store queries as views
<BR>- execution of queries with optional user input parameters ( select <br>- execution of queries with optional user input parameters ( select
* from invoices where year=[parameter "Year of selection"] ) * from invoices where year=[parameter "Year of selection"] )
<BR>- viewing of select type queries result <br>- viewing of select type queries result
<BR>- query deleting and renaming <br>- query deleting and renaming
<BR>- visual query builder with drag &amp; drop capabilities. For any of <br>- visual query builder with drag &amp; drop capabilities. For any of
you who had installed the Tcl/Tk plugin for Netscape Navigator, you can you who had installed the Tcl/Tk plugin for Netscape Navigator, you can
see it at work <A HREF="qbtclet.html">clicking here</A> see it at work <a href="qbtclet.html">clicking here</a>
<BR><B>Sequences</B> <br><b>Sequences</b>
<BR>- defines sequences, delete them and inspect them <br>- defines sequences, delete them and inspect them
<BR><B>Functions</B> <br><b>Functions</b>
<BR>- define, inspect and delete functions in SQL language <br>- define, inspect and delete functions in SQL language
<BR><B>Reports</B> <br><b>Reports</b>
<BR>- design and display simple reports from tables <br>- design and display simple reports from tables
<BR>- fields and labels, font changing, style and size <br>- fields and labels, font changing, style and size
<BR>- saves and loads report description from database <br>- saves and loads report description from database
<BR>- show report previews, sample postscript output file <br>- show report previews, sample postscript output file
<BR><B>Forms</B> <br><b>Forms</b>
<BR>- open user defined forms <br>- open user defined forms
<BR>- form design module available <br>- form design module available
<BR>- query widget available, controls bound to query results <br>- query widget available, controls bound to query results
<BR>- <A HREF="forms.html">click here</A> for a description of forms and <br>- <a href="forms.html">click here</a> for a description of forms and
how they can be used how they can be used
<BR><B>Scripts</B> <br><b>Scripts</b>
<BR>- define, modify and call user defined scripts <br>- define, modify and call user defined scripts
<BR><B>Users</B> <br><b>Users</b>
<BR>- define and modify user parameters <br>- define and modify user parameters
<P>Here is <A HREF="pga-rad.html">a special section concerning forms and <p>Here is <a href="pga-rad.html">a special section concerning forms and
scripts</A> . scripts</a> .
<P>This program is protected by the following <A HREF="copyright.html">copyright</A> <p>This program is protected by the following <a href="copyright.html">copyright</a>
<P>If you have any comment, suggestion for improvements, please feel free <p>If you have any comment, suggestion for improvements, please feel free
to e-mail to : <A HREF="mailto:teo@flex.ro">teo@flex.ro</A> to e-mail to : <a href="mailto:teo@flex.ro">teo@flex.ro</a>
<P><B><FONT COLOR="#FF1493"><FONT SIZE=+2>Mailing list for PgAccess </FONT></FONT></B><A HREF="maillist.html">Here <p><b><font color="#FF1493"><font size=+2>Mailing list for PgAccess </font></font></b><a href="maillist.html">Here
you will find how to subscribe to this mailing list</A>. you will find how to subscribe to this mailing list</a>.
<P> <p>
<HR> <hr>
<H1> <h1>
More information about libpgtcl - downloads</H1> More information about libpgtcl - downloads</h1>
&nbsp;&nbsp;&nbsp;&nbsp; Also, you will need the PostgreSQL to Tcl interface &nbsp;&nbsp;&nbsp;&nbsp; Also, you will need the PostgreSQL to Tcl interface
library, lined as a Tcl/Tk 'load'-able module. It is called libpgtcl and library, lined as a Tcl/Tk 'load'-able module. It is called libpgtcl and
the source is located in the PostgreSQL directory /src/interfaces/libpgtcl. the source is located in the PostgreSQL directory /src/interfaces/libpgtcl.
@ -111,19 +116,19 @@ Specifically, you will need a libpgtcl library that is 'load'-able from
Tcl/Tk.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; This is technically different from Tcl/Tk.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; This is technically different from
an ordinary PostgreSQL loadable object file, because libpgtcl is a collection an ordinary PostgreSQL loadable object file, because libpgtcl is a collection
of object files. Under Linux, this is called libpgtcl.so. of object files. Under Linux, this is called libpgtcl.so.
<P>&nbsp;&nbsp;&nbsp;&nbsp; One of the solutions is to remove from the <p>&nbsp;&nbsp;&nbsp;&nbsp; One of the solutions is to remove from the
source the line containing <B>load libpgtcl.so </B>and to load pgaccess.tcl source the line containing <b>load libpgtcl.so </b>and to load pgaccess.tcl
not with wish, but with pgwish (or wishpg) that wish that was linked with not with wish, but with pgwish (or wishpg) that wish that was linked with
libpgtcl library! I do not recommend this one. libpgtcl library! I do not recommend this one.
<P>&nbsp;&nbsp;&nbsp;&nbsp; If you have installed RedHat 5.x, you should <p>&nbsp;&nbsp;&nbsp;&nbsp; If you have installed RedHat 5.x, you should
get the last distribution kit of PostgreSQL and compile it from scratch. get the last distribution kit of PostgreSQL and compile it from scratch.
RedHat 5.x is using some new versions of libraries and you have to compile RedHat 5.x is using some new versions of libraries and you have to compile
and install again at least <B>libpq </B>and <B><TT>libpgtcl </TT></B>libraries. and install again at least <b>libpq </b>and <b><tt>libpgtcl </tt></b>libraries.
<P>&nbsp;&nbsp;&nbsp; PostgreSQL 6.4 release has a minor bug. I does not <p>&nbsp;&nbsp;&nbsp; PostgreSQL 6.4 release has a minor bug. I does not
includ by default the crypt lib when compiling libpgtcl. So, you will need includ by default the crypt lib when compiling libpgtcl. So, you will need
to manually add a -lcrypt to SHLIB line in Makefile in src/interfaces/libpgtcl to manually add a -lcrypt to SHLIB line in Makefile in src/interfaces/libpgtcl
and then make clean and make again. The new libpgtcl.so library is properly and then make clean and make again. The new libpgtcl.so library is properly
configured to run pgaccess. configured to run pgaccess.
<BR>&nbsp; <br>&nbsp;
</BODY> </body>
</HTML> </html>

25
src/bin/pgaccess/pg93patch.html Normal file
View File

@ -0,0 +1,25 @@
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<meta name="GENERATOR" content="Mozilla/4.5 [en] (X11; I; Linux 2.0.36 i586) [Netscape]">
</head>
<body text="#000000" bgcolor="#FFFFFF" link="#0000FF" vlink="#FF0000" alink="#000088">
<h1>
PgAccess 0.93 patch to make it work with PostgreSQL 6.3.x
<hr WIDTH="100%"></h1>
<p><br>PgAccess 0.93 is working fine with PostgreSQL 6.4.x due to some
changes in libpgtcl !
<p>There is a small patch that you have to make in order to make it work
with 6.3.x !
<p>Replace in procedure <tt>wpg_exec</tt> the following line:
<p><tt>set pgsql(errmsg) [pg_result $pgsql(res) -error]</tt>
<p>with this one :
<p><tt>set pgsql(errmsg) "NO ERROR INFORMATION SUPPLIED"</tt>
<p>And it will work fine! In some error cases, you will not get the appropriate
error message from libpgtcl.
<p>&nbsp;<a href="index.html">Back</a>
</body>
</html>

144
src/bin/pgaccess/pgaccess.tcl
View File

@ -1,4 +1,6 @@
#!/usr/bin/wish #!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
global widget; global widget;
@ -74,6 +76,7 @@ set qlvar(xoffs) 50
set qlvar(reswidth) 150 set qlvar(reswidth) 150
set qlvar(resfields) {} set qlvar(resfields) {}
set qlvar(ressort) {} set qlvar(ressort) {}
set qlvar(resreturn) {}
set qlvar(rescriteria) {} set qlvar(rescriteria) {}
set qlvar(restables) {} set qlvar(restables) {}
set qlvar(critedit) 0 set qlvar(critedit) 0
@ -288,6 +291,7 @@ set objname [.dw.lb get [.dw.lb curselection]]
set tablename $objname set tablename $objname
switch $activetab { switch $activetab {
Queries {open_query design} Queries {open_query design}
Views {open_view_design}
Scripts {design_script $objname} Scripts {design_script $objname}
Forms {fd_load_form $objname design} Forms {fd_load_form $objname design}
Reports { Reports {
@ -343,25 +347,21 @@ cursor_normal
proc {cmd_Functions} {} { proc {cmd_Functions} {} {
global dbc global dbc
set maxim 0 set maxim 16384
set pgid 0
cursor_clock cursor_clock
catch { catch {
wpg_select $dbc "select proowner,count(*) from pg_proc group by proowner" rec { wpg_select $dbc "select oid from pg_database where datname='template1'" rec {
if {$rec(count)>$maxim} { set maxim $rec(oid)
set maxim $rec(count)
set pgid $rec(proowner)
}
} }
}
.dw.lb delete 0 end .dw.lb delete 0 end
catch { catch {
wpg_select $dbc "select proname from pg_proc where prolang=14 and proowner<>$pgid order by proname" rec { wpg_select $dbc "select proname from pg_proc where prolang=14 and oid>$maxim order by proname" rec {
.dw.lb insert end $rec(proname) .dw.lb insert end $rec(proname)
} }
} }
cursor_normal cursor_normal
} }
}
proc {cmd_Import_Export} {how} { proc {cmd_Import_Export} {how} {
global dbc ie_tablename ie_filename activetab global dbc ie_tablename ie_filename activetab
@ -397,7 +397,7 @@ switch $activetab {
Window show .qb Window show .qb
set queryoid 0 set queryoid 0
set queryname {} set queryname {}
set cbv 0 set cbv 0
.qb.cbv configure -state normal .qb.cbv configure -state normal
} }
Users { Users {
@ -585,12 +585,18 @@ cursor_normal
proc {cmd_Views} {} { proc {cmd_Views} {} {
global dbc global dbc
cursor_clock cursor_clock
.dw.lb delete 0 end .dw.lb delete 0 end
catch { 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 { wpg_select $dbc "select relname from pg_class where (relname !~ '^pg_') and (relkind='r') and (relhasrules) order by relname" rec {
.dw.lb insert end $rec(relname) if {[info exists itsaview($rec(relname))]} {
.dw.lb insert end $rec(relname)
}
} }
} }
cursor_normal cursor_normal
@ -602,7 +608,7 @@ if {[winfo exists $base.ddf]} {
return return
} }
frame $base.ddf -borderwidth 1 -height 75 -relief raised -width 55 frame $base.ddf -borderwidth 1 -height 75 -relief raised -width 55
listbox $base.ddf.lb -background #fefefe -borderwidth 1 -font $pref(font_normal) -highlightthickness 0 -selectborderwidth 0 -yscrollcommand [subst {$base.ddf.sb set}] 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 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 -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.lb -x 1 -y 1 -width [expr $w-18] -height 182 -anchor nw -bordermode ignore
@ -773,6 +779,9 @@ switch $fdobj($i,t) {
fd_draw_rectangle $x1 $y1 $x2 $y2 raised #a0a0a0 o$i 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 .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 { entry {
fd_draw_rectangle $x1 $y1 $x2 $y2 sunken white o$i fd_draw_rectangle $x1 $y1 $x2 $y2 sunken white o$i
} }
@ -1141,6 +1150,9 @@ switch $fdobj($item,t) {
entry $base.$name -bo 1 -ba white -selectborderwidth 0 -highlightthickness 0 entry $base.$name -bo 1 -ba white -selectborderwidth 0 -highlightthickness 0
if {$var!=""} {$base.$name configure -textvar $var} if {$var!=""} {$base.$name configure -textvar $var}
} }
text {
text $base.$name -font $pref(font_normal) -borderwidth 1
}
label { label {
set wh {} set wh {}
label $base.$name -font $pref(font_normal) -anchor nw -padx 0 -pady 0 -text $fdobj($item,l) label $base.$name -font $pref(font_normal) -anchor nw -padx 0 -pady 0 -text $fdobj($item,l)
@ -1177,10 +1189,21 @@ return $temp
proc {get_tables} {} { proc {get_tables} {} {
global dbc global dbc
set tbl {} set tbl {}
catch { if {[catch {
wpg_select $dbc "select * from pg_class where (relname !~ '^pg_') and (relkind='r') order by relname" rec { 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 {![regexp "^pga_" $rec(relname)]} then {lappend tbl $rec(relname)} 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 return $tbl
} }
@ -1779,6 +1802,25 @@ set rbvar(justpreview) 1
rb_preview 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} { proc {open_query} {how} {
global dbc queryname mw queryoid global dbc queryname mw queryoid
@ -1968,9 +2010,12 @@ focus .ql.entt
proc {ql_compute_sql} {} { proc {ql_compute_sql} {} {
global qlvar global qlvar
set sqlcmd "select " set sqlcmd "select "
#rjr 8Mar1999 added logical return state for results
for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} { for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
if {[lindex $qlvar(resreturn) $i]} {
if {$sqlcmd!="select "} {set sqlcmd "$sqlcmd, "} if {$sqlcmd!="select "} {set sqlcmd "$sqlcmd, "}
set sqlcmd "$sqlcmd[lindex $qlvar(restables) $i].[lindex $qlvar(resfields) $i]" set sqlcmd "$sqlcmd[lindex $qlvar(restables) $i].\"[lindex $qlvar(resfields) $i]\""
}
} }
set tables {} set tables {}
for {set i 0} {$i<$qlvar(ntables)} {incr i} { for {set i 0} {$i<$qlvar(ntables)} {incr i} {
@ -1984,7 +2029,7 @@ if {[llength $qlvar(links)]>0} {
set sup1 "where " set sup1 "where "
foreach link $qlvar(links) { foreach link $qlvar(links) {
if {$sup1!="where "} {set sup1 "$sup1 and "} if {$sup1!="where "} {set sup1 "$sup1 and "}
set sup1 "$sup1 ([lindex $link 0].[lindex $link 1]=[lindex $link 2].[lindex $link 3])" 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} { for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
@ -1992,7 +2037,7 @@ for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
if {$crit!=""} { if {$crit!=""} {
if {$sup1==""} {set sup1 "where "} if {$sup1==""} {set sup1 "where "}
if {[string length $sup1]>6} {set sup1 "$sup1 and "} if {[string length $sup1]>6} {set sup1 "$sup1 and "}
set sup1 "$sup1 ([lindex $qlvar(restables) $i].[lindex $qlvar(resfields) $i] $crit) " set sup1 "$sup1 ([lindex $qlvar(restables) $i].\"[lindex $qlvar(resfields) $i]\" $crit) "
} }
} }
set sqlcmd "$sqlcmd $sup1" set sqlcmd "$sqlcmd $sup1"
@ -2002,7 +2047,7 @@ for {set i 0} {$i<[llength $qlvar(ressort)]} {incr i} {
if {$how!="unsorted"} { if {$how!="unsorted"} {
if {$how=="Ascending"} {set how asc} else {set how desc} if {$how=="Ascending"} {set how asc} else {set how desc}
if {$sup2==""} {set sup2 " order by "} else {set sup2 "$sup2,"} if {$sup2==""} {set sup2 " order by "} else {set sup2 "$sup2,"}
set sup2 "$sup2 [lindex $qlvar(restables) $i].[lindex $qlvar(resfields) $i] $how " set sup2 "$sup2 [lindex $qlvar(restables) $i].\"[lindex $qlvar(resfields) $i]\" $how "
} }
} }
set sqlcmd "$sqlcmd $sup2" set sqlcmd "$sqlcmd $sup2"
@ -2031,6 +2076,8 @@ if {[ql_get_tag_info $obj res]=="f"} {
if {$col==""} return if {$col==""} return
if {[tk_messageBox -title WARNING -icon question -parent .ql -message "Remove field from result ?" -type yesno -default no]=="no"} 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(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(restables) [lreplace $qlvar(restables) $col $col]
set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $col $col] set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $col $col]
ql_draw_res_panel ql_draw_res_panel
@ -2044,6 +2091,8 @@ if {[tk_messageBox -title WARNING -icon question -parent .ql -message "Remove ta
for {set i [expr [llength $qlvar(restables)]-1]} {$i>=0} {incr i -1} { for {set i [expr [llength $qlvar(restables)]-1]} {$i>=0} {incr i -1} {
if {"$tablename"==[lindex $qlvar(restables) $i]} { if {"$tablename"==[lindex $qlvar(restables) $i]} {
set qlvar(resfields) [lreplace $qlvar(resfields) $i $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(restables) [lreplace $qlvar(restables) $i $i]
set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $i $i] set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $i $i]
} }
@ -2149,6 +2198,7 @@ if {($y>$qlvar(yoffs)) && ($x>$qlvar(xoffs))} {
set qlvar(ressort) [linsert $qlvar(ressort) $col unsorted] set qlvar(ressort) [linsert $qlvar(ressort) $col unsorted]
set qlvar(rescriteria) [linsert $qlvar(rescriteria) $col {}] set qlvar(rescriteria) [linsert $qlvar(rescriteria) $col {}]
set qlvar(restables) [linsert $qlvar(restables) $col $tabtag] set qlvar(restables) [linsert $qlvar(restables) $col $tabtag]
set qlvar(resreturn) [linsert $qlvar(resreturn) $col yes]
ql_draw_res_panel ql_draw_res_panel
} else { } else {
# Drop position : in the table panel # Drop position : in the table panel
@ -2242,6 +2292,7 @@ for {set i $qlvar(xoffs)} {$i<10000} {incr i $qlvar(reswidth)} {
.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 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 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 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 <Button-1> {ql_dragstart %W %x %y}
.ql.c bind mov <B1-Motion> {ql_dragit %W %x %y} .ql.c bind mov <B1-Motion> {ql_dragit %W %x %y}
bind .ql <ButtonRelease-1> {ql_dragstop %x %y} bind .ql <ButtonRelease-1> {ql_dragstop %x %y}
@ -2262,10 +2313,12 @@ for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
if {[lindex $qlvar(rescriteria) $i]!=""} { 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 $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 raise reshdr
.ql.c bind resf <Button-1> {ql_resfield_click %x %y} .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 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} { proc {ql_draw_table} {it} {
@ -2304,6 +2357,7 @@ set qlvar(yoffs) 360
set qlvar(xoffs) 50 set qlvar(xoffs) 50
set qlvar(reswidth) 150 set qlvar(reswidth) 150
set qlvar(resfields) {} set qlvar(resfields) {}
set qlvar(resreturn) {}
set qlvar(ressort) {} set qlvar(ressort) {}
set qlvar(rescriteria) {} set qlvar(rescriteria) {}
set qlvar(restables) {} set qlvar(restables) {}
@ -2383,6 +2437,23 @@ set qlvar(ressort) [lreplace $qlvar(ressort) $col $col $cum]
.ql.c itemconfigure $obj -text $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} { proc {qlc_click} {x y w} {
global qlvar pref global qlvar pref
set qlvar(panstarted) 0 set qlvar(panstarted) 0
@ -2771,7 +2842,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 # Tabs where button Design is enabled
if {[lsearch {Scripts Queries Reports Forms Users} $activetab]!=-1} { if {[lsearch {Scripts Queries Views Reports Forms Users} $activetab]!=-1} {
.dw.btndesign configure -state normal .dw.btndesign configure -state normal
} }
.dw.lb delete 0 end .dw.lb delete 0 end
@ -2916,7 +2987,7 @@ proc vTclWindow.about {base} {
label $base.l2 -relief groove -text {A Tcl/Tk interface to label $base.l2 -relief groove -text {A Tcl/Tk interface to
PostgreSQL PostgreSQL
by Constantin Teodorescu} by Constantin Teodorescu}
label $base.l3 -borderwidth 0 -relief sunken -text {v 0.93} 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: label $base.l4 -relief groove -text {You will always get the latest version at:
http://www.flex.ro/pgaccess http://www.flex.ro/pgaccess
@ -3042,6 +3113,7 @@ global pref
-relief raised -relief raised
listbox $base.lb \ listbox $base.lb \
-background #fefefe \ -background #fefefe \
-selectbackground #c3c3c3 \
-foreground black -highlightthickness 0 -selectborderwidth 0 \ -foreground black -highlightthickness 0 -selectborderwidth 0 \
-yscrollcommand {.dw.sb set} -yscrollcommand {.dw.sb set}
bind $base.lb <Double-Button-1> { bind $base.lb <Double-Button-1> {
@ -3445,6 +3517,7 @@ global pref
-text Create -text Create
listbox $base.lb \ listbox $base.lb \
-background #fefefe -borderwidth 1 \ -background #fefefe -borderwidth 1 \
-selectbackground #c3c3c3 \
-font $pref(font_fix) \ -font $pref(font_fix) \
-selectborderwidth 0 -yscrollcommand {.nt.sb set} -selectborderwidth 0 -yscrollcommand {.nt.sb set}
bind $base.lb <ButtonRelease-1> { bind $base.lb <ButtonRelease-1> {
@ -3686,6 +3759,16 @@ global pref
set qtype A set qtype A
} }
if {$cbv} { 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"] set pgres [wpg_exec $dbc "create view \"$queryname\" as $qcmd"]
if {$pgsql(status)!="PGRES_COMMAND_OK"} { if {$pgsql(status)!="PGRES_COMMAND_OK"} {
show_error "Error defining view\n\n$pgsql(errmsg)" show_error "Error defining view\n\n$pgsql(errmsg)"
@ -3900,6 +3983,7 @@ global pref
-relief raised -text {Report fields} -relief raised -text {Report fields}
listbox $base.lb \ listbox $base.lb \
-background #fefefe -borderwidth 1 \ -background #fefefe -borderwidth 1 \
-selectbackground #c3c3c3 \
-highlightthickness 1 -selectborderwidth 0 \ -highlightthickness 1 -selectborderwidth 0 \
-yscrollcommand {.rb.sb set} -yscrollcommand {.rb.sb set}
bind $base.lb <ButtonRelease-1> { bind $base.lb <ButtonRelease-1> {
@ -4263,7 +4347,7 @@ global pref
label $base.l2 -anchor w -borderwidth 0 -text conturi -textvariable tiw(tablename) label $base.l2 -anchor w -borderwidth 0 -text conturi -textvariable tiw(tablename)
label $base.l3 -borderwidth 0 -text Owner label $base.l3 -borderwidth 0 -text Owner
label $base.l4 -anchor w -borderwidth 1 -textvariable tiw(owner) label $base.l4 -anchor w -borderwidth 1 -textvariable tiw(owner)
listbox $base.lb -background #fefefe -borderwidth 1 -font $pref(font_fix) -highlightthickness 1 -selectborderwidth 0 -yscrollcommand {.tiw.sb set} 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 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.closebtn -borderwidth 1 -command {Window destroy .tiw} -pady 3 -text Close
button $base.renbtn -borderwidth 1 -command { button $base.renbtn -borderwidth 1 -command {
@ -4274,7 +4358,7 @@ global pref
label $base.l12 -borderwidth 1 -relief raised -text size label $base.l12 -borderwidth 1 -relief raised -text size
label $base.lfi -borderwidth 0 -text {Field information} label $base.lfi -borderwidth 0 -text {Field information}
label $base.lii -borderwidth 1 -relief raised -text {Indexes defined} label $base.lii -borderwidth 1 -relief raised -text {Indexes defined}
listbox $base.ilb -background #fefefe -borderwidth 1 -highlightthickness 1 -selectborderwidth 0 listbox $base.ilb -background #fefefe -borderwidth 1 -highlightthickness 1 -selectborderwidth 0 -selectbackground #c3c3c3
bind $base.ilb <ButtonRelease-1> { bind $base.ilb <ButtonRelease-1> {
tiw_show_index tiw_show_index
} }
@ -4664,7 +4748,7 @@ proc vTclWindow.fdtb {base} {
} }
toplevel $base -class Toplevel toplevel $base -class Toplevel
wm focusmodel $base passive wm focusmodel $base passive
wm geometry $base 90x152+0+0 wm geometry $base 90x172+0+0
wm maxsize $base 785 570 wm maxsize $base 785 570
wm minsize $base 1 1 wm minsize $base 1 1
wm overrideredirect $base 0 wm overrideredirect $base 0
@ -4699,6 +4783,10 @@ proc vTclWindow.fdtb {base} {
-anchor w -borderwidth 1 \ -anchor w -borderwidth 1 \
-highlightthickness 0 -text {Radio btn} -value radio \ -highlightthickness 0 -text {Radio btn} -value radio \
-variable fdvar(tool) -width 9 -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 \ radiobutton $base.rb8 \
-anchor w -borderwidth 1 \ -anchor w -borderwidth 1 \
-highlightthickness 0 -text Query -value query -variable fdvar(tool) \ -highlightthickness 0 -text Query -value query -variable fdvar(tool) \
@ -4717,8 +4805,10 @@ proc vTclWindow.fdtb {base} {
-in .fdtb -column 0 -row 5 -columnspan 1 -rowspan 1 -in .fdtb -column 0 -row 5 -columnspan 1 -rowspan 1
grid $base.rb7 \ grid $base.rb7 \
-in .fdtb -column 0 -row 6 -columnspan 1 -rowspan 1 -in .fdtb -column 0 -row 6 -columnspan 1 -rowspan 1
grid $base.rb8 \ grid $base.rb9 \
-in .fdtb -column 0 -row 7 -columnspan 1 -rowspan 1 -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} { proc vTclWindow.sqlw {base} {