]> git.ipfire.org Git - thirdparty/postgresql.git/commitdiff
Add new files.
authorBruce Momjian <bruce@momjian.us>
Mon, 20 Sep 1999 22:03:21 +0000 (22:03 +0000)
committerBruce Momjian <bruce@momjian.us>
Mon, 20 Sep 1999 22:03:21 +0000 (22:03 +0000)
55 files changed:
src/bin/pgaccess/README [new file with mode: 0644]
src/bin/pgaccess/copyright.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/a_right.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/addindex.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/api.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/ball.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/contents.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/copyright.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/documentation.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/download.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/faq.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/features.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/formdemo.sql [new file with mode: 0644]
src/bin/pgaccess/doc/html/forms.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/forms.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/function.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/help.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/index.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/irix.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/linux1.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/maillist.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/main.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/mainwindow.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/newtable.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/newuser.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/old_index.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/permissions.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/pg93patch.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/pga-rad.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/qbtclet.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/qbtclet.tcl [new file with mode: 0644]
src/bin/pgaccess/doc/html/screenshots.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/specialchars.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/todo.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/vdesigner.gif [new file with mode: 0644]
src/bin/pgaccess/doc/html/whatsnew.html [new file with mode: 0644]
src/bin/pgaccess/doc/html/win32.html [new file with mode: 0644]
src/bin/pgaccess/lib/database.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/forms.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/functions.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/help.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/mainlib.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/preferences.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/qed [new file with mode: 0755]
src/bin/pgaccess/lib/queries.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/reports.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/schema.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/scripts.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/sequences.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/tables.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/users.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/views.tcl [new file with mode: 0644]
src/bin/pgaccess/lib/visualqb.tcl [new file with mode: 0644]
src/bin/pgaccess/main.tcl [new file with mode: 0644]
src/bin/pgaccess/pgaccess [new file with mode: 0755]

diff --git a/src/bin/pgaccess/README b/src/bin/pgaccess/README
new file mode 100644 (file)
index 0000000..69a920a
--- /dev/null
@@ -0,0 +1,82 @@
+---------------------------------------------------------------------------
+
+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.98 29 August 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. How to INSTALL ?
+
+You will need a Tcl/Tk package, at least Tcl 7.6 and Tk 4.2, recommended
+Tcl/Tk 8.x
+
+For Unix users, unpack the pgaccess-xxx.tar.gz archieve in you preferred
+directory (usually /usr/local).
+
+Check where your "wish" program is and modify (if needed) the file
+/usr/local/pgaccess/pgaccess and set variables PGACCESS_HOME and 
+PATH_TO_WISH to the appropriate directories.
+
+Include the /usr/local/pgaccess directory into your PATH or make a
+symbolic link to it wherever you want (in PATH directories).
+Example:
+
+$ ln -s /usr/local/pgaccess/pgaccess /usr/bin/pgaccess
+
+You will find also some documentation and FAQ in the doc directory.
+
+
+
+2. Usage
+
+You run it with the command:
+
+        pgaccess [database]
+
+[database] is optional.
+
+
+
+3. Bug reporting
+
+First of all : operating system, PostgreSQL version,Tcl/Tk version.
+A more detailed story of what have you done when error 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 procedure containing the error. 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>
+
diff --git a/src/bin/pgaccess/copyright.html b/src/bin/pgaccess/copyright.html
new file mode 100644 (file)
index 0000000..d67654b
--- /dev/null
@@ -0,0 +1,39 @@
+<HTML>
+<HEAD>
+   <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+   <META NAME="GENERATOR" CONTENT="Mozilla/4.03 [en] (X11; I; Linux 2.0.30 i586) [Netscape]">
+   <TITLE>PgAccess - Copyright notice</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<TT>---------------------------------------------------------------------------</TT>
+<BR><TT></TT>&nbsp;
+<BR><TT></TT>&nbsp;<TT></TT>
+
+<P><TT>Copyright (c) 1994-7 Regents of the University of California</TT><TT></TT>
+
+<P><TT>Permission to use, copy, modify, and distribute this software and
+its</TT>
+<BR><TT>documentation for any purpose, without fee, and without a written
+agreement</TT>
+<BR><TT>is hereby granted, provided that the above copyright notice and
+this</TT>
+<BR><TT>paragraph and the following two paragraphs appear in all copies.</TT><TT></TT>
+
+<P><TT>IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
+PARTY FOR</TT>
+<BR><TT>DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES,
+INCLUDING</TT>
+<BR><TT>LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS</TT>
+<BR><TT>DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED
+OF THE</TT>
+<BR><TT>POSSIBILITY OF SUCH DAMAGE.</TT><TT></TT>
+
+<P><TT>THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,</TT>
+<BR><TT>INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY</TT>
+<BR><TT>AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER
+IS</TT>
+<BR><TT>ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS
+TO</TT>
+<BR><TT>PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.</TT>
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/doc/html/a_right.gif b/src/bin/pgaccess/doc/html/a_right.gif
new file mode 100644 (file)
index 0000000..386e27c
Binary files /dev/null and b/src/bin/pgaccess/doc/html/a_right.gif differ
diff --git a/src/bin/pgaccess/doc/html/addindex.gif b/src/bin/pgaccess/doc/html/addindex.gif
new file mode 100644 (file)
index 0000000..2ff0aa2
Binary files /dev/null and b/src/bin/pgaccess/doc/html/addindex.gif differ
diff --git a/src/bin/pgaccess/doc/html/api.html b/src/bin/pgaccess/doc/html/api.html
new file mode 100644 (file)
index 0000000..7630fd2
--- /dev/null
@@ -0,0 +1,232 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h2>
+PgAccess developer API</h2>
+
+<hr>
+<br>Starting with PgAccess 0.98 I am planning to make available a complete
+API for the PgAccess developers. I plan to make PgAccess not just an administrative
+tool, but also a tool for easy build of small applications.
+<p>That's why PgAccess 0.98 has been internally restructured, every main
+module of PgAccess has became a namespace (see Tcl namespaces) in order&nbsp;
+to hide the variables and internal procedures to the user. Also, all the
+global variables that have been used before were grouped under a single
+big associative array called <b>PgAcVar</b> (PgAccess variables) so they
+should not interfere with user defined global variables.
+<br>&nbsp;
+<br>&nbsp;
+<p><b><font size=+1>Global variables available</font></b>
+<br>&nbsp;
+<center><table BORDER=0 WIDTH="100%" NOSAVE >
+<tr NOSAVE>
+<td ALIGN=LEFT VALIGN=TOP NOSAVE><b>PgAcVar</b></td>
+
+<td>The main global associative array that hold together various information
+needed by PgAccess. User should <b><font color="#FF0000">NOT</font></b>
+alter it under any circumstances.</td>
+</tr>
+
+<tr NOSAVE>
+<td VALIGN=TOP NOSAVE><b>CurrentDB</b></td>
+
+<td>The handler of the current opened database. Can be used for database
+operations as selects or command execution.</td>
+</tr>
+
+<tr NOSAVE>
+<td ALIGN=LEFT VALIGN=TOP NOSAVE><b>Messages</b></td>
+
+<td NOSAVE>The associative array that holds the translation for the current
+language. Loaded from the appropriate language file from lib/languages
+directory</td>
+</tr>
+
+<tr NOSAVE>
+<td ALIGN=LEFT VALIGN=TOP NOSAVE><b>PGACCESS_HOME</b></td>
+
+<td>Keep the system directory of PgAccess root installation</td>
+</tr>
+</table></center>
+
+<br>&nbsp;
+<p><b><font size=+1>Window naming convention</font></b>
+<p>Every toplevel window defined by PgAccess has the following naming convention.
+Every window name starts with <tt>.pgaw</tt> (PgAccess window) followed
+by a colon and a name. <i>Example:</i>
+<blockquote><tt>.pgaw:User , .pgaw:About , .pgaw:ImportExport</tt></blockquote>
+<b><font size=+1>Namespaces available</font></b>
+<p>For every tab from the main database window there is a namespace defined
+(Tables, Queries, Views, Functions, Sequences, Reports, Forms, Scripts,
+Users, Schema). Every namespace has by default the following&nbsp; procedures:
+<ul>
+<li>
+<tt>new</tt>&nbsp; , no parameter needed</li>
+
+<li>
+<tt>open</tt> , need a single parameter, the object name</li>
+
+<li>
+<tt>design</tt> , need a single parameter, the object name</li>
+</ul>
+You can use these procedures if you want to produce the same efects as
+clicking on the desired tab and then on the "New", "Open" or "Design" buttons
+from the main database window.
+<br><i>Example:</i>
+<blockquote><tt>Tables::open "customers"</tt>
+<br><tt>Queries::open "Invoices received"</tt>
+<br><tt>Forms::open "Add new invoice"</tt></blockquote>
+The <tt>Tables::open</tt> procedure accepts two optional parameters, filter
+and order.
+<br><i>Example:</i>
+<blockquote><tt>Tables::open "phonebook" "name ~* 'joe'" "age desc"</tt></blockquote>
+will open a table view window with predefined filter "name ~* 'joe'" and
+ordered by descending age.
+<p>There is also a special namespace called Database.&nbsp; Here are some
+procedures and functions defined for this namespace available to the user:
+<br>&nbsp;
+<table BORDER NOSAVE >
+<tr BGCOLOR="#FFCCFF" NOSAVE>
+<td NOSAVE><b>Name</b></td>
+
+<td NOSAVE><b>Parameters</b></td>
+
+<td><b>Type</b></td>
+
+<td><b>Returns</b></td>
+
+<td NOSAVE><b>Description</b></td>
+</tr>
+
+<tr>
+<td><b>vacuum</b></td>
+
+<td>none</td>
+
+<td>procedure</td>
+
+<td>nothing</td>
+
+<td>vacuums the current database</td>
+</tr>
+
+<tr ALIGN=LEFT VALIGN=TOP NOSAVE>
+<td><b>getTablesList</b></td>
+
+<td>none</td>
+
+<td>function</td>
+
+<td>list</td>
+
+<td NOSAVE>returns the list of tables from the current database</td>
+</tr>
+
+<tr ALIGN=LEFT VALIGN=TOP NOSAVE>
+<td><b>executeUpdate</b></td>
+
+<td>sqlcmd</td>
+
+<td>function</td>
+
+<td>integer</td>
+
+<td NOSAVE>execute the sqlcmd command on the current database returning
+1 if no errors ocurred or 0 if the command failed</td>
+</tr>
+</table>
+
+<p><b><font size=+1>Global functions available</font></b>
+<br>&nbsp;
+<table BORDER NOSAVE >
+<tr BGCOLOR="#99FFCC" NOSAVE>
+<td><b>Name</b></td>
+
+<td><b>Parameters</b></td>
+
+<td NOSAVE><b>Description</b></td>
+</tr>
+
+<tr ALIGN=LEFT VALIGN=TOP NOSAVE>
+<td><b>setCursor</b></td>
+
+<td>type</td>
+
+<td NOSAVE>Set the cursor for all PgAccess windows, type of cursor can
+be WAIT or CLOCK or WATCH for the hourglass , anything else (or none) to
+return to the normal cursor shape</td>
+</tr>
+
+<tr ALIGN=LEFT VALIGN=TOP NOSAVE>
+<td><b>parameter</b></td>
+
+<td>msg</td>
+
+<td NOSAVE>Shows a modal input dialog with the msg message, wait for user
+to enter the data and returns it as a string</td>
+</tr>
+
+<tr>
+<td><b>showError</b></td>
+
+<td>msg</td>
+
+<td>Shows a modal dialog window with an error message</td>
+</tr>
+
+<tr>
+<td></td>
+
+<td></td>
+
+<td></td>
+</tr>
+
+<tr>
+<td></td>
+
+<td></td>
+
+<td></td>
+</tr>
+
+<tr>
+<td></td>
+
+<td></td>
+
+<td></td>
+</tr>
+
+<tr>
+<td></td>
+
+<td></td>
+
+<td></td>
+</tr>
+
+<tr>
+<td></td>
+
+<td></td>
+
+<td></td>
+</tr>
+
+<tr>
+<td></td>
+
+<td></td>
+
+<td></td>
+</tr>
+</table>
+
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/ball.gif b/src/bin/pgaccess/doc/html/ball.gif
new file mode 100644 (file)
index 0000000..02d2034
Binary files /dev/null and b/src/bin/pgaccess/doc/html/ball.gif differ
diff --git a/src/bin/pgaccess/doc/html/contents.html b/src/bin/pgaccess/doc/html/contents.html
new file mode 100644 (file)
index 0000000..971f3f4
--- /dev/null
@@ -0,0 +1,29 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+   <base target="right">
+</head>
+<body bgcolor="#00FFFF">
+<img SRC="ball.gif" ><a href="main.html">What is PgAccess?</a>
+<br><img SRC="ball.gif" ><a href="whatsnew.html">What's new?</a>
+<br><img SRC="ball.gif" ><a href="features.html">Features</a>
+<br><img SRC="ball.gif" ><a href="screenshots.html">Screenshots</a>
+<br><img SRC="ball.gif" ><a href="faq.html">FAQ</a>
+<br><img SRC="ball.gif" ><a href="documentation.html">Documentation</a>
+<br><img SRC="ball.gif" ><a href="todo.html">To-Do list</a>
+<br><img SRC="ball.gif" ><a href="download.html">Download</a>
+<br>&nbsp;
+<p><br>
+<center>
+<p><a href="http://www.linux.org"><img SRC="linux1.gif" BORDER=0 ></a></center>
+
+<p><b>Other links</b>
+<br><img SRC="ball.gif" ><a href="http://www.postgresql.org">PostgreSQL</a>
+<br><img SRC="ball.gif" ><a href="http://www.neuron.com/stewart/vtcl/index.html">Visual Tcl</a>
+<br><img SRC="ball.gif" ><a href="http://www.scriptics.com">Tcl/Tk</a>
+<br><img SRC="ball.gif" ><a href="http://www.linux.org">Linux</a>
+<br><img SRC="ball.gif" ><a href="http://www.java.ro/vtclava/index.html">vTcLava</a>
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/copyright.html b/src/bin/pgaccess/doc/html/copyright.html
new file mode 100644 (file)
index 0000000..d67654b
--- /dev/null
@@ -0,0 +1,39 @@
+<HTML>
+<HEAD>
+   <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+   <META NAME="GENERATOR" CONTENT="Mozilla/4.03 [en] (X11; I; Linux 2.0.30 i586) [Netscape]">
+   <TITLE>PgAccess - Copyright notice</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<TT>---------------------------------------------------------------------------</TT>
+<BR><TT></TT>&nbsp;
+<BR><TT></TT>&nbsp;<TT></TT>
+
+<P><TT>Copyright (c) 1994-7 Regents of the University of California</TT><TT></TT>
+
+<P><TT>Permission to use, copy, modify, and distribute this software and
+its</TT>
+<BR><TT>documentation for any purpose, without fee, and without a written
+agreement</TT>
+<BR><TT>is hereby granted, provided that the above copyright notice and
+this</TT>
+<BR><TT>paragraph and the following two paragraphs appear in all copies.</TT><TT></TT>
+
+<P><TT>IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
+PARTY FOR</TT>
+<BR><TT>DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES,
+INCLUDING</TT>
+<BR><TT>LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS</TT>
+<BR><TT>DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED
+OF THE</TT>
+<BR><TT>POSSIBILITY OF SUCH DAMAGE.</TT><TT></TT>
+
+<P><TT>THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,</TT>
+<BR><TT>INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY</TT>
+<BR><TT>AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER
+IS</TT>
+<BR><TT>ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS
+TO</TT>
+<BR><TT>PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.</TT>
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/doc/html/documentation.html b/src/bin/pgaccess/doc/html/documentation.html
new file mode 100644 (file)
index 0000000..48d3fa5
--- /dev/null
@@ -0,0 +1,19 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h2>
+Documentation</h2>
+
+<hr WIDTH="100%">
+<p>Still need to be written. Some information can be found in the help
+included in the main program.
+<p>Jim Lemon &lt;Jim.Lemon@uts.EDU.AU> has started writing a <a href="tutorial/index.html">tutorial</a>.
+Thought it is based on earlier versions than 0.98 it is a beginning after
+all, isn't it ?
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/download.html b/src/bin/pgaccess/doc/html/download.html
new file mode 100644 (file)
index 0000000..efbe7bf
--- /dev/null
@@ -0,0 +1,42 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h2>
+Download</h2>
+
+<hr>
+<br>The primary site for PgAccess downloads is:
+<ul><a href="ftp://ftp.flex.ro/pub/pgaccess">ftp://ftp.flex.ro/pub/pgaccess</a>
+<ul>
+<li>
+<a href="ftp://ftp.flex.ro/pub/pgaccess/pgaccess-0.98.tar.gz">Unix tar.gz
+file</a></li>
+
+<li>
+<a href="ftp://ftp.flex.ro/pub/pgaccess/pgaccess-0.98.zip">Windows .zip
+file</a></li>
+</ul>
+</ul>
+
+<p>Another one (just with a little bit faster, try this one first) would
+be :
+<ul><a href="ftp://speedy.flex.ro/pub/pgaccess">ftp://speedy.flex.ro/pub/pgaccess</a>
+<ul>
+<li>
+<a href="ftp://speedy.flex.ro/pub/pgaccess/pgaccess-0.98.tar.gz">Unix tar.gz
+file</a></li>
+
+<li>
+<a href="ftp://speedy.flex.ro/pub/pgaccess/pgaccess-0.98.zip">Windows .zip
+file</a></li>
+</ul>
+</ul>
+
+<br>&nbsp;
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/faq.html b/src/bin/pgaccess/doc/html/faq.html
new file mode 100644 (file)
index 0000000..f66dd83
--- /dev/null
@@ -0,0 +1,85 @@
+<!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.61 [en] (X11; I; Linux 2.2.12 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h2>
+PgAccess - FAQ</h2>
+
+<hr>
+<br><b>1. When I run PgAccess I got a message complaining about the crypt
+library! What should I do?</b>
+<blockquote>Versions of PostgreSQL prior to 6.5.1 couldn't reliably detect
+the presence of the crypt library on RedHat 5.x systems. That's why the
+libpgtcl library does not include reference to crypt. You will need to
+get a proper copy of libpgtcl.so library or to compile one. Go to the postgresql
+source directory into src/interfaces/libpgtcl and edit Makefile adding
+-lcrypt to the end of the line SHLIB_LINKS. Make clean and make again.
+Your libpgtcl.so is now prepare to run PgAccess. I strongly recommend you
+to upgrade to PostgreSQL 6.5.1 where this problem has been solved.</blockquote>
+<b>2. I cannot connect to a database from another machine</b>
+<blockquote>There may be two problems here. First of all, PgAccess running
+on the localhost is using two PostgreSQL dependent libraries, libpq and
+libpgtcl. Each of them are compiled for a specific PostgreSQL version.
+If the PostgreSQL version running on your server is different you might
+experience problems. The other problem is related to access rights. On
+the PostgreSQL server, in data directory there is a file pg_hba.conf that
+will grant access rights to users based on host authentication. Ask your
+database administrator to check if your workstation is listed there with
+the appropriate access rights. Try for the beginning the 'trust' mode,
+allowing full access to the databases.</blockquote>
+<b>3. I am experiencing core dumps when trying to run PgAccess. Is PgAccess
+broken?</b>
+<blockquote>No. There were NEVER reported crashes because of PgAccess.
+All of them were related to bad libraries usage. The most frequent was
+the installing of a new PostgreSQL on a RedHat 5.x server where the postgresql-clients
+rpm still exists. So, PgAccess was trying to use the old libpgtcl.so library
+suitable for an older version of PostgreSQL. Before installing a new PostgreSQL
+(either by compiling it ot by rpm packages) remove ANY TRACE of old PostgreSQL.
+PgAccess is fully relying on libpgtcl library in order to get access to
+the database so when you are experiencing that kind of problems, double-check
+libpq and libpgtcl libraries.</blockquote>
+<b>4. When I try to run PgAccess I get the following error : Application
+initialization failed: couldn't connect to display ""</b>
+<blockquote>That kind of error was reported on some Linux RedHat 5.x systems
+when user has su - to root and tried to run PgAccess. Some unknown errors
+in login scripts are not defining the DISPLAY environment and the wish
+application cannot connect to the X display. Try typing <tt>export DISPLAY=localhost:0.0</tt>
+and run PgAccess again.</blockquote>
+<b>5. Cannot run PgAccess on a Windows machine.</b>
+<blockquote>In order to use PgAccess on Windows you must have installed
+two libraries libpq.dll and libpgtcl.dll suitable for your Tcl/Tk package
+and your PostgreSQL server. Note that libraries that work with Tcl/Tk 8.0.x
+won't work with Tcl/Tk 8.1.x and libraries that work with 6.4.2 backend
+won't work with 6.5.x. So, you must properly identify your Tcl/Tk package
+version and your PostgreSQL version and download from the Downloads section
+(or pick from the win32/dll directory of PgAccess distribution) the right
+files. Copy them into your Windows/System directory and try again. Also,
+you should be able to access over the network the machine running the PostgreSQL
+server (try ping-ing it) and have the proper access rights to the database.</blockquote>
+<b>6. How much costs PgAccess?</b>
+<blockquote>PgAccess is a free tool. You won't have to pay anything in
+order to use it. It is protected by the following <a href="copyright.html">copyright</a>
+as PostgreSQL is. I cannot guarantee technical support but I will try to
+answer to your questions as much as I can.</blockquote>
+<b>7. I want to translate PgAccess messages for xxx language. What should
+I do?</b>
+<blockquote>In the PgAccess distribution in lib/languages directory there
+are files with messages translated for different languages. Copy one of
+them and name it after your native language and then start editing it translating
+all the messages. Save it into the same directory and that's all. Don't
+forget to send me a copy in order to include it into the standard distribution.</blockquote>
+
+<p><br><b>8. I am receiving the following error: <tt>message invalid command
+name "namespace" while executing "namespace eval Mainlib</tt>&nbsp; ..."</b>
+<blockquote>That means 100% that you have an older version of Tcl/Tk that
+don't recognize namespaces command. Please upgrade to Tcl/Tk 8.0.x minimum</blockquote>
+
+<br>&nbsp;
+<br>&nbsp;
+<br>&nbsp;
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/features.html b/src/bin/pgaccess/doc/html/features.html
new file mode 100644 (file)
index 0000000..4531663
--- /dev/null
@@ -0,0 +1,52 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+<b>Tables</b>
+<br>- opening multiple tables for viewing, max. n records (changed by preferences
+menu)
+<br>- column resizing, dragging the vertical grid line (better in table
+space rather than in the table header)
+<br>- text wrap in cells - layout saved for every table
+<br>- import/export to external files (SDF,CSV)
+<br>- filter capabilities (enter filter like (price>3.14)
+<br>- sort order capabilities (enter manually the sort field(s))
+<br>- editing in place
+<br>- improved table generator assistant
+<br>- improved field editing
+<br><b>Queries</b>
+<br>- define , edit and stores "user defined queries"
+<br>- store queries as views
+<br>- execution of queries with optional user input parameters ( select
+* from invoices where year=[parameter "Year of selection"] )
+<br>- viewing of select type queries result
+<br>- query deleting and renaming
+<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
+see it at work <a href="qbtclet.html">clicking here</a>
+<br><b>Sequences</b>
+<br>- defines sequences, delete them and inspect them
+<br><b>Functions</b>
+<br>- define, inspect and delete functions in SQL, plpgsql and pgtcl languages
+<br><b>Reports</b>
+<br>- design and display simple reports from tables
+<br>- fields and labels, font changing, style and size
+<br>- saves and loads report description from database
+<br>- show report previews, sample postscript output file
+<br><b>Forms</b>
+<br>- open user defined forms
+<br>- form design module available
+<br>- query widget available, controls bound to query results
+<br>- <a href="forms.html">click here</a> for a description of forms and
+how they can be used
+<br><b>Scripts</b>
+<br>- define, modify and call user defined scripts
+<br><b>Users</b>
+<br>- define and modify user information
+<p><b><a href="api.html">PgAccess API</a></b> for developing small applications
+<br>&nbsp;
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/formdemo.sql b/src/bin/pgaccess/doc/html/formdemo.sql
new file mode 100644 (file)
index 0000000..73bf1c5
--- /dev/null
@@ -0,0 +1,216 @@
+\connect - teo
+CREATE SEQUENCE "cities_id_seq" start 7 increment 1 maxvalue 2147483647 minvalue 1  cache 1 ;
+SELECT nextval ('cities_id_seq');
+CREATE TABLE "pga_queries" (
+       "queryname" character varying(64),
+       "querytype" character,
+       "querycommand" text,
+       "querytables" text,
+       "querylinks" text,
+       "queryresults" text,
+       "querycomments" text);
+CREATE TABLE "pga_forms" (
+       "formname" character varying(64),
+       "formsource" text);
+CREATE TABLE "pga_scripts" (
+       "scriptname" character varying(64),
+       "scriptsource" text);
+CREATE TABLE "pga_reports" (
+       "reportname" character varying(64),
+       "reportsource" text,
+       "reportbody" text,
+       "reportprocs" text,
+       "reportoptions" text);
+CREATE TABLE "phonebook" (
+       "name" character varying(32),
+       "phone_nr" character varying(16),
+       "city" character varying(32),
+       "company" bool,
+       "continent" character varying(16));
+CREATE TABLE "pga_layout" (
+       "tablename" character varying(64),
+       "nrcols" int2,
+       "colnames" text,
+       "colwidth" text);
+CREATE TABLE "pga_schema" (
+       "schemaname" character varying(64),
+       "schematables" text,
+       "schemalinks" text);
+REVOKE ALL on "pga_schema" from PUBLIC;
+GRANT ALL on "pga_schema" to PUBLIC;
+CREATE TABLE "cities" (
+       "id" int4 DEFAULT nextval('"cities_id_seq"') NOT NULL,
+       "name" character varying(32) NOT NULL,
+       "prefix" character varying(16) NOT NULL);
+CREATE FUNCTION "getcityprefix" (int4 ) RETURNS varchar AS 'select prefix from cities where id = $1 ' LANGUAGE 'SQL';
+COPY "pga_queries" FROM stdin;
+Query that can be saved as view        S       select * from phonebook where continent='usa'           \N      \N      \N      \N
+\.
+COPY "pga_forms" FROM stdin;
+Working with Tables namespace  f3 13 {3 4 5 6 7 9 10 11 12 13} 377x263+59+127 {radio usa {36 24 138 36} {} USA selcont} {radio europe {36 45 141 60} {} Europe selcont} {radio africa {36 66 147 81} {} Africa selcont} {label label6 {9 99 339 114} {} {Select one of the above continents and press} {}} {button button7 {270 93 354 117} {Tables::open phonebook "continent='$selcont'" $selorder} {Show them} {}} {button button9 {66 189 312 213} {Tables::design phonebook} {Show me the phonebook table structure} {}} {button button10 {141 228 240 252} {destroy .f3} {Close the form} {}} {button button11 {93 141 282 165} {Tables::open phonebook "company=true"} {Show me only the companies} {}} {radio name {183 24 261 36} {} {Order by name} selorder} {radio phone_nr {183 45 267 57} {} {Order by phone number} selorder}
+A simple demo form     asdf 14 {FS {set color none}} 370x310+50+75 {label label1 {15 36 99 57} {} {Selected color} {} label1 flat #000000 #d9d9d9 1} {entry entry2 {111 36 225 54} {} entry2 color entry2 sunken #000000 #fefefe 1} {radio red {249 21 342 36} {} {Red as cherry} color red flat #900000 #d9d9d9 1} {radio green {249 45 342 60} {} {Green as a melon} color green flat #008800 #d9d9d9 1} {radio blue {249 69 342 84} {} {Blue as the sky} color blue flat #00008c #d9d9d9 1} {button button6 {45 69 198 99} {set color spooky} {Set a weird color} {} button6 ridge #0000b0 #dfbcdf 2} {label label7 {24 129 149 145} {} {The checkbox's value} {} label7 flat #000000 #d9d9d9 1} {entry entry8 {162 127 172 145} {} entry8 cbvalue entry8 sunken #000000 #fefefe 1} {checkbox checkbox9 {180 126 279 150} {} {Check me :-)} cbvalue checkbox9 flat #000000 #d9d9d9 1} {button button10 {219 273 366 303} {destroy .asdf} {Close that simple form} {} button10 raised #000000 #d9d9d9 1} {button button11 {219 237 366 267} {Forms::open "Phone book"} {Open my phone book} {} button11 raised #000000 #d9d9d9 1} {listbox lb {12 192 162 267} {} listbox12 {} lb sunken #000000 #fefefe 1} {button button13 {12 156 162 186} {.asdf.lb insert end red green blue cyan white navy black purple maroon violet} {Add some information} {} button13 raised #000000 #d9d9d9 1} {button button14 {12 273 162 303} {.asdf.lb delete 0 end} {Clear this listbox} {} button14 raised #000000 #d9d9d9 1}
+Working with listboxes f2 5 {FS {set thestudent ""}} 257x263+139+147 {listbox lb {6 6 246 186} {} listbox1 {} lb sunken #000000 #ffffd4 1} {button button2 {9 234 124 258} {# Populate the listbox with some data\
+#\
+\
+foreach student {John Bill Doe Gigi} {\
+\      .f2.lb insert end $student\
+}\
+\
+\
+\
+# Binding the event left button release to the\
+# list box\
+\
+bind .f2.lb <ButtonRelease-1> {\
+\      set idsel [.f2.lb curselection]\
+\      if {$idsel!=""} {\
+\      \       set thestudent [.f2.lb get $idsel]\
+\      }\
+}\
+\
+# Cleaning the variable thestudent\
+\
+set thestudent {}} {Show students} {} button2 groove #000000 #d9d9d9 2} {button button3 {132 234 247 258} {destroy .f2} {Close the form} {} button3 groove #000000 #d9d9d9 1} {label label4 {9 213 119 228} {} {You have selected} {} label4 flat #000000 #d9d9d9 1} {label label5 {129 213 219 228} {} {} thestudent label5 flat #00009a #d9d9d9 1}
+The simplest form      mf 5 {FS {set thename {}}} 306x136+82+146 {label label {42 45 99 60} {} Name {} label flat #000000 #d9d9d9 1 {Helvetica 12 bold italic}} {entry ename {120 42 219 63} {} entry2 thename ename sunken #000000 #fefefe 1 n} {button button3 {6 96 108 129} {set thename Teo} {Set the name} {} button3 raised #000000 #d9d9d9 1 n} {button button4 {192 96 300 129} {destroy .mf} {Close the form} {} button4 raised #000000 #d9d9d9 1 n} {button button5 {114 96 186 129} {set thename {}} {Clear it} {} button5 raised #000000 #d9d9d9 1 n}
+Full featured form     full 21 {FS {set entrydemo {nice}\
+set color {no color selected}}} 377x418+50+130 {label label1 {3 396 165 411} {} {Status line} {} {} sunken #000000 #d9d9d9 2 n} {label label2 {171 396 369 411} {} {Grooved status line} {} {} groove #000098 #d9d9d9 2 f} {label label3 {108 9 270 31} {} {     Full featured form} {} {} ridge #000000 #d9d9d9 4 {Times 16 bold italic}} {button button4 {15 210 144 243} {.full.lb insert end {it's} a nice demo form} {Java style button} {} {} groove #6161b6 #d9d9d9 2 b} {label label5 {15 42 115 58} {} {Java style label} {} {} flat #6161b6 #d9d9d9 1 b} {entry entry6 {123 39 279 60} {} entry6 entrydemo {} groove #000000 #fefefe 2 {Courier 13}} {listbox lb {12 69 147 201} {} listbox8 {} {} ridge #000000 #ffffc8 2 n} {button button9 {18 264 39 282} {} 1 {} {} flat #000000 #d9d9d9 1 n} {button button10 {48 264 68 282} {} 2 {} {} flat #000000 #d9d9d9 1 n} {button button11 {78 264 234 282} {} {and other hidden buttons} {} {} flat #000000 #d9d9d9 1 n} {text txt {153 69 372 201} {} text12 {} {} sunken #000000 #d4ffff 1 n} {button button13 {150 210 369 243} {.full.txt tag configure bold -font {Helvetica 12 bold}\
+.full.txt tag configure italic -font {Helvetica 12 italic}\
+.full.txt tag configure large -font {Helvetica -14 bold}\
+.full.txt tag configure title -font {Helvetica 12 bold italic} -justify center\
+.full.txt tag configure link -font {Helvetica -12 underline} -foreground #000080\
+.full.txt tag configure code -font {Courier 13}\
+.full.txt tag configure warning -font {Helvetica 12 bold} -foreground #800000\
+\
+# That't the way help files are written\
+\
+.full.txt delete 1.0 end\
+.full.txt insert end {Centered title} {title} "\
+\
+You can make different " {} "portions of text bold" {bold} " or italic " {italic} ".\
+Some parts of them can be written as follows" {} "\
+SELECT * FROM PHONEBOOK" {code} "\
+You can also change " {} "colors for some words " {warning} "or underline them" {link} } {Old style button} {} {} raised #000000 #d9d9d9 2 n} {checkbox checkbox14 {48 297 153 309} {} different {} {} flat #00009c #d9d9d9 1 b} {checkbox checkbox15 {48 321 156 336} {} {fonts and} {} {} flat #cc0000 #d9d9d9 1 i} {checkbox checkbox16 {48 345 156 360} {} colors {} {} flat #00b600 #dfb2df 1 f} {radio radio17 {207 297 330 315} {} {red , rosu , rouge} color red flat #9c0000 #d9d9d9 1 n} {radio radio18 {207 321 324 333} {} {green , verde , vert} color green flat #009000 #d9d9d9 1 n} {radio radio19 {207 345 327 363} {} {blue , albastru, bleu} color blue flat #000000 #d9d9d9 1 n} {label selcolor {210 369 345 384} {} {} color {} flat #000000 #d9d9d9 1 n} {button button21 {285 258 363 285} {destroy .full} Exit {} {} raised #7c0000 #dfdbb8 1 b}
+Phone book     pb 28 {FS {}} 444x307+284+246 {label label1 {33 10 68 28} {} Name {} label1 flat #000000 #d9d9d9 1 n} {entry name_entry {87 9 227 27} {} entry2 DataSet(.pb.qs,name) name_entry sunken #000000 #fefefe 1 n} {label label3 {33 37 73 52} {} Phone {} label3 flat #000000 #d9d9d9 1 n} {entry entry4 {87 36 195 54} {} entry4 DataSet(.pb.qs,phone_nr) entry4 sunken #000000 #fefefe 1 n} {label label5 {33 64 78 82} {} City {} label5 flat #000000 #d9d9d9 1 n} {entry entry6 {87 63 195 81} {} entry6 DataSet(.pb.qs,city) entry6 sunken #000000 #fefefe 1 n} {query qs {3 6 33 33} {} query7 {} qs flat {} {} 1 n} {button button8 {174 177 246 203} {namespace eval DataControl(.pb.qs) {\
+\      setSQL "select oid,* from phonebook where name ~* '$what' order by name"\
+\      open\
+\      set nrecs [getRowCount]\
+\      updateDataSet\
+\      fill .pb.allnames name\
+\      bind .pb.allnames <ButtonRelease-1> {\
+\         set ancr [.pb.allnames curselection]\
+\         if {$ancr!=""} {\
+\      \       DataControl(.pb.qs)::moveTo $ancr\
+\      \       DataControl(.pb.qs)::updateDataSet\
+\         }\
+\      }\
+}} {Start search} {} button8 raised #000000 #d9d9d9 1 n} {button button9 {363 276 433 300} {DataControl(.pb.qs)::close\
+DataControl(.pb.qs)::clearDataSet\
+set nrecs {}\
+set what {}\
+destroy .pb\
+} Exit {} button9 raised #000000 #d9d9d9 2 n} {button button10 {291 237 313 257} {namespace eval DataControl(.pb.qs) {\
+\      moveFirst\
+\      updateDataSet\
+}\
+} |< {} button10 ridge #000092 #d9d9d9 2 n} {button button11 {324 237 346 257} {namespace eval DataControl(.pb.qs) {\
+\      movePrevious\
+\      updateDataSet\
+}\
+} << {} button11 ridge #000000 #d9d9d9 2 n} {button button12 {348 237 370 257} {namespace eval DataControl(.pb.qs) {\
+\      moveNext\
+\      updateDataSet\
+}} >> {} button12 ridge #000000 #d9d9d9 2 n} {button button13 {381 237 403 257} {namespace eval DataControl(.pb.qs) {\
+\      moveLast\
+\      updateDataSet\
+}\
+} >| {} button13 ridge #000088 #d9d9d9 2 n} {checkbox checkbox14 {33 87 126 105} {} {Is it a company ?} DataSet(.pb.qs,company) checkbox14 flat #000000 #d9d9d9 1 n} {radio usa {63 108 201 120} {} U.S.A. DataSet(.pb.qs,continent) usa flat #000000 #d9d9d9 1 n} {radio europe {63 126 204 141} {} Europe DataSet(.pb.qs,continent) europe flat #000000 #d9d9d9 1 n} {radio africa {63 144 210 159} {} Africa DataSet(.pb.qs,continent) africa flat #000000 #d9d9d9 1 n} {entry entry18 {129 180 169 198} {} entry18 what entry18 sunken #000000 #fefefe 1 n} {label label19 {108 219 188 234} {} {records found} {} label19 flat #000000 #d9d9d9 1 n} {label label20 {90 219 105 234} {} { } nrecs label20 flat #000000 #d9d9d9 1 n} {label label21 {3 252 33 267} {} OID= {} label21 flat #000000 #d9d9d9 1 n} {label label22 {39 252 87 267} {} { } pbqs(oid) label22 flat #000000 #d9d9d9 1 n} {button button23 {9 276 79 300} {set oid {}\
+catch {set oid $DataSet(.pb.qs,oid)}\
+if {[string trim $oid]!=""} {\
+   sql_exec noquiet "update phonebook set name='$DataSet(.pb.qs,name)', phone_nr='$DataSet(.pb.qs,phone_nr)',city='$DataSet(.pb.qs,city)',company='$DataSet(.pb.qs,company)',continent='$DataSet(.pb.qs,continent)' where oid=$oid"\
+} else {\
+  tk_messageBox -title Error -message "No record is displayed!"\
+}\
+\
+} Update {} button23 raised #000000 #d9d9d9 1 n} {button button24 {210 276 280 300} {set thisname $DataSet(.pb.qs,name)\
+if {[string trim $thisname] != ""} {\
+\      sql_exec noquiet "insert into phonebook values (\
+\      \       '$DataSet(.pb.qs,name)',\
+\      \       '$DataSet(.pb.qs,phone_nr)',\
+\      \       '$DataSet(.pb.qs,city)',\
+\      \       '$DataSet(.pb.qs,company)',\
+\      \       '$DataSet(.pb.qs,continent)'\
+\      )"\
+\      tk_messageBox -title Information -message "A new record has been added!"\
+} else {\
+\      tk_messageBox -title Error -message "This one doesn't have a name?"\
+}\
+\
+} {Add record} {} button24 raised #000000 #d9d9d9 1 n} {button button25 {141 276 204 300} {DataControl(.pb.qs)::clearDataSet\
+# clearcontrols stillinitialise\
+# incorectly booleans controls to {}\
+# so I force it to 'f' (false)\
+set DataSet(.pb.qs,company) f\
+focus .pb.name_entry} {Clear all} {} button25 raised #000000 #d9d9d9 1 n} {listbox allnames {249 6 435 231} {} listbox26 {} allnames sunken #000000 #fefefe 1 n} {label label27 {33 252 90 267} {} {} DataSet(.pb.qs,oid) label27 flat #000000 #d9d9d9 1 n} {label label28 {3 182 128 197} {} {Find name containing} {} {} flat #000000 #d9d9d9 1 n}
+\.
+COPY "pga_scripts" FROM stdin;
+How are forms keeped inside ?  Tables::open pga_forms\
+\
+\
+\
+
+Opening a table with filters   Tables::open phonebook "name ~* 'e'" "name desc"\
+\
+\
+
+Autoexec       Mainlib::tab_click Forms\
+Forms::open {Full featured form}\
+\
+\
+
+\.
+COPY "pga_reports" FROM stdin;
+My phone book  phonebook       set PgAcVar(report,tablename) "phonebook" ; set PgAcVar(report,y_rpthdr) 21 ; set PgAcVar(report,y_pghdr) 47 ; set PgAcVar(report,y_detail) 66 ; set PgAcVar(report,y_pgfoo) 96 ; set PgAcVar(report,y_rptfoo) 126 ; .pgaw:ReportBuilder.c create text 10 35 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -anchor nw -text {name} -tags {t_l mov ro} ; .pgaw:ReportBuilder.c create text 10 52 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -text {name} -tags {f-name t_f rg_detail mov ro} ; .pgaw:ReportBuilder.c create text 141 36 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -anchor nw -text {city} -tags {t_l mov ro} ; .pgaw:ReportBuilder.c create text 141 51 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -text {city} -tags {f-city t_f rg_detail mov ro} ; .pgaw:ReportBuilder.c create text 231 35 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -anchor nw -text {phone_nr} -tags {t_l mov ro} ; .pgaw:ReportBuilder.c create text 231 51 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -text {phone_nr} -tags {f-phone_nr t_f rg_detail mov ro}  \N      \N
+\.
+COPY "phonebook" FROM stdin;
+FIAT   623463445               t       europe
+Gelu Voican    01-32234        Bucuresti       f       europe
+Radu Vasile    01-5523423      Bucuresti       f       europe
+MUGADUMBU SRL  +92 534662634   Cairo   t       africa
+Jimmy Page     66323452                f       europe
+IBM    623346234       \N      t       usa
+John Doe       +44 35 2993825  Washington      f       usa
+Bill Clinton   +44 35 9283845  New York        f       usa
+Monica Levintchi       +44 38 5234526  Dallas  f       usa
+Bill Gates     +42 64 4523454  Los Angeles     f       usa
+COMPAQ 623462345       \N      t       usa
+SUN    784563253       \N      t       usa
+DIGITAL        922644516       \N      t       usa
+Frank Zappa    6734567 Montreal        f       usa
+Constantin Teodorescu  +40 39 611820   Braila  f       europe
+Ngbendu Wazabanga      34577345                f       africa
+Mugabe Kandalam        7635745         f       africa
+Vasile Lupu    52345623        Bucuresti       f       europe
+Gica Farafrica +42 64 4523454  Los Angeles     f       usa
+Victor Ciorbea 634567  Bucuresti       f       europe
+\.
+COPY "pga_layout" FROM stdin;
+pga_forms      2       formname formsource     82 713
+Usaisti        5       name phone_nr city company continent    150 150 150 150 150
+q1     5       name phone_nr city company continent    150 150 150 150 150
+view_saved_from_that_query     5       name phone_nr city company continent    150 150 150 150 150
+phonebook      5       name phone_nr city company continent    150 105 80 66 104
+Query that can be saved as view        5       name phone_nr city company continent    150 150 150 150 150
+cities 3       id name prefix  150 150 150
+\.
+COPY "pga_schema" FROM stdin;
+Simple schema  cities 10 10 phonebook 201.0 84.0       {cities name phonebook city}
+\.
+COPY "cities" FROM stdin;
+3      Braila  4039
+4      Galati  4036
+5      Dallas  5362
+6      Cairo   9352
+1      Bucuresti       4013
+7      Montreal        5325
+\.
+CREATE UNIQUE INDEX "cities_id_key" on "cities" using btree ( "id" "int4_ops" );
diff --git a/src/bin/pgaccess/doc/html/forms.gif b/src/bin/pgaccess/doc/html/forms.gif
new file mode 100644 (file)
index 0000000..947d920
Binary files /dev/null and b/src/bin/pgaccess/doc/html/forms.gif differ
diff --git a/src/bin/pgaccess/doc/html/forms.html b/src/bin/pgaccess/doc/html/forms.html
new file mode 100644 (file)
index 0000000..57ecff5
--- /dev/null
@@ -0,0 +1,203 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body text="#000000" bgcolor="#FEFEDF" link="#0000EF" vlink="#51188E" alink="#FF0000">
+
+<h1>
+FORMS</h1>
+
+<hr WIDTH="100%">
+<p>This version (0.97) of PgAccess has changed the form API : variable
+handling, query results interface and control bindings naming convention.
+Please read it carefully, download the database demo and practice a while
+before trying to design your own forms.
+<p>For the moment, it has only some basic widgets : labels, entries, buttons
+, listboxes , checkboxes and radiobuttons.
+<p>Also there is a pseudo data control widget that allows you yo have access
+to a query results.
+<p><b>How do you generate widgets :</b>
+<ol>
+<li>
+select a widget from the toolbox by clicking the appropriate radiobutton</li>
+
+<li>
+move to the canvas , point with the mouse at the desired location and click
+the mouse button to begin</li>
+
+<li>
+keeping the mouse-button pressed move the mouse in order to draw a rectangle
+that will hold the widget</li>
+
+<li>
+release the mouse-button</li>
+</ol>
+In the rectangle that you have designed it will appear the selected object.
+<br>Move now to the attribute window to change some of its properties.
+<p>Renaming, resizing items are possible (for the moment) only by modifying
+appropriate parameters in attribute window. You <b>must </b>press Enter
+in the edit field after changing a value in order to be accepted.
+<p>You can also move items by dragging them or delete them by pressing
+Del key after selecting them.
+<p>In attribute window, there are some fields named <b><tt><font size=+1>Command
+</font></tt></b>and
+<b><tt><font size=+1>Variable</font></tt></b>.
+<p>The field <b><tt><font size=+1>Command </font></tt></b>have meaning
+only for Button widgets and holds the command that will be invoked when
+the button is pressed.
+<p>&nbsp;&nbsp;&nbsp; The field <b><tt><font size=+1>Variable </font></tt></b>have
+meaning only for EditField , Label widgets , checkboxes and radiobuttons
+and it is the name of the global variable that will hold the value for
+that widget. For checkboxes the values are <b>t</b> and <b>f</b> (from
+true and false) in order to simplify binding to logical data fields (PgAccess
+0.82 used 0 and 1).
+<p>&nbsp;&nbsp;&nbsp; For radiobuttons, it is usual to assign the same
+variable to the same radiobuttons within the same group. That variable
+will contain the name of the widget of the radiobutton that has been pressed.
+Let's presume that you have entered 3 radiobuttons named red, green and
+blue, all of them having the same variable named color. If you will press
+them, they will assign their names to global variable.
+<p>&nbsp;&nbsp;&nbsp; In order to make a simple test, put an entry field
+and set it's variable to <b>v1</b> and a button who's command is "set v1
+whisky". Press the button "Test form" and click on the button. In that
+entry should appear whisky.
+<br>Another test is defining in Script module a script called "My first
+script" having the following commands:
+<br><tt><font size=+1>tk_messageBox -title Warning -message "This is my
+first message!"</font></tt>
+<br>and then define a button who's command is <b><tt><font size=+1>execute_script
+"My first script"</font></tt></b>.
+<br>&nbsp;
+<h2>
+Database manipulation</h2>
+Let's presume that our form have the internal name <b><tt>mf </tt></b>(<b>m</b>y
+<b>f</b>orm). Don't forget that the Tk window names could not start with
+an uppercase letter.
+<br>The window will be referred inside the Tcl/Tk source as <b><tt>.mf</tt></b>
+<br>If you want to close the form in run-time you have to issue the command
+<b><tt>destroy
+.mf</tt></b>
+<p>Also, any widget created inside this window (form) will have the name
+prefixed by <b><tt>.mf ,</tt></b>so we will have <b><tt>.mf.button1</tt></b>
+or <b><tt>.mf.listbox1</tt></b> .
+<p>We can name the data control widget <b><tt>dc</tt></b> for example.
+The fully qualified name for that "virtual widget" will be <b><tt>.mf.dc</tt></b>
+then. A new namespace called <b><tt>DataControl(.mf.dc)</tt></b> will be
+automatically defined.
+<br>The <b><tt>Command </tt></b>property of the data control widget must
+contain the SQL command that will be executed.
+<br>When the form will be in run-time, automatically you will have access
+to the following procedures and functions from the namespace:
+<p><b><tt>open</tt></b> - opens the connection and execute the query (returns
+nothing)
+<br><b><tt>setSQL newsql</tt></b> - set the command query that will be
+executed at the next <b><tt>open</tt></b>
+<br><b><tt>getRowCount</tt></b> - returns the number of records of the
+result set
+<br><b><tt>getRowIndex </tt></b>- returns the current record number inside
+the result set
+<br><b><tt>getFieldList</tt></b> - returns a Tcl list containing the fields
+names from the current result set
+<br><b><tt>moveFirst</tt></b> - move the cursor to the first record in
+the recordset
+<br><b><tt>moveLast</tt></b><tt> , <b>moveNext</b> , <b>movePrevious</b></tt>-
+moves the cursor there
+<br><b><tt>moveTo newrecno</tt></b> - move the cursor to that new record
+number (first is 0)
+<br><b><tt>updateDataSet</tt></b> - update the variables inside the designed
+form that have a particular name (I'll explain later)
+<br><b><tt>clearDataSet</tt></b> - clear the associated DataSet variables
+<br><tt><b>fill listbox field</b> </tt>- fill the named listbox (whole
+widget name as <b><tt>.mf.listbox1</tt></b>) with the all the values of
+that field from the current result set
+<br><b><tt>close</tt></b> - close the result set (<b><font color="#FF0000">if
+you don't close it, you will loose some memory</font></b>)
+<p>These procedures and functions should be called in the normal Tcl namespace
+mode as in the following example:
+<p><tt>DataControl(.mf.dc)::setSQL "select * from phonebook"</tt>
+<br><tt>DataControl(.mf.dc)::open</tt>
+<br><tt>set nrecs [DataControl(.mf.dc)::getRowCount]</tt>
+<p>If you complaint about writting to many DataControl(...) you can include
+many commands into a single namespace eval as in the following example
+:
+<p><tt>namespace eval DataControl(.mf.dc) {</tt>
+<br><tt>&nbsp;&nbsp;&nbsp; setSQL "select * from phonebook"</tt>
+<br><tt>&nbsp;&nbsp;&nbsp; open</tt>
+<br><tt>&nbsp;&nbsp;&nbsp; set nrecs [getRowCount]</tt>
+<br><tt>&nbsp;&nbsp;&nbsp; moveLast</tt>
+<br><tt>&nbsp;&nbsp;&nbsp; updateDataSet</tt>
+<br><tt>}</tt>
+<p>It's no need to close a query-result set if you want to assign it a
+new SQL command and open it again. That will be done automatically releasing
+the memory used for the last result set.
+<br>Opening a new <b>DataControl</b> will automatically position the current
+row index of the result set on the first row (index 0) and will define
+a new global associative array named <b>DataSet</b> that will hold data
+from the current row. The key into that array will be the fully qualified
+name of the data control widget followed by a comma and the name of every
+field in the selected rows.
+<p><i>Example:</i>
+<br><tt>DataSet(.mf.dc,name)</tt>
+<br><tt>DataSet(.mf.dc,city)</tt>
+<p>If you want to bound some controls to the fields of the recordset, you
+will have to name their associate variable like that :
+<p><b><tt>DataSet(.mf.dc,salary)</tt></b> to get the "salary" field , or
+<b><tt>DataSet(.mf.dc,name)</tt></b> to get the "name" field. Using the
+data control procedures <b><tt>DataControl(.mf.dc)::moveNext</tt></b> or
+movePrevious will automatically update the <b><tt>DataSet(.mf.dc,...)</tt></b>
+array so the database information from entries in the form will be refreshed.
+<br>&nbsp;
+<p>Here it is a dumped <b><a href="formdemo.sql">sample database</a></b>
+that contains a demo database. What should you do ?
+<br>Shift-click the above URL in order to download that tiny file (4 Kb).
+Create a empty database and <b><tt>psql yourdatabase &lt;formdemo.sql</tt></b>
+<p>You should find a single table called "phonebook" a form called "Phone
+book" and another "A simple demo form".
+<p>First of all enter and view the phonebook table in table view. Note
+the fields and their values.
+<br>Open the "Phone book" form and enter a letter (a, e or i) in the field
+to the left of "Find" button then press Find. It's fine to enter one letter
+in order to get more records in query result. You will get information
+about the number of records selected, in the listbox you will see all the
+values of field "name" from the current data set. Use buttons to move to
+first, next, previous or last record within the record set.
+<p>In order to add a new record, press the "New" button in order to get
+new, clean entries. Fill them with your data and press "Add new" button.
+A new phonebook record will be added. Also, if you want to update a record,
+change it's values in the displayed fields after finding it and press "Update"
+button. The values will be updated in the database BUT NOT IN THE CURRENT
+QUERY RESULT . If you want to see them modified, make a new query trying
+to find it again.
+<p><font color="#000080">Before using the results from a query you should
+know that the information that has been retrieved could be found only in
+your computer client memory. It has <b>no live connection</b> to the data
+from the database. That's why it isn't possible to develop a simple update
+function as interface to that query-result widget. More than that : a query
+result could be obtained from a SQL command that return a non-updatable
+data set !!! For example fields gathered from multiple tables or summary
+fields. It isn't just simple to make an automatic update procedure. The
+programmer must know how to make the update or the append procedure, sometimes
+using key fields to point to the desired record or an OID. There are examples
+in the demo database in "Phone book" form. It may be possible that in the
+future, I will develop another pseudo-widget describing a table. It would
+be more simple than to implement an update or append or even a delete procedure.</font>
+<p>There is in the demo database also another simple form called "A simple
+demo form". It will show you how to handle variables from checkboxes, radiobuttons,
+how to use listboxes, open another forms and so on. I think they will help
+you.
+<p>In order to avoid naming user defined forms with&nbsp; a particular
+name of another PgAccess form, I would recommend naming them as udf0, udf1
+(user defined form 0 , 1 )
+<p>
+<hr WIDTH="25%">
+<p>Please feel free to send me your opinion at <b>teo@flex.ro</b> on forms
+designing and usage.
+<p><b><font size=+1>KEEP IN MIND !&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
+THE FORM API MAY CHANGE IN ORDER TO BE MORE SIMPLE AND BETTER!</font></b>
+<br><b><font size=+1>SEND ME YOUR WISHES, YOUR IDEAS, YOUR OPINIONS !</font></b>
+<br><b><font size=+1>ALSO ... DON'T BLAME ME IF YOU WILL HAVE TO RE-DESIGN
+YOUR OLD FORMS DUE TO SOME INCOMPATIBILITIES WITH NEWER PGACCESS VERSIONS.</font></b>
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/function.gif b/src/bin/pgaccess/doc/html/function.gif
new file mode 100644 (file)
index 0000000..51634e5
Binary files /dev/null and b/src/bin/pgaccess/doc/html/function.gif differ
diff --git a/src/bin/pgaccess/doc/html/help.gif b/src/bin/pgaccess/doc/html/help.gif
new file mode 100644 (file)
index 0000000..f08fee8
Binary files /dev/null and b/src/bin/pgaccess/doc/html/help.gif differ
diff --git a/src/bin/pgaccess/doc/html/index.html b/src/bin/pgaccess/doc/html/index.html
new file mode 100644 (file)
index 0000000..7ccda19
--- /dev/null
@@ -0,0 +1,11 @@
+<HTML>
+<HEAD>
+<TITLE>PgAccess</TITLE>
+
+<FRAMESET COLS="200,*" border=0 framespacing=0 frameborder=no>
+       <FRAME NAME="left" scrolling="none" src="contents.html">
+       <FRAME NAME="right" scrolling="nonw" src="main.html">
+</FRAMESET>
+
+</HTML>
+
diff --git a/src/bin/pgaccess/doc/html/irix.html b/src/bin/pgaccess/doc/html/irix.html
new file mode 100644 (file)
index 0000000..b678458
--- /dev/null
@@ -0,0 +1,133 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<HTML>
+<HEAD>
+   <TITLE>PgAccess on Irix</TITLE>
+   <META NAME="GENERATOR" CONTENT="Mozilla/3.04Gold (X11; I; Linux 2.0.33 i586) [Netscape]">
+</HEAD>
+<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000EF" VLINK="#51188E" ALINK="#FF0000">
+
+<H1>INSTALLING PgAccess UNDER IRIX 5.3.
+<HR WIDTH="100%"></H1>
+
+<P><B><FONT COLOR="#000080">This HOWO-TO make PgAccess working under Irix
+is written by Stuart Rison</FONT></B></P>
+
+<P>These are the steps that I had to follow to get pgaccess to run on an
+INDIGO2 running postgreSQL 6.3.2 under IRIX 5.3. I make no guarantee whatsoever
+that the same step will work for others but at least it should point you
+in the right direction. Also, I am a biologist by training so I only got
+pgaccess working by fudging (that is, trial and error) this means that
+some of the steps may be unnecessary (e.g. compiling $postgreSQL_source/src/interfaces/libpgtcl
+as both a shared and static library) and they certainly haven't been optimised
+(I know nothing about compiler switches etc.).</P>
+
+<P><B>1) Requirements:</B></P>
+
+<UL>
+<P>You will need:</P>
+
+<UL>
+<LI>postgreSQL source (http://www.postgresql.org)</LI>
+
+<LI>tcl8.0 source (http://www.tclconsortium.org/)</LI>
+
+<LI>tk8.0 source (http://www.tclconsortium.org/)</LI>
+
+<LI>pgaccess source (http://www.flex.ro/pgaccess)</LI>
+</UL>
+</UL>
+
+<P><B>2) Installation:</B></P>
+
+<P>a) tcl/tk:</P>
+
+<UL>
+<P>You must first install tcl and then tk (in that order). I just used
+./configure, no switches and gmake. Their installation should be trouble
+free. Then you must move headers and libraries to the right places so:</P>
+
+<P>Header files: both tcl and tk have a header file (tcl.h and tk.h). The
+tcl.h file is in $tcl_source_dir/generic and the tk.h file is in $tk_source_dir/generic;
+both should be copied to /usr/local/include.</P>
+
+<P>Libraries: compilation (with cc) of tcl and tk yield libraries libtcl8.0.a
+and libtk8.0.a in $source_dir/unix. Both should be copied to /usr/local/lib.</P>
+</UL>
+
+<P>b) postgreSQL:</P>
+
+<UL>
+<P>Make sure you have a fully patched postgreSQL source. If your ./configure
+says it can't load 'IRIX' settings then you most probably will need to
+patch ./configure.</P>
+
+<P>Configure using ./configure with the following switches: ./configure
+--with-includes=/usr/local/include</P>
+
+<P>--with-libraries=/usr/local/lib --with-tcl [this and previous line as
+one]</P>
+
+<P>Then make, make install as usual</P>
+</UL>
+
+<P>c) Compiling libpgtcl:</P>
+
+<UL>
+<P>The source for libpgtcl is in $postgreSQL_directory/src/interfaces/libpgsql.</P>
+
+<P>I do this twice. Once with just gmake. This produces a static library
+libpgtcl.a which I leave where it is (I don't know what to do with it but
+it may just come in handy). The I modify Makefile manually with a text
+editor. Essentially I modify two line:</P>
+
+<P>before:</P>
+
+<P># Shared library stuff</P>
+
+<P>install-shlib-dep := shlib :=</P>
+
+<P>after:</P>
+
+<P># Shared library stuff</P>
+
+<P>install-shlib-dep := install-shlib shlib := libpgtcl.so.1</P>
+
+<P>Then gmake -f Makefile_modified. This creates two shared (.so) libraries:
+libpgtcl.so and libpgtcl.so.1. I can't tell the difference between them
+so I copied them both to /usr/lib/.</P>
+</UL>
+
+<P>d) running pgaccess:</P>
+
+<UL>
+<P>Uncompress pgaccess (usually with gunzip and tar). So long as 'wish'
+(a binary produced when compiling tk8.0) is somewhere in your path, you
+should be able to run pgaccess with:</P>
+
+<P>wish -f $pgaccess_dir/pgaccess.tcl [postgreSQL_database_name]</P>
+</UL>
+
+<P>e) et voila!</P>
+
+<P><B>3) Concluding remarks:</B></P>
+
+<UL>
+<P>As I stated at the start of this document, following the procedure indicated
+above worked for me. I am sure, however, that a few of the steps are unnecessary/non-optimised/stupid
+etc. If any Unix (IRIX) boffin is reading this and you spot anything you
+would like to comment/correct etc. please e-mail me (stuart@ludwig.ucl.ac.uk).
+Also, if you just have questions and think I might help, please contact
+me at the same e-mail.</P>
+
+<P>Finally, I can accept no responsibility if these steps don't work for
+you or if it all goes horribly wrong and you 'damage' your computer trying
+them. Let common sense prevail!</P>
+</UL>
+
+<P>Good luck</P>
+
+<P>Stuart Rison LICR University College London London W1P 8BT<BR>
+<A HREF="mailto:stuart@ludwig.ucl.ac.uk">stuart@ludwig.ucl.ac.uk</A></P>
+
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/doc/html/linux1.gif b/src/bin/pgaccess/doc/html/linux1.gif
new file mode 100644 (file)
index 0000000..b98ac02
Binary files /dev/null and b/src/bin/pgaccess/doc/html/linux1.gif differ
diff --git a/src/bin/pgaccess/doc/html/maillist.html b/src/bin/pgaccess/doc/html/maillist.html
new file mode 100644 (file)
index 0000000..4e0ce85
--- /dev/null
@@ -0,0 +1,43 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<HTML>
+<HEAD>
+   <TITLE></TITLE>
+   <META NAME="GENERATOR" CONTENT="Mozilla/3.04Gold (X11; I; Linux 2.0.32 i586) [Netscape]">
+</HEAD>
+<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000EF" VLINK="#51188E" ALINK="#FF0000">
+
+<P>The mailing list for PgAccess is : &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<B><TT>pgsql-interfaces@postgresql.org</TT></B></P>
+
+<P>If you have some questions regarding PgAccess you should mail to this
+address. I will also answer to messages addresed directly to me but it
+would be better to post your messages here because it might be possible
+to get an answer quickly from another user of PgAccess.</P>
+
+<P>
+<HR WIDTH="100%"></P>
+
+<P>To subscribe please send a mail message to&nbsp;:</P>
+
+<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<B><TT><FONT SIZE=+1>pgsql-interfaces-request@postgresql.org
+</FONT></TT></B>&nbsp;</P>
+
+<P>having a single line in the body message :&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<B><TT><FONT SIZE=+1>subscribe</FONT></TT></B></P>
+
+<P>In a couple of minutes , if everything is ok, you must receive something
+like that :</P>
+
+<P>
+<HR WIDTH="100%"></P>
+
+<P><TT>Welcome to the pgsql-interfaces mailing list!</TT></P>
+
+<P><TT>Please save this message for future reference. Thank you.</TT></P>
+
+<P><TT>If you ever want to remove yourself from this mailing list, you
+can send mail to &lt;Majordomo@hub.org&gt; with the following command in
+the body of your email message:</TT></P>
+
+<P><TT>unsubscribe pgsql-interfaces yourname@yourdomain</TT></P>
+<TT></TT>
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/doc/html/main.html b/src/bin/pgaccess/doc/html/main.html
new file mode 100644 (file)
index 0000000..2bddfd6
--- /dev/null
@@ -0,0 +1,34 @@
+<!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.61 [en] (X11; I; Linux 2.2.12 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h1>
+PgAccess
+<hr WIDTH="100%"></h1>
+A free graphical database management tool for <a href="http://www.postgresql.org">PostgreSQL</a>.
+PgAccess has been written by <a href="mailto:teo@flex.ro">Constantin Teodorescu</a>
+using Visual Tcl, the best tool for developing Tcl/Tk applications I've
+ever seen.
+<p><b>Last version</b>
+<br>Last stable version is 0.98 , released on 29 August 1999. Read <a href="whatsnew.html">what's
+new</a> in 0.98.
+<p><b>Portability issues</b>
+<br>PgAccess is available for every platform where PostgreSQL was ported
+and where a Tcl/Tk package is available. PgAccess has been reported running
+on :
+<br>- Linux
+<br>- FreeBSD
+<br>- Solaris
+<br>- HPUX
+<br>- Irix
+<br>- Windows 95,98,NT
+<p>PgAccess needs Tcl/Tk versions 8.0.x and higher thought PgAccess. For
+win32 platforms there are some special DLL's that have to be downloaded
+and installed, more information <a href="win32.html">here</a>.
+<p>PgAccess is protected by the following <a href="copyright.html">copyright</a>.
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/mainwindow.gif b/src/bin/pgaccess/doc/html/mainwindow.gif
new file mode 100644 (file)
index 0000000..6a48792
Binary files /dev/null and b/src/bin/pgaccess/doc/html/mainwindow.gif differ
diff --git a/src/bin/pgaccess/doc/html/newtable.gif b/src/bin/pgaccess/doc/html/newtable.gif
new file mode 100644 (file)
index 0000000..891d056
Binary files /dev/null and b/src/bin/pgaccess/doc/html/newtable.gif differ
diff --git a/src/bin/pgaccess/doc/html/newuser.gif b/src/bin/pgaccess/doc/html/newuser.gif
new file mode 100644 (file)
index 0000000..5c56c9a
Binary files /dev/null and b/src/bin/pgaccess/doc/html/newuser.gif differ
diff --git a/src/bin/pgaccess/doc/html/old_index.html b/src/bin/pgaccess/doc/html/old_index.html
new file mode 100644 (file)
index 0000000..4bbf11f
--- /dev/null
@@ -0,0 +1,143 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+   <title>PgAccess - a Tcl/Tk PostgreSQL interface</title>
+</head>
+<body bgcolor="#FFFFFF">
+
+<h1>
+PgAccess - a free database management tool for <a href="http://www.postgreSQL.org">PostgreSQL</a></h1>
+
+<hr>
+<li>
+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
+one (zip file for Windows)</a></li>
+
+<center>
+<p><br>Latest stable version of PgAccess is 0.97 , released 16 August 1999
+!
+<p><font size=+2>PgAccess 0.93 and higher will not work from the beginning
+with PostgreSQL 6.3.x !!</font>
+<br><font size=+2>Read <a href="pg93patch.html">here</a> how to apply a
+simple patch in order to make it work !</font></center>
+<b><font color="#000000"><font size=+2></font></font></b>
+<center><table BORDER=2 NOSAVE >
+<tr NOSAVE>
+<td NOSAVE><b><font color="#FF0000"><font size=+2>NEW</font></font></b></td>
+
+<td NOSAVE><b><font color="#000000"><font size=+2>International version
+(english, french, italian, romanian)</font></font></b></td>
+</tr>
+
+<tr NOSAVE>
+<td NOSAVE><b><font color="#FF0000"><font size=+2>NEW</font></font></b></td>
+
+<td><b><font size=+2>Context sensitive Help</font></b></td>
+</tr>
+</table></center>
+
+<center>
+<p>Precompiled libpgtcl and libpq binaries and dll's for i386 are <a href="ftp://ftp.flex.ro/pub/pgaccess">here
+</a>!!!</center>
+
+<h3>
+<font color="#000080">Installation problems</font></h3>
+
+<ul>
+<li>
+Some problems related with locale special characters could be solved by
+this <a href="specialchars.html">simple patch</a></li>
+
+<li>
+I think that there were some problems loading libpgtcl library. I invite
+you to read a <a href="index.html#libpgtcl">special section concerning
+libpgtcl</a></li>
+
+<li>
+For Silicon Graphics Indigo computers, Irix operating system, there is
+a <a href="irix.html">HOWTO make PgAccess to work</a></li>
+</ul>
+
+<h3>
+<font color="#191970">What does PgAccess now!</font></h3>
+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)
+view </a>, <a href="pic-pga-3.gif">visual query builder </a>.
+<p><b>Tables</b>
+<br>- opening multiple tables for viewing, max. n records (changed by preferences
+menu)
+<br>- column resizing, dragging the vertical grid line (better in table
+space rather than in the table header)
+<br>- text wrap in cells - layout saved for every table
+<br>- import/export to external files (SDF,CSV)
+<br>- filter capabilities (enter filter like (price>3.14)
+<br>- sort order capabilities (enter manually the sort field(s))
+<br>- editing in place
+<br>- improved table generator assistant
+<br>- improved field editing
+<br><b>Queries</b>
+<br>- define , edit and stores "user defined queries"
+<br>- store queries as views
+<br>- execution of queries with optional user input parameters ( select
+* from invoices where year=[parameter "Year of selection"] )
+<br>- viewing of select type queries result
+<br>- query deleting and renaming
+<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
+see it at work <a href="qbtclet.html">clicking here</a>
+<br><b>Sequences</b>
+<br>- defines sequences, delete them and inspect them
+<br><b>Functions</b>
+<br>- define, inspect and delete functions in SQL, plpgsql and pgtcl languages
+<br><b>Reports</b>
+<br>- design and display simple reports from tables
+<br>- fields and labels, font changing, style and size
+<br>- saves and loads report description from database
+<br>- show report previews, sample postscript output file
+<br><b>Forms</b>
+<br>- open user defined forms
+<br>- form design module available
+<br>- query widget available, controls bound to query results
+<br>- <a href="forms.html">click here</a> for a description of forms and
+how they can be used
+<br><b>Scripts</b>
+<br>- define, modify and call user defined scripts
+<br><b>Users</b>
+<br>- define and modify user information
+<p>Here is <a href="pga-rad.html">a special section concerning forms and
+scripts</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
+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
+you will find how to subscribe to this mailing list</a>.
+<p>
+<hr>
+<h1>
+More information about libpgtcl - downloads</h1>
+&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
+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.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 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.
+<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
+not with wish, but with pgwish (or wishpg) that wish that was linked with
+libpgtcl library! I do not recommend this one.
+<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.
+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.
+<p>&nbsp;&nbsp;&nbsp; PostgreSQL 6.4 release has a minor bug. I does not
+include 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
+and then make clean and make again. The new libpgtcl.so library is properly
+configured to run pgaccess.
+<br>&nbsp;
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/permissions.gif b/src/bin/pgaccess/doc/html/permissions.gif
new file mode 100644 (file)
index 0000000..06c4349
Binary files /dev/null and b/src/bin/pgaccess/doc/html/permissions.gif differ
diff --git a/src/bin/pgaccess/doc/html/pg93patch.html b/src/bin/pgaccess/doc/html/pg93patch.html
new file mode 100644 (file)
index 0000000..4c77bfa
--- /dev/null
@@ -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>
diff --git a/src/bin/pgaccess/doc/html/pga-rad.html b/src/bin/pgaccess/doc/html/pga-rad.html
new file mode 100644 (file)
index 0000000..7564cf7
--- /dev/null
@@ -0,0 +1,65 @@
+<HTML>
+<HEAD>
+   <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+   <META NAME="GENERATOR" CONTENT="Mozilla/4.04 [en] (X11; I; Linux 2.0.32 i586) [Netscape]">
+</HEAD>
+<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000EF" VLINK="#51188E" ALINK="#FF0000">
+
+<H1>
+PgAccess - Scripts and Forms&nbsp;
+<HR WIDTH="100%"></H1>
+Beginning with 0.70 version, I have introduced in PgAccess two new modules
+for operating with scripts and forms.
+
+<P>&nbsp;&nbsp; This would give to PgAccess the power of creating application
+directly into PgAccess, defining new modules, procedures, forms and possibly
+making it a rapid development tool for PostgreSQL. The "scripts" and "forms"
+modules are using two new tables called pga_forms and pga_scripts. PgAccess
+take care of creating them if user is opening a new database and grant
+ALL permissions on them to PUBLIC.
+<BR>&nbsp;
+<BR>&nbsp;&nbsp; Of course, when Designing a script, a simple text editor
+is opened and text is saved as is in pga_scripts table. When "designing"
+a form, a "form editor" that would be very similar with "Visual Tcl" is
+invoked.
+
+<P>&nbsp;&nbsp; This mechanism and the extremely versatile scripting mode
+of Tcl/Tk would give PgAccess a great power for creating end user application
+using PostgreSQL. The most important thing is that the user could call
+procedures and functions that I have used for building up PgAccess !
+<H3>
+Forms</H3>
+&nbsp;&nbsp; Forms are used for creating windows and placing widgets inside
+it. When PgAccess interpret them, a new window appear, with buttons as
+defined that could call "user defined scripts", "user defined procedures"
+or "internal PgAccess procedures".
+<BR>&nbsp;&nbsp; Forms can hold all the widgets allowed in Tcl/Tk , buttons,
+check-boxes, radio-buttons, list-boxes, frames, canvases, etc. With these
+forms, you can control your application so PgAccess would become just a
+"shell", a startup point for you applications. See the&nbsp; <A HREF="forms.html">special
+section concerning forms.</A>
+<H3>
+Scripts</H3>
+&nbsp;&nbsp; Scripts are normal Tcl/Tk code that is interpreted by Tcl/Tk.
+You can define your own procedures inside a script called "Library" for
+example. You can call your procedures from within another script, from
+another procedure.
+<BR>&nbsp;&nbsp; The most important thing is that you have total access
+to the PgAccess core of functions and procedures used by me in building
+PgAccess as an application. Just write <B><TT><FONT COLOR="#000080">open_table
+"Your sample table"</FONT></TT></B> and you'll see the result.
+<BR>&nbsp;&nbsp; If you are writing a script called "Autoexec" then it
+will be executed every time the database is opened. You can put inside
+different commands that you want to be executed such as : running scripts
+that would define your own procedures such as <B><TT><FONT COLOR="#000080">execute_script
+"My own procedure library"</FONT></TT></B> or open a form with <B><TT><FONT COLOR="#000080">open_form
+"Main window with menu buttons"</FONT></TT></B> , and so on.
+
+<P>
+<HR WIDTH="100%">
+<BR>Remember : I'm waiting your messages at <A HREF="mailto:teo@flex.ro">teo@flex.ro</A>
+
+<P>
+<HR WIDTH="50%">
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/doc/html/qbtclet.html b/src/bin/pgaccess/doc/html/qbtclet.html
new file mode 100644 (file)
index 0000000..b990c0f
--- /dev/null
@@ -0,0 +1,45 @@
+<html>
+
+<title> Visual Query Builder in Tcl/Tk </title>
+<body bgcolor=white>
+<h1> Visual Query Builder</h1>
+<hr>
+This visual query builder is included in <a href='http://www.flex.ro/pgaccess'>
+PgAccess</a>, a visual interface to 
+<a href='http://www.postgreSQL.org'> PostgreSQL</a> written entirely in 
+vTcl , (Visual Tcl).
+
+
+<p align="center">
+
+<embed src="qbtclet.tcl"  width=590 height=485>
+
+</p>
+
+<br>
+
+
+Visual Query Designer demo<br>
+Click <a href='qbtclet.tar.gz'>here</a> to download the source </a>
+created by Constantin Teodorescu with vTcl (visual Tcl), teo@flex.ro
+<hr>
+Facitilies<br>
+ - drag and drop selection of fields<br>
+ - drag and drop fields from a table to another do create links<br>
+ - move table position by dragging<br>
+ - point and click any link or table then press delete to delete them<br>
+ - modify sort order by clicking on (unsorted)<br>
+ - enter filter conditions as criteria (>2000 , ='item')<br>
+ - easy panning of table and result panels<br>
+ - show SQL command<br>
+<br>
+If you want to use it for your database, modify ql_read_struct in order to read
+ your table structure.
+<br>
+Feel free to use, modify or copy this software for non-commercial purposes.<br>
+In any other case, please contact me.
+<br>
+FLEX Consulting Braila, ROMANIA is able to deliver high end interfaces 
+and any other commercial products written in Tcl/Tk just like that you have seen.
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/qbtclet.tcl b/src/bin/pgaccess/doc/html/qbtclet.tcl
new file mode 100644 (file)
index 0000000..9d086a3
--- /dev/null
@@ -0,0 +1,529 @@
+#################################
+# GLOBAL VARIABLES
+#
+global qlvar; 
+global widget; 
+
+#################################
+# USER DEFINED PROCEDURES
+#
+proc init {argc argv} {
+global qlvar
+set qlvar(yoffs) 360
+set qlvar(xoffs) 50
+set qlvar(reswidth) 150
+}
+
+init $argc $argv
+
+proc main {argc argv} {
+
+}
+
+proc show_message {usrmsg} {
+global msg
+set msg $usrmsg
+after 2000 {set msg {}}
+}
+
+proc ql_delete_object {} {
+global qlvar
+# Checking if there 
+set obj [.c find withtag hili]
+if {$obj==""} return
+if {[ql_get_tag_info $obj link]=="s"} {
+#    if {[tk_messageBox -title WARNING -icon question -message "Remove link ?" -type yesno -default no]=="no"} return
+       show_message "Deleting the link from tables ..."
+    set linkid [ql_get_tag_info $obj lkid]
+    set qlvar(links) [lreplace $qlvar(links) $linkid $linkid]
+    .c delete links
+    ql_draw_links
+} else {
+    set tablename [ql_get_tag_info $obj tab]
+    if {$tablename==""} return
+#    if {[tk_messageBox -title WARNING -icon question -message "Remove table $tablename from query ?" -type yesno -default no]=="no"} return
+       show_message "Deleting table from query ..."
+    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(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 {($tablename==[lindex $thelink 0]) || ($tablename==[lindex $thelink 2])} {
+            set qlvar(links) [lreplace $qlvar(links) $i $i]
+        }
+    }
+    .c delete tab$tablename
+    .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 [.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
+}
+. configure -cursor hand1
+.c raise $draginfo(obj)
+set draginfo(table) 0
+if {[ql_get_tag_info $draginfo(obj) table]=="header"} {
+    set draginfo(is_a_table) 1
+    .c itemconfigure [.c find withtag hili] -fill black
+    .c dtag [.c find withtag hili] hili
+    .c addtag hili withtag $draginfo(obj)
+    .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
+. configure -cursor top_left_arrow
+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
+.c lower $draginfo(obj)
+.c lower rect
+.c lower links
+set qlvar(panstarted) 0
+if {$draginfo(is_a_table)} {
+    set draginfo(obj) {}
+    .c delete links
+    ql_draw_links
+    return
+}
+.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 [.c bbox resmarker] 0]-$qlvar(xoffs)]
+    set newfld [.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]
+    ql_draw_res_panel    
+} else {
+    # Drop position : in the table panel
+    set droptarget [.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
+.c delete links
+set i 0
+foreach link $qlvar(links) {
+    # Compute the source and destination right edge
+    set sre [lindex [.c bbox tab[lindex $link 0]] 2]
+    set dre [lindex [.c bbox tab[lindex $link 2]] 2]
+    # Compute field bound boxes
+    set sbbox [.c bbox [lindex $link 4]]
+    set dbbox [.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]
+        .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]
+        .c create line [expr $x2-10] $y2 $x2 $y2 -tags {links} -width 3
+        .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]
+        .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]
+        .c create line $x2 $y2 [expr $x2+10] $y2 -width 3 -tags [subst {links lkid$i}]
+        .c create line [expr $x1-10] $y1 [expr $x2+10] $y2 -tags [subst {links lkid$i}] -width 2
+    }
+    incr i
+}
+.c lower links
+.c bind links <Button-1> {ql_link_click %x %y}
+}
+
+proc ql_draw_lizzard {} {
+global qlvar
+ql_read_struct
+.c delete all
+set posx 20
+for {set it 0} {$it<$qlvar(ntables)} {incr it} {
+    ql_draw_table $it
+#    set posy 10
+#    set tablename $qlvar(tablename$it)
+#    .c create text $posx $posy -text $tablename -anchor nw -tags [subst {tab$tablename f-oid mov tableheader}] -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
+#    incr posy 16
+#    foreach fld $qlvar(tablestruct$it) {
+#        .c create text $posx $posy -text $fld -anchor nw -tags [subst {f-$fld tab$tablename mov}] -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+#        incr posy 14
+#    }
+#    set reg [.c bbox tab$tablename]
+#    .c create rectangle [lindex $reg 0] [lindex $reg 1] [lindex $reg 2] [lindex $reg 3] -fill #EEEEEE -tags [subst {rect tab$tablename}]
+#    .c create line [lindex $reg 0] [expr [lindex $reg 1]+15] [lindex $reg 2] [expr [lindex $reg 1]+15] -tags [subst {rect tab$tablename}]
+#    set posx [expr $posx+40+[lindex $reg 2]-[lindex $reg 0]]
+}
+.c lower rect
+.c create line 0 $qlvar(yoffs) 10000 $qlvar(yoffs) -width 3
+.c create rectangle 0 $qlvar(yoffs) 10000 5000 -fill #FFFFFF
+for {set i [expr 15+$qlvar(yoffs)]} {$i<500} {incr i 15} {
+    .c create line $qlvar(xoffs) $i 10000 $i -fill #CCCCCC -tags {resgrid}
+}    
+for {set i $qlvar(xoffs)} {$i<10000} {incr i $qlvar(reswidth)} {
+    .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)
+.c create line $qlvar(xoffs) $qlvar(yoffs) $qlvar(xoffs) 500 -tags {resmarker resgrid}
+.c create rectangle 0 $qlvar(yoffs) $qlvar(xoffs) 5000 -fill #EEEEEE -tags {reshdr}
+.c create text 5 [expr 1+$qlvar(yoffs)] -text Field: -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags {reshdr}
+.c create text 5 [expr 16+$qlvar(yoffs)] -text Table: -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags {reshdr}
+.c create text 5 [expr 31+$qlvar(yoffs)] -text Sort: -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags {reshdr}
+.c create text 5 [expr 46+$qlvar(yoffs)] -text Criteria: -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags {reshdr}
+.c bind mov <Button-1> {ql_dragstart %W %x %y}
+.c bind mov <B1-Motion> {ql_dragit %W %x %y}
+bind . <ButtonRelease-1> {ql_dragstop %x %y}
+bind . <Button-1> {qlc_click %x %y %W}
+bind . <B1-Motion> {ql_pan %x %y}
+bind . <Key-Delete> {ql_delete_object}
+set qlvar(resfields) {}
+set qlvar(ressort) {}
+set qlvar(rescriteria) {}
+set qlvar(restables) {}
+set qlvar(critedit) 0
+set qlvar(links) {}
+set qlvar(linktodelete) {}
+}
+
+proc ql_draw_res_panel {} {
+global qlvar
+# Compute the offset of the result panel due to panning
+set resoffset [expr [lindex [.c bbox resmarker] 0]-$qlvar(xoffs)]
+    .c delete resp
+    for {set i 0} {$i<[llength $qlvar(resfields)]} {incr i} {
+        .c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)] [expr 1+$qlvar(yoffs)] -text [lindex $qlvar(resfields) $i] -anchor nw -fill navy -tags {resf resp} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+        .c create text [expr $resoffset+4+$qlvar(xoffs)+$i*$qlvar(reswidth)] [expr 16+$qlvar(yoffs)] -text [lindex $qlvar(restables) $i] -anchor nw -tags {resp rest} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+        .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 -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+        if {[lindex $qlvar(rescriteria) $i]!=""} {
+            .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 -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*  -tags [subst {resp cr-c$i-r0}]
+        }
+    }
+    .c raise reshdr
+    .c bind sort <Button-1> {ql_swap_sort %W %x %y}
+}
+
+proc ql_draw_table {it} {
+global qlvar
+
+set posy 10
+set allbox [.c bbox rect]
+if {$allbox==""} {set posx 10} else {set posx [expr 20+[lindex $allbox 2]]}
+set tablename $qlvar(tablename$it)
+.c create text $posx $posy -text $tablename -anchor nw -tags [subst {tab$tablename f-oid mov tableheader}] -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
+incr posy 16
+foreach fld $qlvar(tablestruct$it) {
+   .c create text $posx $posy -text $fld -anchor nw -tags [subst {f-$fld tab$tablename mov}] -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+   incr posy 14
+}
+set reg [.c bbox tab$tablename]
+.c create rectangle [lindex $reg 0] [lindex $reg 1] [lindex $reg 2] [lindex $reg 3] -fill #EEEEEE -tags [subst {rect tab$tablename}]
+.c create line [lindex $reg 0] [expr [lindex $reg 1]+15] [lindex $reg 2] [expr [lindex $reg 1]+15] -tags [subst {rect tab$tablename}]
+}
+
+proc ql_get_tag_info {obj prefix} {
+set taglist [.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_link_click {x y} {
+global qlvar
+
+set obj [.c find closest $x $y 1 links]
+if {[ql_get_tag_info $obj link]!="s"} return
+.c itemconfigure [.c find withtag hili] -fill black
+.c dtag [.c find withtag hili] hili
+.c addtag hili withtag $obj
+.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"} {
+    .c move mov $dx $dy
+    .c move links $dx $dy
+    .c move rect $dx $dy
+} else {
+    .c move resp $dx 0
+    .c move resgrid $dx 0
+    .c raise reshdr
+}
+}
+
+proc ql_read_struct {} {
+global qlvar
+
+set qlvar(ntables) 3
+set qlvar(tablename0) Facturi
+set qlvar(tablename1) Nommat
+set qlvar(tablename2) Incasari
+set qlvar(tablestruct0) [list factura client valoare tva]
+set qlvar(tablestruct1) [list cod denumire pret greutate procent_tva]
+set qlvar(tablestruct2) [list data valoare nrdoc referinta]
+}
+
+proc ql_show_sql {} {
+global qlvar
+
+set sqlcmd "select "
+for {set i 0} {$i<[llength $qlvar(resfields)]} {incr 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} {
+    lappend tables $qlvar(tablename$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 range $sup1 0 4]=="where"} {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(resfields) $i] $how "
+    }
+}
+set sqlcmd "$sqlcmd $sup2"
+set qlvar(sql) $sqlcmd
+#tk_messageBox -message $sqlcmd
+.c delete sqlpage
+.c create rectangle 0 0 2000 [expr $qlvar(yoffs)-1] -fill #ffffff -tags {sqlpage}
+.c create text 10 10 -text $sqlcmd -anchor nw -width 550 -tags {sqlpage} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+.c bind sqlpage <Button-1> {.c delete sqlpage}
+}
+
+proc ql_swap_sort {w x y} {
+global qlvar
+set obj [$w find closest $x $y]
+set taglist [.c gettags $obj]
+if {[lsearch $taglist sort]==-1} return
+set cum [.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]
+.c itemconfigure $obj -text $cum
+}
+
+proc qlc_click {x y w} {
+global qlvar
+set qlvar(panstarted) 0
+if {$w==".c"} {
+    set canpan 1
+    if {$y<$qlvar(yoffs)} {
+        if {[llength [.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
+            set qlvar(panobject) tables
+    } else {
+        set qlvar(panobject) result
+    }
+    if {$canpan} {
+        . 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 [.c bbox resmarker] 0]-$qlvar(xoffs)]
+if {$isedit} {
+    set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $qlvar(critcol) $qlvar(critcol) $qlvar(critval)]
+    .c delete cr-c$qlvar(critcol)-r$qlvar(critrow)
+    .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 -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags [subst {resp cr-c$qlvar(critcol)-r$qlvar(critrow)}]
+    set qlvar(critedit) 0
+}
+catch {destroy .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 .entc -textvar qlvar(critval) -borderwidth 0 -background #FFFFFF -highlightthickness 0 -selectborderwidth 0  -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+place .entc -x $nx -y $ny -height 14
+focus .entc
+bind .entc <Button-1> {set qlvar(panstarted) 0}
+set qlvar(critcol) $col
+set qlvar(critrow) 0
+set qlvar(critedit) 1
+}
+
+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} }
+    }
+}
+
+
+       set base ""
+    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 
+    label $base.msg -textvar msg -borderwidth 1 -relief sunken
+    button $base.b2 \
+        -borderwidth 1 -command ql_draw_lizzard \
+        -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+        -pady 3 -text {Paint demo tables} 
+    button $base.showbtn \
+        -borderwidth 1 -command ql_show_sql \
+        -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+        -pady 3 -text {Show SQL} 
+    ###################
+    # SETTING GEOMETRY
+    ###################
+    place $base.c \
+        -x 5 -y 30 -width 578 -height 425 -anchor nw -bordermode ignore 
+    place $base.b2 \
+        -x 5 -y 5 -height 26 -anchor nw -bordermode ignore 
+    place $base.showbtn \
+        -x 130 -y 5 -height 26 -anchor nw -bordermode ignore 
+       place $base.msg \
+               -x 5 -y 460 -width 578 -anchor nw
+
+main $argc $argv
diff --git a/src/bin/pgaccess/doc/html/screenshots.html b/src/bin/pgaccess/doc/html/screenshots.html
new file mode 100644 (file)
index 0000000..0cf3ac6
--- /dev/null
@@ -0,0 +1,43 @@
+<!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.61 [en] (X11; I; Linux 2.2.12 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h3>
+Image gallery
+<hr WIDTH="100%"></h3>
+
+<ul>
+<li>
+&nbsp;<a href="mainwindow.gif">Main window</a> 9 Kb</li>
+
+<li>
+&nbsp;<a href="newtable.gif">Creating a new table</a> 9 Kb</li>
+
+<li>
+&nbsp;<a href="permissions.gif">Table access control</a> 10 Kb</li>
+
+<li>
+&nbsp;<a href="addindex.gif">Adding a new index</a> 12 Kb</li>
+
+<li>
+&nbsp;<a href="vdesigner.gif">The visual query designer</a> 16 Kb</li>
+
+<li>
+&nbsp;<a href="function.gif">Working with functions</a> 10 Kb</li>
+
+<li>
+&nbsp;<a href="forms.gif">Form designer</a> 19 Kb</li>
+
+<li>
+&nbsp;<a href="newuser.gif">User management</a> 4 Kb</li>
+
+<li>
+&nbsp;<a href="help.gif">Help</a> 7 Kb</li>
+</ul>
+
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/specialchars.html b/src/bin/pgaccess/doc/html/specialchars.html
new file mode 100644 (file)
index 0000000..b6b82f2
--- /dev/null
@@ -0,0 +1,47 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<HTML>
+<HEAD>
+   <TITLE>Special locale characters</TITLE>
+   <META NAME="GENERATOR" CONTENT="Mozilla/3.04Gold (X11; I; Linux 2.0.32 i586) [Netscape]">
+</HEAD>
+<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000EF" VLINK="#51188E" ALINK="#FF0000">
+
+<H1>Special locale characters and PgAccess 
+<HR WIDTH="100%"></H1>
+
+<P>The problem is related with some special characters used in different
+countries because PgAccess did not use fonts with `-ISO8859-1' encoding
+-- </P>
+
+<P>The sollution was proposed by H.P.Heidinger ( hph@hphbbs.ruhr.de) and
+it's very simple.</P>
+
+<P>If you look into PgAccess, you will find fonts declared as follows :</P>
+
+<P><TT>$ grep -e '-font' -i pgaccess.tcl<BR>
+-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \<BR>
+-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \<BR>
+-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \<BR>
+-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \</TT></P>
+
+<P>It should be something like: -adobe-helvetica-medium-r-normal-*-*-120-*-*-*-*-iso8859-1</P>
+
+<P>You can achieve this by running the following script :</P>
+
+<P><TT>#!/bin/sh<BR>
+cp pgaccess.tcl pgaccess.tcl-org<BR>
+cat pgaccess.tcl |\<BR>
+sed -e's/\-\*\-\*\ /\-iso8859\-1\ /g' |\<BR>
+sed -e's/\-\*\-\*\}/\-iso8859\-1}/g' |\<BR>
+sed -e's/\-\*\-\*\]/\-iso8859\-1]/g' |\<BR>
+sed -e's/\-\*\-\*$/\-iso8859\-1/g' |\<BR>
+sed -e's/\-Clean\-/\-Fixed\-/g' |\<BR>
+sed -e's/clean/fixed/g' &gt;pgaccess.iso<BR>
+mv pgaccess.iso pgaccess.tcl<BR>
+chmod +x pgaccess.tcl</TT></P>
+
+<P>The final version of PgAccess (1.0) will let the user decide what fonts
+will be used through a &quot;preferences&quot; dialog window.</P>
+
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/doc/html/todo.html b/src/bin/pgaccess/doc/html/todo.html
new file mode 100644 (file)
index 0000000..f19b61a
--- /dev/null
@@ -0,0 +1,11 @@
+<html>
+<body bgcolor="#FEFEDF">
+<h2>ToDo List</h2><hr>
+ - Finish the report generator module<br>
+ - Enhance the form designer<br>
+ - Enhance the scripts module<br>
+ - Translations in other languages<br>
+<br>
+Please send any suggestions by mail to <a href="mailto:teo@flex.ro">Constantin Teodorescu</a>. 
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/vdesigner.gif b/src/bin/pgaccess/doc/html/vdesigner.gif
new file mode 100644 (file)
index 0000000..71349e6
Binary files /dev/null and b/src/bin/pgaccess/doc/html/vdesigner.gif differ
diff --git a/src/bin/pgaccess/doc/html/whatsnew.html b/src/bin/pgaccess/doc/html/whatsnew.html
new file mode 100644 (file)
index 0000000..f2faede
--- /dev/null
@@ -0,0 +1,50 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+<b>29 August 1999</b> - PgAccess 0.98 has been released!
+<ul>
+<li>
+international version (romanian, french, italian translations available)
+in separate files (japanese translation now possible)</li>
+
+<li>
+context sensitive help, complete help for SQL commands</li>
+
+<li>
+geometry changes for many forms</li>
+
+<li>
+form designer enhancements (widget icons , new attribute window style,
+form startup script)</li>
+
+<li>
+ability to inspect PostgreSQL system tables (preferences)</li>
+
+<li>
+enhanced table design window, table permissions</li>
+
+<li>
+distribution archive changes</li>
+
+<li>
+unified internal global variables</li>
+
+<li>
+unified internal window naming conventions</li>
+
+<li>
+usage of Tcl namespaces for all modules</li>
+
+<li>
+PgAccess developer <a href="api.html">API</a></li>
+
+<li>
+web site enhancements</li>
+</ul>
+
+</body>
+</html>
diff --git a/src/bin/pgaccess/doc/html/win32.html b/src/bin/pgaccess/doc/html/win32.html
new file mode 100644 (file)
index 0000000..368eb99
--- /dev/null
@@ -0,0 +1,45 @@
+<!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.61 [en] (X11; I; Linux 2.2.11 i586) [Netscape]">
+</head>
+<body bgcolor="#FEFEDF">
+
+<h2>
+PgAccess on Win32</h2>
+
+<hr>In order to run PgAccess on a Win32 workstation you should follow the
+following steps:
+<ol>
+<li>
+download and install a Tcl/Tk package from <a href="http://www.scriptics.com">Scriptics</a>
+(8.0.x or 8.1.x)</li>
+
+<li>
+install PgAccess package</li>
+
+<li>
+check the Tcl/Tk version that you have</li>
+
+<li>
+check the PostgreSQL version installed on your database server machine</li>
+
+<li>
+get from win32/dll directory the appropriate libraries suitable for your
+Tcl/Tk version and PostgreSQL version and copy them into your Windows/System
+directory renaming them as libpq.dll and libpgtcl.dll</li>
+
+<li>
+check if your win32 workstation is able to see your database server (ping
+yourdatabaseserver)</li>
+
+<li>
+ask your database administrator to verify if your win32 workstation has
+access rights to the database (pg_hba.conf)</li>
+</ol>
+
+<p><br>You should be able to run PgAccess.
+<br>&nbsp;
+</body>
+</html>
diff --git a/src/bin/pgaccess/lib/database.tcl b/src/bin/pgaccess/lib/database.tcl
new file mode 100644 (file)
index 0000000..828baf0
--- /dev/null
@@ -0,0 +1,61 @@
+namespace eval Database {
+
+proc {getTablesList} {} {
+global CurrentDB PgAcVar
+       set tlist {}
+       if {[catch {
+               wpg_select $CurrentDB "select c.relname,count(c.relname) from pg_class C, pg_rewrite R where (r.ev_class = C.oid) and (r.ev_type = '1') group by relname" rec {
+                       if {$rec(count)!=0} {
+                               set itsaview($rec(relname)) 1
+                       }
+               }
+               if {! $PgAcVar(pref,systemtables)} {
+                       wpg_select $CurrentDB "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 tlist $rec(relname)
+                                       }
+                               }
+                       }
+               } else {
+                       wpg_select $CurrentDB "select relname from pg_class where (relkind='r') order by relname" rec {
+                               if {![info exists itsaview($rec(relname))]} {
+                                       lappend tlist $rec(relname)
+                               }
+                       }
+               }
+       } gterrmsg]} {
+               showError $gterrmsg
+       }
+       return $tlist
+}
+
+
+proc {vacuum} {} {
+global PgAcVar CurrentDB
+       if {$CurrentDB==""} return;
+       set PgAcVar(statusline,dbname) [format [intlmsg "vacuuming database %s ..."] $PgAcVar(currentdb,dbname)]
+       setCursor CLOCK
+       set pgres [wpg_exec $CurrentDB "vacuum;"]
+       catch {pg_result $pgres -clear}
+       setCursor DEFAULT
+       set PgAcVar(statusline,dbname) $PgAcVar(currentdb,dbname)
+}
+
+
+proc {getPgType} {oid} {
+global CurrentDB
+       set temp "unknown"
+       wpg_select $CurrentDB "select typname from pg_type where oid=$oid" rec {
+               set temp $rec(typname)
+       }
+       return $temp
+}
+
+
+proc {executeUpdate} {sqlcmd} {
+global CurrentDB
+       return [sql_exec noquiet $sqlcmd]
+}
+
+}
diff --git a/src/bin/pgaccess/lib/forms.tcl b/src/bin/pgaccess/lib/forms.tcl
new file mode 100644 (file)
index 0000000..631c353
--- /dev/null
@@ -0,0 +1,1263 @@
+namespace eval Forms {
+
+proc {new} {} {
+global PgAcVar
+       Window show .pgaw:FormDesign:menu
+       tkwait visibility .pgaw:FormDesign:menu
+       Window show .pgaw:FormDesign:toolbar
+       tkwait visibility .pgaw:FormDesign:toolbar
+       Window show .pgaw:FormDesign:attributes
+       tkwait visibility .pgaw:FormDesign:attributes
+       Window show .pgaw:FormDesign:draft
+       design:init
+}
+
+
+proc {open} {formname} {
+        forms:load $formname run
+        design:run
+}
+
+proc {design} {formname} {
+       forms:load $formname design
+}
+
+
+proc {design:change_coords} {} {
+global PgAcVar
+       set PgAcVar(fdvar,dirty) 1
+       set i $PgAcVar(fdvar,attributeFrame)
+       if {$i == 0} {
+               # it's the form
+               set errmsg ""
+               if {[catch {wm geometry .pgaw:FormDesign:draft $PgAcVar(fdvar,c_width)x$PgAcVar(fdvar,c_height)+$PgAcVar(fdvar,c_left)+$PgAcVar(fdvar,c_top)} errmsg] != 0} {
+                       showError $errmsg
+               }
+               return
+       }               
+       set c [list $PgAcVar(fdvar,c_left) $PgAcVar(fdvar,c_top) [expr $PgAcVar(fdvar,c_left)+$PgAcVar(fdvar,c_width)] [expr $PgAcVar(fdvar,c_top)+$PgAcVar(fdvar,c_height)]]
+       set PgAcVar(fdobj,$i,coord) $c
+       .pgaw:FormDesign:draft.c delete o$i
+       design:draw_object $i
+       design:draw_hookers $i
+}
+
+
+proc {design:delete_object} {} {
+global PgAcVar
+       set i $PgAcVar(fdvar,moveitemobj)
+       .pgaw:FormDesign:draft.c delete o$i
+       .pgaw:FormDesign:draft.c delete hook
+       set j [lsearch $PgAcVar(fdvar,objlist) $i]
+       set PgAcVar(fdvar,objlist) [lreplace $PgAcVar(fdvar,objlist) $j $j]
+       set PgAcVar(fdvar,dirty) 1
+}
+
+
+proc {design:draw_hook} {x y} {
+       .pgaw:FormDesign:draft.c create rectangle [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] -fill black -tags hook
+}
+
+
+proc {design:draw_hookers} {i} {
+global PgAcVar
+       foreach {x1 y1 x2 y2} $PgAcVar(fdobj,$i,coord) {}
+       .pgaw:FormDesign:draft.c delete hook
+       design:draw_hook $x1 $y1
+       design:draw_hook $x1 $y2
+       design:draw_hook $x2 $y1
+       design:draw_hook $x2 $y2
+}
+
+
+proc {design:draw_grid} {} {
+       for {set i 0} {$i<100} {incr i} {
+               .pgaw:FormDesign:draft.c create line 0 [expr {$i*6}] 1000 [expr {$i*6}] -fill #afafaf -tags grid
+               .pgaw:FormDesign:draft.c create line [expr {$i*6}] 0 [expr {$i*6}] 1000 -fill #afafaf -tags grid
+       }
+}
+
+
+proc {design:draw_object} {i} {
+global PgAcVar
+set c $PgAcVar(fdobj,$i,coord)
+foreach {x1 y1 x2 y2} $c {}
+.pgaw:FormDesign:draft.c delete o$i
+set wfont $PgAcVar(fdobj,$i,font)
+switch $wfont {
+       {} {set wfont $PgAcVar(pref,font_normal) ; set PgAcVar(fdobj,$i,font) normal}
+       normal  {set wfont $PgAcVar(pref,font_normal)}
+       bold  {set wfont $PgAcVar(pref,font_bold)}
+       italic  {set wfont $PgAcVar(pref,font_italic)}
+       fixed  {set wfont $PgAcVar(pref,font_fix)}
+}
+switch $PgAcVar(fdobj,$i,class) {
+       button {
+               design:draw_rectangle $x1 $y1 $x2 $y2 $PgAcVar(fdobj,$i,relief) $PgAcVar(fdobj,$i,bcolor) o$i
+               .pgaw:FormDesign:draft.c create text [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] -fill $PgAcVar(fdobj,$i,fcolor) -text $PgAcVar(fdobj,$i,label) -font $wfont -tags o$i
+       }
+       text {
+               design:draw_rectangle $x1 $y1 $x2 $y2 $PgAcVar(fdobj,$i,relief) $PgAcVar(fdobj,$i,bcolor) o$i
+       }
+       entry {
+               design:draw_rectangle $x1 $y1 $x2 $y2 $PgAcVar(fdobj,$i,relief) $PgAcVar(fdobj,$i,bcolor) o$i
+       }
+       label {
+               set temp $PgAcVar(fdobj,$i,label)
+               if {$temp==""} {set temp "____"}
+               design:draw_rectangle $x1 $y1 $x2 $y2 $PgAcVar(fdobj,$i,relief) $PgAcVar(fdobj,$i,bcolor) o$i
+               .pgaw:FormDesign:draft.c create text [expr {$x1+1}] [expr {$y1+1}] -text $temp -fill $PgAcVar(fdobj,$i,fcolor) -font $wfont -anchor nw -tags o$i
+       }
+       checkbox {
+               design:draw_rectangle [expr $x1+2] [expr $y1+5] [expr $x1+12] [expr $y1+15] raised #a0a0a0 o$i
+               .pgaw:FormDesign:draft.c create text [expr $x1+20] [expr $y1+3] -text $PgAcVar(fdobj,$i,label) -anchor nw \
+                -fill $PgAcVar(fdobj,$i,fcolor) -font $wfont -tags o$i
+       }
+       radio {
+               .pgaw:FormDesign:draft.c create oval [expr $x1+4] [expr $y1+5] [expr $x1+14] [expr $y1+15] -fill white -tags o$i
+               .pgaw:FormDesign:draft.c create text [expr $x1+24] [expr $y1+3] -text $PgAcVar(fdobj,$i,label) -anchor nw \
+                -fill $PgAcVar(fdobj,$i,fcolor) -font $wfont -tags o$i
+       }
+       query {
+               .pgaw:FormDesign:draft.c create oval $x1 $y1 [expr $x1+20] [expr $y1+20] -fill white -tags o$i
+               .pgaw:FormDesign:draft.c create text [expr $x1+5] [expr $y1+4] -text Q  -anchor nw -font $PgAcVar(pref,font_normal) -tags o$i
+       }
+       listbox {
+               design:draw_rectangle $x1 $y1 [expr $x2-12] $y2 sunken $PgAcVar(fdobj,$i,bcolor) o$i
+               design:draw_rectangle [expr $x2-11] $y1 $x2 $y2 sunken gray o$i
+               .pgaw:FormDesign:draft.c create line [expr $x2-5] $y1 $x2 [expr $y1+10] -fill #808080 -tags o$i
+               .pgaw:FormDesign:draft.c create line [expr $x2-10] [expr $y1+9] $x2 [expr $y1+9] -fill #808080 -tags o$i
+               .pgaw:FormDesign:draft.c create line [expr $x2-10] [expr $y1+9] [expr $x2-5] $y1 -fill white -tags o$i
+               .pgaw:FormDesign:draft.c create line [expr $x2-5] $y2 $x2 [expr $y2-10] -fill #808080 -tags o$i
+               .pgaw:FormDesign:draft.c create line [expr $x2-10] [expr $y2-9] $x2 [expr $y2-9] -fill white -tags o$i
+               .pgaw:FormDesign:draft.c create line [expr $x2-10] [expr $y2-9] [expr $x2-5] $y2 -fill white -tags o$i
+       }
+}
+.pgaw:FormDesign:draft.c raise hook
+}
+
+proc {design:draw_rectangle} {x1 y1 x2 y2 relief color tag} {
+       if {$relief=="raised"} {
+               set c1 white
+               set c2 #606060
+       }
+       if {$relief=="sunken"} {
+               set c1 #606060
+               set c2 white
+       }
+       if {$relief=="ridge"} {
+               design:draw_rectangle $x1 $y1 $x2 $y2 raised none $tag
+               design:draw_rectangle [expr {$x1+1}] [expr {$y1+1}] [expr {$x2+1}] [expr {$y2+1}] sunken none $tag
+               design:draw_rectangle [expr {$x1+2}] [expr {$y1+2}] $x2 $y2 flat $color $tag
+               return
+       }
+       if {$relief=="groove"} {
+               design:draw_rectangle $x1 $y1 $x2 $y2 sunken none $tag
+               design:draw_rectangle [expr {$x1+1}] [expr {$y1+1}] [expr {$x2+1}] [expr {$y2+1}] raised none $tag
+               design:draw_rectangle [expr {$x1+2}] [expr {$y1+2}] $x2 $y2 flat $color $tag
+               return
+       }
+       if {$color != "none"} {
+               .pgaw:FormDesign:draft.c create rectangle $x1 $y1 $x2 $y2 -outline "" -fill $color -tags $tag
+       }
+       if {$relief=="flat"} {
+               return
+       }
+       .pgaw:FormDesign:draft.c create line $x1 $y1 $x2 $y1 -fill $c1 -tags $tag
+       .pgaw:FormDesign:draft.c create line $x1 $y1 $x1 $y2 -fill $c1 -tags $tag
+       .pgaw:FormDesign:draft.c create line $x1 $y2 $x2 $y2 -fill $c2 -tags $tag
+       .pgaw:FormDesign:draft.c create line $x2 $y1 $x2 [expr 1+$y2] -fill $c2 -tags $tag
+}
+
+
+proc {design:init} {} {
+global PgAcVar
+       PgAcVar:clean fdvar,*
+       PgAcVar:clean fdobj,*
+       catch {.pgaw:FormDesign:draft.c delete all}
+       # design:draw_grid
+       set PgAcVar(fdobj,0,name) {f1}
+       set PgAcVar(fdobj,0,class) form
+       set PgAcVar(fdobj,0,command) {}
+       set PgAcVar(fdvar,formtitle) "New form"
+       set PgAcVar(fdvar,objnum) 0
+       set PgAcVar(fdvar,objlist) {}
+       set PgAcVar(fdvar,oper) none
+       set PgAcVar(fdvar,tool) point
+       set PgAcVar(fdvar,resizable) 1
+       set PgAcVar(fdvar,dirty) 0
+}
+
+
+proc {design:item_click} {x y} {
+global PgAcVar
+       set PgAcVar(fdvar,oper) none
+       set PgAcVar(fdvar,moveitemobj) {}
+       set il [.pgaw:FormDesign:draft.c find overlapping $x $y $x $y]
+       .pgaw:FormDesign:draft.c delete hook
+       if {[llength $il] == 0} {
+               design:show_attributes 0
+               return
+       }
+       set tl [.pgaw:FormDesign:draft.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 PgAcVar(fdvar,moveitemobj) $objnum
+       set PgAcVar(fdvar,moveitemx) $x
+       set PgAcVar(fdvar,moveitemy) $y
+       set PgAcVar(fdvar,oper) move
+       design:show_attributes $objnum
+       design:draw_hookers $objnum
+}
+
+
+proc {forms:load} {name mode} {
+global PgAcVar CurrentDB
+       design:init
+       set PgAcVar(fdvar,formtitle) $name
+       if {$mode=="design"} {
+               Window show .pgaw:FormDesign:draft
+               Window show .pgaw:FormDesign:menu
+               Window show .pgaw:FormDesign:attributes
+               Window show .pgaw:FormDesign:toolbar
+       }
+       set res [wpg_exec $CurrentDB "select * from pga_forms where formname='$PgAcVar(fdvar,formtitle)'"]
+       set info [lindex [pg_result $res -getTuple 0] 1]
+       pg_result $res -clear
+       set PgAcVar(fdobj,0,name) [lindex $info 0]
+       set PgAcVar(fdvar,objnum) [lindex $info 1]
+       # check for old format , prior to 0.97 that
+       # save here the objlist (deprecated)
+       set temp [lindex $info 2]
+       if {[lindex $temp 0] == "FS"} {
+               set PgAcVar(fdobj,0,command) [lindex $temp 1]
+       } else {
+               set PgAcVar(fdobj,0,command) {}
+       }
+       set PgAcVar(fdvar,objlist) {}
+       set PgAcVar(fdvar,geometry) [lindex $info 3]
+       set i 1
+       foreach objinfo [lrange $info 4 end] {
+               lappend PgAcVar(fdvar,objlist) $i
+               set PgAcVar(fdobj,$i,class)    [lindex $objinfo 0]
+               set PgAcVar(fdobj,$i,name)     [lindex $objinfo 1]
+               set PgAcVar(fdobj,$i,coord)    [lindex $objinfo 2]
+               set PgAcVar(fdobj,$i,command)  [lindex $objinfo 3]
+               set PgAcVar(fdobj,$i,label)    [lindex $objinfo 4]
+               set PgAcVar(fdobj,$i,variable) [lindex $objinfo 5]
+               design:setDefaultReliefAndColor $i
+               set PgAcVar(fdobj,$i,value) $PgAcVar(fdobj,$i,name)
+               if {[llength $objinfo] >  6 } {
+                       set PgAcVar(fdobj,$i,value)       [lindex $objinfo 6]
+                       set PgAcVar(fdobj,$i,relief)      [lindex $objinfo 7]
+                       set PgAcVar(fdobj,$i,fcolor)      [lindex $objinfo 8]
+                       set PgAcVar(fdobj,$i,bcolor)      [lindex $objinfo 9]
+                       set PgAcVar(fdobj,$i,borderwidth) [lindex $objinfo 10]
+                       set PgAcVar(fdobj,$i,font)        [lindex $objinfo 11]
+                       # for space saving purposes we have saved onbly the first letter
+                       switch $PgAcVar(fdobj,$i,font) {
+                               n {set PgAcVar(fdobj,$i,font) normal}
+                               i {set PgAcVar(fdobj,$i,font) italic}
+                               b {set PgAcVar(fdobj,$i,font) bold}
+                               f {set PgAcVar(fdobj,$i,font) fixed}
+                       }
+               }
+               if {$mode=="design"} {design:draw_object $i}
+               incr i
+       }
+       if {$mode=="design"} {wm geometry .pgaw:FormDesign:draft $PgAcVar(fdvar,geometry)}
+}
+
+
+proc {design:mouse_down} {x y} {
+global PgAcVar
+       set x [expr 3*int($x/3)]
+       set y [expr 3*int($y/3)]
+       set PgAcVar(fdvar,xstart) $x
+       set PgAcVar(fdvar,ystart) $y
+       if {$PgAcVar(fdvar,tool)=="point"} {
+               design:item_click $x $y
+               return
+       }
+       set PgAcVar(fdvar,oper) draw
+}
+
+
+proc {design:mouse_move} {x y} {
+global PgAcVar
+       #set PgAcVar(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 $PgAcVar(fdvar,oper)}
+       if {$oper=="draw"} {
+               catch {.pgaw:FormDesign:draft.c delete curdraw}
+               .pgaw:FormDesign:draft.c create rectangle $PgAcVar(fdvar,xstart) $PgAcVar(fdvar,ystart) $x $y -tags curdraw
+               return
+       }
+       if {$oper=="move"} {
+               set dx [expr $x-$PgAcVar(fdvar,moveitemx)]
+               set dy [expr $y-$PgAcVar(fdvar,moveitemy)]
+               .pgaw:FormDesign:draft.c move o$PgAcVar(fdvar,moveitemobj) $dx $dy
+               .pgaw:FormDesign:draft.c move hook $dx $dy
+               set PgAcVar(fdvar,moveitemx) $x
+               set PgAcVar(fdvar,moveitemy) $y
+               set PgAcVar(fdvar,dirty) 1
+       }
+}
+
+proc {design:setDefaultReliefAndColor} {i} {
+global PgAcVar
+       set PgAcVar(fdobj,$i,borderwidth) 1
+       set PgAcVar(fdobj,$i,relief) flat
+       set PgAcVar(fdobj,$i,fcolor) {}
+       set PgAcVar(fdobj,$i,bcolor) {}
+       set PgAcVar(fdobj,$i,font) normal
+       switch $PgAcVar(fdobj,$i,class) {
+               button {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #d9d9d9
+                       set PgAcVar(fdobj,$i,relief) raised
+               }
+               text {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #fefefe
+                       set PgAcVar(fdobj,$i,relief) sunken
+               }
+               entry {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #fefefe
+                       set PgAcVar(fdobj,$i,relief) sunken
+               }
+               label {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #d9d9d9
+                       set PgAcVar(fdobj,$i,relief) flat
+               }
+               checkbox {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #d9d9d9
+                       set PgAcVar(fdobj,$i,relief) flat
+               }
+               radio {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #d9d9d9
+                       set PgAcVar(fdobj,$i,relief) flat
+               }
+               listbox {
+                       set PgAcVar(fdobj,$i,fcolor) #000000
+                       set PgAcVar(fdobj,$i,bcolor) #fefefe
+                       set PgAcVar(fdobj,$i,relief) sunken
+               }
+       }
+}
+
+proc {design:mouse_up} {x y} {
+global PgAcVar
+       set x [expr 3*int($x/3)]
+       set y [expr 3*int($y/3)]
+       if {$PgAcVar(fdvar,oper)=="move"} {
+               set PgAcVar(fdvar,moveitem) {}
+               set PgAcVar(fdvar,oper) none
+               set oc $PgAcVar(fdobj,$PgAcVar(fdvar,moveitemobj),coord)
+               set dx [expr $x - $PgAcVar(fdvar,xstart)]
+               set dy [expr $y - $PgAcVar(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 PgAcVar(fdobj,$PgAcVar(fdvar,moveitemobj),coord) $newcoord
+               design:show_attributes $PgAcVar(fdvar,moveitemobj)
+               design:draw_hookers $PgAcVar(fdvar,moveitemobj)
+               return
+       }
+       if {$PgAcVar(fdvar,oper)!="draw"} return
+       set PgAcVar(fdvar,oper) none
+       .pgaw:FormDesign:draft.c delete curdraw
+       # Check for x2<x1 or y2<y1
+       if {$x<$PgAcVar(fdvar,xstart)} {set temp $x ; set x $PgAcVar(fdvar,xstart) ; set PgAcVar(fdvar,xstart) $temp}
+       if {$y<$PgAcVar(fdvar,ystart)} {set temp $y ; set y $PgAcVar(fdvar,ystart) ; set PgAcVar(fdvar,ystart) $temp}
+       # Check for too small sizes
+       if {[expr $x-$PgAcVar(fdvar,xstart)]<20} {set x [expr $PgAcVar(fdvar,xstart)+20]}
+       if {[expr $y-$PgAcVar(fdvar,ystart)]<10} {set y [expr $PgAcVar(fdvar,ystart)+10]}
+       incr PgAcVar(fdvar,objnum)
+       set i $PgAcVar(fdvar,objnum)
+       lappend PgAcVar(fdvar,objlist) $i
+
+       set PgAcVar(fdobj,$i,class) $PgAcVar(fdvar,tool)
+       set PgAcVar(fdobj,$i,coord) [list $PgAcVar(fdvar,xstart) $PgAcVar(fdvar,ystart) $x $y]
+       set PgAcVar(fdobj,$i,name) $PgAcVar(fdvar,tool)$i
+       set PgAcVar(fdobj,$i,label) $PgAcVar(fdvar,tool)$i
+       set PgAcVar(fdobj,$i,command) {}
+       set PgAcVar(fdobj,$i,variable) {}
+       set PgAcVar(fdobj,$i,value) {}
+
+       design:setDefaultReliefAndColor $i
+       
+       design:draw_object $i
+       design:show_attributes $i
+       set PgAcVar(fdvar,moveitemobj) $i
+       design:draw_hookers $i
+       set PgAcVar(fdvar,tool) point
+       set PgAcVar(fdvar,dirty) 1
+}
+
+
+proc {design:save} {name} {
+global PgAcVar CurrentDB
+       if {[string length $PgAcVar(fdobj,0,name)]==0} {
+               tk_messageBox -title [intlmsg Warning] -message [intlmsg "Forms need an internal name, only literals, low case"]
+               return 0
+       }
+       if {[string length $PgAcVar(fdvar,formtitle)]==0} {
+               tk_messageBox -title [intlmsg Warning] -message [intlmsg "Form must have a name"]
+               return 0
+       }
+       set info [list $PgAcVar(fdobj,0,name) $PgAcVar(fdvar,objnum) [list FS $PgAcVar(fdobj,0,command)] [wm geometry .pgaw:FormDesign:draft]]
+       foreach i $PgAcVar(fdvar,objlist) {
+               set wfont $PgAcVar(fdobj,$i,font)
+               if {[lsearch {normal bold italic fixed} $wfont] != -1} {
+                       set wfont [string range $wfont 0 0]
+               }
+               lappend info [list $PgAcVar(fdobj,$i,class) $PgAcVar(fdobj,$i,name) $PgAcVar(fdobj,$i,coord) $PgAcVar(fdobj,$i,command) $PgAcVar(fdobj,$i,label) $PgAcVar(fdobj,$i,variable) $PgAcVar(fdobj,$i,value) $PgAcVar(fdobj,$i,relief) $PgAcVar(fdobj,$i,fcolor) $PgAcVar(fdobj,$i,bcolor) $PgAcVar(fdobj,$i,borderwidth) $wfont]
+       }
+       sql_exec noquiet "delete from pga_forms where formname='$PgAcVar(fdvar,formtitle)'"
+       regsub -all "'" $info "''" info
+       sql_exec noquiet "insert into pga_forms values ('$PgAcVar(fdvar,formtitle)','$info')"
+       Mainlib::cmd_Forms
+       set PgAcVar(fdvar,dirty) 0
+       return 1
+}
+
+
+proc {design:set_name} {} {
+global PgAcVar
+       set i $PgAcVar(fdvar,moveitemobj)
+       foreach k $PgAcVar(fdvar,objlist) {
+               if {($PgAcVar(fdobj,$k,name)==$PgAcVar(fdvar,c_name)) && ($i!=$k)} {
+                       tk_messageBox -title [intlmsg Warning] -message [format [intlmsg "There is another object (a %s) with the same name.\nPlease change it!"] $PgAcVar(fdobj,$k,class)]
+                       return
+               }
+       }
+       set PgAcVar(fdobj,$i,name) $PgAcVar(fdvar,c_name)
+       design:show_attributes $i
+       set PgAcVar(fdvar,dirty) 1
+}
+
+
+proc {design:set_text} {} {
+global PgAcVar
+       design:draw_object $PgAcVar(fdvar,moveitemobj)
+       set PgAcVar(fdvar,dirty) 1
+}
+
+
+proc {design:createAttributesFrame} {i} {
+global PgAcVar
+       # Check if attributes frame is already created for that item
+       
+       if {[info exists PgAcVar(fdvar,attributeFrame)]} {
+               if {$PgAcVar(fdvar,attributeFrame) == $i} return
+       }
+       set PgAcVar(fdvar,attributeFrame) $i
+       
+       # Delete old widgets from the frame
+       foreach wid [winfo children .pgaw:FormDesign:attributes.f] {
+               destroy $wid
+       }
+
+       set row 0
+       set base .pgaw:FormDesign:attributes.f
+       grid columnconf $base 1 -weight 1
+
+       set objclass $PgAcVar(fdobj,$i,class)
+
+       # if i is zero, then the object is the form
+       
+       if {$i == 0} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg {Startup script}]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,command) \
+               -background #fefefe -borderwidth 1 -width 200 
+               button $base.b$row \
+               -borderwidth 1 -padx 1 -pady 0 -text ... -command "
+                               Window show .pgaw:FormDesign:commands
+                               set PgAcVar(fdvar,commandFor) $i
+                               .pgaw:FormDesign:commands.f.txt delete 1.0 end
+                               .pgaw:FormDesign:commands.f.txt insert end \$PgAcVar(fdobj,$i,command)"
+               grid $base.l$row \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w                               
+               grid $base.b$row \
+               -in $base -column 2 -row $row -columnspan 1 -rowspan 1 
+               incr row
+       }
+
+       # does it have a text attribute ?
+       if {[lsearch {button label radio checkbox} $objclass] > -1} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg Text]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,label) \
+               -background #fefefe -borderwidth 1 -width 200 
+               bind $base.e$row <Key-Return> "Forms::design:set_text"
+               grid $base.l$row \
+                       -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 -sticky w                                
+               incr row
+       }
+
+       # does it have a variable attribute ?
+       if {[lsearch {button label radio checkbox entry} $objclass] > -1} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg Variable]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,variable) \
+               -background #fefefe -borderwidth 1 -width 200 
+               grid $base.l$row \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w                               
+               incr row
+       }
+
+       # does it have a Command attribute ?
+       if {[lsearch {button checkbox} $objclass] > -1} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg Command]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,command) \
+               -background #fefefe -borderwidth 1 -width 200 
+               button $base.b$row \
+               -borderwidth 1 -padx 1 -pady 0 -text ... -command "
+                               Window show .pgaw:FormDesign:commands
+                               set PgAcVar(fdvar,commandFor) $i
+                               .pgaw:FormDesign:commands.f.txt delete 1.0 end
+                               .pgaw:FormDesign:commands.f.txt insert end \$PgAcVar(fdobj,$i,command)"
+               grid $base.l$row \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w                               
+               grid $base.b$row \
+               -in $base -column 2 -row $row -columnspan 1 -rowspan 1 
+               incr row
+       }
+
+       # does it have a value attribute ?
+       if {[lsearch {radio checkbox} $objclass] > -1} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg Value]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,value) \
+               -background #fefefe -borderwidth 1 -width 200 
+               grid $base.l$row \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w                               
+               incr row
+       }
+
+       # does it have fonts ?
+       if {[lsearch {label button entry listbox text checkbox radio} $objclass] > -1} {
+               label $base.lfont \
+                       -borderwidth 0 -text [intlmsg Font]
+               grid $base.lfont \
+                       -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -pady 2 -sticky w 
+               entry $base.efont -textvariable PgAcVar(fdobj,$i,font) \
+               -background #fefefe -borderwidth 1 -width 200 
+               bind $base.efont <Key-Return> "Forms::design:draw_object $i ; set PgAcVar(fdvar,dirty) 1"
+               grid $base.efont \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 -sticky w                                
+               menubutton $base.mbf \
+           -borderwidth 1 -menu $base.mbf.m -padx 2 -pady 0 \
+               -text {...}  -font $PgAcVar(pref,font_normal) -relief raised
+               menu $base.mbf.m \
+                       -borderwidth 1 -cursor {} -tearoff 0 -font $PgAcVar(pref,font_normal)
+               foreach font {normal bold italic fixed} {
+                       $base.mbf.m add command \
+               -command "
+                       set PgAcVar(fdobj,$i,font) $font
+                       Forms::design:draw_object $i
+                       set PgAcVar(fdvar,dirty) 1
+               " -label $font
+               }
+               grid $base.mbf \
+                       -in $base -column 2 -row $row -columnspan 1 -rowspan 1 -pady 2 -padx 2 -sticky w 
+               incr row
+       }
+
+       # does it have colors ?
+       if {[lsearch {label button radio checkbox entry listbox text} $objclass] > -1} {
+               label $base.lcf \
+               -borderwidth 0 -text [intlmsg Foreground]
+               label $base.scf \
+               -background $PgAcVar(fdobj,$i,fcolor) -borderwidth 1 -relief sunken -width 200 
+               button $base.bcf \
+                       -command "set tempcolor \[tk_chooseColor -initialcolor $PgAcVar(fdobj,$i,fcolor) -title {Choose color}\] 
+                               if {\$tempcolor != {}} {
+                                       set PgAcVar(fdobj,$i,fcolor) \$tempcolor
+                                       $base.scf configure -background \$PgAcVar(fdobj,$i,fcolor)
+                                       set PgAcVar(fdvar,dirty) 1
+                                       Forms::design:draw_object $i
+                               }" \
+               -borderwidth 1 -padx 1 -pady 0 -text ... 
+               grid $base.lcf \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.scf \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w 
+               grid $base.bcf \
+               -in $base -column 2 -row $row -columnspan 1 -rowspan 1 
+               incr row
+               label $base.lcb \
+                       -borderwidth 0 -text Background 
+               label $base.scb \
+                       -background $PgAcVar(fdobj,$i,bcolor) -borderwidth 1 -relief sunken -width 200 
+               button $base.bcb \
+                       -command "set tempcolor \[tk_chooseColor -initialcolor $PgAcVar(fdobj,$i,bcolor) -title {Choose color}\]
+                               if {\$tempcolor != {}} {
+                                       set PgAcVar(fdobj,$i,bcolor) \$tempcolor
+                                       $base.scb configure -background \$PgAcVar(fdobj,$i,bcolor)
+                                       set PgAcVar(fdvar,dirty) 1
+                                       Forms::design:draw_object $i
+                               }" \
+                       -borderwidth 1 -padx 1 -pady 0 -text ... 
+               grid $base.lcb \
+                       -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.scb \
+                       -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 -sticky w 
+               grid $base.bcb \
+                       -in $base -column 2 -row $row -columnspan 1 -rowspan 1
+               incr row
+       }
+
+       # does it have border types ?
+       if {[lsearch {label button entry listbox text} $objclass] > -1} {
+               label $base.lrelief \
+                       -borderwidth 0 -text [intlmsg Relief]
+               grid $base.lrelief \
+                       -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -pady 2 -sticky w 
+               menubutton $base.mb \
+           -borderwidth 2 -menu $base.mb.m -padx 4 -pady 3 -width 100 -relief $PgAcVar(fdobj,$i,relief) \
+               -text groove -textvariable PgAcVar(fdobj,$i,relief) \
+               -font $PgAcVar(pref,font_normal)
+               menu $base.mb.m \
+                       -borderwidth 1 -cursor {} -tearoff 0 -font $PgAcVar(pref,font_normal)
+               foreach brdtype {raised sunken ridge groove flat} {
+                       $base.mb.m add command \
+               -command "
+                       set PgAcVar(fdobj,$i,relief) $brdtype
+                       $base.mb configure -relief \$PgAcVar(fdobj,$i,relief)
+                       Forms::design:draw_object $i
+               " -label $brdtype
+               }
+               grid $base.mb \
+                       -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -pady 2 -padx 2 -sticky w 
+               incr row
+
+       }
+
+       # is it a DataControl ?
+       if {$objclass == "query"} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg SQL]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,command) \
+               -background #fefefe -borderwidth 1 -width 200 
+               grid $base.l$row \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w                               
+               incr row
+       }
+
+       # does it have a borderwidth attribute ?
+       if {[lsearch {button label radio checkbox entry listbox text} $objclass] > -1} {
+               label $base.l$row \
+               -borderwidth 0 -text [intlmsg {Border width}]
+               entry $base.e$row -textvariable PgAcVar(fdobj,$i,borderwidth) \
+               -background #fefefe -borderwidth 1 -width 200 
+               grid $base.l$row \
+               -in $base -column 0 -row $row -columnspan 1 -rowspan 1 -sticky w 
+               grid $base.e$row \
+               -in $base -column 1 -row $row -columnspan 1 -rowspan 1 -padx 2 \
+               -sticky w                               
+               incr row
+       }
+
+
+       # The last dummy label
+       
+       label $base.ldummy -text {} -borderwidth 0
+       grid $base.ldummy -in $base -column 0 -row 100
+       grid rowconf $base 100 -weight 1
+
+}
+
+
+proc {design:show_attributes} {i} {
+global PgAcVar
+       set objclass $PgAcVar(fdobj,$i,class)
+       set PgAcVar(fdvar,c_class) $objclass
+       design:createAttributesFrame $i
+       set PgAcVar(fdvar,c_name) $PgAcVar(fdobj,$i,name)
+       if {$i == 0} {
+               # Object 0 is the form
+               set c [split [winfo geometry .pgaw:FormDesign:draft] x+]
+               set PgAcVar(fdvar,c_top) [lindex $c 3]
+               set PgAcVar(fdvar,c_left) [lindex $c 2]
+               set PgAcVar(fdvar,c_width) [lindex $c 0]
+               set PgAcVar(fdvar,c_height) [lindex $c 1]
+               return
+       }
+       set c $PgAcVar(fdobj,$i,coord)
+       set PgAcVar(fdvar,c_top) [lindex $c 1]
+       set PgAcVar(fdvar,c_left) [lindex $c 0]
+       set PgAcVar(fdvar,c_width) [expr [lindex $c 2]-[lindex $c 0]]
+       set PgAcVar(fdvar,c_height) [expr [lindex $c 3]-[lindex $c 1]]
+}
+
+
+proc {design:run} {} {
+global PgAcVar CurrentDB DataControlVar
+set base .$PgAcVar(fdobj,0,name)
+if {[winfo exists $base]} {
+   wm deiconify $base; return
+}
+toplevel $base -class Toplevel
+wm focusmodel $base passive
+wm geometry $base $PgAcVar(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 $PgAcVar(fdvar,formtitle)
+foreach item $PgAcVar(fdvar,objlist) {
+set coord $PgAcVar(fdobj,$item,coord)
+set name $PgAcVar(fdobj,$item,name)
+set wh "-width [expr 3+[lindex $coord 2]-[lindex $coord 0]]  -height [expr 3+[lindex $coord 3]-[lindex $coord 1]]"
+set visual 1
+
+set wfont $PgAcVar(fdobj,$item,font)
+switch $wfont {
+       {} {set wfont $PgAcVar(pref,font_normal)}
+       normal  {set wfont $PgAcVar(pref,font_normal)}
+       bold  {set wfont $PgAcVar(pref,font_bold)}
+       italic  {set wfont $PgAcVar(pref,font_italic)}
+       fixed  {set wfont $PgAcVar(pref,font_fix)}
+}
+
+namespace forget ::DataControl($base.$name)
+
+# Checking if relief ridge or groove has borderwidth 2
+if {[lsearch {ridge groove} $PgAcVar(fdobj,$item,relief)] != -1} {
+       if {$PgAcVar(fdobj,$item,borderwidth) < 2} {
+               set PgAcVar(fdobj,$item,borderwidth) 2
+       }
+}
+
+# Checking if borderwidth is okay
+if {[lsearch {0 1 2 3 4 5} $PgAcVar(fdobj,$item,borderwidth)] == -1} {
+       set PgAcVar(fdobj,$item,borderwidth) 1
+}
+
+set cmd {}
+catch {set cmd $PgAcVar(fdobj,$item,command)}
+
+switch $PgAcVar(fdobj,$item,class) {
+       button {
+               button $base.$name  -borderwidth 1 -padx 0 -pady 0 -text "$PgAcVar(fdobj,$item,label)" \
+               -fg $PgAcVar(fdobj,$item,fcolor) -bg $PgAcVar(fdobj,$item,bcolor) \
+               -borderwidth $PgAcVar(fdobj,$item,borderwidth) \
+               -relief $PgAcVar(fdobj,$item,relief) -font $wfont -command [subst {$cmd}]
+               if {$PgAcVar(fdobj,$item,variable) != ""} {
+                       $base.$name configure -textvariable $PgAcVar(fdobj,$item,variable)
+               }
+       }
+       checkbox {
+               checkbutton  $base.$name -onvalue t -offvalue f -font $wfont \
+               -fg $PgAcVar(fdobj,$item,fcolor) \
+               -borderwidth $PgAcVar(fdobj,$item,borderwidth) \
+               -command [subst {$cmd}] \
+               -text "$PgAcVar(fdobj,$item,label)" -variable "$PgAcVar(fdobj,$item,variable)" -borderwidth 1
+               set wh {}
+       }
+       query {
+               set visual 0
+               set DataControlVar($base.$name,sql) $PgAcVar(fdobj,$item,command)
+               namespace eval ::DataControl($base.$name) "proc open {} {
+                       global CurrentDB DataControlVar
+                       variable tuples
+                       catch {unset tuples}
+                       set wn \[focus\] ; setCursor CLOCK
+                       set res \[wpg_exec \$CurrentDB \"\$DataControlVar($base.$name,sql)\"\]
+                       pg_result \$res -assign tuples
+                       set fl {}
+                       foreach fd \[pg_result \$res -lAttributes\] {lappend fl \[lindex \$fd 0\]}
+                       set DataControlVar($base.$name,fields) \$fl
+                       set DataControlVar($base.$name,recno) 0
+                       set DataControlVar($base.$name,nrecs) \[pg_result \$res -numTuples\]
+                       setCursor NORMAL
+               }"
+               namespace eval ::DataControl($base.$name) "proc setSQL {sqlcmd} {
+                       global DataControlVar
+                       set DataControlVar($base.$name,sql) \$sqlcmd
+               }"
+               namespace eval ::DataControl($base.$name) "proc getRowCount {} {
+                       global DataControlVar
+                       return \$DataControlVar($base.$name,nrecs)
+               }"
+               namespace eval ::DataControl($base.$name)  "proc getRowIndex {} {
+                       global DataControlVar
+                       return \$DataControlVar($base.$name,recno)
+               }"
+               namespace eval ::DataControl($base.$name)  "proc moveTo {newrecno} {
+                       global DataControlVar
+                       set DataControlVar($base.$name,recno) \$newrecno
+               }"
+               namespace eval ::DataControl($base.$name) "proc close {} {
+                       variable tuples
+                       catch {unset tuples}
+               }"
+               namespace eval ::DataControl($base.$name)  "proc getFieldList {} {
+                       global DataControlVar
+                       return \$DataControlVar($base.$name,fields)
+               }"
+               namespace eval ::DataControl($base.$name)  "proc fill {lb fld} {
+                       global DataControlVar
+                       variable tuples
+                       \$lb delete 0 end
+                       for {set i 0} {\$i<\$DataControlVar($base.$name,nrecs)} {incr i} {
+                               \$lb insert end \$tuples\(\$i,\$fld\)
+                       }
+               }"
+               namespace eval ::DataControl($base.$name)  "proc moveFirst {} {global DataControlVar ; set DataControlVar($base.$name,recno) 0}"
+               namespace eval ::DataControl($base.$name)  "proc moveNext {} {global DataControlVar ; incr DataControlVar($base.$name,recno) ; if {\$DataControlVar($base.$name,recno)==\[getRowCount\]} {moveLast}}"
+               namespace eval ::DataControl($base.$name)  "proc movePrevious {} {global DataControlVar ; incr DataControlVar($base.$name,recno) -1 ; if {\$DataControlVar($base.$name,recno)==-1} {moveFirst}}"
+               namespace eval ::DataControl($base.$name)  "proc moveLast {} {global DataControlVar ; set DataControlVar($base.$name,recno) \[expr \[getRowCount\] -1\]}"
+               namespace eval ::DataControl($base.$name)  "proc updateDataSet {} {\
+                       global DataControlVar
+                       global DataSet
+                       variable tuples
+                       set i \$DataControlVar($base.$name,recno)
+                       foreach fld \$DataControlVar($base.$name,fields) {
+                               catch {
+                                       upvar DataSet\($base.$name,\$fld\) dbvar
+                                       set dbvar \$tuples\(\$i,\$fld\)
+                               }
+                       }
+               }"
+               namespace eval ::DataControl($base.$name)  "proc clearDataSet {} {
+                       global DataControlVar
+                       global DataSet
+                       catch { foreach fld \$DataControlVar($base.$name,fields) {
+                               catch {
+                                       upvar DataSet\($base.$name,\$fld\) dbvar
+                                       set dbvar {}
+                               }
+                       }}
+               }"
+       }
+       radio {
+               radiobutton  $base.$name -font $wfont -text "$PgAcVar(fdobj,$item,label)" \
+               -fg $PgAcVar(fdobj,$item,fcolor) -bg $PgAcVar(fdobj,$item,bcolor) -variable $PgAcVar(fdobj,$item,variable) \
+               -value $PgAcVar(fdobj,$item,value) -borderwidth 1
+               set wh {}
+       }
+       entry {
+               set var {} ; catch {set var $PgAcVar(fdobj,$item,variable)}
+               entry $base.$name -bg $PgAcVar(fdobj,$item,bcolor) -fg $PgAcVar(fdobj,$item,fcolor) \
+               -borderwidth $PgAcVar(fdobj,$item,borderwidth) -font $wfont \
+               -relief $PgAcVar(fdobj,$item,relief) -selectborderwidth 0  -highlightthickness 0 
+               if {$var!=""} {$base.$name configure -textvar $var}
+       }
+       text {
+               text $base.$name -fg $PgAcVar(fdobj,$item,fcolor) -bg $PgAcVar(fdobj,$item,bcolor) \
+               -relief $PgAcVar(fdobj,$item,relief) -borderwidth $PgAcVar(fdobj,$item,borderwidth) \
+               -font $wfont
+       }
+       label {
+               # set wh {}
+               label $base.$name -font $wfont -anchor nw -padx 0 -pady 0 -text $PgAcVar(fdobj,$item,label) \
+               -borderwidth $PgAcVar(fdobj,$item,borderwidth) \
+               -relief $PgAcVar(fdobj,$item,relief)  -fg $PgAcVar(fdobj,$item,fcolor) -bg $PgAcVar(fdobj,$item,bcolor) 
+               set var {} ; catch {set var $PgAcVar(fdobj,$item,variable)}
+               if {$var!=""} {$base.$name configure -textvar $var}
+       }
+       listbox {
+               listbox $base.$name -bg $PgAcVar(fdobj,$item,bcolor)  -highlightthickness 0 -selectborderwidth 0 \
+               -borderwidth $PgAcVar(fdobj,$item,borderwidth) -relief $PgAcVar(fdobj,$item,relief) \
+               -fg $PgAcVar(fdobj,$item,fcolor) -bg $PgAcVar(fdobj,$item,bcolor) -font $wfont -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"]}
+}
+if {$PgAcVar(fdobj,0,command) != ""} {
+       uplevel #0 $PgAcVar(fdobj,0,command)
+}
+}
+
+proc {design:close} {} {
+global PgAcVar
+       if {$PgAcVar(fdvar,dirty)} {
+               if {[tk_messageBox -title [intlmsg Warning] -message [intlmsg "Do you want to save the form into the database?"] -type yesno -default yes]=="yes"} {
+                       if {[design:save $PgAcVar(fdvar,formtitle)]==0} {return}
+               }
+       }
+       catch {Window destroy .pgaw:FormDesign:draft}
+       catch {Window destroy .pgaw:FormDesign:toolbar}
+       catch {Window destroy .pgaw:FormDesign:menu}
+       catch {Window destroy .pgaw:FormDesign:attributes}
+       catch {Window destroy .pgaw:FormDesign:commands}
+       catch {Window destroy .$PgAcVar(fdobj,0,name)}
+}
+
+}
+
+proc vTclWindow.pgaw:FormDesign:draft {base} {
+       if {$base == ""} {
+               set base .pgaw:FormDesign:draft
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 377x315+50+130
+       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 [intlmsg "Form design"]
+       bind $base <Key-Delete> {
+               Forms::design:delete_object
+       }
+       bind $base <Key-F1> "Help::load form_design"
+       canvas $base.c \
+               -background #a0a0a0 -height 207 -highlightthickness 0 -relief ridge \
+               -selectborderwidth 0 -width 295 
+       bind $base.c <Button-1> {
+               Forms::design:mouse_down %x %y
+       }
+       bind $base.c <ButtonRelease-1> {
+               Forms::design:mouse_up %x %y
+       }
+       bind $base.c <Motion> {
+               Forms::design:mouse_move %x %y
+       }
+       pack $base.c \
+               -in .pgaw:FormDesign:draft -anchor center -expand 1 -fill both -side top
+}
+
+proc vTclWindow.pgaw:FormDesign:attributes {base} {
+       if {$base == ""} {
+               set base .pgaw:FormDesign:attributes
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 237x300+461+221
+       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 [intlmsg "Attributes"]
+
+       # The identification frame
+
+       frame $base.fi \
+        -borderwidth 2 -height 75 -relief groove -width 125 
+       label $base.fi.lclass \
+        -borderwidth 0 -text [intlmsg Class]
+       entry $base.fi.eclass -textvariable PgAcVar(fdvar,c_class) \
+        -borderwidth 1 -width 200 
+       label $base.fi.lname \
+        -borderwidth 0 -text [intlmsg Name]
+       entry $base.fi.ename -textvariable PgAcVar(fdvar,c_name) \
+        -background #fefefe -borderwidth 1 -width 200 
+       bind $base.fi.ename <Key-Return> {
+               Forms::design:set_name
+       }
+
+
+       # The geometry frame
+
+       frame $base.fg \
+        -borderwidth 2 -height 75 -relief groove -width 125 
+       entry $base.fg.e1 -textvariable PgAcVar(fdvar,c_width) \
+        -background #fefefe -borderwidth 1 -width 5 
+       entry $base.fg.e2 -textvariable PgAcVar(fdvar,c_height) \
+        -background #fefefe -borderwidth 1 -width 5 
+       entry $base.fg.e3 -textvariable PgAcVar(fdvar,c_left) \
+        -background #fefefe -borderwidth 1 -width 5 
+       entry $base.fg.e4 -textvariable PgAcVar(fdvar,c_top) \
+        -background #fefefe -borderwidth 1 -width 5 
+       bind $base.fg.e1 <Key-Return> {
+               Forms::design:change_coords
+       }
+       bind $base.fg.e2 <Key-Return> {
+               Forms::design:change_coords
+       }
+       bind $base.fg.e3 <Key-Return> {
+               Forms::design:change_coords
+       }
+       bind $base.fg.e4 <Key-Return> {
+               Forms::design:change_coords
+       }
+       label $base.fg.l1 \
+        -borderwidth 0 -text Width 
+       label $base.fg.l2 \
+        -borderwidth 0 -text Height 
+       label $base.fg.l3 \
+        -borderwidth 0 -text Left 
+       label $base.fg.l4 \
+        -borderwidth 0 -text Top 
+       label $base.fg.lx1 \
+        -borderwidth 0 -text x 
+       label $base.fg.lp1 \
+        -borderwidth 0 -text + 
+       label $base.fg.lp2 \
+        -borderwidth 0 -text + 
+
+       # The frame for the rest of the attributes (dynamically generated)
+
+       
+       frame $base.f \
+        -borderwidth 2 -height 75 -relief groove -width 125 
+
+
+       # Geometry for "identification frame"
+
+
+       place $base.fi \
+        -x 5 -y 5 -width 230 -height 55 -anchor nw -bordermode ignore 
+       grid columnconf $base.fi 1 -weight 1
+       grid $base.fi.lclass \
+        -in $base.fi -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.fi.eclass \
+        -in $base.fi -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 2 \
+        -sticky w 
+       grid $base.fi.lname \
+        -in $base.fi -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.fi.ename \
+        -in $base.fi -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2 \
+        -sticky w 
+
+
+
+       # Geometry for "geometry frame"
+
+       place $base.fg \
+        -x 5 -y 60 -width 230 -height 45 -anchor nw -bordermode ignore 
+       grid $base.fg.e1 \
+        -in $base.fg -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fg.e2 \
+        -in $base.fg -column 2 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fg.e3 \
+        -in $base.fg -column 4 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fg.e4 \
+        -in $base.fg -column 6 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fg.l1 \
+        -in $base.fg -column 0 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.fg.l2 \
+        -in $base.fg -column 2 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.fg.l3 \
+        -in $base.fg -column 4 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.fg.l4 \
+        -in $base.fg -column 6 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.fg.lx1 \
+        -in $base.fg -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fg.lp1 \
+        -in $base.fg -column 5 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fg.lp2 \
+        -in $base.fg -column 3 -row 0 -columnspan 1 -rowspan 1 
+
+       place $base.f -x 5 -y 105 -width 230 -height 190 -anchor nw
+
+}
+
+
+proc vTclWindow.pgaw:FormDesign:commands {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:FormDesign:commands
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 640x480+120+100
+       wm maxsize $base 785 570
+       wm minsize $base 1 19
+       wm overrideredirect $base 0
+       wm resizable $base 1 1
+       wm title $base [intlmsg "Command"]
+       frame $base.f \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       scrollbar $base.f.sb \
+               -borderwidth 1 -command {.pgaw:FormDesign:commands.f.txt yview} -orient vert -width 12 
+       text $base.f.txt \
+               -font $PgAcVar(pref,font_fix) -height 1 -tabs {20 40 60 80 100 120 140 160 180 200} \
+               -width 200 -yscrollcommand {.pgaw:FormDesign:commands.f.sb set} 
+       frame $base.fb \
+               -height 75 -width 125 
+       button $base.fb.b1 \
+               -borderwidth 1 \
+               -command {
+                       set PgAcVar(fdobj,$PgAcVar(fdvar,commandFor),command) [.pgaw:FormDesign:commands.f.txt get 1.0 "end - 1 chars"]
+                       Window hide .pgaw:FormDesign:commands
+                       set PgAcVar(fdvar,dirty) 1
+               } -text [intlmsg Save] -width 5 
+       button $base.fb.b2 \
+               -borderwidth 1 -command {Window hide .pgaw:FormDesign:commands} \
+               -text [intlmsg Cancel]
+       pack $base.f \
+               -in .pgaw:FormDesign:commands -anchor center -expand 1 -fill both -side top 
+       pack $base.f.sb \
+               -in .pgaw:FormDesign:commands.f -anchor e -expand 1 -fill y -side right 
+       pack $base.f.txt \
+               -in .pgaw:FormDesign:commands.f -anchor center -expand 1 -fill both -side top 
+       pack $base.fb \
+               -in .pgaw:FormDesign:commands -anchor center -expand 0 -fill none -side top 
+       pack $base.fb.b1 \
+               -in .pgaw:FormDesign:commands.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.b2 \
+               -in .pgaw:FormDesign:commands.fb -anchor center -expand 0 -fill none -side top 
+}
+
+proc vTclWindow.pgaw:FormDesign:menu {base} {
+       if {$base == ""} {
+               set base .pgaw:FormDesign:menu
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 432x74+0+0
+       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 [intlmsg "Form designer"]
+       frame $base.f1 \
+               -height 75 -relief groove -width 125 
+       label $base.f1.l1 \
+               -borderwidth 0 -text "[intlmsg {Form name}] "
+       entry $base.f1.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(fdvar,formtitle) 
+       frame $base.f2 \
+               -height 75 -relief groove -width 125 
+       label $base.f2.l \
+               -borderwidth 0 -text "[intlmsg {Form's window internal name}] "
+       entry $base.f2.e \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(fdobj,0,name) 
+       frame $base.f3 \
+               -height 1 -width 125 
+       button $base.f3.b1 \
+               -command {set PgAcVar(fdvar,geometry) [wm geometry .pgaw:FormDesign:draft] ; Forms::design:run} -padx 1 \
+               -text [intlmsg {Test form}]
+       button $base.f3.b2 \
+               -command {destroy .$PgAcVar(fdobj,0,name)} -padx 1 \
+               -text [intlmsg {Close test form}]
+       button $base.f3.b3 \
+               -command {Forms::design:save nimic} -padx 1 -text [intlmsg Save]
+       button $base.f3.b4 \
+               -command {Forms::design:close} \
+               -padx 1 -text [intlmsg Close]
+       pack $base.f1 \
+               -in .pgaw:FormDesign:menu -anchor center -expand 0 -fill x -pady 2 -side top 
+       pack $base.f1.l1 \
+               -in .pgaw:FormDesign:menu.f1 -anchor center -expand 0 -fill none -side left 
+       pack $base.f1.e1 \
+               -in .pgaw:FormDesign:menu.f1 -anchor center -expand 1 -fill x -side left 
+       pack $base.f2 \
+               -in .pgaw:FormDesign:menu -anchor center -expand 0 -fill x -pady 1 -side top 
+       pack $base.f2.l \
+               -in .pgaw:FormDesign:menu.f2 -anchor center -expand 0 -fill none -side left 
+       pack $base.f2.e \
+               -in .pgaw:FormDesign:menu.f2 -anchor center -expand 1 -fill x -side left 
+       pack $base.f3 \
+               -in .pgaw:FormDesign:menu -anchor center -expand 0 -fill x -pady 2 -side bottom 
+       pack $base.f3.b1 \
+               -in .pgaw:FormDesign:menu.f3 -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.b2 \
+               -in .pgaw:FormDesign:menu.f3 -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.b3 \
+               -in .pgaw:FormDesign:menu.f3 -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.b4 \
+               -in .pgaw:FormDesign:menu.f3 -anchor center -expand 0 -fill none -side right 
+}
+
+
+proc vTclWindow.pgaw:FormDesign:toolbar {base} {
+global PgAcVar
+       foreach wid {button frame radiobutton checkbutton label text entry listbox query} {
+               image create photo "icon_$wid"  -file [file join $PgAcVar(PGACCESS_HOME) images icon_$wid.gif] 
+       }
+       if {$base == ""} {
+               set base .pgaw:FormDesign:toolbar
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel -menu .pgaw:FormDesign:toolbar.m17 
+       wm focusmodel $base passive
+       wm geometry $base 29x235+1+130
+       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 [intlmsg "Toolbar"]
+       button $base.b1 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) button} -image icon_button \
+               -padx 9 -pady 3 
+       button $base.b3 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) radio} \
+               -image icon_radiobutton -padx 9 -pady 3 
+       button $base.b4 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) checkbox} \
+               -image icon_checkbutton -padx 9 -pady 3 
+       button $base.b5 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) label} -image icon_label \
+               -padx 9 -pady 3 
+       button $base.b6 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) text} -image icon_text \
+               -padx 9 -pady 3 
+       button $base.b7 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) entry} -image icon_entry \
+               -padx 9 -pady 3 
+       button $base.b8 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) listbox} -image icon_listbox \
+               -padx 9 -pady 3 
+       button $base.b9 \
+               -borderwidth 1 -command {set PgAcVar(fdvar,tool) query} -height 21 \
+               -image icon_query -padx 9 -pady 3 -width 20 
+       grid $base.b1 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 2 -columnspan 1 -rowspan 1 
+       grid $base.b3 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 4 -columnspan 1 -rowspan 1 
+       grid $base.b4 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 5 -columnspan 1 -rowspan 1 
+       grid $base.b5 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.b6 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 6 -columnspan 1 -rowspan 1 
+       grid $base.b7 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.b8 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 7 -columnspan 1 -rowspan 1 
+       grid $base.b9 \
+               -in .pgaw:FormDesign:toolbar -column 0 -row 8 -columnspan 2 -rowspan 3 
+}
+
diff --git a/src/bin/pgaccess/lib/functions.tcl b/src/bin/pgaccess/lib/functions.tcl
new file mode 100644 (file)
index 0000000..96e4860
--- /dev/null
@@ -0,0 +1,181 @@
+namespace eval Functions {
+
+proc {new} {} {
+global PgAcVar
+       Window show .pgaw:Function
+       set PgAcVar(function,name) {}
+       set PgAcVar(function,nametodrop) {}
+       set PgAcVar(function,parameters) {}
+       set PgAcVar(function,returns) {}
+       set PgAcVar(function,language) {}
+       .pgaw:Function.fs.text1 delete 1.0 end
+       focus .pgaw:Function.fp.e1
+       wm transient .pgaw:Function .pgaw:Main
+}
+
+
+proc {design} {functionname} {
+global PgAcVar CurrentDB
+       Window show .pgaw:Function
+       .pgaw:Function.fs.text1 delete 1.0 end
+       wpg_select $CurrentDB "select * from pg_proc where proname='$functionname'" rec {
+               set PgAcVar(function,name) $functionname
+               set temppar $rec(proargtypes)
+               set PgAcVar(function,returns) [Database::getPgType $rec(prorettype)]
+               set funcnrp $rec(pronargs)
+               set prolanguage $rec(prolang)
+               .pgaw:Function.fs.text1 insert end $rec(prosrc)
+       }
+       wpg_select $CurrentDB "select lanname from pg_language where oid=$prolanguage" rec {
+               set PgAcVar(function,language) $rec(lanname)
+       }
+       if { $PgAcVar(function,language)=="C" || $PgAcVar(function,language)=="c" } {
+           wpg_select $CurrentDB "select probin from pg_proc where proname='$functionname'" rec {
+               .pgaw:Function.fs.text1 delete 1.0 end
+               .pgaw:Function.fs.text1 insert end $rec(probin)
+           }
+       }
+       set PgAcVar(function,parameters) {}
+       for {set i 0} {$i<$funcnrp} {incr i} {
+               lappend PgAcVar(function,parameters) [Database::getPgType [lindex $temppar $i]]
+       }
+       set PgAcVar(function,parameters) [join $PgAcVar(function,parameters) ,]
+       set PgAcVar(function,nametodrop) "$PgAcVar(function,name) ($PgAcVar(function,parameters))"
+}
+
+
+proc {save} {} {
+global PgAcVar
+       if {$PgAcVar(function,name)==""} {
+               focus .pgaw:Function.fp.e1
+               showError [intlmsg "You must supply a name for this function!"]
+       } elseif {$PgAcVar(function,returns)==""} {
+               focus .pgaw:Function.fp.e3
+               showError [intlmsg "You must supply a return type!"]
+       } elseif {$PgAcVar(function,language)==""} {
+               focus .pgaw:Function.fp.e4
+               showError [intlmsg "You must supply the function language!"]
+       } else {
+               set funcbody [.pgaw:Function.fs.text1 get 1.0 end]
+               regsub -all "\n" $funcbody " " funcbody
+               if {$PgAcVar(function,nametodrop) != ""} {
+                       if {! [sql_exec noquiet "drop function $PgAcVar(function,nametodrop)"]} {
+                               return
+                       }
+               }
+               if {[sql_exec noquiet "create function $PgAcVar(function,name) ($PgAcVar(function,parameters)) returns $PgAcVar(function,returns) as '$funcbody' language '$PgAcVar(function,language)'"]} {
+                       Window destroy .pgaw:Function
+                       tk_messageBox -title PostgreSQL -parent .pgaw:Main -message [intlmsg "Function saved!"]
+                       Mainlib::tab_click Functions
+               }                                               
+       }
+}
+
+}
+
+proc vTclWindow.pgaw:Function {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:Function
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 480x330+98+212
+       wm maxsize $base 1009 738
+       wm minsize $base 480 330
+       wm overrideredirect $base 0
+       wm resizable $base 1 1
+       wm deiconify $base
+       wm title $base [intlmsg "Function"]
+       bind $base <Key-F1> "Help::load functions"
+       frame $base.fp \
+               -height 88 -relief groove -width 125 
+       label $base.fp.l1 \
+               -borderwidth 0 -relief raised -text [intlmsg Name]
+       entry $base.fp.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(function,name) 
+       bind $base.fp.e1 <Key-Return> {
+               focus .pgaw:Function.fp.e2
+       }
+       label $base.fp.l2 \
+               -borderwidth 0 -relief raised -text [intlmsg Parameters]
+       entry $base.fp.e2 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(function,parameters) -width 15 
+       bind $base.fp.e2 <Key-Return> {
+               focus .pgaw:Function.fp.e3
+       }
+       label $base.fp.l3 \
+               -borderwidth 0 -relief raised -text [intlmsg Returns]
+       entry $base.fp.e3 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(function,returns) 
+       bind $base.fp.e3 <Key-Return> {
+               focus .pgaw:Function.fp.e4
+       }
+       label $base.fp.l4 \
+               -borderwidth 0 -relief raised -text [intlmsg Language]
+       entry $base.fp.e4 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(function,language) -width 15 
+       bind $base.fp.e4 <Key-Return> {
+               focus .pgaw:Function.fs.text1
+       }
+       label $base.fp.lspace \
+               -borderwidth 0 -relief raised -text {    } 
+       frame $base.fs \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       text $base.fs.text1 \
+               -background #fefefe -foreground #000000 -borderwidth 1 -font $PgAcVar(pref,font_fix) -height 16 \
+               -tabs {20 40 60 80 100 120} -width 43 -yscrollcommand {.pgaw:Function.fs.vsb set} 
+       scrollbar $base.fs.vsb \
+               -borderwidth 1 -command {.pgaw:Function.fs.text1 yview} -orient vert 
+       frame $base.fb \
+               -borderwidth 2 -height 75 -width 125 
+       frame $base.fb.fbc \
+               -borderwidth 2 -height 75 -width 125 
+       button $base.fb.fbc.btnsave -command {Functions::save} \
+               -borderwidth 1 -padx 9 -pady 3 -text [intlmsg Save]
+       button $base.fb.fbc.btnhelp -command {Help::load functions} \
+               -borderwidth 1 -padx 9 -pady 3 -text [intlmsg Help]
+       button $base.fb.fbc.btncancel \
+               -borderwidth 1 -command {Window destroy .pgaw:Function} -padx 9 -pady 3 \
+               -text [intlmsg Cancel]
+       pack $base.fp \
+               -in .pgaw:Function -anchor center -expand 0 -fill x -side top 
+       grid $base.fp.l1 \
+               -in .pgaw:Function.fp -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.fp.e1 \
+               -in .pgaw:Function.fp -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fp.l2 \
+               -in .pgaw:Function.fp -column 3 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.fp.e2 \
+               -in .pgaw:Function.fp -column 4 -row 0 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.fp.l3 \
+               -in .pgaw:Function.fp -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.fp.e3 \
+               -in .pgaw:Function.fp -column 1 -row 4 -columnspan 1 -rowspan 1 
+       grid $base.fp.l4 \
+               -in .pgaw:Function.fp -column 3 -row 4 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.fp.e4 \
+               -in .pgaw:Function.fp -column 4 -row 4 -columnspan 1 -rowspan 1 -pady 3 
+       grid $base.fp.lspace \
+               -in .pgaw:Function.fp -column 2 -row 4 -columnspan 1 -rowspan 1 
+       pack $base.fs \
+               -in .pgaw:Function -anchor center -expand 1 -fill both -side top 
+       pack $base.fs.text1 \
+               -in .pgaw:Function.fs -anchor center -expand 1 -fill both -side left 
+       pack $base.fs.vsb \
+               -in .pgaw:Function.fs -anchor center -expand 0 -fill y -side right 
+       pack $base.fb \
+               -in .pgaw:Function -anchor center -expand 0 -fill x -side bottom 
+       pack $base.fb.fbc \
+               -in .pgaw:Function.fb -anchor center -expand 0 -fill none -side top 
+       pack $base.fb.fbc.btnsave \
+               -in .pgaw:Function.fb.fbc -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.fbc.btnhelp \
+               -in .pgaw:Function.fb.fbc -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.fbc.btncancel \
+               -in .pgaw:Function.fb.fbc -anchor center -expand 0 -fill none -side right 
+}
+
diff --git a/src/bin/pgaccess/lib/help.tcl b/src/bin/pgaccess/lib/help.tcl
new file mode 100644 (file)
index 0000000..87f6570
--- /dev/null
@@ -0,0 +1,127 @@
+namespace eval Help {
+
+proc {findLink} {} {
+       foreach tagname [.pgaw:Help.f.t tag names current] {
+               if {$tagname!="link"} {
+                       load $tagname
+                       return
+               }
+       }
+}
+
+
+proc {load} {topic args} {
+global PgAcVar
+       if {![winfo exists .pgaw:Help]} {
+               Window show .pgaw:Help
+               tkwait visibility .pgaw:Help
+       }
+       wm deiconify .pgaw:Help
+       if {![info exists PgAcVar(help,history)]} {
+               set PgAcVar(help,history) {}
+       }
+       if {[llength $args]==1} {
+               set PgAcVar(help,current_topic) [lindex $args 0]
+               set PgAcVar(help,history) [lrange $PgAcVar(help,history) 0 [lindex $args 0]]
+       } else {
+               lappend PgAcVar(help,history) $topic
+               set PgAcVar(help,current_topic) [expr {[llength $PgAcVar(help,history)]-1}]
+       }
+       # Limit the history length to 100 topics
+       if {[llength $PgAcVar(help,history)]>100} {
+               set PgAcVar(help,history) [lrange $PgAcVar(help,history) 1 end]
+       }
+
+       .pgaw:Help.f.t configure -state normal
+       .pgaw:Help.f.t delete 1.0 end
+       .pgaw:Help.f.t tag configure bold -font $PgAcVar(pref,font_bold)
+       .pgaw:Help.f.t tag configure italic -font $PgAcVar(pref,font_italic)
+       .pgaw:Help.f.t tag configure large -font {Helvetica -14 bold}
+       .pgaw:Help.f.t tag configure title -font $PgAcVar(pref,font_bold) -justify center
+       .pgaw:Help.f.t tag configure link -font {Helvetica -12 underline} -foreground #000080
+       .pgaw:Help.f.t tag configure code -font $PgAcVar(pref,font_fix)
+       .pgaw:Help.f.t tag configure warning -font $PgAcVar(pref,font_bold) -foreground #800000
+       .pgaw:Help.f.t tag bind link <Button-1> {Help::findLink}
+       set errmsg {}
+       .pgaw:Help.f.t configure -tabs {30 60 90 120 150 180 210 240 270 300 330 360 390}
+       catch { source [file join $PgAcVar(PGACCESS_HOME) lib help $topic.hlp] } errmsg
+       if {$errmsg!=""} {
+               .pgaw:Help.f.t insert end "Error loading help file [file join $PgAcVar(PGACCESS_HOME) $topic.hlp]\n\n$errmsg" bold
+       }
+       .pgaw:Help.f.t configure -state disabled
+       focus .pgaw:Help.f.sb
+}
+
+proc {back} {} {
+global PgAcVar
+       if {![info exists PgAcVar(help,history)]} {return}
+       if {[llength $PgAcVar(help,history)]==0} {return}
+       set i $PgAcVar(help,current_topic)
+       if {$i<1} {return}
+       incr i -1
+       load [lindex $PgAcVar(help,history) $i] $i
+}
+
+
+}
+
+proc vTclWindow.pgaw:Help {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:Help
+       }
+       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 - 640)/2}]
+       set y [expr {($sh - 480)/2}] 
+       wm geometry $base 640x480+$x+$y
+       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 [intlmsg "Help"]
+       bind $base <Key-Escape> "Window destroy .pgaw:Help"
+       frame $base.fb \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       button $base.fb.bback \
+               -command Help::back -padx 9 -pady 3 -text [intlmsg Back]
+       button $base.fb.bi \
+               -command {Help::load index} -padx 9 -pady 3 -text [intlmsg Index]
+       button $base.fb.bp \
+               -command {Help::load postgresql} -padx 9 -pady 3 -text PostgreSQL 
+       button $base.fb.btnclose \
+               -command {Window destroy .pgaw:Help} -padx 9 -pady 3 -text [intlmsg Close]
+       frame $base.f \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       text $base.f.t \
+               -borderwidth 1 -cursor {} -font $PgAcVar(pref,font_normal) -height 2 \
+               -highlightthickness 0 -state disabled \
+               -tabs {30 60 90 120 150 180 210 240 270 300 330 360 390} -width 8 \
+               -wrap word -yscrollcommand {.pgaw:Help.f.sb set} 
+       scrollbar $base.f.sb \
+               -borderwidth 1 -command {.pgaw:Help.f.t yview} -highlightthickness 0 \
+               -orient vert 
+       pack $base.fb \
+               -in .pgaw:Help -anchor center -expand 0 -fill x -side top 
+       pack $base.fb.bback \
+               -in .pgaw:Help.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.bi \
+               -in .pgaw:Help.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.bp \
+               -in .pgaw:Help.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.btnclose \
+               -in .pgaw:Help.fb -anchor center -expand 0 -fill none -side right 
+       pack $base.f \
+               -in .pgaw:Help -anchor center -expand 1 -fill both -side top 
+       pack $base.f.t \
+               -in .pgaw:Help.f -anchor center -expand 1 -fill both -side left 
+       pack $base.f.sb \
+               -in .pgaw:Help.f -anchor center -expand 0 -fill y -side right 
+}
+
diff --git a/src/bin/pgaccess/lib/mainlib.tcl b/src/bin/pgaccess/lib/mainlib.tcl
new file mode 100644 (file)
index 0000000..b4379a4
--- /dev/null
@@ -0,0 +1,987 @@
+namespace eval Mainlib {
+
+proc {cmd_Delete} {} {
+global PgAcVar CurrentDB
+if {$CurrentDB==""} return;
+set objtodelete [get_dwlb_Selection]
+if {$objtodelete==""} return;
+set delmsg [format [intlmsg "You are going to delete\n\n %s \n\nProceed?"] $objtodelete]
+if {[tk_messageBox -title [intlmsg "FINAL WARNING"] -parent .pgaw:Main -message $delmsg -type yesno -default no]=="no"} { return }
+switch $PgAcVar(activetab) {
+       Tables {
+               sql_exec noquiet "drop table \"$objtodelete\""
+               sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
+               cmd_Tables
+       }
+       Schema {
+               sql_exec quiet "delete from pga_schema where schemaname='$objtodelete'"
+               cmd_Schema
+       }
+       Views {
+               sql_exec noquiet "drop view \"$objtodelete\""
+               sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
+               cmd_Views
+       }
+       Queries {
+               sql_exec quiet "delete from pga_queries where queryname='$objtodelete'"
+               sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
+               cmd_Queries
+       }
+       Scripts {
+               sql_exec quiet "delete from pga_scripts where scriptname='$objtodelete'"
+               cmd_Scripts
+       }
+       Forms {
+               sql_exec quiet "delete from pga_forms where formname='$objtodelete'"
+               cmd_Forms
+       }
+       Sequences {
+               sql_exec quiet "drop sequence \"$objtodelete\""
+               cmd_Sequences
+       }
+       Functions {
+               delete_function $objtodelete
+               cmd_Functions
+       }
+       Reports {
+               sql_exec noquiet "delete from pga_reports where reportname='$objtodelete'"
+               cmd_Reports
+       }
+       Users {
+               sql_exec noquiet "drop user \"$objtodelete\""
+               cmd_Users
+       }
+}
+}
+
+proc {cmd_Design} {} {
+global PgAcVar CurrentDB
+if {$CurrentDB==""} return;
+if {[.pgaw:Main.lb curselection]==""} return;
+set objname [.pgaw:Main.lb get [.pgaw:Main.lb curselection]]
+set tablename $objname
+switch $PgAcVar(activetab) {
+       Tables  {
+               Tables::design $objname
+       }
+       Schema  {
+               Schema::open $objname
+       }
+       Queries {
+               Queries::design $objname
+       }
+       Views {
+               Views::design $objname
+       }
+       Scripts {
+               Scripts::design $objname
+       }
+       Forms {
+               Forms::design $objname
+       }
+       Functions {
+               Functions::design $objname
+       }
+       Reports {
+               Reports::design $objname
+       }
+       Users {
+               Users::design $objname
+       }
+}
+}
+
+proc {cmd_Forms} {} {
+global CurrentDB
+       setCursor CLOCK
+       .pgaw:Main.lb delete 0 end
+       catch {
+               wpg_select $CurrentDB "select formname from pga_forms order by formname" rec {
+                       .pgaw:Main.lb insert end $rec(formname)
+               }
+       }
+       setCursor DEFAULT
+}
+
+
+proc {cmd_Functions} {} {
+global CurrentDB
+       set maxim 16384
+       setCursor CLOCK
+       catch {
+               wpg_select $CurrentDB "select oid from pg_database where datname='template1'" rec {
+                       set maxim $rec(oid)
+               }
+       }
+       .pgaw:Main.lb delete 0 end
+       catch {
+               wpg_select $CurrentDB "select proname from pg_proc where oid>$maxim order by proname" rec {
+                       .pgaw:Main.lb insert end $rec(proname)
+               }       
+       }
+       setCursor DEFAULT
+}
+
+
+proc {cmd_Import_Export} {how} {
+global PgAcVar CurrentDB
+       if {$CurrentDB==""} return;
+       Window show .pgaw:ImportExport
+       set PgAcVar(impexp,tablename) {}
+       set PgAcVar(impexp,filename) {}
+       set PgAcVar(impexp,delimiter) {}
+       if {$PgAcVar(activetab)=="Tables"} {
+               set tn [get_dwlb_Selection]
+               set PgAcVar(impexp,tablename) $tn
+               if {$tn!=""} {set PgAcVar(impexp,filename) "$tn.txt"}
+       }
+       .pgaw:ImportExport.expbtn configure -text [intlmsg $how]
+}
+
+
+proc {cmd_New} {} {
+global PgAcVar CurrentDB
+if {$CurrentDB==""} return;
+switch $PgAcVar(activetab) {
+       Tables {
+               Tables::new
+       }
+       Schema {
+               Schema::new
+       }
+       Queries {
+               Queries::new
+       }
+       Users {
+               Users::new
+       }
+       Views {
+               Views::new
+       }
+       Sequences {
+               Sequences::new
+       }
+       Reports {
+               Reports::new
+       }
+       Forms {
+               Forms::new
+       }
+       Scripts {
+               Scripts::new
+       }
+       Functions {
+               Functions::new
+       }
+}
+}
+
+
+proc {cmd_Open} {} {
+global PgAcVar CurrentDB
+       if {$CurrentDB==""} return;
+       set objname [get_dwlb_Selection]
+       if {$objname==""} return;
+       switch $PgAcVar(activetab) {
+               Tables          { Tables::open $objname }
+               Schema          { Schema::open $objname }
+               Forms           { Forms::open $objname }
+               Scripts         { Scripts::open $objname }
+               Queries         { Queries::open $objname }
+               Views           { Views::open $objname }
+               Sequences       { Sequences::open $objname }
+               Functions       { Functions::design $objname }
+               Reports         { Reports::open $objname }
+       }
+}
+
+
+
+proc {cmd_Queries} {} {
+global CurrentDB
+       .pgaw:Main.lb delete 0 end
+       catch {
+               wpg_select $CurrentDB "select queryname from pga_queries order by queryname" rec {
+                       .pgaw:Main.lb insert end $rec(queryname)
+               }
+       }
+}
+
+
+proc {cmd_Rename} {} {
+global PgAcVar CurrentDB
+       if {$CurrentDB==""} return;
+       if {$PgAcVar(activetab)=="Views"} return;
+       if {$PgAcVar(activetab)=="Sequences"} return;
+       if {$PgAcVar(activetab)=="Functions"} return;
+       if {$PgAcVar(activetab)=="Users"} return;
+       set temp [get_dwlb_Selection]
+       if {$temp==""} {
+               tk_messageBox -title [intlmsg Warning] -parent .pgaw:Main -message [intlmsg "Please select an object first!"]
+               return;
+       }
+       set PgAcVar(Old_Object_Name) $temp
+       Window show .pgaw:RenameObject
+}
+
+
+proc {cmd_Reports} {} {
+global CurrentDB
+       setCursor CLOCK
+       catch {
+               wpg_select $CurrentDB "select reportname from pga_reports order by reportname" rec {
+               .pgaw:Main.lb insert end "$rec(reportname)"
+               }
+       }
+       setCursor DEFAULT
+}
+
+proc {cmd_Users} {} {
+global CurrentDB
+       setCursor CLOCK
+       .pgaw:Main.lb delete 0 end
+       catch {
+               wpg_select $CurrentDB "select * from pg_user order by usename" rec {
+                       .pgaw:Main.lb insert end $rec(usename)
+               }
+       }
+       setCursor DEFAULT
+}
+
+
+proc {cmd_Scripts} {} {
+global CurrentDB
+       setCursor CLOCK
+       .pgaw:Main.lb delete 0 end
+       catch {
+               wpg_select $CurrentDB "select scriptname from pga_scripts order by scriptname" rec {
+               .pgaw:Main.lb insert end $rec(scriptname)
+               }
+       }
+       setCursor DEFAULT
+}
+
+
+proc {cmd_Sequences} {} {
+global CurrentDB
+
+setCursor CLOCK
+.pgaw:Main.lb delete 0 end
+catch {
+       wpg_select $CurrentDB "select relname from pg_class where (relname not like 'pg_%') and (relkind='S') order by relname" rec {
+               .pgaw:Main.lb insert end $rec(relname)
+       }
+}
+setCursor DEFAULT
+}
+
+proc {cmd_Tables} {} {
+global CurrentDB
+       setCursor CLOCK
+       .pgaw:Main.lb delete 0 end
+       foreach tbl [Database::getTablesList] {.pgaw:Main.lb insert end $tbl}
+       setCursor DEFAULT
+}
+
+proc {cmd_Schema} {} {
+global CurrentDB
+.pgaw:Main.lb delete 0 end
+catch {
+       wpg_select $CurrentDB "select schemaname from pga_schema order by schemaname" rec {
+               .pgaw:Main.lb insert end $rec(schemaname)
+       }
+}
+}
+
+proc {cmd_Views} {} {
+global CurrentDB
+setCursor CLOCK
+.pgaw:Main.lb delete 0 end
+catch {
+       wpg_select $CurrentDB "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 $CurrentDB "select relname from pg_class where (relname !~ '^pg_') and (relkind='r') and (relhasrules) order by relname" rec {
+               if {[info exists itsaview($rec(relname))]} {
+                       .pgaw:Main.lb insert end $rec(relname)
+               }
+       }
+}
+setCursor DEFAULT
+}
+
+proc {delete_function} {objname} {
+global CurrentDB
+       wpg_select $CurrentDB "select proargtypes,pronargs from pg_proc where proname='$objname'" rec {
+               set PgAcVar(function,parameters) $rec(proargtypes)
+               set nrpar $rec(pronargs)
+       }
+       set lispar {}
+       for {set i 0} {$i<$nrpar} {incr i} {
+               lappend lispar [Database::getPgType [lindex $PgAcVar(function,parameters) $i]]
+       }
+       set lispar [join $lispar ,]
+       sql_exec noquiet "drop function $objname ($lispar)"
+}
+
+
+proc {draw_tabs} {} {
+global PgAcVar
+       set ypos 85
+       foreach tab $PgAcVar(tablist) {
+               label .pgaw:Main.tab$tab -borderwidth 1  -anchor w -relief raised -text [intlmsg $tab]
+               place .pgaw:Main.tab$tab -x 10 -y $ypos -height 25 -width 82 -anchor nw -bordermode ignore
+               lower .pgaw:Main.tab$tab
+               bind .pgaw:Main.tab$tab <Button-1> "Mainlib::tab_click $tab"
+               incr ypos 25
+       }
+       set PgAcVar(activetab) ""
+}
+
+
+proc {get_dwlb_Selection} {} {
+       set temp [.pgaw:Main.lb curselection]
+       if {$temp==""} return "";
+       return [.pgaw:Main.lb get $temp]
+}
+
+
+
+
+proc {sqlw_display} {msg} {
+       if {![winfo exists .pgaw:SQLWindow]} {return}
+       .pgaw:SQLWindow.f.t insert end "$msg\n\n"
+       .pgaw:SQLWindow.f.t see end
+       set nrlines [lindex [split [.pgaw:SQLWindow.f.t index end] .] 0]
+       if {$nrlines>50} {
+               .pgaw:SQLWindow.f.t delete 1.0 3.0
+       }
+}
+
+
+proc {open_database} {} {
+global PgAcVar CurrentDB
+setCursor CLOCK
+if {$PgAcVar(opendb,username)!=""} {
+       if {$PgAcVar(opendb,host)!=""} {
+               set connres [catch {set newdbc [pg_connect -conninfo "host=$PgAcVar(opendb,host) port=$PgAcVar(opendb,pgport) dbname=$PgAcVar(opendb,dbname) user=$PgAcVar(opendb,username) password=$PgAcVar(opendb,password)"]} msg]
+       } else {
+               set connres [catch {set newdbc [pg_connect -conninfo "dbname=$PgAcVar(opendb,dbname) user=$PgAcVar(opendb,username) password=$PgAcVar(opendb,password)"]} msg]
+       }
+} else {
+       set connres [catch {set newdbc [pg_connect $PgAcVar(opendb,dbname) -host $PgAcVar(opendb,host) -port $PgAcVar(opendb,pgport)]} msg]
+}
+if {$connres} {
+       setCursor DEFAULT
+       showError [format [intlmsg "Error trying to connect to database '%s' on host %s \n\nPostgreSQL error message:%s"] $PgAcVar(opendb,dbname) $PgAcVar(opendb,host) $msg"]
+       return $msg
+} else {
+       catch {pg_disconnect $CurrentDB}
+       set CurrentDB $newdbc
+       set PgAcVar(currentdb,host) $PgAcVar(opendb,host)
+       set PgAcVar(currentdb,pgport) $PgAcVar(opendb,pgport)
+       set PgAcVar(currentdb,dbname) $PgAcVar(opendb,dbname)
+       set PgAcVar(currentdb,username) $PgAcVar(opendb,username)
+       set PgAcVar(currentdb,password) $PgAcVar(opendb,password)
+       set PgAcVar(statusline,dbname) $PgAcVar(currentdb,dbname)
+       set PgAcVar(pref,lastdb) $PgAcVar(currentdb,dbname)
+       set PgAcVar(pref,lasthost) $PgAcVar(currentdb,host)
+       set PgAcVar(pref,lastport) $PgAcVar(currentdb,pgport)
+       set PgAcVar(pref,lastusername) $PgAcVar(currentdb,username)
+       Preferences::save
+       catch {setCursor DEFAULT ; Window hide .pgaw:OpenDB}
+       tab_click Tables
+       # Check for pga_ tables
+       foreach {table structure} {pga_queries {queryname varchar(64),querytype char(1),querycommand text,querytables text,querylinks text,queryresults text,querycomments 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} pga_schema {schemaname varchar(64),schematables text,schemalinks text}} {
+               set pgres [wpg_exec $CurrentDB "select relname from pg_class where relname='$table'"]
+               if {$PgAcVar(pgsql,status)!="PGRES_TUPLES_OK"} {
+                       showError "[intlmsg {FATAL ERROR searching for PgAccess system tables}] : $PgAcVar(pgsql,errmsg)\nStatus:$PgAcVar(pgsql,status)"
+                       catch {pg_disconnect $CurrentDB}
+                       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"
+               } else {
+                       foreach fieldspec [split $structure ,] {
+                               set field [lindex [split $fieldspec] 0]
+                               set pgres [wpg_exec $CurrentDB "select \"$field\" from \"$table\""]
+                               if {$PgAcVar(pgsql,status)!="PGRES_TUPLES_OK"} {
+                                       if {![regexp "attribute '$field' not found" $PgAcVar(pgsql,errmsg)]} {
+                                               showError "[intlmsg {FATAL ERROR upgrading PgAccess table}] $table: $PgAcVar(pgsql,errmsg)\nStatus:$PgAcVar(pgsql,status)"
+                                               catch {pg_disconnect $CurrentDB}
+                                               exit
+                                       } else {
+                                               pg_result $pgres -clear
+                                               sql_exec quiet "alter table \"$table\" add column $fieldspec "
+                                       }
+                               }
+                       }
+               }
+               catch {pg_result $pgres -clear}
+       }
+       
+       # searching for autoexec script
+       wpg_select $CurrentDB "select * from pga_scripts where scriptname ~* '^autoexec$'" recd {
+               eval $recd(scriptsource)
+       }
+       return ""
+}
+}
+
+
+proc {tab_click} {tabname} {
+global PgAcVar CurrentDB
+       set w .pgaw:Main.tab$tabname
+       if {$CurrentDB==""} return;
+       set curtab $tabname
+       #if {$PgAcVar(activetab)==$curtab} return;
+       .pgaw:Main.btndesign configure -state disabled
+       if {$PgAcVar(activetab)!=""} {
+               place .pgaw:Main.tab$PgAcVar(activetab) -x 10
+               .pgaw:Main.tab$PgAcVar(activetab) configure -font $PgAcVar(pref,font_normal)
+       }
+       $w configure -font $PgAcVar(pref,font_bold)
+       place $w -x 7
+       place .pgaw:Main.lmask -x 80 -y [expr 86+25*[lsearch -exact $PgAcVar(tablist) $curtab]]
+       set PgAcVar(activetab) $curtab
+       # Tabs where button Design is enabled
+       if {[lsearch {Tables Schema Scripts Queries Functions Views Reports Forms Users} $PgAcVar(activetab)]!=-1} {
+               .pgaw:Main.btndesign configure -state normal
+       }
+       .pgaw:Main.lb delete 0 end
+       cmd_$curtab
+}
+
+
+
+}
+
+
+proc vTclWindow.pgaw:Main {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:Main
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel \
+               -background #efefef -cursor left_ptr
+       wm focusmodel $base passive
+       wm geometry $base 332x390+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"
+       bind $base <Key-F1> "Help::load index"
+       label $base.labframe \
+               -relief raised 
+       listbox $base.lb \
+               -background #fefefe \
+               -selectbackground #c3c3c3 \
+               -foreground black -highlightthickness 0 -selectborderwidth 0 \
+               -yscrollcommand {.pgaw:Main.sb set} 
+       bind $base.lb <Double-Button-1> {
+               Mainlib::cmd_Open
+       }
+       button $base.btnnew \
+               -borderwidth 1 -command Mainlib::cmd_New -text [intlmsg New]
+       button $base.btnopen \
+               -borderwidth 1 -command Mainlib::cmd_Open -text [intlmsg Open]
+       button $base.btndesign \
+               -borderwidth 1 -command Mainlib::cmd_Design -text [intlmsg Design]
+       label $base.lmask \
+               -borderwidth 0 \
+               -text {  } 
+       frame $base.fm \
+        -borderwidth 1 -height 75 -relief raised -width 125 
+       menubutton $base.fm.mndb \
+               -borderwidth 1 -font $PgAcVar(pref,font_normal) \
+               -menu .pgaw:Main.fm.mndb.01 -padx 4 -pady 3 -text [intlmsg Database]
+       menu $base.fm.mndb.01 \
+               -borderwidth 1 -font $PgAcVar(pref,font_normal) \
+               -tearoff 0 
+       $base.fm.mndb.01 add command \
+               -command {
+Window show .pgaw:OpenDB
+set PgAcVar(opendb,host) $PgAcVar(currentdb,host)
+set PgAcVar(opendb,pgport) $PgAcVar(currentdb,pgport)
+focus .pgaw:OpenDB.f1.e3
+wm transient .pgaw:OpenDB .pgaw:Main
+.pgaw:OpenDB.f1.e3 selection range 0 end} \
+               -label [intlmsg Open] -font $PgAcVar(pref,font_normal)
+       $base.fm.mndb.01 add command \
+               -command {.pgaw:Main.lb delete 0 end
+set CurrentDB {}
+set PgAcVar(currentdb,dbname) {}
+set PgAcVar(statusline,dbname) {}} \
+               -label [intlmsg Close]
+       $base.fm.mndb.01 add command \
+               -command Database::vacuum -label [intlmsg Vacuum]
+       $base.fm.mndb.01 add separator
+       $base.fm.mndb.01 add command \
+               -command {Mainlib::cmd_Import_Export Import} -label [intlmsg {Import table}]
+       $base.fm.mndb.01 add command \
+               -command {Mainlib::cmd_Import_Export Export} -label [intlmsg {Export table}]
+       $base.fm.mndb.01 add separator
+       $base.fm.mndb.01 add command \
+               -command Preferences::configure -label [intlmsg Preferences]
+       $base.fm.mndb.01 add command \
+               -command "Window show .pgaw:SQLWindow" -label [intlmsg "SQL window"]
+       $base.fm.mndb.01 add separator
+       $base.fm.mndb.01 add command \
+               -command {
+set PgAcVar(activetab) {}
+Preferences::save
+catch {pg_disconnect $CurrentDB}
+exit} -label [intlmsg Exit]
+       label $base.lshost \
+               -relief groove -text localhost -textvariable PgAcVar(currentdb,host) 
+       label $base.lsdbname \
+               -anchor w \
+               -relief groove -textvariable PgAcVar(statusline,dbname) 
+       scrollbar $base.sb \
+               -borderwidth 1 -command {.pgaw:Main.lb yview} -orient vert 
+       menubutton $base.fm.mnob \
+               -borderwidth 1 \
+               -menu .pgaw:Main.fm.mnob.m -font $PgAcVar(pref,font_normal) -text [intlmsg Object]
+       menu $base.fm.mnob.m \
+               -borderwidth 1 -font $PgAcVar(pref,font_normal) \
+               -tearoff 0 
+       $base.fm.mnob.m add command \
+               -command Mainlib::cmd_New -font $PgAcVar(pref,font_normal) -label [intlmsg New] 
+       $base.fm.mnob.m add command \
+               -command Mainlib::cmd_Delete -label [intlmsg Delete] 
+       $base.fm.mnob.m add command \
+               -command Mainlib::cmd_Rename -label [intlmsg Rename] 
+       menubutton $base.fm.mnhelp \
+               -borderwidth 1 \
+               -menu .pgaw:Main.fm.mnhelp.m -font $PgAcVar(pref,font_normal) -text [intlmsg Help]
+       menu $base.fm.mnhelp.m \
+               -borderwidth 1 -font $PgAcVar(pref,font_normal) \
+               -tearoff 0 
+       $base.fm.mnhelp.m add command \
+               -label [intlmsg Contents] -command {Help::load index}
+       $base.fm.mnhelp.m add command \
+               -label PostgreSQL  -command {Help::load postgresql}
+       $base.fm.mnhelp.m add separator
+       $base.fm.mnhelp.m add command \
+               -command {Window show .pgaw:About} -label [intlmsg About]
+       place $base.labframe \
+               -x 80 -y 30 -width 246 -height 325 -anchor nw -bordermode ignore 
+       place $base.lb \
+               -x 90 -y 75 -width 210 -height 272 -anchor nw -bordermode ignore 
+       place $base.btnnew \
+               -x 89 -y 40 -width 75 -height 25 -anchor nw -bordermode ignore 
+       place $base.btnopen \
+               -x 166 -y 40 -width 75 -height 25 -anchor nw -bordermode ignore 
+       place $base.btndesign \
+               -x 243 -y 40 -width 76 -height 25 -anchor nw -bordermode ignore 
+       place $base.lmask \
+               -x 1550 -y 4500 -width 10 -height 23 -anchor nw -bordermode ignore 
+       place $base.lshost \
+               -x 3 -y 370 -width 91 -height 20 -anchor nw -bordermode ignore 
+       place $base.lsdbname \
+               -x 95 -y 370 -width 233 -height 20 -anchor nw -bordermode ignore 
+       place $base.sb \
+               -x 301 -y 74 -width 18 -height 274 -anchor nw -bordermode ignore 
+       place $base.fm \
+        -x 1 -y 0 -width 331 -height 25 -anchor nw -bordermode ignore 
+       pack $base.fm.mndb \
+        -in .pgaw:Main.fm -anchor center -expand 0 -fill none -side left 
+       pack $base.fm.mnob \
+        -in .pgaw:Main.fm -anchor center -expand 0 -fill none -side left 
+       pack $base.fm.mnhelp \
+        -in .pgaw:Main.fm -anchor center -expand 0 -fill none -side right 
+}
+
+proc vTclWindow.pgaw:ImportExport {base} {
+       if {$base == ""} {
+               set base .pgaw:ImportExport
+       }
+       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 [intlmsg "Import-Export table"]
+       label $base.l1  -borderwidth 0 -text [intlmsg {Table name}]
+       entry $base.e1  -background #fefefe -borderwidth 1 -textvariable PgAcVar(impexp,tablename) 
+       label $base.l2  -borderwidth 0 -text [intlmsg {File name}]
+       entry $base.e2  -background #fefefe -borderwidth 1 -textvariable PgAcVar(impexp,filename) 
+       label $base.l3  -borderwidth 0 -text [intlmsg {Field delimiter}]
+       entry $base.e3  -background #fefefe -borderwidth 1 -textvariable PgAcVar(impexp,delimiter) 
+       button $base.expbtn  -borderwidth 1  -command {if {$PgAcVar(impexp,tablename)==""} {
+       showError [intlmsg "You have to supply a table name!"]
+} elseif {$PgAcVar(impexp,filename)==""} {
+       showError [intlmsg "You have to supply a external file name!"]
+} else {
+       if {$PgAcVar(impexp,delimiter)==""} {
+               set sup ""
+       } else {
+               set sup " USING DELIMITERS '$PgAcVar(impexp,delimiter)'"
+       }
+       if {[.pgaw:ImportExport.expbtn cget -text]=="Import"} {
+               set oper "FROM"
+       } else {
+               set oper "TO"
+       }
+               if {$PgAcVar(impexp,withoids)} {
+                               set sup2 " WITH OIDS "
+               } else {
+                               set sup2 ""
+               }
+       set sqlcmd "COPY \"$PgAcVar(impexp,tablename)\" $sup2 $oper '$PgAcVar(impexp,filename)'$sup"
+       setCursor CLOCK
+       if {[sql_exec noquiet $sqlcmd]} {
+               tk_messageBox -title [intlmsg Information] -parent .pgaw:ImportExport -message [intlmsg "Operation completed!"]
+               Window destroy .pgaw:ImportExport
+       }
+       setCursor DEFAULT
+}}  -text Export 
+       button $base.cancelbtn  -borderwidth 1 -command {Window destroy .pgaw:ImportExport} -text [intlmsg Cancel]
+       checkbutton $base.oicb  -borderwidth 1  -text [intlmsg {with OIDs}] -variable PgAcVar(impexp,withoids) 
+       place $base.l1  -x 15 -y 15 -anchor nw -bordermode ignore 
+       place $base.e1  -x 115 -y 10 -height 22 -anchor nw -bordermode ignore 
+       place $base.l2  -x 15 -y 45 -anchor nw -bordermode ignore 
+       place $base.e2  -x 115 -y 40 -height 22 -anchor nw -bordermode ignore 
+       place $base.l3  -x 15 -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 vTclWindow.pgaw:RenameObject {base} {
+       if {$base == ""} {
+               set base .pgaw:RenameObject
+       }
+       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 [intlmsg "Rename"]
+       label $base.l1  -borderwidth 0 -text [intlmsg {New name}]
+       entry $base.e1  -background #fefefe -borderwidth 1 -textvariable PgAcVar(New_Object_Name) 
+       button $base.b1  -borderwidth 1  -command {
+                       if {$PgAcVar(New_Object_Name)==""} {
+                               showError [intlmsg "You must give object a new name!"]
+                       } elseif {$PgAcVar(activetab)=="Tables"} {
+                               set retval [sql_exec noquiet "alter table \"$PgAcVar(Old_Object_Name)\" rename to \"$PgAcVar(New_Object_Name)\""]
+                               if {$retval} {
+                                       sql_exec quiet "update pga_layout set tablename='$PgAcVar(New_Object_Name)' where tablename='$PgAcVar(Old_Object_Name)'"
+                                       Mainlib::cmd_Tables
+                                       Window destroy .pgaw:RenameObject
+                               }
+                       } elseif {$PgAcVar(activetab)=="Queries"} {
+                               set pgres [wpg_exec $CurrentDB "select * from pga_queries where queryname='$PgAcVar(New_Object_Name)'"]
+                               if {$PgAcVar(pgsql,status)!="PGRES_TUPLES_OK"} {
+                                       showError "[intlmsg {Error retrieving from}] pga_queries\n$PgAcVar(pgsql,errmsg)\n$PgAcVar(pgsql,status)"
+                               } elseif {[pg_result $pgres -numTuples]>0} {
+                                       showError [format [intlmsg "Query '%s' already exists!"] $PgAcVar(New_Object_Name)]
+                               } else {
+                                       sql_exec noquiet "update pga_queries set queryname='$PgAcVar(New_Object_Name)' where queryname='$PgAcVar(Old_Object_Name)'"
+                                       sql_exec noquiet "update pga_layout set tablename='$PgAcVar(New_Object_Name)' where tablename='$PgAcVar(Old_Object_Name)'"
+                                       Mainlib::cmd_Queries
+                                       Window destroy .pgaw:RenameObject
+                               }
+                               catch {pg_result $pgres -clear}
+                       } elseif {$PgAcVar(activetab)=="Forms"} {
+                               set pgres [wpg_exec $CurrentDB "select * from pga_forms where formname='$PgAcVar(New_Object_Name)'"]
+                               if {$PgAcVar(pgsql,status)!="PGRES_TUPLES_OK"} {
+                                       showError "[intlmsg {Error retrieving from}] pga_forms\n$PgAcVar(pgsql,errmsg)\n$PgAcVar(pgsql,status)"
+                               } elseif {[pg_result $pgres -numTuples]>0} {
+                                       showError [format [intlmsg "Form '%s' already exists!"] $PgAcVar(New_Object_Name)]
+                               } else {
+                                       sql_exec noquiet "update pga_forms set formname='$PgAcVar(New_Object_Name)' where formname='$PgAcVar(Old_Object_Name)'"
+                                       Mainlib::cmd_Forms
+                                       Window destroy .pgaw:RenameObject
+                               }
+                               catch {pg_result $pgres -clear}
+                       } elseif {$PgAcVar(activetab)=="Scripts"} {
+                               set pgres [wpg_exec $CurrentDB "select * from pga_scripts where scriptname='$PgAcVar(New_Object_Name)'"]
+                               if {$PgAcVar(pgsql,status)!="PGRES_TUPLES_OK"} {
+                                       showError "[intlmsg {Error retrieving from}] pga_scripts\n$PgAcVar(pgsql,errmsg)\n$PgAcVar(pgsql,status)"
+                               } elseif {[pg_result $pgres -numTuples]>0} {
+                                       showError [format [intlmsg "Script '%s' already exists!"] $PgAcVar(New_Object_Name)]
+                               } else {
+                                       sql_exec noquiet "update pga_scripts set scriptname='$PgAcVar(New_Object_Name)' where scriptname='$PgAcVar(Old_Object_Name)'"
+                                       Mainlib::cmd_Scripts
+                                       Window destroy .pgaw:RenameObject
+                               }
+                               catch {pg_result $pgres -clear}
+                       } elseif {$PgAcVar(activetab)=="Schema"} {
+                               set pgres [wpg_exec $CurrentDB "select * from pga_schema where schemaname='$PgAcVar(New_Object_Name)'"]
+                               if {$PgAcVar(pgsql,status)!="PGRES_TUPLES_OK"} {
+                                       showError "[intlmsg {Error retrieving from}] pga_schema\n$PgAcVar(pgsql,errmsg)\n$PgAcVar(pgsql,status)"
+                               } elseif {[pg_result $pgres -numTuples]>0} {
+                                       showError [format [intlmsg "Schema '%s' already exists!"] $PgAcVar(New_Object_Name)]
+                               } else {
+                                       sql_exec noquiet "update pga_schema set schemaname='$PgAcVar(New_Object_Name)' where schemaname='$PgAcVar(Old_Object_Name)'"
+                                       Mainlib::cmd_Schema
+                                       Window destroy .pgaw:RenameObject
+                               }
+                               catch {pg_result $pgres -clear}
+                       }
+          } -text [intlmsg Rename]
+       button $base.b2  -borderwidth 1 -command {Window destroy .pgaw:RenameObject} -text [intlmsg 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 55 -y 65 -width 80 -anchor nw -bordermode ignore 
+       place $base.b2  -x 155 -y 65 -width 80 -anchor nw -bordermode ignore
+}
+
+
+proc vTclWindow.pgaw:GetParameter {base} {
+       if {$base == ""} {
+               set base .pgaw:GetParameter
+       }
+       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 [intlmsg "Input parameter"]
+       label $base.l1 \
+               -anchor nw -borderwidth 1 \
+               -justify left -relief sunken -textvariable PgAcVar(getqueryparam,msg) -wraplength 200 
+       entry $base.e1 \
+               -background #fefefe -borderwidth 1 -highlightthickness 0 \
+               -textvariable PgAcVar(getqueryparam,var) 
+       bind $base.e1 <Key-KP_Enter> {
+               set PgAcVar(getqueryparam,result) 1
+destroy .pgaw:GetParameter
+       }
+       bind $base.e1 <Key-Return> {
+               set PgAcVar(getqueryparam,result) 1
+destroy .pgaw:GetParameter
+       }
+       button $base.bok \
+               -borderwidth 1 -command {set PgAcVar(getqueryparam,result) 1
+destroy .pgaw:GetParameter} -text Ok 
+       button $base.bcanc \
+               -borderwidth 1 -command {set PgAcVar(getqueryparam,result) 0
+destroy .pgaw:GetParameter} -text [intlmsg 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.pgaw:SQLWindow {base} {
+       if {$base == ""} {
+               set base .pgaw:SQLWindow
+       }
+       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 [intlmsg "SQL window"]
+       frame $base.f \
+               -borderwidth 1 -height 392 -relief raised -width 396 
+       scrollbar $base.f.01 \
+               -borderwidth 1 -command {.pgaw:SQLWindow.f.t xview} -orient horiz \
+               -width 10 
+       scrollbar $base.f.02 \
+               -borderwidth 1 -command {.pgaw:SQLWindow.f.t yview} -orient vert -width 10 
+       text $base.f.t \
+               -borderwidth 1 \
+               -height 200 -width 200 -wrap word \
+               -xscrollcommand {.pgaw:SQLWindow.f.01 set} \
+               -yscrollcommand {.pgaw:SQLWindow.f.02 set} 
+       button $base.b1 \
+               -borderwidth 1 -command {.pgaw:SQLWindow.f.t delete 1.0 end} -text [intlmsg Clean]
+       button $base.b2 \
+               -borderwidth 1 -command {destroy .pgaw:SQLWindow} -text [intlmsg Close] 
+       grid columnconf $base 0 -weight 1
+       grid columnconf $base 1 -weight 1
+       grid rowconf $base 0 -weight 1
+       grid $base.f \
+               -in .pgaw:SQLWindow -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 .pgaw:SQLWindow.f -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew 
+       grid $base.f.02 \
+               -in .pgaw:SQLWindow.f -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky ns 
+       grid $base.f.t \
+               -in .pgaw:SQLWindow.f -column 0 -row 0 -columnspan 1 -rowspan 1 \
+               -sticky nesw 
+       grid $base.b1 \
+               -in .pgaw:SQLWindow -column 0 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.b2 \
+               -in .pgaw:SQLWindow -column 1 -row 1 -columnspan 1 -rowspan 1 
+}
+
+proc vTclWindow.pgaw:About {base} {
+       if {$base == ""} {
+               set base .pgaw: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 [intlmsg "About"]
+       label $base.l1  -borderwidth 3 -font -Adobe-Helvetica-Bold-R-Normal-*-*-180-*-*-*-*-*  -relief ridge -text PgAccess 
+       label $base.l2  -relief groove  -text [intlmsg "A Tcl/Tk interface to\nPostgreSQL\nby Constantin Teodorescu"]
+       label $base.l3  -borderwidth 0 -relief sunken -text {v 0.98}
+       label $base.l4  -relief groove  -text "[intlmsg {You will always get the latest version at:}]
+http://www.flex.ro/pgaccess
+
+[intlmsg {Suggestions at}] : teo@flex.ro"
+       button $base.b1  -borderwidth 1 -command {Window destroy .pgaw: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.pgaw:OpenDB {base} {
+       if {$base == ""} {
+               set base .pgaw:OpenDB
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 283x172+119+210
+       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 [intlmsg "Open database"]
+       frame $base.f1 \
+               -borderwidth 2 -height 75 -width 125 
+       label $base.f1.l1 \
+               -borderwidth 0 -relief raised -text [intlmsg Host]
+       entry $base.f1.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(opendb,host) -width 200 
+       bind $base.f1.e1 <Key-KP_Enter> {
+               focus .pgaw:OpenDB.f1.e2
+       }
+       bind $base.f1.e1 <Key-Return> {
+               focus .pgaw:OpenDB.f1.e2
+       }
+       label $base.f1.l2 \
+               -borderwidth 0 -relief raised -text [intlmsg Port]
+       entry $base.f1.e2 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(opendb,pgport) -width 200 
+       bind $base.f1.e2 <Key-Return> {
+               focus .pgaw:OpenDB.f1.e3
+       }
+       label $base.f1.l3 \
+               -borderwidth 0 -relief raised -text [intlmsg Database]
+       entry $base.f1.e3 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(opendb,dbname) -width 200 
+       bind $base.f1.e3 <Key-Return> {
+               focus .pgaw:OpenDB.f1.e4
+       }
+       label $base.f1.l4 \
+               -borderwidth 0 -relief raised -text [intlmsg Username]
+       entry $base.f1.e4 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(opendb,username) \
+               -width 200 
+       bind $base.f1.e4 <Key-Return> {
+               focus .pgaw:OpenDB.f1.e5
+       }
+       label $base.f1.ls2 \
+               -borderwidth 0 -relief raised -text { } 
+       label $base.f1.l5 \
+               -borderwidth 0 -relief raised -text [intlmsg Password]
+       entry $base.f1.e5 \
+               -background #fefefe -borderwidth 1 -show x -textvariable PgAcVar(opendb,password) \
+               -width 200 
+       bind $base.f1.e5 <Key-Return> {
+               focus .pgaw:OpenDB.fb.btnopen
+       }
+       frame $base.fb \
+               -height 75 -relief groove -width 125 
+       button $base.fb.btnopen \
+               -borderwidth 1 -command Mainlib::open_database -padx 9 \
+               -pady 3 -text [intlmsg Open]
+       button $base.fb.btncancel \
+               -borderwidth 1 -command {Window hide .pgaw:OpenDB} \
+               -padx 9 -pady 3 -text [intlmsg Cancel]
+       place $base.f1 \
+               -x 9 -y 5 -width 265 -height 126 -anchor nw -bordermode ignore 
+       grid columnconf $base.f1 2 -weight 1
+       grid $base.f1.l1 \
+               -in .pgaw:OpenDB.f1 -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e1 \
+               -in .pgaw:OpenDB.f1 -column 2 -row 0 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.l2 \
+               -in .pgaw:OpenDB.f1 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e2 \
+               -in .pgaw:OpenDB.f1 -column 2 -row 2 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.l3 \
+               -in .pgaw:OpenDB.f1 -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e3 \
+               -in .pgaw:OpenDB.f1 -column 2 -row 4 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.l4 \
+               -in .pgaw:OpenDB.f1 -column 0 -row 6 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e4 \
+               -in .pgaw:OpenDB.f1 -column 2 -row 6 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.ls2 \
+               -in .pgaw:OpenDB.f1 -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f1.l5 \
+               -in .pgaw:OpenDB.f1 -column 0 -row 7 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e5 \
+               -in .pgaw:OpenDB.f1 -column 2 -row 7 -columnspan 1 -rowspan 1 -pady 2 
+       place $base.fb \
+               -x 0 -y 135 -width 283 -height 40 -anchor nw -bordermode ignore 
+       grid $base.fb.btnopen \
+               -in .pgaw:OpenDB.fb -column 0 -row 0 -columnspan 1 -rowspan 1 -padx 5 
+       grid $base.fb.btncancel \
+               -in .pgaw:OpenDB.fb -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 5 
+}
+
+
diff --git a/src/bin/pgaccess/lib/preferences.tcl b/src/bin/pgaccess/lib/preferences.tcl
new file mode 100644 (file)
index 0000000..c752e03
--- /dev/null
@@ -0,0 +1,273 @@
+namespace eval Preferences {
+
+proc {load} {} {
+global PgAcVar
+       setDefaultFonts
+       setGUIPreferences
+       # Set some default values for preferences
+       set PgAcVar(pref,rows) 200
+       set PgAcVar(pref,tvfont) clean
+       set PgAcVar(pref,autoload) 1
+       set PgAcVar(pref,systemtables) 0
+       set PgAcVar(pref,lastdb) {}
+       set PgAcVar(pref,lasthost) localhost
+       set PgAcVar(pref,lastport) 5432
+       set PgAcVar(pref,username) {}
+       set PgAcVar(pref,password) {}
+       set PgAcVar(pref,language) english
+       set retval [catch {set fid [open "~/.pgaccessrc" r]} errmsg]
+       if {! $retval} {
+               while {![eof $fid]} {
+                       set pair [gets $fid]
+                       set PgAcVar([lindex $pair 0]) [lindex $pair 1]
+               }
+               close $fid
+               setGUIPreferences
+       }
+       # The following preferences values will be ignored from the .pgaccessrc file
+       set PgAcVar(pref,typecolors) {black red brown #007e00 #004e00 blue orange yellow pink purple cyan  magenta lightblue lightgreen gray lightyellow}
+       set PgAcVar(pref,typelist) {text bool bytea float8 float4 int4 char name int8 int2 int28 regproc oid tid xid cid}
+       loadInternationalMessages
+}
+       
+       
+proc {save} {} {
+global PgAcVar
+       catch {
+               set fid [open "~/.pgaccessrc" w]
+               foreach key [array names PgAcVar pref,*] { puts $fid "$key {$PgAcVar($key)}" }
+               close $fid
+       }
+       if {$PgAcVar(activetab)=="Tables"} {
+               Mainlib::tab_click Tables
+       }
+}
+
+proc {configure} {} {
+global PgAcVar
+       Window show .pgaw:Preferences
+       foreach language  [lsort $PgAcVar(AVAILABLE_LANGUAGES)] {.pgaw:Preferences.fpl.flb.llb insert end $language}
+       wm transient .pgaw:Preferences .pgaw:Main
+}
+
+
+proc {loadInternationalMessages} {} {
+global Messages PgAcVar
+       set PgAcVar(AVAILABLE_LANGUAGES) {english}
+       foreach filename [glob -nocomplain [file join $PgAcVar(PGACCESS_HOME) lib languages *]] {
+               lappend PgAcVar(AVAILABLE_LANGUAGES) [file tail $filename]
+       }
+       catch { unset Messages }
+       catch { source [file join $PgAcVar(PGACCESS_HOME) lib languages $PgAcVar(pref,language)] }
+}
+
+
+proc {changeLanguage} {} {
+global PgAcVar
+       set sel [.pgaw:Preferences.fpl.flb.llb curselection]
+       if {$sel==""} {return}
+       set desired [.pgaw:Preferences.fpl.flb.llb get $sel]
+       if {$desired==$PgAcVar(pref,language)} {return}
+       set PgAcVar(pref,language) $desired
+       loadInternationalMessages
+       return
+       foreach wid [winfo children .pgaw:Main] {
+               set wtext {}
+               catch { set wtext [$wid cget -text] }
+               if {$wtext != ""} {
+                       $wid configure -text [intlmsg $wtext]
+               }
+       }
+}
+
+
+proc {setDefaultFonts} {} {
+global PgAcVar tcl_platform
+if {[string toupper $tcl_platform(platform)]=="WINDOWS"} {
+       set PgAcVar(pref,font_normal) {"MS Sans Serif" 8}
+       set PgAcVar(pref,font_bold) {"MS Sans Serif" 8 bold}
+       set PgAcVar(pref,font_fix) {Terminal 8}
+       set PgAcVar(pref,font_italic) {"MS Sans Serif" 8 italic}
+} else {
+       set PgAcVar(pref,font_normal) -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
+       set PgAcVar(pref,font_bold) -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
+       set PgAcVar(pref,font_italic) -Adobe-Helvetica-Medium-O-Normal-*-*-120-*-*-*-*-*
+       set PgAcVar(pref,font_fix) -*-Clean-Medium-R-Normal-*-*-130-*-*-*-*-*
+}
+}
+
+
+proc {setGUIPreferences} {} {
+global PgAcVar
+       foreach wid {Label Text Button Listbox Checkbutton Radiobutton} {
+               option add *$wid.font $PgAcVar(pref,font_normal)
+       }
+       option add *Entry.background #fefefe
+       option add *Entry.foreground #000000
+       option add *Button.BorderWidth 1
+}
+
+}
+
+
+################### END OF NAMESPACE PREFERENCES #################
+
+proc vTclWindow.pgaw:Preferences {base} {
+       if {$base == ""} {
+               set base .pgaw:Preferences
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 450x360+100+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 [intlmsg "Preferences"]
+       bind $base <Key-Escape> "Window destroy .pgaw:Preferences"
+       frame $base.fl \
+               -height 75 -relief groove -width 10 
+       frame $base.fr \
+               -height 75 -relief groove -width 10 
+       frame $base.f1 \
+               -height 80 -relief groove -width 125 
+       label $base.f1.l1 \
+               -borderwidth 0 -relief raised \
+               -text [intlmsg {Max rows displayed in table/query view}]
+       entry $base.f1.erows \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(pref,rows) -width 7 
+       frame $base.f2 \
+               -height 75 -relief groove -width 125 
+       label $base.f2.l \
+               -borderwidth 0 -relief raised -text [intlmsg {Table viewer font}]
+       label $base.f2.ls \
+               -borderwidth 0 -relief raised -text {      } 
+       radiobutton $base.f2.pgaw:rb1 \
+               -borderwidth 1 -text [intlmsg {fixed width}] -value clean \
+               -variable PgAcVar(pref,tvfont) 
+       radiobutton $base.f2.pgaw:rb2 \
+               -borderwidth 1 -text [intlmsg proportional] -value helv -variable PgAcVar(pref,tvfont) 
+       frame $base.ff \
+               -height 75 -relief groove -width 125 
+       label $base.ff.l1 \
+               -borderwidth 0 -relief raised -text [intlmsg {Font normal}]
+       entry $base.ff.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(pref,font_normal) \
+               -width 200 
+       label $base.ff.l2 \
+               -borderwidth 0 -relief raised -text [intlmsg {Font bold}]
+       entry $base.ff.e2 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(pref,font_bold) \
+               -width 200 
+       label $base.ff.l3 \
+               -borderwidth 0 -relief raised -text [intlmsg {Font italic}]
+       entry $base.ff.e3 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(pref,font_italic) \
+               -width 200 
+       label $base.ff.l4 \
+               -borderwidth 0 -relief raised -text [intlmsg {Font fixed}]
+       entry $base.ff.e4 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(pref,font_fix) \
+               -width 200 
+       frame $base.fls \
+               -borderwidth 1 -height 2 -relief sunken -width 125 
+       frame $base.fal \
+               -height 75 -relief groove -width 125 
+       checkbutton $base.fal.al \
+               -borderwidth 1 -text [intlmsg {Auto-load the last opened database at startup}] \
+        -variable PgAcVar(pref,autoload) -anchor w
+       checkbutton $base.fal.st \
+               -borderwidth 1 -text [intlmsg {View system tables}] \
+        -variable PgAcVar(pref,systemtables) -anchor w
+       frame $base.fpl \
+               -height 49 -relief groove -width 125 
+       label $base.fpl.lt \
+               -borderwidth 0 -relief raised -text [intlmsg {Preferred language}]
+       frame $base.fpl.flb \
+               -height 75 -relief sunken -width 125 
+       listbox $base.fpl.flb.llb \
+               -borderwidth 1 -height 6 -yscrollcommand {.pgaw:Preferences.fpl.flb.vsb set} 
+       scrollbar $base.fpl.flb.vsb \
+               -borderwidth 1 -command {.pgaw:Preferences.fpl.flb.llb yview} -orient vert 
+       frame $base.fb \
+        -height 75 -relief groove -width 125 
+       button $base.fb.btnsave \
+               -command {if {$PgAcVar(pref,rows)>200} {
+       tk_messageBox -title [intlmsg Warning] -parent .pgaw:Preferences -message [intlmsg "A big number of rows displayed in table view will take a lot of memory!"]
+}
+Preferences::changeLanguage
+Preferences::save
+Window destroy .pgaw:Preferences
+tk_messageBox -title [intlmsg Warning] -parent .pgaw:Main -message [intlmsg "Changed fonts may appear in the next working session!"]} \
+               -padx 9 -pady 3 -text [intlmsg Save]
+       button $base.fb.btncancel \
+               -command {Window destroy .pgaw:Preferences} -padx 9 -pady 3 -text [intlmsg Cancel]
+       pack $base.fl \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill y -side left 
+       pack $base.fr \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill y -side right 
+       pack $base.f1 \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill x -pady 5 -side top 
+       pack $base.f1.l1 \
+               -in .pgaw:Preferences.f1 -anchor center -expand 0 -fill none -side left 
+       pack $base.f1.erows \
+               -in .pgaw:Preferences.f1 -anchor center -expand 0 -fill none -side left 
+       pack $base.f2 \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill x -pady 5 -side top 
+       pack $base.f2.l \
+               -in .pgaw:Preferences.f2 -anchor center -expand 0 -fill none -side left 
+       pack $base.f2.ls \
+               -in .pgaw:Preferences.f2 -anchor center -expand 0 -fill none -side left 
+       pack $base.f2.pgaw:rb1 \
+               -in .pgaw:Preferences.f2 -anchor center -expand 0 -fill none -side left 
+       pack $base.f2.pgaw:rb2 \
+               -in .pgaw:Preferences.f2 -anchor center -expand 0 -fill none -side left 
+       pack $base.ff \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill x -side top 
+       grid columnconf $base.ff 1 -weight 1
+       grid $base.ff.l1 \
+               -in .pgaw:Preferences.ff -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.ff.e1 \
+               -in .pgaw:Preferences.ff -column 1 -row 0 -columnspan 1 -rowspan 1 -pady 1 
+       grid $base.ff.l2 \
+               -in .pgaw:Preferences.ff -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.ff.e2 \
+               -in .pgaw:Preferences.ff -column 1 -row 2 -columnspan 1 -rowspan 1 -pady 1 
+       grid $base.ff.l3 \
+               -in .pgaw:Preferences.ff -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.ff.e3 \
+               -in .pgaw:Preferences.ff -column 1 -row 4 -columnspan 1 -rowspan 1 -pady 1 
+       grid $base.ff.l4 \
+               -in .pgaw:Preferences.ff -column 0 -row 6 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.ff.e4 \
+               -in .pgaw:Preferences.ff -column 1 -row 6 -columnspan 1 -rowspan 1 -pady 1 
+       pack $base.fls \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill x -pady 5 -side top 
+       pack $base.fal \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill x -side top 
+       pack $base.fal.al \
+               -in .pgaw:Preferences.fal -anchor center -expand 0 -fill x -side top -anchor w 
+       pack $base.fal.st \
+               -in .pgaw:Preferences.fal -anchor center -expand 0 -fill x -side top -anchor w
+       pack $base.fpl \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill x -side top 
+       pack $base.fpl.lt \
+               -in .pgaw:Preferences.fpl -anchor center -expand 0 -fill none -side top 
+       pack $base.fpl.flb \
+               -in .pgaw:Preferences.fpl -anchor center -expand 0 -fill none -side top 
+       pack $base.fpl.flb.llb \
+               -in .pgaw:Preferences.fpl.flb -anchor center -expand 0 -fill none -side left 
+       pack $base.fpl.flb.vsb \
+               -in .pgaw:Preferences.fpl.flb -anchor center -expand 0 -fill y -side right 
+       pack $base.fb \
+               -in .pgaw:Preferences -anchor center -expand 0 -fill none -side bottom 
+       grid $base.fb.btnsave \
+               -in .pgaw:Preferences.fb -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fb.btncancel \
+               -in .pgaw:Preferences.fb -column 1 -row 0 -columnspan 1 -rowspan 1 
+}
+
diff --git a/src/bin/pgaccess/lib/qed b/src/bin/pgaccess/lib/qed
new file mode 100755 (executable)
index 0000000..4db7a01
--- /dev/null
@@ -0,0 +1,7 @@
+#!/bin/bash
+for fisier in *.tcl ; do
+       echo $fisier ;
+       sed -e "s/show_error/showError/g" <$fisier >temp
+       mv temp $fisier
+done
+
diff --git a/src/bin/pgaccess/lib/queries.tcl b/src/bin/pgaccess/lib/queries.tcl
new file mode 100644 (file)
index 0000000..b25ec70
--- /dev/null
@@ -0,0 +1,228 @@
+namespace eval Queries {
+
+
+proc {new} {} {
+global PgAcVar
+               Window show .pgaw:QueryBuilder
+               PgAcVar:clean query,*
+               set PgAcVar(query,oid) 0
+               set PgAcVar(query,name) {}
+               set PgAcVar(query,asview) 0
+               set PgAcVar(query,tables) {}
+               set PgAcVar(query,links) {}
+               set PgAcVar(query,results) {}
+               .pgaw:QueryBuilder.saveAsView configure -state normal
+}
+
+
+proc {open} {queryname} {
+global PgAcVar
+       if {! [loadQuery $queryname]} return;
+       if {$PgAcVar(query,type)=="S"} then {
+               set wn [Tables::getNewWindowName]
+               set PgAcVar(mw,$wn,query) [subst $PgAcVar(query,sqlcmd)]
+               set PgAcVar(mw,$wn,updatable) 0
+               set PgAcVar(mw,$wn,isaquery) 1
+               Tables::createWindow
+               wm title $wn "Query result: $PgAcVar(query,name)"
+               Tables::loadLayout $wn $PgAcVar(query,name)
+               Tables::selectRecords $wn $PgAcVar(mw,$wn,query)
+       } else {
+               set answ [tk_messageBox -title [intlmsg 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 {design} {queryname} {
+global PgAcVar
+       if {! [loadQuery $queryname]} return;
+       Window show .pgaw:QueryBuilder
+       .pgaw:QueryBuilder.text1 delete 0.0 end
+       .pgaw:QueryBuilder.text1 insert end $PgAcVar(query,sqlcmd)
+       .pgaw:QueryBuilder.text2 delete 0.0 end
+       .pgaw:QueryBuilder.text2 insert end $PgAcVar(query,comments)    
+}
+
+
+proc {loadQuery} {queryname} {
+global PgAcVar CurrentDB
+       set PgAcVar(query,name) $queryname
+       if {[set pgres [wpg_exec $CurrentDB "select querycommand,querytype,querytables,querylinks,queryresults,querycomments,oid from pga_queries where queryname='$PgAcVar(query,name)'"]]==0} then {
+               showError [intlmsg "Error retrieving query definition"]
+               return 0
+       }
+       if {[pg_result $pgres -numTuples]==0} {
+               showError [format [intlmsg "Query '%s' was not found!"] $PgAcVar(query,name)]
+               pg_result $pgres -clear
+               return 0
+       }
+       set tuple [pg_result $pgres -getTuple 0]
+       set PgAcVar(query,sqlcmd)   [lindex $tuple 0]
+       set PgAcVar(query,type)     [lindex $tuple 1]
+       set PgAcVar(query,tables)   [lindex $tuple 2]
+       set PgAcVar(query,links)    [lindex $tuple 3]
+       set PgAcVar(query,results)  [lindex $tuple 4]
+       set PgAcVar(query,comments) [lindex $tuple 5]
+       set PgAcVar(query,oid)      [lindex $tuple 6]
+       pg_result $pgres -clear
+       return 1
+}
+
+
+proc {visualDesigner} {} {
+global PgAcVar
+       Window show .pgaw:VisualQuery
+       VisualQueryBuilder::loadVisualLayout
+       focus .pgaw:VisualQuery.fb.entt
+}
+
+
+proc {save} {} {
+global PgAcVar CurrentDB
+if {$PgAcVar(query,name)==""} then {
+       showError [intlmsg "You have to supply a name for this query!"]
+       focus .pgaw:QueryBuilder.eqn
+} else {
+       set qcmd [.pgaw:QueryBuilder.text1 get 1.0 end]
+       set PgAcVar(query,comments) [.pgaw:QueryBuilder.text2 get 1.0 end]
+       regsub -all "\n" $qcmd " " qcmd
+       if {$qcmd==""} then {
+       showError [intlmsg "This query has no commands?"]
+       } else {
+               if { [lindex [split [string toupper [string trim $qcmd]]] 0] == "SELECT" } {
+                       set qtype S
+               } else {
+                       set qtype A
+               }
+               if {$PgAcVar(query,asview)} {
+                       wpg_select $CurrentDB "select pg_get_viewdef('$PgAcVar(query,name)') as vd" tup {
+                               if {$tup(vd)!="Not a view"} {
+                                       if {[tk_messageBox -title [intlmsg Warning] -message [format [intlmsg "View '%s' already exists!\nOverwrite ?"] $PgAcVar(query,name)] -type yesno -default no]=="yes"} {
+                                               set pg_res [wpg_exec $CurrentDB "drop view \"$PgAcVar(query,name)\""]
+                                               if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} {
+                                                       showError "[intlmsg {Error deleting view}] '$PgAcVar(query,name)'"
+                                               }
+                                       }
+                               }
+                       }
+                       set pgres [wpg_exec $CurrentDB "create view \"$PgAcVar(query,name)\" as $qcmd"]
+                       if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} {
+                               showError "[intlmsg {Error defining view}]\n\n$PgAcVar(pgsql,errmsg)"
+                       } else {
+                               Mainlib::tab_click Views
+                               Window destroy .pgaw:QueryBuilder
+                       }
+                       catch {pg_result $pgres -clear}
+               } else {
+                       regsub -all "'" $qcmd "''" qcmd
+                       regsub -all "'" $PgAcVar(query,comments) "''" PgAcVar(query,comments)
+                       regsub -all "'" $PgAcVar(query,results) "''" PgAcVar(query,results)
+                       setCursor CLOCK
+                       if {$PgAcVar(query,oid)==0} then {
+                               set pgres [wpg_exec $CurrentDB "insert into pga_queries values ('$PgAcVar(query,name)','$qtype','$qcmd','$PgAcVar(query,tables)','$PgAcVar(query,links)','$PgAcVar(query,results)','$PgAcVar(query,comments)')"]
+                       } else {
+                               set pgres [wpg_exec $CurrentDB "update pga_queries set queryname='$PgAcVar(query,name)',querytype='$qtype',querycommand='$qcmd',querytables='$PgAcVar(query,tables)',querylinks='$PgAcVar(query,links)',queryresults='$PgAcVar(query,results)',querycomments='$PgAcVar(query,comments)' where oid=$PgAcVar(query,oid)"]
+                       }
+                       setCursor DEFAULT
+                       if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} then {
+                               showError "[intlmsg {Error executing query}]\n$PgAcVar(pgsql,errmsg)"
+                       } else {
+                               Mainlib::tab_click Queries
+                               if {$PgAcVar(query,oid)==0} {set PgAcVar(query,oid) [pg_result $pgres -oid]}
+                       }
+               }
+               catch {pg_result $pgres -clear}
+       }
+}
+}
+
+
+proc {execute} {} {
+global PgAcVar
+set qcmd [.pgaw:QueryBuilder.text1 get 0.0 end]
+regsub -all "\n" [string trim $qcmd] " " qcmd
+if {[lindex [split [string toupper $qcmd]] 0]!="SELECT"} {
+       if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:QueryBuilder -message [intlmsg "This is an action query!\n\nExecute it?"] -type yesno -default no]=="yes"} {
+               sql_exec noquiet $qcmd
+       }
+} else {
+       set wn [Tables::getNewWindowName]
+       set PgAcVar(mw,$wn,query) [subst $qcmd]
+       set PgAcVar(mw,$wn,updatable) 0
+       set PgAcVar(mw,$wn,isaquery) 1
+       Tables::createWindow
+       Tables::loadLayout $wn $PgAcVar(query,name)
+       Tables::selectRecords $wn $PgAcVar(mw,$wn,query)
+}
+}
+
+proc {close} {} {
+global PgAcVar
+       .pgaw:QueryBuilder.saveAsView configure -state normal
+       set PgAcVar(query,asview) 0
+       set PgAcVar(query,name) {}
+       .pgaw:QueryBuilder.text1 delete 1.0 end
+       Window destroy .pgaw:QueryBuilder
+}
+
+
+}
+
+
+proc vTclWindow.pgaw:QueryBuilder {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:QueryBuilder
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 542x364+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 [intlmsg "Query builder"]
+       bind $base <Key-F1> "Help::load queries"
+       label $base.lqn  -borderwidth 0 -text [intlmsg {Query name}]
+       entry $base.eqn  -background #fefefe -borderwidth 1 -foreground #000000  -highlightthickness 1 -selectborderwidth 0 -textvariable PgAcVar(query,name) 
+       text $base.text1  -background #fefefe -borderwidth 1  -font $PgAcVar(pref,font_normal) -foreground #000000 -highlightthickness 1 -wrap word 
+       label $base.lcomm -borderwidth 0 -text [intlmsg Comments]
+       text $base.text2  -background #fefefe -borderwidth 1  -font $PgAcVar(pref,font_normal) -foreground #000000 -highlightthickness 1 -wrap word 
+       checkbutton $base.saveAsView  -borderwidth 1  -text [intlmsg {Save this query as a view}] -variable PgAcVar(query,asview) 
+       frame $base.frb \
+               -height 75 -relief groove -width 125 
+       button $base.frb.savebtn -command {Queries::save} \
+               -borderwidth 1 -text [intlmsg {Save query definition}]
+       button $base.frb.execbtn -command {Queries::execute} \
+               -borderwidth 1 -text [intlmsg {Execute query}]
+       button $base.frb.pgaw:VisualQueryshow -command {Queries::visualDesigner} \
+               -borderwidth 1 -text [intlmsg {Visual designer}]
+       button $base.frb.termbtn -command {Queries::close} \
+               -borderwidth 1 -text [intlmsg Close]
+       place $base.lqn  -x 5 -y 5 -anchor nw -bordermode ignore 
+       place $base.eqn  -x 100 -y 1 -width 335 -height 24 -anchor nw -bordermode ignore 
+       place $base.frb \
+               -x 5 -y 55 -width 530 -height 35 -anchor nw -bordermode ignore 
+       pack $base.frb.savebtn \
+               -in $base.frb -anchor center -expand 0 -fill none -side left 
+       pack $base.frb.execbtn \
+               -in $base.frb -anchor center -expand 0 -fill none -side left 
+       pack $base.frb.pgaw:VisualQueryshow \
+               -in $base.frb -anchor center -expand 0 -fill none -side left 
+       pack $base.frb.termbtn \
+               -in $base.frb -anchor center -expand 0 -fill none -side right 
+       place $base.text1  -x 5 -y 90 -width 530 -height 160 -anchor nw -bordermode ignore 
+       place $base.lcomm -x 5 -y 255
+       place $base.text2  -x 5 -y 270 -width 530 -height 86 -anchor nw -bordermode ignore 
+       place $base.saveAsView  -x 5 -y 30 -height 25 -anchor nw -bordermode ignore 
+}
+
diff --git a/src/bin/pgaccess/lib/reports.tcl b/src/bin/pgaccess/lib/reports.tcl
new file mode 100644 (file)
index 0000000..c526ca9
--- /dev/null
@@ -0,0 +1,599 @@
+namespace eval Reports {
+
+
+proc {new} {} {
+global PgAcVar
+       Window show .pgaw:ReportBuilder
+       tkwait visibility .pgaw:ReportBuilder
+       init
+       set PgAcVar(report,reportname) {}
+       set PgAcVar(report,justpreview) 0
+       focus .pgaw:ReportBuilder.e2
+}
+
+
+proc {open} {reportname} {
+global PgAcVar CurrentDB
+       Window show .pgaw:ReportBuilder
+       #tkwait visibility .pgaw:ReportBuilder
+       Window hide .pgaw:ReportBuilder
+       Window show .pgaw:ReportPreview
+       init
+       set PgAcVar(report,reportname) $reportname
+       loadReport
+       tkwait visibility .pgaw:ReportPreview
+       set PgAcVar(report,justpreview) 1
+       preview
+}
+
+
+proc {design} {reportname} {
+global PgAcVar
+       Window show .pgaw:ReportBuilder
+       tkwait visibility .pgaw:ReportBuilder
+       init
+       set PgAcVar(report,reportname) $reportname
+       loadReport
+       set PgAcVar(report,justpreview) 0
+}
+
+
+proc {drawReportAreas} {} {
+global PgAcVar
+foreach rg $PgAcVar(report,regions) {
+       .pgaw:ReportBuilder.c delete bg_$rg
+       .pgaw:ReportBuilder.c create line 0 $PgAcVar(report,y_$rg) 5000 $PgAcVar(report,y_$rg) -tags [subst {bg_$rg}]
+       .pgaw:ReportBuilder.c create rectangle 6 [expr $PgAcVar(report,y_$rg)-3] 12 [expr $PgAcVar(report,y_$rg)+3] -fill black -tags [subst {bg_$rg mov reg}]
+       .pgaw:ReportBuilder.c lower bg_$rg
+}
+}
+
+proc {toggleAlignMode} {} {
+set bb [.pgaw:ReportBuilder.c bbox hili]
+if {[.pgaw:ReportBuilder.balign cget -text]=="left"} then {
+       .pgaw:ReportBuilder.balign configure -text right
+       .pgaw:ReportBuilder.c itemconfigure hili -anchor ne
+       .pgaw:ReportBuilder.c move hili [expr [lindex $bb 2]-[lindex $bb 0]-3] 0
+} else {
+       .pgaw:ReportBuilder.balign configure -text left
+       .pgaw:ReportBuilder.c itemconfigure hili -anchor nw
+       .pgaw:ReportBuilder.c move hili [expr [lindex $bb 0]-[lindex $bb 2]+3] 0
+}
+}
+
+proc {getBoldStatus} {} {
+       if {[.pgaw:ReportBuilder.lbold cget -relief]=="raised"} then {return Medium} else {return Bold}
+}
+
+proc {getItalicStatus} {} {
+       if {[.pgaw:ReportBuilder.lita cget -relief]=="raised"} then {return R} else {return O}
+}
+
+proc {toggleBold} {} {
+       if {[getBoldStatus]=="Bold"} {
+          .pgaw:ReportBuilder.lbold configure -relief raised
+       } else {
+          .pgaw:ReportBuilder.lbold configure -relief sunken
+       }
+       setObjectFont
+}
+
+
+proc {toggleItalic} {} {
+       if {[getItalicStatus]=="O"} {
+          .pgaw:ReportBuilder.lita configure -relief raised
+       } else {
+          .pgaw:ReportBuilder.lita configure -relief sunken
+       }
+       setObjectFont
+}
+
+
+proc {setFont} {} {
+       set temp [.pgaw:ReportBuilder.bfont cget -text]
+       if {$temp=="Courier"} then {
+         .pgaw:ReportBuilder.bfont configure -text Helvetica
+       } else {
+         .pgaw:ReportBuilder.bfont configure -text Courier
+       }
+       setObjectFont
+}
+
+
+proc {getSourceFields} {} {
+global PgAcVar CurrentDB
+       .pgaw:ReportBuilder.lb delete 0 end
+       if {$PgAcVar(report,tablename)==""} return ;
+       #setCursor CLOCK
+       wpg_select $CurrentDB "select attnum,attname from pg_class,pg_attribute where (pg_class.relname='$PgAcVar(report,tablename)') and (pg_class.oid=pg_attribute.attrelid) and (attnum>0) order by attnum" rec {
+               .pgaw:ReportBuilder.lb insert end $rec(attname)
+       }
+       #setCursor DEFAULT
+}
+
+
+proc {hasTag} {id tg} {
+       if {[lsearch [.pgaw:ReportBuilder.c itemcget $id -tags] $tg]==-1} then {return 0 } else {return 1}
+}
+
+
+proc {init} {} {
+global PgAcVar
+       set PgAcVar(report,xl_auto) 10
+       set PgAcVar(report,xf_auto) 10
+       set PgAcVar(report,regions) {rpthdr pghdr detail pgfoo rptfoo}
+       set PgAcVar(report,y_rpthdr) 30
+       set PgAcVar(report,y_pghdr) 60
+       set PgAcVar(report,y_detail) 90
+       set PgAcVar(report,y_pgfoo) 120
+       set PgAcVar(report,y_rptfoo) 150
+       set PgAcVar(report,e_rpthdr) [intlmsg {Report header}]
+       set PgAcVar(report,e_pghdr) [intlmsg {Page header}]
+       set PgAcVar(report,e_detail) [intlmsg {Detail record}]
+       set PgAcVar(report,e_pgfoo) [intlmsg {Page footer}]
+       set PgAcVar(report,e_rptfoo) [intlmsg {Report footer}]
+       drawReportAreas
+}
+
+proc {loadReport} {} {
+global PgAcVar CurrentDB
+       .pgaw:ReportBuilder.c delete all
+       wpg_select $CurrentDB "select * from pga_reports where reportname='$PgAcVar(report,reportname)'" rcd {
+               eval $rcd(reportbody)
+       }
+       getSourceFields
+       drawReportAreas
+}
+
+
+proc {preview} {} {
+global PgAcVar CurrentDB
+Window show .pgaw:ReportPreview
+.pgaw:ReportPreview.fr.c delete all
+set ol [.pgaw:ReportBuilder.c find withtag ro]
+set fields {}
+foreach objid $ol {
+       set tags [.pgaw:ReportBuilder.c itemcget $objid -tags]
+       lappend fields [string range [lindex $tags [lsearch -glob $tags f-*]] 2 64]
+       lappend fields [lindex [.pgaw:ReportBuilder.c coords $objid] 0]
+       lappend fields [lindex [.pgaw:ReportBuilder.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"} {
+               .pgaw:ReportPreview.fr.c create text $x [expr $py+$y] -text [.pgaw:ReportBuilder.c itemcget $objid -text]  -font [.pgaw:ReportBuilder.c itemcget $objid -font] -anchor nw
+       }
+}
+incr py [expr $PgAcVar(report,y_pghdr)-$PgAcVar(report,y_rpthdr)]
+# Parsing detail group
+set di [lsearch $PgAcVar(report,regions) detail]
+set y_hi $PgAcVar(report,y_detail)
+set y_lo $PgAcVar(report,y_[lindex $PgAcVar(report,regions) [expr $di-1]])
+wpg_select $CurrentDB "select * from \"$PgAcVar(report,tablename)\"" rec {
+       foreach {field x y objid objtype} $fields {
+               if {($y>=$y_lo) && ($y<=$y_hi)} then {
+               if {$objtype=="t_f"} {
+                       .pgaw:ReportPreview.fr.c create text $x [expr $py+$y] -text $rec($field) -font [.pgaw:ReportBuilder.c itemcget $objid -font] -anchor [.pgaw:ReportBuilder.c itemcget $objid -anchor]
+               }
+               if {$objtype=="t_l"} {
+                       .pgaw:ReportPreview.fr.c create text $x [expr $py+$y] -text [.pgaw:ReportBuilder.c itemcget $objid -text]  -font [.pgaw:ReportBuilder.c itemcget $objid -font] -anchor nw
+               }
+               }
+       }
+       incr py [expr $PgAcVar(report,y_detail)-$PgAcVar(report,y_pghdr)]
+}
+.pgaw:ReportPreview.fr.c configure -scrollregion [subst {0 0 1000 $py}]
+}
+
+
+proc {print} {} {
+       set bb [.pgaw:ReportPreview.fr.c bbox all]
+       .pgaw:ReportPreview.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 .pgaw:ReportBuilder -message "The printed image in Postscript is in the file pgaccess-report.ps"
+}
+
+
+proc {save} {} {
+global PgAcVar
+set prog "set PgAcVar(report,tablename) \"$PgAcVar(report,tablename)\""
+foreach region $PgAcVar(report,regions) {
+       set prog "$prog ; set PgAcVar(report,y_$region) $PgAcVar(report,y_$region)"
+}
+foreach obj [.pgaw:ReportBuilder.c find all] {
+       if {[.pgaw:ReportBuilder.c type $obj]=="text"} {
+               set bb [.pgaw:ReportBuilder.c bbox $obj]
+               if {[.pgaw:ReportBuilder.c itemcget $obj -anchor]=="nw"} then {set x [expr [lindex $bb 0]+1]} else {set x [expr [lindex $bb 2]-2]}
+               set prog "$prog ; .pgaw:ReportBuilder.c create text $x [lindex $bb 1] -font [.pgaw:ReportBuilder.c itemcget $obj -font] -anchor [.pgaw:ReportBuilder.c itemcget $obj -anchor] -text {[.pgaw:ReportBuilder.c itemcget $obj -text]} -tags {[.pgaw:ReportBuilder.c itemcget $obj -tags]}"
+       }
+}
+sql_exec noquiet "delete from pga_reports where reportname='$PgAcVar(report,reportname)'"
+sql_exec noquiet "insert into pga_reports (reportname,reportsource,reportbody) values ('$PgAcVar(report,reportname)','$PgAcVar(report,tablename)','$prog')"
+}
+
+
+proc {addField} {} {
+global PgAcVar
+       set fldname [.pgaw:ReportBuilder.lb get [.pgaw:ReportBuilder.lb curselection]]
+       set newid [.pgaw:ReportBuilder.c create text $PgAcVar(report,xf_auto) [expr $PgAcVar(report,y_rpthdr)+5] -text $fldname -tags [subst {t_l mov ro}] -anchor nw -font $PgAcVar(pref,font_normal)]
+       .pgaw:ReportBuilder.c create text $PgAcVar(report,xf_auto) [expr $PgAcVar(report,y_pghdr)+5] -text $fldname -tags [subst {f-$fldname t_f rg_detail mov ro}] -anchor nw -font $PgAcVar(pref,font_normal)
+       set bb [.pgaw:ReportBuilder.c bbox $newid]
+       incr PgAcVar(report,xf_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
+}
+
+
+proc {addLabel} {} {
+global PgAcVar
+       set fldname $PgAcVar(report,labeltext)
+       set newid [.pgaw:ReportBuilder.c create text $PgAcVar(report,xl_auto) [expr $PgAcVar(report,y_rpthdr)+5] -text $fldname -tags [subst {t_l mov ro}] -anchor nw -font $PgAcVar(pref,font_normal)]
+       set bb [.pgaw:ReportBuilder.c bbox $newid]
+       incr PgAcVar(report,xl_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
+}
+
+
+proc {setObjectFont} {} {
+global PgAcVar
+       .pgaw:ReportBuilder.c itemconfigure hili -font -Adobe-[.pgaw:ReportBuilder.bfont cget -text]-[getBoldStatus]-[getItalicStatus]-Normal--*-$PgAcVar(report,pointsize)-*-*-*-*-*-*
+}
+
+
+proc {deleteObject} {} {
+       if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:ReportBuilder -message "Delete current report object?" -type yesno -default no]=="no"} return;
+       .pgaw:ReportBuilder.c delete hili
+}
+
+
+proc {dragMove} {w x y} {
+global PgAcVar
+       # Showing current region
+       foreach rg $PgAcVar(report,regions) {
+               set PgAcVar(report,msg) $PgAcVar(report,e_$rg)
+               if {$PgAcVar(report,y_$rg)>$y} break;
+       }
+       set temp {}
+       catch {set temp $PgAcVar(draginfo,obj)}
+       if {"$temp" != ""} {
+               set dx [expr $x - $PgAcVar(draginfo,x)]
+               set dy [expr $y - $PgAcVar(draginfo,y)]
+               if {$PgAcVar(draginfo,region)!=""} {
+                       set x $PgAcVar(draginfo,x) ; $w move bg_$PgAcVar(draginfo,region) 0 $dy
+               } else {
+                       $w move $PgAcVar(draginfo,obj) $dx $dy
+               }
+               set PgAcVar(draginfo,x) $x
+               set PgAcVar(draginfo,y) $y
+       }
+}
+
+
+proc {dragStart} {w x y} {
+global PgAcVar
+focus .pgaw:ReportBuilder.c
+catch {unset draginfo}
+set obj {}
+# Only movable objects start dragging
+foreach id [$w find overlapping $x $y $x $y] {
+       if {[hasTag $id mov]} {
+               set obj $id
+               break
+       }
+}
+if {$obj==""} return;
+set PgAcVar(draginfo,obj) $obj
+set taglist [.pgaw:ReportBuilder.c itemcget $obj -tags]
+set i [lsearch -glob $taglist bg_*]
+if {$i==-1} {
+       set PgAcVar(draginfo,region) {}
+} else {
+       set PgAcVar(draginfo,region) [string range [lindex $taglist $i] 3 64]
+} 
+.pgaw:ReportBuilder configure -cursor hand1
+.pgaw:ReportBuilder.c itemconfigure [.pgaw:ReportBuilder.c find withtag hili] -fill black
+.pgaw:ReportBuilder.c dtag [.pgaw:ReportBuilder.c find withtag hili] hili
+.pgaw:ReportBuilder.c addtag hili withtag $PgAcVar(draginfo,obj)
+.pgaw:ReportBuilder.c itemconfigure hili -fill blue
+set PgAcVar(draginfo,x) $x
+set PgAcVar(draginfo,y) $y
+set PgAcVar(draginfo,sx) $x
+set PgAcVar(draginfo,sy) $y
+# Setting font information
+if {[.pgaw:ReportBuilder.c type hili]=="text"} {
+       set fnta [split [.pgaw:ReportBuilder.c itemcget hili -font] -]
+       .pgaw:ReportBuilder.bfont configure -text [lindex $fnta 2]
+       if {[lindex $fnta 3]=="Medium"} then {.pgaw:ReportBuilder.lbold configure -relief raised} else {.pgaw:ReportBuilder.lbold configure -relief sunken}
+       if {[lindex $fnta 4]=="R"} then {.pgaw:ReportBuilder.lita configure -relief raised} else {.pgaw:ReportBuilder.lita configure -relief sunken}
+       set PgAcVar(report,pointsize) [lindex $fnta 8]
+       if {[hasTag $obj t_f]} {set PgAcVar(report,info) "Database field"}
+       if {[hasTag $obj t_l]} {set PgAcVar(report,info) "Label"}
+       if {[.pgaw:ReportBuilder.c itemcget $obj -anchor]=="nw"} then {.pgaw:ReportBuilder.balign configure -text left} else {.pgaw:ReportBuilder.balign configure -text right}
+}
+}
+
+proc {dragStop} {x y} {
+global PgAcVar
+# when click Close, ql window is destroyed but event ButtonRelease-1 is fired
+if {![winfo exists .pgaw:ReportBuilder]} return;
+.pgaw:ReportBuilder configure -cursor left_ptr
+set este {}
+catch {set este $PgAcVar(draginfo,obj)}
+if {$este==""} return
+# Erase information about object beeing dragged
+if {$PgAcVar(draginfo,region)!=""} {
+       set dy 0
+       foreach rg $PgAcVar(report,regions) {
+               .pgaw:ReportBuilder.c move rg_$rg 0 $dy
+               if {$rg==$PgAcVar(draginfo,region)} {
+                       set dy [expr $y-$PgAcVar(report,y_$PgAcVar(draginfo,region))]
+               }
+               incr PgAcVar(report,y_$rg) $dy
+       }
+#    .pgaw:ReportBuilder.c move det 0 [expr $y-$PgAcVar(report,y_$PgAcVar(draginfo,region))]
+       set PgAcVar(report,y_$PgAcVar(draginfo,region)) $y
+       drawReportAreas
+} else {
+       # Check if object beeing dragged is inside the canvas
+       set bb [.pgaw:ReportBuilder.c bbox $PgAcVar(draginfo,obj)]
+       if {[lindex $bb 0] < 5} {
+               .pgaw:ReportBuilder.c move $PgAcVar(draginfo,obj) [expr 5-[lindex $bb 0]] 0
+       }
+}
+set PgAcVar(draginfo,obj) {}
+PgAcVar:clean draginfo,*
+}
+
+
+proc {deleteAllObjects} {} {
+       if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:ReportBuilder -message [intlmsg "All report information will be deleted.\n\nProceed ?"] -type yesno -default no]=="yes"} then {
+               .pgaw:ReportBuilder.c delete all
+               init
+               drawReportAreas
+       }
+}
+
+}
+
+################################################################
+
+
+proc vTclWindow.pgaw:ReportBuilder {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:ReportBuilder
+       }
+       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 [intlmsg "Report builder"]
+       label $base.l1 \
+               -borderwidth 1 \
+               -relief raised -text [intlmsg {Report fields}]
+       listbox $base.lb \
+               -background #fefefe -foreground #000000 -borderwidth 1 \
+               -selectbackground #c3c3c3 \
+               -highlightthickness 1 -selectborderwidth 0 \
+               -yscrollcommand {.pgaw:ReportBuilder.sb set} 
+       bind $base.lb <ButtonRelease-1> {
+               Reports::addField
+       }
+       canvas $base.c \
+               -background #fffeff -borderwidth 2 -height 207 -highlightthickness 0 \
+               -relief ridge -takefocus 1 -width 295 
+       bind $base.c <Button-1> {
+               Reports::dragStart %W %x %y
+       }
+       bind $base.c <ButtonRelease-1> {
+               Reports::dragStop %x %y
+       }
+       bind $base.c <Key-Delete> {
+               Reports::deleteObject
+       }
+       bind $base.c <Motion> {
+               Reports::dragMove %W %x %y
+       }
+       button $base.bt2 \
+               -command Reports::deleteAllObjects \
+               -text [intlmsg {Delete all}]
+       button $base.bt4 \
+               -command Reports::preview \
+               -text [intlmsg Preview]
+       button $base.bt5 \
+               -borderwidth 1 -command {Window destroy .pgaw:ReportBuilder} \
+               -text [intlmsg Close]
+       scrollbar $base.sb \
+               -borderwidth 1 -command {.pgaw:ReportBuilder.lb yview} -orient vert 
+       label $base.lmsg \
+               -anchor w \
+               -relief groove -text [intlmsg {Report header}] -textvariable PgAcVar(report,msg) 
+       entry $base.e2 \
+               -background #fefefe -borderwidth 1 -highlightthickness 0 \
+               -textvariable PgAcVar(report,tablename) 
+       bind $base.e2 <Key-Return> {
+               Reports::getSourceFields
+       }
+       entry $base.elab \
+               -background #fefefe -borderwidth 1 -highlightthickness 0 \
+               -textvariable PgAcVar(report,labeltext) 
+       button $base.badl \
+               -borderwidth 1 -command Reports::addLabel \
+               -text [intlmsg {Add label}]
+       label $base.lbold \
+               -borderwidth 1 -relief raised -text B 
+       bind $base.lbold <Button-1> {
+               Reports::toggleBold
+       }
+       label $base.lita \
+               -borderwidth 1 \
+               -font $PgAcVar(pref,font_italic) \
+               -relief raised -text i 
+       bind $base.lita <Button-1> {
+               Reports::toggleItalic
+       }
+       entry $base.eps \
+               -background #fefefe -highlightthickness 0 -relief groove \
+               -textvariable PgAcVar(report,pointsize) 
+       bind $base.eps <Key-Return> {
+               Reports::setObjectFont
+       }
+       label $base.linfo \
+               -anchor w  \
+               -relief groove -text {Database field} -textvariable PgAcVar(report,info) 
+       label $base.llal \
+               -borderwidth 0 -text Align 
+       button $base.balign \
+               -borderwidth 0 -command Reports::toggleAlignMode \
+               -relief groove -text right 
+       button $base.savebtn \
+               -borderwidth 1 -command Reports::save \
+               -text [intlmsg Save]
+       label $base.lfn \
+               -borderwidth 0 -text Font 
+       button $base.bfont \
+               -borderwidth 0 \
+               -command Reports::setFont \
+               -relief groove -text Courier 
+       button $base.bdd \
+               -borderwidth 1 \
+               -command {if {[winfo exists .pgaw:ReportBuilder.ddf]} {
+       destroy .pgaw:ReportBuilder.ddf
+} else {
+       create_drop_down .pgaw:ReportBuilder 405 22 200
+       focus .pgaw:ReportBuilder.ddf.sb
+       foreach tbl [Database::getTablesList] {.pgaw:ReportBuilder.ddf.lb insert end $tbl}
+       bind .pgaw:ReportBuilder.ddf.lb <ButtonRelease-1> {
+               set i [.pgaw:ReportBuilder.ddf.lb curselection]
+               if {$i!=""} {set PgAcVar(report,tablename) [.pgaw:ReportBuilder.ddf.lb get $i]}
+               destroy .pgaw:ReportBuilder.ddf
+               Reports::getSourceFields
+               break
+       }
+}} \
+               -highlightthickness 0 -image dnarw 
+       label $base.lrn \
+               -borderwidth 0 -text [intlmsg {Report name}]
+       entry $base.ern \
+               -background #fefefe -borderwidth 1 -highlightthickness 0 \
+               -textvariable PgAcVar(report,reportname) 
+       bind $base.ern <Key-F5> {
+               loadReport
+       }
+       label $base.lrs \
+               -borderwidth 0 -text [intlmsg {Report source}]
+       label $base.ls \
+               -borderwidth 1 -relief raised 
+       entry $base.ef \
+               -background #fefefe -borderwidth 1 -highlightthickness 0 \
+               -textvariable PgAcVar(report,formula) 
+       button $base.baf \
+               -borderwidth 1 \
+               -text [intlmsg {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.pgaw:ReportPreview {base} {
+       if {$base == ""} {
+               set base .pgaw:ReportPreview
+       }
+       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 {.pgaw:ReportPreview.fr.sb set} 
+       scrollbar $base.fr.sb \
+               -borderwidth 1 -command {.pgaw:ReportPreview.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 {$PgAcVar(report,justpreview)} then {Window destroy .pgaw:ReportBuilder} ; Window destroy .pgaw:ReportPreview} \
+               -text [intlmsg Close] 
+       button $base.f1.button17 \
+               -borderwidth 1 -command Reports::print \
+               -text Print 
+       pack $base.fr \
+               -in .pgaw:ReportPreview -anchor center -expand 1 -fill both -side top 
+       pack $base.fr.c \
+               -in .pgaw:ReportPreview.fr -anchor center -expand 1 -fill both -side left 
+       pack $base.fr.sb \
+               -in .pgaw:ReportPreview.fr -anchor center -expand 0 -fill y -side right 
+       pack $base.f1 \
+               -in .pgaw:ReportPreview -anchor center -expand 0 -fill none -side top 
+       pack $base.f1.button18 \
+               -in .pgaw:ReportPreview.f1 -anchor center -expand 0 -fill none -side right 
+       pack $base.f1.button17 \
+               -in .pgaw:ReportPreview.f1 -anchor center -expand 0 -fill none -side left 
+}
diff --git a/src/bin/pgaccess/lib/schema.tcl b/src/bin/pgaccess/lib/schema.tcl
new file mode 100644 (file)
index 0000000..d3e40ef
--- /dev/null
@@ -0,0 +1,585 @@
+namespace eval Schema {
+
+
+proc {new} {} {
+global PgAcVar
+       init
+       Window show .pgaw:Schema
+       set PgAcVar(schema,oid) 0
+       set PgAcVar(schema,name) {}
+       set PgAcVar(schema,tables) {}
+       set PgAcVar(schema,links) {}
+       set PgAcVar(schema,results) {}
+       focus .pgaw:Schema.f.e
+}
+
+
+proc {open} {obj} {
+global PgAcVar CurrentDB
+       init
+       set PgAcVar(schema,name) $obj
+       if {[set pgres [wpg_exec $CurrentDB "select schematables,schemalinks,oid from pga_schema where schemaname='$PgAcVar(schema,name)'"]]==0} then {
+               showError [intlmsg "Error retrieving schema definition"]
+               return
+       }
+       if {[pg_result $pgres -numTuples]==0} {
+               showError [format [intlmsg "Schema '%s' was not found!"] $PgAcVar(schema,name)]
+               pg_result $pgres -clear
+               return
+       }
+       set tuple [pg_result $pgres -getTuple 0]
+       set tables [lindex $tuple 0]
+       set links [lindex $tuple 1]
+       set PgAcVar(schema,oid) [lindex $tuple 2]
+       pg_result $pgres -clear
+       Window show .pgaw:Schema
+       foreach {t x y} $tables { 
+               set PgAcVar(schema,newtablename) $t
+               addNewTable $x $y
+       }
+       set PgAcVar(schema,links) $links
+       drawLinks
+}
+
+
+proc {addNewTable} {{tabx 0} {taby 0}} {
+global PgAcVar CurrentDB
+
+if {$PgAcVar(schema,newtablename)==""} return
+if {$PgAcVar(schema,newtablename)=="*"} {
+       set tbllist [Database::getTablesList]
+       foreach tn [array names PgAcVar schema,tablename*] {
+               if { [set linkid [lsearch $tbllist $PgAcVar($tn)]] != -1 } {
+                       set tbllist [lreplace $tbllist $linkid $linkid]
+               }
+       }
+       foreach t $tbllist {
+               set PgAcVar(schema,newtablename) $t
+               addNewTable
+       }
+       return
+}
+
+foreach tn [array names PgAcVar schema,tablename*] {
+       if {$PgAcVar(schema,newtablename)==$PgAcVar($tn)} {
+               showError [format [intlmsg "Table '%s' already in schema"] $PgAcVar($tn)]
+               return
+       }
+}
+set fldlist {}
+setCursor CLOCK
+wpg_select $CurrentDB "select attnum,attname,typname from pg_class,pg_attribute,pg_type where (pg_class.relname='$PgAcVar(schema,newtablename)') and (pg_class.oid=pg_attribute.attrelid) and (attnum>0) and (atttypid=pg_type.oid) order by attnum" rec {
+               lappend fldlist $rec(attname) $rec(typname)
+}
+setCursor DEFAULT
+if {$fldlist==""} {
+       showError [format [intlmsg "Table '%s' not found!"] $PgAcVar(schema,newtablename)]
+       return
+}
+set PgAcVar(schema,tablename$PgAcVar(schema,ntables)) $PgAcVar(schema,newtablename)
+set PgAcVar(schema,tablestruct$PgAcVar(schema,ntables)) $fldlist
+set PgAcVar(schema,tablex$PgAcVar(schema,ntables)) $tabx
+set PgAcVar(schema,tabley$PgAcVar(schema,ntables)) $taby
+incr PgAcVar(schema,ntables)
+if {$PgAcVar(schema,ntables)==1} {
+   drawAll
+} else {
+   drawTable [expr $PgAcVar(schema,ntables)-1]
+}
+lappend PgAcVar(schema,tables) $PgAcVar(schema,newtablename)  $PgAcVar(schema,tablex[expr $PgAcVar(schema,ntables)-1]) $PgAcVar(schema,tabley[expr $PgAcVar(schema,ntables)-1])
+set PgAcVar(schema,newtablename) {}
+focus .pgaw:Schema.f.e
+}
+
+proc {drawAll} {} {
+global PgAcVar
+       .pgaw:Schema.c delete all
+       for {set it 0} {$it<$PgAcVar(schema,ntables)} {incr it} {
+               drawTable $it
+       }
+       .pgaw:Schema.c lower rect
+       drawLinks
+
+       .pgaw:Schema.c bind mov <Button-1> {Schema::dragStart %W %x %y}
+       .pgaw:Schema.c bind mov <B1-Motion> {Schema::dragMove %W %x %y}
+       bind .pgaw:Schema.c <ButtonRelease-1> {Schema::dragStop %x %y}
+       bind .pgaw:Schema <Button-1> {Schema::canvasClick %x %y %W}
+       bind .pgaw:Schema <B1-Motion> {Schema::canvasPanning %x %y}
+       bind .pgaw:Schema <Key-Delete> {Schema::deleteObject}
+}
+
+
+proc {drawTable} {it} {
+global PgAcVar
+
+if {$PgAcVar(schema,tablex$it)==0} {
+       set posy $PgAcVar(schema,nexty)
+       set posx $PgAcVar(schema,nextx)
+       set PgAcVar(schema,tablex$it) $posx
+       set PgAcVar(schema,tabley$it) $posy
+} else {
+       set posx [expr int($PgAcVar(schema,tablex$it))]
+       set posy [expr int($PgAcVar(schema,tabley$it))]
+}
+set tablename $PgAcVar(schema,tablename$it)
+.pgaw:Schema.c create text $posx $posy -text "$tablename" -anchor nw -tags [subst {tab$it f-oid mov tableheader}] -font $PgAcVar(pref,font_bold)
+incr posy 16
+foreach {fld ftype} $PgAcVar(schema,tablestruct$it) {
+   if {[set cindex [lsearch $PgAcVar(pref,typelist) $ftype]] == -1} {set cindex 1}
+   .pgaw:Schema.c create text $posx $posy -text $fld -fill [lindex $PgAcVar(pref,typecolors) $cindex] -anchor nw -tags [subst {f-$fld tab$it mov}] -font $PgAcVar(pref,font_normal)
+   incr posy 14
+}
+set reg [.pgaw:Schema.c bbox tab$it]
+.pgaw:Schema.c create rectangle [lindex $reg 0] [lindex $reg 1] [lindex $reg 2] [lindex $reg 3] -fill #EEEEEE -tags [subst {rect outer tab$it}]
+.pgaw:Schema.c create line [lindex $reg 0] [expr [lindex $reg 1]+15] [lindex $reg 2] [expr [lindex $reg 1]+15] -tags [subst {rect tab$it}]
+.pgaw:Schema.c lower tab$it
+.pgaw:Schema.c lower rect
+set reg [.pgaw:Schema.c bbox tab$it]
+
+
+set nexty [lindex $reg 1]
+set nextx [expr 20+[lindex $reg 2]]
+if {$nextx > [winfo width .pgaw:Schema.c] } {
+       set nextx 10
+       set allbox [.pgaw:Schema.c bbox rect]
+       set nexty [expr 20 + [lindex $allbox 3]]
+}
+set PgAcVar(schema,nextx) $nextx
+set PgAcVar(schema,nexty) $nexty
+
+}
+
+proc {deleteObject} {} {
+global PgAcVar
+# Checking if there 
+set obj [.pgaw:Schema.c find withtag hili]
+if {$obj==""} return
+# Is object a link ?
+if {[getTagInfo $obj link]=="s"} {
+       if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:Schema -message [intlmsg "Remove link ?"] -type yesno -default no]=="no"} return
+       set linkid [getTagInfo $obj lkid]
+       set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $linkid $linkid]
+       .pgaw:Schema.c delete links
+       drawLinks
+       return
+}
+# Is object a table ?
+set tablealias [getTagInfo $obj tab]
+set tablename $PgAcVar(schema,tablename$tablealias)
+if {"$tablename"==""} return
+if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:Schema -message [format [intlmsg "Remove table %s from query?"] $tablename] -type yesno -default no]=="no"} return
+for {set i [expr [llength $PgAcVar(schema,links)]-1]} {$i>=0} {incr i -1} {
+       set thelink [lindex $PgAcVar(schema,links) $i]
+       if {($tablealias==[lindex $thelink 0]) || ($tablealias==[lindex $thelink 2])} {
+               set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $i $i]
+       }
+}
+for {set i 0} {$i<$PgAcVar(schema,ntables)} {incr i} {
+       set temp {}
+       catch {set temp $PgAcVar(schema,tablename$i)}
+       if {"$temp"=="$tablename"} {
+               unset PgAcVar(schema,tablename$i)
+               unset PgAcVar(schema,tablestruct$i)
+               break
+       }
+}
+#incr PgAcVar(schema,ntables) -1
+.pgaw:Schema.c delete tab$tablealias
+.pgaw:Schema.c delete links
+drawLinks
+}
+
+
+proc {dragMove} {w x y} {
+global PgAcVar
+       if {"$PgAcVar(draginfo,obj)" == ""} {return}
+       set dx [expr $x - $PgAcVar(draginfo,x)]
+       set dy [expr $y - $PgAcVar(draginfo,y)]
+       if {$PgAcVar(draginfo,is_a_table)} {
+               $w move $PgAcVar(draginfo,tabletag) $dx $dy
+               drawLinks
+       } else {
+               $w move $PgAcVar(draginfo,obj) $dx $dy
+       }
+       set PgAcVar(draginfo,x) $x
+       set PgAcVar(draginfo,y) $y
+}
+
+
+proc {dragStart} {w x y} {
+global PgAcVar
+PgAcVar:clean draginfo,*
+set PgAcVar(draginfo,obj) [$w find closest $x $y]
+if {[getTagInfo $PgAcVar(draginfo,obj) r]=="ect"} {
+       # If it'a a rectangle, exit
+       set PgAcVar(draginfo,obj) {}
+       return
+}
+.pgaw:Schema configure -cursor hand1
+.pgaw:Schema.c raise $PgAcVar(draginfo,obj)
+set PgAcVar(draginfo,table) 0
+if {[getTagInfo $PgAcVar(draginfo,obj) table]=="header"} {
+       set PgAcVar(draginfo,is_a_table) 1
+       set taglist [.pgaw:Schema.c gettags $PgAcVar(draginfo,obj)]
+       set PgAcVar(draginfo,tabletag) [lindex $taglist [lsearch -regexp $taglist "^tab\[0-9\]*"]]
+       .pgaw:Schema.c raise $PgAcVar(draginfo,tabletag)
+       .pgaw:Schema.c itemconfigure [.pgaw:Schema.c find withtag hili] -fill black
+       .pgaw:Schema.c dtag [.pgaw:Schema.c find withtag hili] hili
+       .pgaw:Schema.c addtag hili withtag $PgAcVar(draginfo,obj)
+       .pgaw:Schema.c itemconfigure hili -fill blue
+} else {
+       set PgAcVar(draginfo,is_a_table) 0
+}
+set PgAcVar(draginfo,x) $x
+set PgAcVar(draginfo,y) $y
+set PgAcVar(draginfo,sx) $x
+set PgAcVar(draginfo,sy) $y
+}
+
+proc {dragStop} {x y} {
+global PgAcVar
+# when click Close, schema window is destroyed but event ButtonRelease-1 is fired
+if {![winfo exists .pgaw:Schema]} return;
+.pgaw:Schema configure -cursor left_ptr
+set este {}
+catch {set este $PgAcVar(draginfo,obj)}
+if {$este==""} return
+# Re-establish the normal paint order so
+# information won't be overlapped by table rectangles
+# or link lines
+.pgaw:Schema.c lower $PgAcVar(draginfo,obj)
+.pgaw:Schema.c lower rect
+.pgaw:Schema.c lower links
+set PgAcVar(schema,panstarted) 0
+if {$PgAcVar(draginfo,is_a_table)} {
+       set tabnum [getTagInfo $PgAcVar(draginfo,obj) tab]
+       foreach w [.pgaw:Schema.c find withtag $PgAcVar(draginfo,tabletag)] {
+               if {[lsearch [.pgaw:Schema.c gettags $w] outer] != -1} {
+                       foreach [list PgAcVar(schema,tablex$tabnum) PgAcVar(schema,tabley$tabnum) x1 y1] [.pgaw:Schema.c coords $w] {}
+                       break
+               }
+       }
+       set PgAcVar(draginfo,obj) {}
+       .pgaw:Schema.c delete links
+       drawLinks
+       return
+} 
+# not a table
+.pgaw:Schema.c move $PgAcVar(draginfo,obj) [expr $PgAcVar(draginfo,sx)-$x] [expr $PgAcVar(draginfo,sy)-$y]
+set droptarget [.pgaw:Schema.c find overlapping $x $y $x $y]
+set targettable {}
+foreach item $droptarget {
+       set targettable $PgAcVar(schema,tablename[getTagInfo $item tab])
+       set targetfield [getTagInfo $item f-]
+       if {($targettable!="") && ($targetfield!="")} {
+               set droptarget $item
+               break
+       }
+}
+# check if target object isn't a rectangle
+if {[getTagInfo $droptarget rec]=="t"} {set targettable {}}
+if {$targettable!=""} {
+       # Target has a table
+       # See about originate table
+       set sourcetable $PgAcVar(schema,tablename[getTagInfo $PgAcVar(draginfo,obj) tab])
+       if {$sourcetable!=""} {
+               # Source has also a tab .. tag
+               set sourcefield [getTagInfo $PgAcVar(draginfo,obj) f-]
+               if {$sourcetable!=$targettable} {
+                       lappend PgAcVar(schema,links) [list $sourcetable $sourcefield $targettable $targetfield]
+                       drawLinks
+               }
+       }
+}
+# Erase information about object beeing dragged
+set PgAcVar(draginfo,obj) {}
+}
+
+proc {drawLinks} {} {
+global PgAcVar
+.pgaw:Schema.c delete links
+set i 0
+foreach link $PgAcVar(schema,links) {
+       set sourcenum -1
+       set targetnum -1
+       # Compute the source and destination right edge
+       foreach t [array names PgAcVar schema,tablename*] {
+               if {[regexp "^$PgAcVar($t)$" [lindex $link 0] ]} {
+                       set sourcenum [string range $t 16 end]
+               } elseif {[regexp "^$PgAcVar($t)$" [lindex $link 2] ]} {
+                       set targetnum [string range $t 16 end]
+               } 
+       }       
+       set sb [findField $sourcenum [lindex $link 1]]
+       set db [findField $targetnum [lindex $link 3]]
+       if {($sourcenum == -1 )||($targetnum == -1)||($sb ==-1)||($db==-1)} { 
+               set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $i $i]
+               showError "Link from [lindex $link 0].[lindex $link 1] to [lindex $link 2].[lindex $link 3] not found!"
+       } else {
+
+               set sre [lindex [.pgaw:Schema.c bbox tab$sourcenum] 2]
+               set dre [lindex [.pgaw:Schema.c bbox tab$targetnum] 2]
+               # Compute field bound boxes
+               set sbbox [.pgaw:Schema.c bbox $sb]
+               set dbbox [.pgaw:Schema.c bbox $db]
+               # 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]
+                       .pgaw:Schema.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]
+                       .pgaw:Schema.c create line [expr $x2-10] $y2 $x2 $y2 \
+                               -tags [subst {links lkid$i}] -width 3
+                       .pgaw:Schema.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]
+                       .pgaw:Schema.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]
+                       .pgaw:Schema.c create line $x2 $y2 [expr $x2+10] $y2 -width 3 \
+                               -tags [subst {links lkid$i}]
+                       .pgaw:Schema.c create line [expr $x1-10] $y1 [expr $x2+10] $y2 \
+                               -tags [subst {links lkid$i}] -width 2
+               }
+               incr i
+       }
+}
+.pgaw:Schema.c lower links
+.pgaw:Schema.c bind links <Button-1> {Schema::linkClick %x %y}
+}
+
+
+proc {getSchemaTabless} {} {
+global PgAcVar
+       set tablelist {}
+       foreach key [array names PgAcVar schema,tablename*] {
+               regsub schema,tablename $key "" num
+               lappend tablelist $PgAcVar($key) $PgAcVar(schema,tablex$num) $PgAcVar(schema,tabley$num)
+       }
+       return $tablelist
+}
+
+
+proc {findField} {alias field} {
+foreach obj [.pgaw:Schema.c find withtag f-${field}] {
+       if {[lsearch [.pgaw:Schema.c gettags $obj] tab$alias] != -1} {return $obj}
+       }
+return -1
+}
+
+
+proc {addLink} {sourcetable sourcefield targettable targetfield} {
+global PgAcVar
+       lappend PgAcVar(schema,links) [list $sourcetable $sourcefield $targettable $targetfield]
+}
+
+
+proc {getTagInfo} {obj prefix} {
+       set taglist [.pgaw:Schema.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 {init} {} {
+global PgAcVar
+       PgAcVar:clean schema,*
+       set PgAcVar(schema,nexty) 10
+       set PgAcVar(schema,nextx) 10
+       set PgAcVar(schema,links) {}
+       set PgAcVar(schema,ntables) 0
+       set PgAcVar(schema,newtablename) {}
+}
+
+
+proc {linkClick} {x y} {
+global PgAcVar
+       set obj [.pgaw:Schema.c find closest $x $y 1 links]
+       if {[getTagInfo $obj link]!="s"} return
+       .pgaw:Schema.c itemconfigure [.pgaw:Schema.c find withtag hili] -fill black
+       .pgaw:Schema.c dtag [.pgaw:Schema.c find withtag hili] hili
+       .pgaw:Schema.c addtag hili withtag $obj
+       .pgaw:Schema.c itemconfigure $obj -fill blue
+}
+
+
+proc {canvasPanning} {x y} {
+global PgAcVar
+       set panstarted 0
+       catch {set panstarted $PgAcVar(schema,panstarted) }
+       if {!$panstarted} return
+       set dx [expr $x-$PgAcVar(schema,panstartx)]
+       set dy [expr $y-$PgAcVar(schema,panstarty)]
+       set PgAcVar(schema,panstartx) $x
+       set PgAcVar(schema,panstarty) $y
+       if {$PgAcVar(schema,panobject)=="tables"} {
+               .pgaw:Schema.c move mov $dx $dy
+               .pgaw:Schema.c move links $dx $dy
+               .pgaw:Schema.c move rect $dx $dy
+       } else {
+               .pgaw:Schema.c move resp $dx 0
+               .pgaw:Schema.c move resgrid $dx 0
+               .pgaw:Schema.c raise reshdr
+       }
+}
+
+
+proc print {c} {
+       set types {
+               {{Postscript Files}     {.ps}}
+               {{All Files}    *}
+       }
+       if {[catch {tk_getSaveFile -defaultextension .ps -filetypes $types \
+                               -title "Print to Postscript"} fn] || [string match {} $fn]} return
+       if {[catch {::open $fn "w" } fid]} {
+               return -code error "Save Error: Unable to open '$fn' for writing\n$fid"
+       }
+       puts $fid [$c postscript -rotate 1]
+       close $fid
+}
+
+
+proc {canvasClick} {x y w} {
+global PgAcVar
+set PgAcVar(schema,panstarted) 0
+if {$w==".pgaw:Schema.c"} {
+       set canpan 1
+       if {[llength [.pgaw:Schema.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
+       set PgAcVar(schema,panobject) tables
+       if {$canpan} {
+               if {[.pgaw:Schema.c find withtag hili]!=""} {
+                       .pgaw:Schema.c itemconfigure [.pgaw:Schema.c find withtag hili] -fill black
+                       .pgaw:Schema.c dtag [.pgaw:Schema.c find withtag hili] hili
+               }
+
+               .pgaw:Schema configure -cursor hand1
+               set PgAcVar(schema,panstartx) $x
+               set PgAcVar(schema,panstarty) $y
+               set PgAcVar(schema,panstarted) 1
+       }
+}
+}
+
+}
+
+proc vTclWindow.pgaw:Schema {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:Schema
+       }
+       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 title $base [intlmsg "Visual schema designer"]
+       bind $base <B1-Motion> {
+               Schema::canvasPanning %x %y
+       }
+       bind $base <Button-1> {
+               Schema::canvasClick %x %y %W
+       }
+       bind $base <ButtonRelease-1> {
+               Schema::dragStop %x %y
+       }
+       bind $base <Key-Delete> {
+               Schema::deleteObject
+       }
+       canvas $base.c  -background #fefefe -borderwidth 2 -height 207 -relief ridge  -takefocus 0 -width 295 
+       frame $base.f \
+        -height 75 -relief groove -width 125 
+       label $base.f.l -text [intlmsg {Add table}]
+       entry $base.f.e \
+        -background #fefefe -borderwidth 1 
+       bind $base.f.e <Key-Return> {
+               Schema::addNewTable
+    }
+       button $base.f.bdd \
+        -image dnarw \
+        -command {if {[winfo exists .pgaw:Schema.ddf]} {
+       destroy .pgaw:Schema.ddf
+} else {
+       create_drop_down .pgaw:Schema 70 27 200
+       focus .pgaw:Schema.ddf.sb
+       foreach tbl [Database::getTablesList] {.pgaw:Schema.ddf.lb insert end $tbl}
+       bind .pgaw:Schema.ddf.lb <ButtonRelease-1> {
+               set i [.pgaw:Schema.ddf.lb curselection]
+               if {$i!=""} {
+                       set PgAcVar(schema,newtablename) [.pgaw:Schema.ddf.lb get $i]
+                       Schema::addNewTable
+               }
+               destroy .pgaw:Schema.ddf
+               break
+       }
+}} \
+        -padx 1 -pady 1 
+       button $base.f.btnclose \
+               -command {Schema::init
+Window destroy .pgaw:Schema} -padx 2 -pady 3 -text [intlmsg Close]
+       button $base.f.printbtn \
+               -command {Schema::print .pgaw:Schema.c} -padx 1 -pady 3 -text [intlmsg Print]
+       button $base.f.btnsave \
+               -command {if {$PgAcVar(schema,name)==""} then {
+       showError [intlmsg "You have to supply a name for this schema!"]
+       focus .pgaw:Schema.f.esn
+} else {
+       setCursor CLOCK
+       set tables [Schema::getSchemaTabless]
+       if {$PgAcVar(schema,oid)==0} then {
+               set pgres [wpg_exec $CurrentDB "insert into pga_schema values ('$PgAcVar(schema,name)','$tables','$PgAcVar(schema,links)')"]
+       } else {
+               set pgres [wpg_exec $CurrentDB "update pga_schema set schemaname='$PgAcVar(schema,name)',schematables='$tables',schemalinks='$PgAcVar(schema,links)' where oid=$PgAcVar(schema,oid)"]
+       }
+       setCursor DEFAULT
+       if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} then {
+               showError "[intlmsg {Error executing query}]\n$PgAcVar(pgsql,errmsg)"
+       } else {
+               Mainlib::tab_click Schema
+               if {$PgAcVar(schema,oid)==0} {set PgAcVar(schema,oid) [pg_result $pgres -oid]}
+       }
+       catch {pg_result $pgres -clear}
+}} \
+               -padx 2 -pady 3 -text [intlmsg {Save schema}]
+       label $base.f.ls1 -text {  } 
+       entry $base.f.esn \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(schema,name) 
+       label $base.f.lsn -text [intlmsg {Schema name}]
+       place $base.c  -x 5 -y 30 -width 748 -height 500 -anchor nw -bordermode ignore 
+       place $base.f \
+               -x 5 -y 5 -width 748 -height 25 -anchor nw -bordermode ignore 
+       pack $base.f.l \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side left 
+       pack $base.f.e \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side left 
+       pack $base.f.bdd \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side left 
+       pack $base.f.btnclose \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
+       pack $base.f.printbtn \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
+       pack $base.f.btnsave \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
+       pack $base.f.ls1 \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
+       pack $base.f.esn \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
+       pack $base.f.lsn \
+               -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
+
+}
+
+
diff --git a/src/bin/pgaccess/lib/scripts.tcl b/src/bin/pgaccess/lib/scripts.tcl
new file mode 100644 (file)
index 0000000..0302e1f
--- /dev/null
@@ -0,0 +1,88 @@
+namespace eval Scripts {
+
+proc {new} {} {
+       design {}
+}
+
+
+proc {open} {scriptname} {
+global CurrentDB
+       set ss {}
+       wpg_select $CurrentDB "select * from pga_scripts where scriptname='$scriptname'" rec {
+               set ss $rec(scriptsource)
+       }
+       if {[string length $ss] > 0} {
+               eval $ss
+       }
+}
+
+
+proc {design} {scriptname} {
+global PgAcVar CurrentDB
+       Window show .pgaw:Scripts
+       set PgAcVar(script,name) $scriptname
+       .pgaw:Scripts.src delete 1.0 end
+       if {[string length $scriptname]==0} return;
+       wpg_select $CurrentDB "select * from pga_scripts where scriptname='$scriptname'" rec {
+               .pgaw:Scripts.src insert end $rec(scriptsource)    
+       }
+}
+
+
+proc {execute} {scriptname} {
+       # a wrap for execute command
+       open $scriptname
+}
+
+
+proc {save} {} {
+global PgAcVar
+       if {$PgAcVar(script,name)==""} {
+               tk_messageBox -title [intlmsg Warning] -parent .pgaw:Scripts -message [intlmsg "The script must have a name!"]
+       } else {
+          sql_exec noquiet "delete from pga_scripts where scriptname='$PgAcVar(script,name)'"
+          regsub -all {\\} [.pgaw:Scripts.src get 1.0 end] {\\\\} PgAcVar(script,body)
+          regsub -all ' $PgAcVar(script,body)  \\' PgAcVar(script,body)
+          sql_exec noquiet "insert into pga_scripts values ('$PgAcVar(script,name)','$PgAcVar(script,body)')"
+          Mainlib::tab_click Scripts
+       }
+}
+
+}
+
+
+########################## END OF NAMESPACE SCRIPTS ##################
+
+proc vTclWindow.pgaw:Scripts {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:Scripts
+       }
+       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 [intlmsg "Design script"]
+       frame $base.f1  -height 55 -relief groove -width 125 
+       label $base.f1.l1  -borderwidth 0 -text [intlmsg {Script name}]
+       entry $base.f1.e1  -background #fefefe -borderwidth 1 -highlightthickness 0 -textvariable PgAcVar(script,name) -width 32 
+       text $base.src -background #fefefe -foreground #000000 -font $PgAcVar(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 .pgaw:Scripts} -text [intlmsg Cancel]
+       button $base.f2.b2  -borderwidth 1  -command Scripts::save \
+               -text [intlmsg Save] -width 6 
+       pack $base.f1  -in .pgaw:Scripts -anchor center -expand 0 -fill x -pady 2 -side top 
+       pack $base.f1.l1  -in .pgaw:Scripts.f1 -anchor center -expand 0 -fill none -ipadx 2 -side left 
+       pack $base.f1.e1  -in .pgaw:Scripts.f1 -anchor center -expand 0 -fill none -side left 
+       pack $base.src  -in .pgaw:Scripts -anchor center -expand 1 -fill both -padx 2 -side top 
+       pack $base.f2  -in .pgaw:Scripts -anchor center -expand 0 -fill none -side top 
+       pack $base.f2.b1  -in .pgaw:Scripts.f2 -anchor center -expand 0 -fill none -side right 
+       pack $base.f2.b2  -in .pgaw:Scripts.f2 -anchor center -expand 0 -fill none -side right
+}
+
diff --git a/src/bin/pgaccess/lib/sequences.tcl b/src/bin/pgaccess/lib/sequences.tcl
new file mode 100644 (file)
index 0000000..834eaab
--- /dev/null
@@ -0,0 +1,159 @@
+namespace eval Sequences {
+
+proc {new} {} {
+global PgAcVar
+       Window show .pgaw:Sequence
+       set PgAcVar(seq,name) {}
+       set PgAcVar(seq,incr) 1
+       set PgAcVar(seq,start) 1
+       set PgAcVar(seq,minval) 1
+       set PgAcVar(seq,maxval) 2147483647
+       focus .pgaw:Sequence.f1.e1
+}
+
+proc {open} {seqname} {
+global PgAcVar CurrentDB
+Window show .pgaw:Sequence
+set flag 1
+wpg_select $CurrentDB "select * from \"$seqname\"" rec {
+       set flag 0
+       set PgAcVar(seq,name) $seqname
+       set PgAcVar(seq,incr) $rec(increment_by)
+       set PgAcVar(seq,start) $rec(last_value)
+       .pgaw:Sequence.f1.l3 configure -text [intlmsg "Last value"]
+       set PgAcVar(seq,minval) $rec(min_value)
+       set PgAcVar(seq,maxval) $rec(max_value)
+       .pgaw:Sequence.fb.btnsave configure -state disabled
+}
+if {$flag} {
+       showError [format [intlmsg "Sequence '%s' not found!"] $seqname]
+} else {
+       for {set i 1} {$i<6} {incr i} {
+               .pgaw:Sequence.f1.e$i configure -state disabled
+       }
+       focus .pgaw:Sequence.fb.btncancel
+}
+}
+
+proc {save} {} {
+global PgAcVar
+       if {$PgAcVar(seq,name)==""} {
+               showError [intlmsg "You should supply a name for this sequence"]
+       } else {
+               set s1 {};set s2 {};set s3 {};set s4 {};
+               if {$PgAcVar(seq,incr)!=""} {set s1 "increment $PgAcVar(seq,incr)"};
+               if {$PgAcVar(seq,start)!=""} {set s2 "start $PgAcVar(seq,start)"};
+               if {$PgAcVar(seq,minval)!=""} {set s3 "minvalue $PgAcVar(seq,minval)"};
+               if {$PgAcVar(seq,maxval)!=""} {set s4 "maxvalue $PgAcVar(seq,maxval)"};
+               set sqlcmd "create sequence \"$PgAcVar(seq,name)\" $s1 $s2 $s3 $s4"
+               if {[sql_exec noquiet $sqlcmd]} {
+                       Mainlib::cmd_Sequences
+                       tk_messageBox -title [intlmsg Information] -parent .pgaw:Sequence -message [intlmsg "Sequence created!"]
+               }
+       }
+}
+
+}
+
+proc vTclWindow.pgaw:Sequence {base} {
+       if {$base == ""} {
+               set base .pgaw:Sequence
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 283x172+119+210
+       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 [intlmsg "Sequence"]
+       bind $base <Key-F1> "Help::load sequences"
+       frame $base.f1 \
+               -borderwidth 2 -height 75 -width 125 
+       label $base.f1.l1 \
+               -borderwidth 0 -relief raised -text [intlmsg {Sequence name}]
+       entry $base.f1.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(seq,name) -width 200 
+       bind $base.f1.e1 <Key-KP_Enter> {
+               focus .pgaw:Sequence.f1.e2
+       }
+       bind $base.f1.e1 <Key-Return> {
+               focus .pgaw:Sequence.f1.e2
+       }
+       label $base.f1.l2 \
+               -borderwidth 0 -relief raised -text [intlmsg Increment]
+       entry $base.f1.e2 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(seq,incr) -width 200 
+       bind $base.f1.e2 <Key-Return> {
+               focus .pgaw:Sequence.f1.e3
+       }
+       label $base.f1.l3 \
+               -borderwidth 0 -relief raised -text [intlmsg {Start value}]
+       entry $base.f1.e3 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(seq,start) -width 200 
+       bind $base.f1.e3 <Key-Return> {
+               focus .pgaw:Sequence.f1.e4
+       }
+       label $base.f1.l4 \
+               -borderwidth 0 -relief raised -text [intlmsg Minvalue]
+       entry $base.f1.e4 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(seq,minval) \
+               -width 200 
+       bind $base.f1.e4 <Key-Return> {
+               focus .pgaw:Sequence.f1.e5
+       }
+       label $base.f1.ls2 \
+               -borderwidth 0 -relief raised -text { } 
+       label $base.f1.l5 \
+               -borderwidth 0 -relief raised -text [intlmsg Maxvalue]
+       entry $base.f1.e5 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(seq,maxval) \
+               -width 200 
+       bind $base.f1.e5 <Key-Return> {
+               focus .pgaw:Sequence.fb.btnsave
+       }
+       frame $base.fb \
+               -height 75 -relief groove -width 125 
+       button $base.fb.btnsave \
+               -borderwidth 1 -command Sequences::save \
+               -padx 9 -pady 3 -text [intlmsg {Define sequence}]
+       button $base.fb.btncancel \
+               -borderwidth 1 -command {Window destroy .pgaw:Sequence} \
+               -padx 9 -pady 3 -text [intlmsg Close]
+       place $base.f1 \
+               -x 9 -y 5 -width 265 -height 126 -anchor nw -bordermode ignore 
+       grid columnconf $base.f1 2 -weight 1
+       grid $base.f1.l1 \
+               -in .pgaw:Sequence.f1 -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e1 \
+               -in .pgaw:Sequence.f1 -column 2 -row 0 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.l2 \
+               -in .pgaw:Sequence.f1 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e2 \
+               -in .pgaw:Sequence.f1 -column 2 -row 2 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.l3 \
+               -in .pgaw:Sequence.f1 -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e3 \
+               -in .pgaw:Sequence.f1 -column 2 -row 4 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.l4 \
+               -in .pgaw:Sequence.f1 -column 0 -row 6 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e4 \
+               -in .pgaw:Sequence.f1 -column 2 -row 6 -columnspan 1 -rowspan 1 -pady 2 
+       grid $base.f1.ls2 \
+               -in .pgaw:Sequence.f1 -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f1.l5 \
+               -in .pgaw:Sequence.f1 -column 0 -row 7 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f1.e5 \
+               -in .pgaw:Sequence.f1 -column 2 -row 7 -columnspan 1 -rowspan 1 -pady 2 
+       place $base.fb \
+               -x 0 -y 135 -width 283 -height 40 -anchor nw -bordermode ignore 
+       grid $base.fb.btnsave \
+               -in .pgaw:Sequence.fb -column 0 -row 0 -columnspan 1 -rowspan 1 -padx 5 
+       grid $base.fb.btncancel \
+               -in .pgaw:Sequence.fb -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 5 
+}
+
diff --git a/src/bin/pgaccess/lib/tables.tcl b/src/bin/pgaccess/lib/tables.tcl
new file mode 100644 (file)
index 0000000..8572312
--- /dev/null
@@ -0,0 +1,2158 @@
+namespace eval Tables {
+
+
+proc {new} {} {
+       PgAcVar:clean nt,*
+       Window show .pgaw:NewTable
+       focus .pgaw:NewTable.etabn
+}
+
+
+proc {open} {tablename {filter ""} {order ""}} {
+global PgAcVar
+       set wn [getNewWindowName]
+       createWindow
+       set PgAcVar(mw,$wn,tablename) $tablename
+       loadLayout $wn $tablename
+       set PgAcVar(mw,$wn,sortfield) $order
+       set PgAcVar(mw,$wn,filter) $filter
+       set PgAcVar(mw,$wn,query) "select oid,\"$tablename\".* from \"$tablename\""
+       set PgAcVar(mw,$wn,updatable) 1
+       set PgAcVar(mw,$wn,isaquery) 0
+       initVariables $wn
+       refreshRecords $wn
+       catch {wm title $wn "$tablename"}
+}
+
+
+proc {design} {tablename} {
+global PgAcVar CurrentDB
+       if {$CurrentDB==""} return;
+       set PgAcVar(tblinfo,tablename) $tablename
+       refreshTableInformation
+}
+
+
+proc {refreshTableInformation} {} {
+global PgAcVar CurrentDB
+       Window show .pgaw:TableInfo
+       wm title .pgaw:TableInfo "[intlmsg {Table information}] : $PgAcVar(tblinfo,tablename)"
+       .pgaw:TableInfo.f1.lb delete 0 end
+       .pgaw:TableInfo.f2.fl.ilb delete 0 end
+       .pgaw:TableInfo.f2.fr.lb delete 0 end
+       .pgaw:TableInfo.f3.plb delete 0 end
+       set PgAcVar(tblinfo,isunique) {}
+       set PgAcVar(tblinfo,isclustered) {}
+       set PgAcVar(tblinfo,indexfields) {}
+       wpg_select $CurrentDB "select attnum,attname,typname,attlen,attnotnull,atttypmod,usename,usesysid,pg_class.oid,relpages,reltuples,relhaspkey,relhasrules,relacl from pg_class,pg_user,pg_attribute,pg_type where (pg_class.relname='$PgAcVar(tblinfo,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(attnotnull) == "t"} {
+                       set notnull "NOT NULL"
+               } else {
+                       set notnull {}
+               }
+               if {$rec(attnum)>0} {.pgaw:TableInfo.f1.lb insert end [format "%-33.33s %-14.14s %6.6s    %-8.8s" $rec(attname) $ftype $fsize $notnull]}
+               set PgAcVar(tblinfo,owner) $rec(usename)
+               set PgAcVar(tblinfo,tableoid) $rec(oid)
+               set PgAcVar(tblinfo,ownerid) $rec(usesysid)
+               set PgAcVar(tblinfo,f$rec(attnum)) $rec(attname)
+               set PgAcVar(tblinfo,numtuples) $rec(reltuples)
+               set PgAcVar(tblinfo,numpages) $rec(relpages)
+               set PgAcVar(tblinfo,permissions) $rec(relacl)
+               if {$rec(relhaspkey)=="t"} {
+                       set PgAcVar(tblinfo,hasprimarykey) [intlmsg Yes]
+               } else {
+                       set PgAcVar(tblinfo,hasprimarykey) [intlmsg No]
+               }
+               if {$rec(relhasrules)=="t"} {
+                       set PgAcVar(tblinfo,hasrules) [intlmsg Yes]
+               } else {
+                       set PgAcVar(tblinfo,hasrules) [intlmsg No]
+               }
+       }
+       set PgAcVar(tblinfo,indexlist) {}
+       wpg_select $CurrentDB "select oid,indexrelid from pg_index where (pg_class.relname='$PgAcVar(tblinfo,tablename)') and (pg_class.oid=pg_index.indrelid)" rec {
+               lappend PgAcVar(tblinfo,indexlist) $rec(oid)
+               wpg_select $CurrentDB "select relname from pg_class where oid=$rec(indexrelid)" rec1 {
+                       .pgaw:TableInfo.f2.fl.ilb insert end $rec1(relname)
+               }
+       }
+       #
+       # showing permissions
+       set temp $PgAcVar(tblinfo,permissions)
+       regsub "^\{" $temp {} temp
+       regsub "\}$" $temp {} temp
+       regsub -all "\"" $temp {} temp
+       foreach token [split $temp ,] {
+               set oli [split $token =]
+               set uname [lindex $oli 0]
+               set rights [lindex $oli 1]
+               if {$uname == ""} {set uname PUBLIC}
+               set r_select " "
+               set r_update " "
+               set r_insert " "
+               set r_rule   " "
+               if {[string first r $rights] != -1} {set r_select x}
+               if {[string first w $rights] != -1} {set r_update x}
+               if {[string first a $rights] != -1} {set r_insert x}
+               if {[string first R $rights] != -1} {set r_rule   x}
+               #
+               # changing the format of the following line can affect the loadPermissions procedure
+               # see below
+               .pgaw:TableInfo.f3.plb insert end [format "%-23.23s %11s %11s %11s %11s" $uname $r_select $r_update $r_insert $r_rule]
+               
+       }
+}
+
+proc {loadPermissions} {} {
+global PgAcVar
+       set sel [.pgaw:TableInfo.f3.plb curselection]
+       if {$sel == ""} {
+               bell
+               return
+       }
+       set line [.pgaw:TableInfo.f3.plb get $sel]
+       set uname [string trim [string range $line 0 22]]
+       Window show .pgaw:Permissions
+       wm transient .pgaw:Permissions .pgaw:TableInfo
+       set PgAcVar(permission,username) $uname
+       set PgAcVar(permission,select) [expr {"x"==[string range $line 34 34]}]
+       set PgAcVar(permission,update) [expr {"x"==[string range $line 46 46]}]
+       set PgAcVar(permission,insert) [expr {"x"==[string range $line 58 58]}]
+       set PgAcVar(permission,rule)   [expr {"x"==[string range $line 70 70]}]
+       focus .pgaw:Permissions.f1.ename
+}
+
+
+proc {newPermissions} {} {
+global PgAcVar
+       PgAcVar:clean permission,*
+       Window show .pgaw:Permissions
+       wm transient .pgaw:Permissions .pgaw:TableInfo
+       focus .pgaw:Permissions.f1.ename
+}
+
+
+proc {savePermissions} {} {
+global PgAcVar
+       if {$PgAcVar(permission,username) == ""} {
+               showError [intlmsg "User without name?"]
+               return
+       }
+       sql_exec noquiet "revoke all on \"$PgAcVar(tblinfo,tablename)\" from $PgAcVar(permission,username)"
+       if {$PgAcVar(permission,select)} {
+               sql_exec noquiet "GRANT SELECT on \"$PgAcVar(tblinfo,tablename)\" to $PgAcVar(permission,username)"
+       }
+       if {$PgAcVar(permission,insert)} {
+               sql_exec noquiet "GRANT INSERT on \"$PgAcVar(tblinfo,tablename)\" to $PgAcVar(permission,username)"
+       }
+       if {$PgAcVar(permission,update)} {
+               sql_exec noquiet "GRANT UPDATE on \"$PgAcVar(tblinfo,tablename)\" to $PgAcVar(permission,username)"
+       }
+       if {$PgAcVar(permission,rule)} {
+               sql_exec noquiet "GRANT RULE on \"$PgAcVar(tblinfo,tablename)\" to $PgAcVar(permission,username)"
+       }
+       refreshTableInformation
+}
+
+
+proc {clusterIndex} {} {
+global PgAcVar
+       set sel [.pgaw:TableInfo.f2.fl.ilb curselection]
+       if {$sel == ""} {
+               showError [intlmsg "You have to select an index!"]
+               return
+       }
+       bell
+       if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:TableInfo -message [format [intlmsg "You choose to cluster index\n\n %s \n\nAll other indices will be lost!\nProceed?"] [.pgaw:TableInfo.f2.fl.ilb get $sel]] -type yesno -default no]=="no"} {return}
+       if {[sql_exec noquiet "cluster \"[.pgaw:TableInfo.f2.fl.ilb get $sel]\" on \"$PgAcVar(tblinfo,tablename)\""]} {
+               refreshTableInformation
+       }               
+}
+
+
+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 {dragMove} {w x y} {
+global PgAcVar
+       set dlo ""
+       catch { set dlo $PgAcVar(draglocation,obj) }
+       if {$dlo != ""} {
+               set dx [expr $x - $PgAcVar(draglocation,x)]
+               set dy [expr $y - $PgAcVar(draglocation,y)]
+               $w move $dlo $dx $dy
+               set PgAcVar(draglocation,x) $x
+               set PgAcVar(draglocation,y) $y
+       }
+}
+
+
+proc {dragStart} {wn w x y} {
+global PgAcVar
+       PgAcVar:clean draglocation,*
+       set object [$w find closest $x $y]
+       if {[lsearch [$wn.c gettags $object] movable]==-1} return;
+       $wn.c bind movable <Leave> {}
+       set PgAcVar(draglocation,obj) $object
+       set PgAcVar(draglocation,x) $x
+       set PgAcVar(draglocation,y) $y
+       set PgAcVar(draglocation,start) $x
+}
+
+
+proc {dragStop} {wn w x y} {
+global PgAcVar CurrentDB
+       set dlo ""
+       catch { set dlo $PgAcVar(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 $PgAcVar(draglocation,obj) v]
+               set diff [expr $x-$PgAcVar(draglocation,start)]
+               if {$diff==0} return;
+               set newcw {}
+               for {set i 0} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
+                       if {$i==$ctr} {
+               lappend newcw [expr [lindex $PgAcVar(mw,$wn,colwidth) $i]+$diff]
+                       } else {
+               lappend newcw [lindex $PgAcVar(mw,$wn,colwidth) $i]
+                       }
+               }
+               set PgAcVar(mw,$wn,colwidth) $newcw
+               $wn.c itemconfigure c$ctr -width [expr [lindex $PgAcVar(mw,$wn,colwidth) $ctr]-5]
+               drawHeaders $wn
+               drawHorizontalLines $wn
+               if {$PgAcVar(mw,$wn,crtrow)!=""} {showRecord $wn $PgAcVar(mw,$wn,crtrow)}
+               for {set i [expr $ctr+1]} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
+                       $wn.c move c$i $diff 0
+               }
+               setCursor CLOCK
+               sql_exec quiet "update pga_layout set colwidth='$PgAcVar(mw,$wn,colwidth)' where tablename='$PgAcVar(mw,$wn,layout_name)'"
+               setCursor DEFAULT
+       }
+}
+
+
+proc {canvasClick} {wn x y} {
+global PgAcVar
+       if {![finishEdit $wn]} return
+       # Determining row
+       for {set row 0} {$row<$PgAcVar(mw,$wn,nrecs)} {incr row} {
+               if {[lindex $PgAcVar(mw,$wn,rowy) $row]>$y} break
+       }
+       incr row -1
+       if {$y>[lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,last_rownum)]} {set row $PgAcVar(mw,$wn,last_rownum)}
+       if {$row<0} return
+       set PgAcVar(mw,$wn,row_edited) $row
+       set PgAcVar(mw,$wn,crtrow) $row
+       showRecord $wn $row
+       if {$PgAcVar(mw,$wn,errorsavingnew)} return
+       # Determining column
+       set posx [expr -$PgAcVar(mw,$wn,leftoffset)]
+       set col 0
+       foreach cw $PgAcVar(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} {
+                       startEdit $wn $item $x $y
+                       break
+               }
+       }
+}
+
+
+proc {deleteRecord} {wn} {
+global PgAcVar CurrentDB
+       if {!$PgAcVar(mw,$wn,updatable)} return;
+       if {![finishEdit $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 $PgAcVar(mw,$wn,keylist) $row]
+       if {[tk_messageBox -title [intlmsg "FINAL WARNING"] -icon question -parent $wn -message [intlmsg "Delete current record ?"] -type yesno -default no]=="no"} return
+       if {[sql_exec noquiet "delete from \"$PgAcVar(mw,$wn,tablename)\" where oid=$oid"]} {
+               $wn.c delete hili
+       }
+}
+
+
+proc {drawHeaders} {wn} {
+global PgAcVar
+       $wn.c delete header
+       set posx [expr 5-$PgAcVar(mw,$wn,leftoffset)]
+       for {set i 0} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
+               set xf [expr $posx+[lindex $PgAcVar(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 $PgAcVar(mw,$wn,colwidth) $i]*1.0/2] 14 -text [lindex $PgAcVar(mw,$wn,colnames) $i] -tags header -fill navy -font $PgAcVar(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 PgAcVar(mw,$wn,r_edge) $posx
+       $wn.c bind movable <Button-1> "Tables::dragStart $wn %W %x %y"
+       $wn.c bind movable <B1-Motion> {Tables::dragMove %W %x %y}
+       $wn.c bind movable <ButtonRelease-1> "Tables::dragStop $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 {drawHorizontalLines} {wn} {
+global PgAcVar
+       $wn.c delete hgrid
+       set posx 10
+       for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
+               set ledge($j) $posx
+               incr posx [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]+2]
+               set textwidth($j) [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]-5]
+       }
+       incr posx -6
+       for {set i 0} {$i<$PgAcVar(mw,$wn,nrecs)} {incr i} {
+               $wn.c create line [expr -$PgAcVar(mw,$wn,leftoffset)] [lindex $PgAcVar(mw,$wn,rowy) [expr $i+1]] [expr $posx-$PgAcVar(mw,$wn,leftoffset)] [lindex $PgAcVar(mw,$wn,rowy) [expr $i+1]] -fill gray -tags [subst {hgrid g$i}]
+       }
+       if {$PgAcVar(mw,$wn,updatable)} {
+               set i $PgAcVar(mw,$wn,nrecs)
+               set posy [expr 14+[lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,nrecs)]]
+               $wn.c create line [expr -$PgAcVar(mw,$wn,leftoffset)] $posy [expr $posx-$PgAcVar(mw,$wn,leftoffset)] $posy -fill gray -tags [subst {hgrid g$i}]
+       }
+}
+
+
+proc {drawNewRecord} {wn} {
+global PgAcVar
+       set posx [expr 10-$PgAcVar(mw,$wn,leftoffset)]
+       set posy [lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,last_rownum)]
+       if {$PgAcVar(pref,tvfont)=="helv"} {
+               set tvfont $PgAcVar(pref,font_normal)
+       } else {
+               set tvfont $PgAcVar(pref,font_fix)
+       }
+       if {$PgAcVar(mw,$wn,updatable)} {
+         for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
+               $wn.c create text $posx $posy -text * -tags [subst {r$PgAcVar(mw,$wn,nrecs) c$j q new unt}]  -anchor nw -font $tvfont -width [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]-5]
+               incr posx [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]+2]
+         }
+         incr posy 14
+         $wn.c create line [expr -$PgAcVar(mw,$wn,leftoffset)] $posy [expr $PgAcVar(mw,$wn,r_edge)-$PgAcVar(mw,$wn,leftoffset)] $posy -fill gray -tags [subst {hgrid g$PgAcVar(mw,$wn,nrecs)}]
+       }
+}
+
+
+proc {editMove} { wn {distance 1} {position end} } {
+       global PgAcVar 
+
+       # This routine moves the cursor some relative distance
+       # from one cell being editted to another cell in the table.
+       # Typical distances are 1, +1, $PgAcVar(mw,$wn,colcount), and 
+       # -$PgAcVar(mw,$wn,colcount).  Position is where
+       # the cursor will be placed within the cell.  The valid
+       # positions are 0 and end.
+
+       # get the current row and column
+       set current_cell_id $PgAcVar(mw,$wn,id_edited)
+       set tags [$wn.c gettags $current_cell_id] 
+       regexp {r([0-9]+)} $tags match crow
+       regexp {c([0-9]+)} $tags match ccol
+
+
+       # calculate next row and column
+       set colcount $PgAcVar(mw,$wn,colcount)
+       set ccell [expr ($crow * $colcount) + $ccol]
+       set ncell [expr $ccell + $distance]
+       set nrow [expr $ncell / $colcount]
+       set ncol [expr $ncell % $colcount]
+
+
+       # find the row of the next cell
+       if {$distance < 0} {
+               set row_increment -1
+       } else {
+               set row_increment 1
+       }
+       set id_tuple [$wn.c find withtag r$nrow] 
+       # skip over deleted rows...
+       while {[llength $id_tuple] == 0} {
+               # case above first row of table
+               if {$nrow < 0} {
+                       return
+               # case at or beyond last row of table
+               } elseif {$nrow >= $PgAcVar(mw,$wn,nrecs)} {
+                       if {![insertNewRecord $wn]} {
+                  set PgAcVar(mw,$wn,errorsavingnew) 1
+                       return
+                 }
+                 set id_tuple [$wn.c find withtag r$nrow] 
+                 break
+               }
+       incr nrow $row_increment
+               set id_tuple [$wn.c find withtag r$nrow] 
+       }
+
+       # find the widget id of the next cell
+       set next_cell_id [lindex [lsort -integer $id_tuple] $ncol]
+       if {[string compare $next_cell_id {}] == 0} {
+               set next_cell_id [$wn.c find withtag $current_cell_id]
+       }
+
+       # make sure that the new cell is in the visible window
+       set toprec $PgAcVar(mw,$wn,toprec)
+       set numscreenrecs [getVisibleRecordsCount $wn]
+       if {$nrow < $toprec} {
+          # case nrow above visable window
+          scrollWindow $wn moveto \
+               [expr $nrow *[recordSizeInScrollbarUnits $wn]]
+       } elseif {$nrow > ($toprec + $numscreenrecs - 1)} {
+          # case nrow below visable window
+               scrollWindow $wn moveto \
+               [expr ($nrow - $numscreenrecs + 2) * [recordSizeInScrollbarUnits $wn]]
+       }
+       # I need to find a better way to pan -kk
+       foreach {x1 y1 x2 y2}  [$wn.c bbox $next_cell_id] {break}
+       while {$x1 <= $PgAcVar(mw,$wn,leftoffset)} {
+               panRight $wn
+               foreach {x1 y1 x2 y2}  [$wn.c bbox $next_cell_id] {break}
+       }
+       set rightedge [expr $x1 + [lindex $PgAcVar(mw,$wn,colwidth) $ncol]]
+       while {$rightedge > ($PgAcVar(mw,$wn,leftoffset) + [winfo width $wn.c])} {
+               panLeft $wn
+       }
+
+       # move to the next cell
+       foreach {x1 y1 x2 y2}  [$wn.c bbox $next_cell_id] {break}
+       switch -exact -- $position {
+               0 {
+                       canvasClick $wn [incr x1  ] [incr y1 ]
+       }
+       end -
+               default {
+                       canvasClick $wn [incr x2  -1] [incr y2 -1]
+       }
+       }
+}
+
+
+proc {editText} {wn c k} {
+global PgAcVar
+set bbin [$wn.c bbox r$PgAcVar(mw,$wn,row_edited)]
+switch $k {
+       BackSpace { set dp [expr [$wn.c index $PgAcVar(mw,$wn,id_edited) insert]-1];if {$dp>=0} {$wn.c dchars $PgAcVar(mw,$wn,id_edited) $dp $dp; set PgAcVar(mw,$wn,dirtyrec) 1}}
+       Home {$wn.c icursor $PgAcVar(mw,$wn,id_edited) 0}
+       End {$wn.c icursor $PgAcVar(mw,$wn,id_edited) end}
+               Left {
+                       set position [expr [$wn.c index $PgAcVar(mw,$wn,id_edited) insert]-1]
+                       if {$position < 0} {
+               editMove $wn -1 end
+               return
+                       }
+                       $wn.c icursor $PgAcVar(mw,$wn,id_edited) $position
+               }
+       Delete {}
+               Right {
+                       set position [expr [$wn.c index $PgAcVar(mw,$wn,id_edited) insert]+1]
+                       if {$position > [$wn.c index $PgAcVar(mw,$wn,id_edited) end] } {
+               editMove $wn 1 0
+               return
+                       }
+                       $wn.c icursor $PgAcVar(mw,$wn,id_edited) $position
+               }
+               Return -
+               Tab {editMove $wn; return}
+               ISO_Left_Tab {editMove $wn -1; return}
+               Up  {editMove $wn -$PgAcVar(mw,$wn,colcount); return }
+               Down  {editMove $wn $PgAcVar(mw,$wn,colcount); return }
+       Escape {set PgAcVar(mw,$wn,dirtyrec) 0; $wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -text $PgAcVar(mw,$wn,text_initial_value); $wn.c focus {}}
+       default {if {[string compare $c " "]>-1} {$wn.c insert $PgAcVar(mw,$wn,id_edited) insert $c;set PgAcVar(mw,$wn,dirtyrec) 1}}
+}
+set bbout [$wn.c bbox r$PgAcVar(mw,$wn,row_edited)]
+set dy [expr [lindex $bbout 3]-[lindex $bbin 3]]
+if {$dy==0} return
+set re $PgAcVar(mw,$wn,row_edited)
+$wn.c move g$re 0 $dy
+for {set i [expr 1+$re]} {$i<=$PgAcVar(mw,$wn,nrecs)} {incr i} {
+       $wn.c move r$i 0 $dy
+       $wn.c move g$i 0 $dy
+       set rh [lindex $PgAcVar(mw,$wn,rowy) $i]
+       incr rh $dy
+       set PgAcVar(mw,$wn,rowy) [lreplace $PgAcVar(mw,$wn,rowy) $i $i $rh]
+}
+showRecord $wn $PgAcVar(mw,$wn,row_edited)
+# Delete is trapped by window interpreted as record delete
+#    Delete {$wn.c dchars $PgAcVar(mw,$wn,id_edited) insert insert; set PgAcVar(mw,$wn,dirtyrec) 1}
+}
+
+
+proc {finishEdit} {wn} {
+global PgAcVar CurrentDB
+# User has edited the text ?
+if {!$PgAcVar(mw,$wn,dirtyrec)} {
+       # No, unfocus text
+       $wn.c focus {}
+       # For restoring * to the new record position
+       if {$PgAcVar(mw,$wn,id_edited)!=""} {
+               if {[lsearch [$wn.c gettags $PgAcVar(mw,$wn,id_edited)] new]!=-1} {
+                       $wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -text $PgAcVar(mw,$wn,text_initial_value)
+               }
+       }
+       set PgAcVar(mw,$wn,id_edited) {};set PgAcVar(mw,$wn,text_initial_value) {}
+       return 1
+}
+# Trimming the spaces
+set fldval [string trim [$wn.c itemcget $PgAcVar(mw,$wn,id_edited) -text]]
+$wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -text $fldval
+if {[string compare $PgAcVar(mw,$wn,text_initial_value) $fldval]==0} {
+       set PgAcVar(mw,$wn,dirtyrec) 0
+       $wn.c focus {}
+       set PgAcVar(mw,$wn,id_edited) {};set PgAcVar(mw,$wn,text_initial_value) {}
+       return 1
+}
+setCursor CLOCK
+set oid [lindex $PgAcVar(mw,$wn,keylist) $PgAcVar(mw,$wn,row_edited)]
+set fld [lindex $PgAcVar(mw,$wn,colnames) [get_tag_info $wn $PgAcVar(mw,$wn,id_edited) c]]
+set fillcolor black
+if {$PgAcVar(mw,$wn,row_edited)==$PgAcVar(mw,$wn,last_rownum)} {
+       set fillcolor red
+       set sfp [lsearch $PgAcVar(mw,$wn,newrec_fields) "\"$fld\""]
+       if {$sfp>-1} {
+               set PgAcVar(mw,$wn,newrec_fields) [lreplace $PgAcVar(mw,$wn,newrec_fields) $sfp $sfp]
+               set PgAcVar(mw,$wn,newrec_values) [lreplace $PgAcVar(mw,$wn,newrec_values) $sfp $sfp]
+       }                       
+       lappend PgAcVar(mw,$wn,newrec_fields) "\"$fld\""
+       lappend PgAcVar(mw,$wn,newrec_values) '$fldval'
+       # Remove the untouched tag from the object
+       $wn.c dtag $PgAcVar(mw,$wn,id_edited) unt
+               $wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -fill red
+       set retval 1
+} else {
+       set PgAcVar(mw,$wn,msg) "Updating record ..."
+       after 1000 "set PgAcVar(mw,$wn,msg) {}"
+       regsub -all ' $fldval  \\' sqlfldval
+
+#FIXME rjr 4/29/1999 special case null so it can be entered into tables
+#really need to write a tcl sqlquote proc which quotes the string only
+#if necessary, so it can be used all over pgaccess, instead of explicit 's
+
+       if {$sqlfldval == "null"} {
+               set retval [sql_exec noquiet "update \"$PgAcVar(mw,$wn,tablename)\" \
+               set \"$fld\"= null where oid=$oid"]
+       } else {
+               set retval [sql_exec noquiet "update \"$PgAcVar(mw,$wn,tablename)\" \
+               set \"$fld\"='$sqlfldval' where oid=$oid"]
+       }
+}
+setCursor DEFAULT
+if {!$retval} {
+       set PgAcVar(mw,$wn,msg) ""
+       focus $wn.c
+       return 0
+}
+set PgAcVar(mw,$wn,dirtyrec) 0
+$wn.c focus {}
+set PgAcVar(mw,$wn,id_edited) {};set PgAcVar(mw,$wn,text_initial_value) {}
+return 1
+}
+
+proc {loadLayout} {wn layoutname} {
+global PgAcVar CurrentDB
+       setCursor CLOCK
+       set PgAcVar(mw,$wn,layout_name) $layoutname
+       catch {unset PgAcVar(mw,$wn,colcount) PgAcVar(mw,$wn,colnames) PgAcVar(mw,$wn,colwidth)}
+       set PgAcVar(mw,$wn,layout_found) 0
+       set pgres [wpg_exec $CurrentDB "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 PgAcVar(mw,$wn,colcount) [lindex $layoutinfo 1]
+                       set PgAcVar(mw,$wn,colnames)  [lindex $layoutinfo 2]
+                       set PgAcVar(mw,$wn,colwidth) [lindex $layoutinfo 3]
+                       set goodoid [lindex $layoutinfo 4]
+                       set PgAcVar(mw,$wn,layout_found) 1
+               }
+               if {$nrlay>1} {
+                       showError "Multiple ($nrlay) layout info found\n\nPlease report the bug!"
+                       sql_exec quiet "delete from pga_layout where (tablename='$PgAcVar(mw,$wn,tablename)') and (oid<>$goodoid)"
+               }
+       }
+       pg_result $pgres -clear
+}
+
+
+proc {panLeft} {wn } {
+global PgAcVar
+       if {![finishEdit $wn]} return;
+       if {$PgAcVar(mw,$wn,leftcol)==[expr $PgAcVar(mw,$wn,colcount)-1]} return;
+       set diff [expr 2+[lindex $PgAcVar(mw,$wn,colwidth) $PgAcVar(mw,$wn,leftcol)]]
+       incr PgAcVar(mw,$wn,leftcol)
+       incr PgAcVar(mw,$wn,leftoffset) $diff
+       $wn.c move header -$diff 0
+       $wn.c move q -$diff 0
+       $wn.c move hgrid -$diff 0
+}
+
+
+proc {panRight} {wn} {
+global PgAcVar
+       if {![finishEdit $wn]} return;
+       if {$PgAcVar(mw,$wn,leftcol)==0} return;
+       incr PgAcVar(mw,$wn,leftcol) -1
+       set diff [expr 2+[lindex $PgAcVar(mw,$wn,colwidth) $PgAcVar(mw,$wn,leftcol)]]
+       incr PgAcVar(mw,$wn,leftoffset) -$diff
+       $wn.c move header $diff 0
+       $wn.c move q $diff 0
+       $wn.c move hgrid $diff 0
+}
+
+
+proc {insertNewRecord} {wn} {
+global PgAcVar CurrentDB
+       if {![finishEdit $wn]} {return 0}
+       if {$PgAcVar(mw,$wn,newrec_fields)==""} {return 1}
+       set PgAcVar(mw,$wn,msg) "Saving new record ..."
+       after 1000 "set PgAcVar(mw,$wn,msg) {}"
+       set pgres [wpg_exec $CurrentDB "insert into \"$PgAcVar(mw,$wn,tablename)\" ([join $PgAcVar(mw,$wn,newrec_fields) ,]) values ([join $PgAcVar(mw,$wn,newrec_values) ,])" ]
+       if {[pg_result $pgres -status]!="PGRES_COMMAND_OK"} {
+               set errmsg [pg_result $pgres -error]
+               showError "[intlmsg {Error inserting new record}]\n\n$errmsg"
+               return 0
+       }
+       set oid [pg_result $pgres -oid]
+       lappend PgAcVar(mw,$wn,keylist) $oid
+       pg_result $pgres -clear
+       # Get bounds of the last record
+       set lrbb [$wn.c bbox new]
+       lappend PgAcVar(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 PgAcVar(mw,$wn,last_rownum)
+       incr PgAcVar(mw,$wn,nrecs)
+       drawNewRecord $wn
+       set PgAcVar(mw,$wn,newrec_fields) {}
+       set PgAcVar(mw,$wn,newrec_values) {}
+       return 1
+}
+
+
+proc {scrollWindow} {wn par1 args} {
+global PgAcVar
+       if {![finishEdit $wn]} return;
+       if {$par1=="scroll"} {
+               set newtop $PgAcVar(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 $PgAcVar(mw,$wn,nrecs)-1]} {set newtop [expr $PgAcVar(mw,$wn,nrecs)-1]}
+               }
+       } elseif {$par1=="moveto"} {
+               set newtop [expr int([lindex $args 0]*$PgAcVar(mw,$wn,nrecs))]
+       } else {
+               return
+       }
+       if {$newtop<0} return;
+       if {$newtop>=[expr $PgAcVar(mw,$wn,nrecs)-1]} return;
+       set dy [expr [lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,toprec)]-[lindex $PgAcVar(mw,$wn,rowy) $newtop]]
+       $wn.c move q 0 $dy
+       $wn.c move hgrid 0 $dy
+       set newrowy {}
+       foreach y $PgAcVar(mw,$wn,rowy) {lappend newrowy [expr $y+$dy]}
+       set PgAcVar(mw,$wn,rowy) $newrowy
+       set PgAcVar(mw,$wn,toprec) $newtop
+       setScrollbar $wn
+}
+
+
+proc {initVariables} {wn} {
+global PgAcVar
+       set PgAcVar(mw,$wn,newrec_fields) {}
+       set PgAcVar(mw,$wn,newrec_values) {}
+}
+
+proc {selectRecords} {wn sql} {
+global PgAcVar CurrentDB
+if {![finishEdit $wn]} return;
+initVariables $wn
+$wn.c delete q
+$wn.c delete header
+$wn.c delete hgrid
+$wn.c delete new
+set PgAcVar(mw,$wn,leftcol) 0
+set PgAcVar(mw,$wn,leftoffset) 0
+set PgAcVar(mw,$wn,crtrow) {}
+set PgAcVar(mw,$wn,msg) [intlmsg "Accessing data. Please wait ..."]
+catch {$wn.f1.b1 configure -state disabled}
+setCursor CLOCK
+set is_error 1
+if {[sql_exec noquiet "BEGIN"]} {
+       if {[sql_exec noquiet "declare mycursor cursor for $sql"]} {
+               set pgres [wpg_exec $CurrentDB "fetch $PgAcVar(pref,rows) in mycursor"]
+               if {$PgAcVar(pgsql,status)=="PGRES_TUPLES_OK"} {
+                       set is_error 0
+               }
+       }
+}
+if {$is_error} {
+       sql_exec quiet "END"
+       set PgAcVar(mw,$wn,msg) {}
+       catch {$wn.f1.b1 configure -state normal}
+       setCursor DEFAULT
+       set PgAcVar(mw,$wn,msg) "Error executing : $sql"
+       return
+}
+if {$PgAcVar(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 {$PgAcVar(mw,$wn,layout_found)} then {
+       if {  ($PgAcVar(mw,$wn,colcount) != [expr [llength $attrlist]-$shift]) ||
+                 ($PgAcVar(mw,$wn,colcount) != [llength $PgAcVar(mw,$wn,colnames)]) ||
+                 ($PgAcVar(mw,$wn,colcount) != [llength $PgAcVar(mw,$wn,colwidth)]) } then {
+               # No. of columns don't match, something is wrong
+               # tk_messageBox -title [intlmsg Information] -message "Layout info changed !\nRescanning..."
+               set PgAcVar(mw,$wn,layout_found) 0
+               sql_exec quiet "delete from pga_layout where tablename='$PgAcVar(mw,$wn,layout_name)'"
+       }
+}
+# Always take the col. names from the result
+set PgAcVar(mw,$wn,colcount) [llength $attrlist]
+if {$PgAcVar(mw,$wn,updatable)} then {incr PgAcVar(mw,$wn,colcount) -1}
+set PgAcVar(mw,$wn,colnames) {}
+# In defPgAcVar(mw,$wn,colwidth) prepare PgAcVar(mw,$wn,colwidth) (in case that not layout_found)
+set defPgAcVar(mw,$wn,colwidth) {}
+for {set i 0} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
+       lappend PgAcVar(mw,$wn,colnames) [lindex [lindex $attrlist [expr {$i+$shift}]] 0]
+       lappend defPgAcVar(mw,$wn,colwidth) 150
+}
+if {!$PgAcVar(mw,$wn,layout_found)} {
+       set PgAcVar(mw,$wn,colwidth) $defPgAcVar(mw,$wn,colwidth)
+       sql_exec quiet "insert into pga_layout values ('$PgAcVar(mw,$wn,layout_name)',$PgAcVar(mw,$wn,colcount),'$PgAcVar(mw,$wn,colnames)','$PgAcVar(mw,$wn,colwidth)')"
+       set PgAcVar(mw,$wn,layout_found) 1
+}
+set PgAcVar(mw,$wn,nrecs) [pg_result $pgres -numTuples]
+if {$PgAcVar(mw,$wn,nrecs)>$PgAcVar(pref,rows)} {
+       set PgAcVar(mw,$wn,msg) "Only first $PgAcVar(pref,rows) records from $PgAcVar(mw,$wn,nrecs) have been loaded"
+       set PgAcVar(mw,$wn,nrecs) $PgAcVar(pref,rows)
+}
+set tagoid {}
+if {$PgAcVar(pref,tvfont)=="helv"} {
+       set tvfont $PgAcVar(pref,font_normal)
+} else {
+       set tvfont $PgAcVar(pref,font_fix)
+}
+# Computing column's left edge
+set posx 10
+for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
+       set ledge($j) $posx
+       incr posx [expr {[lindex $PgAcVar(mw,$wn,colwidth) $j]+2}]
+       set textwidth($j) [expr {[lindex $PgAcVar(mw,$wn,colwidth) $j]-5}]
+}
+incr posx -6
+set posy 24
+drawHeaders $wn
+set PgAcVar(mw,$wn,updatekey) oid
+set PgAcVar(mw,$wn,keylist) {}
+set PgAcVar(mw,$wn,rowy) {24}
+set PgAcVar(mw,$wn,msg) "Loading maximum $PgAcVar(pref,rows) records ..."
+set wupdatable $PgAcVar(mw,$wn,updatable)
+for {set i 0} {$i<$PgAcVar(mw,$wn,nrecs)} {incr i} {
+       set curtup [pg_result $pgres -getTuple $i]
+       if {$wupdatable} then {lappend PgAcVar(mw,$wn,keylist) [lindex $curtup 0]}
+       for {set j 0} {$j<$PgAcVar(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 PgAcVar(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 PgAcVar(mw,$wn,msg) {}"
+set PgAcVar(mw,$wn,last_rownum) $i
+# Defining position for input data
+drawNewRecord $wn
+pg_result $pgres -clear
+sql_exec quiet "END"
+set PgAcVar(mw,$wn,toprec) 0
+setScrollbar $wn
+if {$PgAcVar(mw,$wn,updatable)} then {
+       $wn.c bind q <Key> "Tables::editText $wn %A %K"
+} else {
+       $wn.c bind q <Key> {}
+}
+set PgAcVar(mw,$wn,dirtyrec) 0
+$wn.c raise header
+catch {$wn.f1.b1 configure -state normal}
+setCursor DEFAULT
+}
+
+
+proc recordSizeInScrollbarUnits {wn} {
+       # record size in scrollbar units
+       global PgAcVar
+       return [expr 1.0/$PgAcVar(mw,$wn,nrecs)]
+}
+
+
+proc getVisibleRecordsCount {wn} {
+       # number of records that fit in the window at its current size
+       expr [winfo height $wn.c]/14
+}
+
+
+proc {setScrollbar} {wn} {
+global PgAcVar
+       if {$PgAcVar(mw,$wn,nrecs)==0} return;
+       # Fixes problem of window resizing messing up the scrollbar size.
+       set record_size [recordSizeInScrollbarUnits $wn];
+       $wn.sb set [expr $PgAcVar(mw,$wn,toprec)*$record_size] \
+       [expr ($PgAcVar(mw,$wn,toprec)+[getVisibleRecordsCount $wn])*$record_size]
+}
+
+
+proc {refreshRecords} {wn} {
+global PgAcVar
+       set nq $PgAcVar(mw,$wn,query)
+       if {($PgAcVar(mw,$wn,isaquery)) && ("$PgAcVar(mw,$wn,filter)$PgAcVar(mw,$wn,sortfield)"!="")} {
+               showError [intlmsg "Sorting and filtering not (yet) available from queries!\n\nPlease enter them in the query definition!"]
+               set PgAcVar(mw,$wn,sortfield) {}
+               set PgAcVar(mw,$wn,filter) {}
+       } else {
+               if {$PgAcVar(mw,$wn,filter)!=""} {
+                       set nq "$PgAcVar(mw,$wn,query) where ($PgAcVar(mw,$wn,filter))"
+               } else {
+                       set nq $PgAcVar(mw,$wn,query)
+               }
+               if {$PgAcVar(mw,$wn,sortfield)!=""} {
+                       set nq "$nq order by $PgAcVar(mw,$wn,sortfield)"
+               }
+       }
+       if {[insertNewRecord $wn]} {selectRecords $wn $nq}
+}
+
+
+proc {showRecord} {wn row} {
+global PgAcVar
+       set PgAcVar(mw,$wn,errorsavingnew) 0
+       if {$PgAcVar(mw,$wn,newrec_fields)!=""} {
+               if {$row!=$PgAcVar(mw,$wn,last_rownum)} {
+                       if {![insertNewRecord $wn]} {
+               set PgAcVar(mw,$wn,errorsavingnew) 1
+               return
+                       }
+               }
+       }
+       set y1 [lindex $PgAcVar(mw,$wn,rowy) $row]
+       set y2 [lindex $PgAcVar(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 $PgAcVar(mw,$wn,colwidth) {incr x [expr $wi+2]}
+       $wn.c delete crtrec
+       $wn.c create rectangle [expr -1-$PgAcVar(mw,$wn,leftoffset)] $y1 [expr $x-$PgAcVar(mw,$wn,leftoffset)] $y2 -fill #EEEEEE -outline {} -tags {q crtrec}
+       $wn.c lower crtrec
+}
+
+
+proc {startEdit} {wn id x y} {
+global PgAcVar
+       if {!$PgAcVar(mw,$wn,updatable)} return
+       set PgAcVar(mw,$wn,id_edited) $id
+       set PgAcVar(mw,$wn,dirtyrec) 0
+       set PgAcVar(mw,$wn,text_initial_value) [$wn.c itemcget $id -text]
+       focus $wn.c
+       $wn.c focus $id
+       $wn.c icursor $id @$x,$y
+       if {$PgAcVar(mw,$wn,row_edited)==$PgAcVar(mw,$wn,nrecs)} {
+               if {[$wn.c itemcget $id -text]=="*"} {
+                       $wn.c itemconfigure $id -text ""
+                       $wn.c icursor $id 0
+               }
+       }
+}
+
+
+proc {canvasPaste} {wn x y} {
+global PgAcVar
+       $wn.c insert $PgAcVar(mw,$wn,id_edited) insert [selection get]
+       set PgAcVar(mw,$wn,dirtyrec) 1
+}
+
+proc {getNewWindowName} {} {
+global PgAcVar
+       incr PgAcVar(mwcount)
+       return .pgaw:$PgAcVar(mwcount)
+}
+
+
+
+proc {createWindow} {{base ""}} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:$PgAcVar(mwcount)
+               set included 0
+       } else {
+               set included 1
+       }
+       set wn $base
+       set PgAcVar(mw,$wn,dirtyrec) 0
+       set PgAcVar(mw,$wn,id_edited) {}
+       set PgAcVar(mw,$wn,filter) {}
+       set PgAcVar(mw,$wn,sortfield) {}
+       if {! $included} {
+               if {[winfo exists $base]} {
+                       wm deiconify $base; return
+               }
+               toplevel $base -class Toplevel
+               wm focusmodel $base passive
+               wm geometry $base 650x400
+               wm maxsize $base 1009 738
+               wm minsize $base 650 400
+               wm overrideredirect $base 0
+               wm resizable $base 1 1
+               wm deiconify $base
+               wm title $base [intlmsg "Table"]
+       }
+       bind $base <Key-Delete> "Tables::deleteRecord $wn"
+       bind $base <Key-F1> "Help::load tables"
+       if {! $included} {
+               frame $base.f1  -borderwidth 2 -height 75 -relief groove -width 125 
+               label $base.f1.l1  -borderwidth 0 -text [intlmsg {Sort field}]
+               entry $base.f1.e1  -background #fefefe -borderwidth 1 -width 14  -highlightthickness 1 -textvariable PgAcVar(mw,$wn,sortfield)
+               bind $base.f1.e1 <Key-Return> "Tables::refreshRecords $wn"      
+               bind $base.f1.e1 <Key-KP_Enter> "Tables::refreshRecords $wn"    
+               label $base.f1.lb1  -borderwidth 0 -text {     } 
+               label $base.f1.l2  -borderwidth 0 -text [intlmsg {Filter conditions}]
+               entry $base.f1.e2  -background #fefefe -borderwidth 1  -highlightthickness 1 -textvariable PgAcVar(mw,$wn,filter)
+               bind $base.f1.e2 <Key-Return> "Tables::refreshRecords $wn"      
+               bind $base.f1.e2 <Key-KP_Enter> "Tables::refreshRecords $wn"    
+               button $base.f1.b1  -borderwidth 1 -text [intlmsg Close] -command "
+               if {\[Tables::insertNewRecord $wn\]} {
+                       $wn.c delete rows
+                       $wn.c delete header
+                       Window destroy $wn
+                       PgAcVar:clean mw,$wn,*
+               }"
+               button $base.f1.b2  -borderwidth 1 -text [intlmsg Reload] -command "Tables::refreshRecords $wn"
+       }
+       frame $base.frame20  -borderwidth 2 -height 75 -relief groove -width 125 
+       button $base.frame20.01  -borderwidth 1 -text < -command "Tables::panRight $wn"
+       label $base.frame20.02  -anchor w -borderwidth 1 -height 1  -relief sunken -text {} -textvariable PgAcVar(mw,$wn,msg) 
+       button $base.frame20.03  -borderwidth 1 -text > -command "Tables::panLeft $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 "Tables::scrollWindow $wn"
+       bind $base.c <Button-1> "Tables::canvasClick $wn %x %y"
+       bind $base.c <Button-2> "Tables::canvasPaste $wn %x %y"
+       bind $base.c <Button-3> "if {[Tables::finishEdit $wn]} \"Tables::insertNewRecord $wn\""
+
+       # Prevent Tab from moving focus out of canvas widget
+       bind $base.c <Tab> break
+
+       if {! $included} {
+               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 {renameColumn} {} {
+global PgAcVar CurrentDB
+       if {[string length [string trim $PgAcVar(tblinfo,new_cn)]]==0} {
+               showError [intlmsg "Field name not entered!"]
+               return
+       }
+       set old_name [string trim [string range $PgAcVar(tblinfo,old_cn) 0 31]]
+       set PgAcVar(tblinfo,new_cn) [string trim $PgAcVar(tblinfo,new_cn)]
+       if {$old_name == $PgAcVar(tblinfo,new_cn)} {
+               showError [intlmsg "New name is the same as the old one!"]
+               return
+       }
+       foreach line [.pgaw:TableInfo.f1.lb get 0 end] {
+               if {[string trim [string range $line 0 31]]==$PgAcVar(tblinfo,new_cn)} {
+                       showError [format [intlmsg {Column name '%s' already exists in this table!}] $PgAcVar(tblinfo,new_cn)]
+                       return
+               }
+       }
+       if {[sql_exec noquiet "alter table \"$PgAcVar(tblinfo,tablename)\" rename column \"$old_name\" to \"$PgAcVar(tblinfo,new_cn)\""]} {
+               refreshTableInformation
+               Window destroy .pgaw:RenameField
+       }
+}
+
+
+
+proc {addNewIndex} {} {
+global PgAcVar
+       set iflds [.pgaw:TableInfo.f1.lb curselection]
+       if {$iflds==""} {
+               showError [intlmsg "You have to select index fields!"]
+               return
+       }
+       set ifldslist {}
+       foreach i $iflds {lappend ifldslist "\"[string trim [string range [.pgaw:TableInfo.f1.lb get $i] 0 32]]\""}
+       set PgAcVar(addindex,indexname) $PgAcVar(tblinfo,tablename)_[join $ifldslist _]
+       # Replace the quotes with underlines
+       regsub -all {"} $PgAcVar(addindex,indexname) {_} PgAcVar(addindex,indexname)
+       # Replace the double underlines
+       while {[regsub -all {__} $PgAcVar(addindex,indexname) {_} PgAcVar(addindex,indexname)]} {}
+       # Replace the final underline
+       regsub -all {_$} $PgAcVar(addindex,indexname) {} PgAcVar(addindex,indexname)
+       set PgAcVar(addindex,indexfields) [join $ifldslist ,]
+       Window show .pgaw:AddIndex
+       wm transient .pgaw:AddIndex .pgaw:TableInfo
+}
+
+proc {deleteIndex} {} {
+global PgAcVar
+       set sel [.pgaw:TableInfo.f2.fl.ilb curselection]
+       if {$sel == ""} {
+               showError [intlmsg "You have to select an index!"]
+               return
+       }
+       if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:TableInfo -message [format [intlmsg "You choose to delete index\n\n %s \n\nProceed?"] [.pgaw:TableInfo.f2.fl.ilb get $sel]] -type yesno -default no]=="no"} {return}
+       if {[sql_exec noquiet "drop index \"[.pgaw:TableInfo.f2.fl.ilb get $sel]\""]} {
+               refreshTableInformation
+       }
+}
+
+proc {createNewIndex} {} {
+global PgAcVar
+       if {$PgAcVar(addindex,indexname)==""} {
+               showError [intlmsg "Index name cannot be null!"]
+               return
+       }
+       setCursor CLOCK
+       if {[sql_exec noquiet "CREATE $PgAcVar(addindex,unique) INDEX \"$PgAcVar(addindex,indexname)\" on \"$PgAcVar(tblinfo,tablename)\" ($PgAcVar(addindex,indexfields))"]} {
+               setCursor DEFAULT
+               Window destroy .pgaw:AddIndex
+               refreshTableInformation
+       }
+       setCursor DEFAULT
+}
+
+
+proc {showIndexInformation} {} {
+global PgAcVar CurrentDB
+set cs [.pgaw:TableInfo.f2.fl.ilb curselection]
+if {$cs==""} return
+set idxname [.pgaw:TableInfo.f2.fl.ilb get $cs]
+wpg_select $CurrentDB "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 PgAcVar(tblinfo,isunique) [intlmsg Yes]
+       } else {
+               set PgAcVar(tblinfo,isunique) [intlmsg No]
+       }
+       if {$rec(indisclustered)=="t"} {
+               set PgAcVar(tblinfo,isclustered) [intlmsg Yes]
+       } else {
+               set PgAcVar(tblinfo,isclustered) [intlmsg No]
+       }
+       set PgAcVar(tblinfo,indexfields) {}
+       .pgaw:TableInfo.f2.fr.lb delete 0 end
+       foreach field $rec(indkey) {
+               if {$field!=0} {
+#            wpg_select $CurrentDB "select attname from pg_attribute where attrelid=$PgAcVar(tblinfo,tableoid) and attnum=$field" rec1 {
+#                set PgAcVar(tblinfo,indexfields) "$PgAcVar(tblinfo,indexfields) $rec1(attname)"
+#            }
+               set PgAcVar(tblinfo,indexfields) "$PgAcVar(tblinfo,indexfields) $PgAcVar(tblinfo,f$field)"
+               .pgaw:TableInfo.f2.fr.lb insert end $PgAcVar(tblinfo,f$field)
+               }
+
+       }
+}
+set PgAcVar(tblinfo,indexfields) [string trim $PgAcVar(tblinfo,indexfields)]
+}
+
+
+proc {addNewColumn} {} {
+global PgAcVar
+       if {$PgAcVar(addfield,name)==""} {
+               showError [intlmsg "Empty field name ?"]
+               focus .pgaw:AddField.e1
+               return
+       }               
+       if {$PgAcVar(addfield,type)==""} {
+               showError [intlmsg "No field type ?"]
+               focus .pgaw:AddField.e2
+               return
+       }
+       if {![sql_exec quiet "alter table \"$PgAcVar(tblinfo,tablename)\" add column \"$PgAcVar(addfield,name)\" $PgAcVar(addfield,type)"]} {
+               showError "[intlmsg {Cannot add column}]\n\n$PgAcVar(pgsql,errmsg)"
+               return
+       }
+       Window destroy .pgaw:AddField
+       sql_exec quiet "update pga_layout set colnames=colnames || ' {$PgAcVar(addfield,name)}', colwidth=colwidth || ' 150',nrcols=nrcols+1 where tablename='$PgAcVar(tblinfo,tablename)'"
+       refreshTableInformation
+}
+
+
+proc {newtable:add_new_field} {} {
+global PgAcVar
+if {$PgAcVar(nt,fieldname)==""} {
+       showError [intlmsg "Enter a field name"]
+       focus .pgaw:NewTable.e2
+       return
+}
+if {$PgAcVar(nt,fldtype)==""} {
+       showError [intlmsg "The field type is not specified!"]
+       return
+}
+if {($PgAcVar(nt,fldtype)=="varchar")&&($PgAcVar(nt,fldsize)=="")} {
+       focus .pgaw:NewTable.e3
+       showError [intlmsg "You must specify field size!"]
+       return
+}
+if {$PgAcVar(nt,fldsize)==""} then {set sup ""} else {set sup "($PgAcVar(nt,fldsize))"}
+if {[regexp $PgAcVar(nt,fldtype) "varchartextdatetime"]} {set supc "'"} else {set supc ""}
+# Don't put the ' arround default value if it contains the now() function
+if {([regexp $PgAcVar(nt,fldtype) "datetime"]) && ([regexp now $PgAcVar(nt,defaultval)])} {set supc ""}
+# Clear the notnull attribute if field type is serial
+if {$PgAcVar(nt,fldtype)=="serial"} {set PgAcVar(nt,notnull) " "}
+if {$PgAcVar(nt,defaultval)==""} then {set sup2 ""} else {set sup2 " DEFAULT $supc$PgAcVar(nt,defaultval)$supc"}
+# Checking for field name collision
+set inspos end
+for {set i 0} {$i<[.pgaw:NewTable.lb size]} {incr i} {
+       set linie [.pgaw:NewTable.lb get $i]
+       if {$PgAcVar(nt,fieldname)==[string trim [string range $linie 2 33]]} {
+               if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:NewTable -message [format [intlmsg "There is another field with the same name: '%s'!\n\nReplace it ?"] $PgAcVar(nt,fieldname)] -type yesno -default yes]=="no"} return
+               .pgaw:NewTable.lb delete $i
+               set inspos $i
+               break
+       }        
+  }
+.pgaw:NewTable.lb insert $inspos [format "%1s %-32.32s %-14s%-16s" $PgAcVar(nt,primarykey) $PgAcVar(nt,fieldname) $PgAcVar(nt,fldtype)$sup $sup2$PgAcVar(nt,notnull)]
+focus .pgaw:NewTable.e2
+set PgAcVar(nt,fieldname) {}
+set PgAcVar(nt,fldsize) {}
+set PgAcVar(nt,defaultval) {}
+set PgAcVar(nt,primarykey) " "
+}
+
+proc {newtable:create} {} {
+global PgAcVar CurrentDB
+if {$PgAcVar(nt,tablename)==""} then {
+       showError [intlmsg "You must supply a name for your table!"]
+       focus .pgaw:NewTable.etabn
+       return
+}
+if {[.pgaw:NewTable.lb size]==0} then {
+       showError [intlmsg "Your table has no fields!"]
+       focus .pgaw:NewTable.e2
+       return
+}
+set fl {}
+set pkf {}
+foreach line [.pgaw:NewTable.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 \"$PgAcVar(nt,tablename)\" ([join $fl ,]"
+if {$PgAcVar(nt,constraint)!=""} then {set temp "$temp, constraint \"$PgAcVar(nt,constraint)\""}
+if {$PgAcVar(nt,check)!=""} then {set temp "$temp check ($PgAcVar(nt,check))"}
+if {[llength $pkf]>0} then {set temp "$temp, primary key([join $pkf ,])"}
+set temp "$temp)"
+if {$PgAcVar(nt,inherits)!=""} then {set temp "$temp inherits ($PgAcVar(nt,inherits))"}
+setCursor CLOCK
+if {[sql_exec noquiet $temp]} {
+       Window destroy .pgaw:NewTable
+       Mainlib::cmd_Tables
+}
+setCursor DEFAULT
+}
+
+proc {tabSelect} {i} {
+global PgAcVar
+       set base .pgaw:TableInfo
+       foreach tab {0 1 2 3} {
+               if {$i == $tab} {
+                       place $base.l$tab -y 13
+                       place $base.f$tab -x 15 -y 45
+                       $base.l$tab configure -font $PgAcVar(pref,font_bold)
+               } else {
+                       place $base.l$tab -y 15
+                       place $base.f$tab -x 15 -y 500
+                       $base.l$tab configure -font $PgAcVar(pref,font_normal)
+               }
+       }
+       array set coord [place info $base.l$i]
+       place $base.lline -x [expr {1+$coord(-x)}]
+}
+
+
+}
+
+####################   END OF NAMESPACE TABLES ####################
+
+proc vTclWindow.pgaw:NewTable {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:NewTable
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 634x392+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 [intlmsg "Create new table"]
+       bind $base <Key-F1> "Help::load new_table"
+       entry $base.etabn \
+               -background #fefefe -borderwidth 1 -selectborderwidth 0 \
+               -textvariable PgAcVar(nt,tablename) 
+       bind $base.etabn <Key-Return> {
+               focus .pgaw:NewTable.einh
+       }
+       label $base.li \
+               -anchor w -borderwidth 0 -text [intlmsg Inherits]
+       entry $base.einh \
+               -background #fefefe -borderwidth 1 -selectborderwidth 0 \
+               -textvariable PgAcVar(nt,inherits) 
+       bind $base.einh <Key-Return> {
+               focus .pgaw:NewTable.e2
+       }
+       button $base.binh \
+               -borderwidth 1 \
+               -command {if {[winfo exists .pgaw:NewTable.ddf]} {
+       destroy .pgaw:NewTable.ddf
+} else {
+       create_drop_down .pgaw:NewTable 386 23 220
+       focus .pgaw:NewTable.ddf.sb
+       foreach tbl [Database::getTablesList] {.pgaw:NewTable.ddf.lb insert end $tbl}
+       bind .pgaw:NewTable.ddf.lb <ButtonRelease-1> {
+               set i [.pgaw:NewTable.ddf.lb curselection]
+               if {$i!=""} {
+                       if {$PgAcVar(nt,inherits)==""} {
+               set PgAcVar(nt,inherits) "\"[.pgaw:NewTable.ddf.lb get $i]\""
+                       } else {
+               set PgAcVar(nt,inherits) "$PgAcVar(nt,inherits),\"[.pgaw:NewTable.ddf.lb get $i]\""
+                       }
+               }
+               if {$i!=""} {focus .pgaw:NewTable.e2}
+               destroy .pgaw:NewTable.ddf
+               break
+       }
+}} \
+               -highlightthickness 0 -takefocus 0 -image dnarw
+       entry $base.e2 \
+               -background #fefefe -borderwidth 1 -selectborderwidth 0 \
+               -textvariable PgAcVar(nt,fieldname) 
+       bind $base.e2 <Key-Return> {
+               focus .pgaw:NewTable.e1
+       }
+       entry $base.e1 \
+               -background #fefefe -borderwidth 1 -selectborderwidth 0 \
+               -textvariable PgAcVar(nt,fldtype) 
+       bind $base.e1 <Key-Return> {
+               focus .pgaw:NewTable.e5
+       }
+       entry $base.e3 \
+               -background #fefefe -borderwidth 1 -selectborderwidth 0 \
+               -textvariable PgAcVar(nt,fldsize) 
+       bind $base.e3 <Key-Return> {
+               focus .pgaw:NewTable.e5
+       }
+       entry $base.e5 \
+               -background #fefefe -borderwidth 1 -selectborderwidth 0 \
+               -textvariable PgAcVar(nt,defaultval) 
+       bind $base.e5 <Key-Return> {
+               focus .pgaw:NewTable.cb1
+       }
+       checkbutton $base.cb1 \
+               -borderwidth 1 \
+               -offvalue { } -onvalue { NOT NULL} -text [intlmsg {field cannot be null}] \
+               -variable PgAcVar(nt,notnull) 
+       label $base.lab1 \
+               -borderwidth 0 -text [intlmsg type]
+       label $base.lab2 \
+               -borderwidth 0 -anchor w -text [intlmsg {field name}]
+       label $base.lab3 \
+               -borderwidth 0 -text [intlmsg size]
+       label $base.lab4 \
+               -borderwidth 0 -anchor w -text [intlmsg {Default value}]
+       button $base.addfld \
+               -borderwidth 1 -command Tables::newtable:add_new_field \
+               -text [intlmsg {Add field}]
+       button $base.delfld \
+               -borderwidth 1 -command {catch {.pgaw:NewTable.lb delete [.pgaw:NewTable.lb curselection]}} \
+               -text [intlmsg {Delete field}]
+       button $base.emptb \
+               -borderwidth 1 -command {.pgaw:NewTable.lb delete 0 [.pgaw:NewTable.lb size]} \
+               -text [intlmsg {Delete all}]
+       button $base.maketbl \
+               -borderwidth 1 -command Tables::newtable:create \
+               -text [intlmsg Create]
+       listbox $base.lb \
+               -background #fefefe -foreground #000000 -borderwidth 1 \
+               -selectbackground #c3c3c3 -font $PgAcVar(pref,font_fix) \
+               -selectborderwidth 0 -yscrollcommand {.pgaw:NewTable.sb set} 
+       bind $base.lb <ButtonRelease-1> {
+               if {[.pgaw:NewTable.lb curselection]!=""} {
+       set fldname [string trim [lindex [split [.pgaw:NewTable.lb get [.pgaw:NewTable.lb curselection]]] 0]]
+}
+       }
+       button $base.exitbtn \
+               -borderwidth 1 -command {Window destroy .pgaw:NewTable} \
+               -text [intlmsg Cancel]
+       button $base.helpbtn \
+               -borderwidth 1 -command {Help::load new_table} \
+               -text [intlmsg Help]
+       label $base.l1 \
+               -anchor w -borderwidth 1 \
+               -relief raised -text "       [intlmsg {field name}]"
+       label $base.l2 \
+               -borderwidth 1 \
+               -relief raised -text [intlmsg type]
+       label $base.l3 \
+               -borderwidth 1 \
+               -relief raised -text [intlmsg options]
+       scrollbar $base.sb \
+               -borderwidth 1 -command {.pgaw:NewTable.lb yview} -orient vert 
+       label $base.l93 \
+               -anchor w -borderwidth 0 -text [intlmsg {Table name}]
+       button $base.mvup \
+               -borderwidth 1 \
+               -command {if {[.pgaw:NewTable.lb size]>1} {
+       set i [.pgaw:NewTable.lb curselection]
+       if {($i!="")&&($i>0)} {
+               .pgaw:NewTable.lb insert [expr $i-1] [.pgaw:NewTable.lb get $i]
+               .pgaw:NewTable.lb delete [expr $i+1]
+               .pgaw:NewTable.lb selection set [expr $i-1]
+       }
+}} \
+               -text [intlmsg {Move up}]
+       button $base.mvdn \
+               -borderwidth 1 \
+               -command {if {[.pgaw:NewTable.lb size]>1} {
+       set i [.pgaw:NewTable.lb curselection]
+       if {($i!="")&&($i<[expr [.pgaw:NewTable.lb size]-1])} {
+               .pgaw:NewTable.lb insert [expr $i+2] [.pgaw:NewTable.lb get $i]
+               .pgaw:NewTable.lb delete $i
+               .pgaw:NewTable.lb selection set [expr $i+1]
+       }
+}} \
+               -text [intlmsg {Move down}]
+       button $base.button17 \
+               -borderwidth 1 \
+               -command {
+if {[winfo exists .pgaw:NewTable.ddf]} {
+       destroy .pgaw:NewTable.ddf
+} else {
+       create_drop_down .pgaw:NewTable 291 80 97
+       focus .pgaw:NewTable.ddf.sb
+       .pgaw:NewTable.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 .pgaw:NewTable.ddf.lb <ButtonRelease-1> {
+               set i [.pgaw:NewTable.ddf.lb curselection]
+               if {$i!=""} {set PgAcVar(nt,fldtype) [.pgaw:NewTable.ddf.lb get $i]}
+               destroy .pgaw:NewTable.ddf
+               if {$i!=""} {
+                       if {[lsearch {char varchar} $PgAcVar(nt,fldtype)]==-1} {
+               set PgAcVar(nt,fldsize) {}
+               .pgaw:NewTable.e3 configure -state disabled
+               focus .pgaw:NewTable.e5
+                       } else {
+               .pgaw:NewTable.e3 configure -state normal
+               focus .pgaw:NewTable.e3
+                       }
+               }
+               break
+       }
+}} \
+               -highlightthickness 0 -takefocus 0 -image dnarw 
+       label $base.lco \
+               -borderwidth 0 -anchor w -text [intlmsg Constraint]
+       entry $base.eco \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(nt,constraint) 
+       label $base.lch \
+               -borderwidth 0 -text [intlmsg check]
+       entry $base.ech \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(nt,check) 
+       label $base.ll \
+               -borderwidth 1 \
+               -relief raised 
+       checkbutton $base.pk \
+               -borderwidth 1 \
+               -offvalue { } -onvalue * -text [intlmsg {primary key}] -variable PgAcVar(nt,primarykey) 
+       label $base.lpk \
+               -borderwidth 1 \
+               -relief raised -text K 
+       place $base.etabn \
+               -x 105 -y 5 -width 136 -height 20 -anchor nw -bordermode ignore 
+       place $base.li \
+               -x 245 -y 7 -height 16 -anchor nw -bordermode ignore 
+       place $base.einh \
+               -x 300 -y 5 -width 308 -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 105 -y 60 -width 136 -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 470 -y 60 -width 46 -height 20 -anchor nw -bordermode ignore 
+       place $base.e5 \
+               -x 105 -y 82 -width 136 -height 20 -anchor nw -bordermode ignore 
+       place $base.cb1 \
+               -x 245 -y 83 -height 20 -anchor nw -bordermode ignore 
+       place $base.lab1 \
+               -x 247 -y 62 -height 16 -anchor nw -bordermode ignore 
+       place $base.lab2 \
+               -x 4 -y 62 -height 16 -anchor nw -bordermode ignore 
+       place $base.lab3 \
+               -x 400 -y 62 -height 16 -anchor nw -bordermode ignore 
+       place $base.lab4 \
+               -x 5 -y 84 -height 16 -anchor nw -bordermode ignore 
+       place $base.addfld \
+               -x 530 -y 58 -width 100 -height 26 -anchor nw -bordermode ignore 
+       place $base.delfld \
+               -x 530 -y 190 -width 100 -height 26 -anchor nw -bordermode ignore 
+       place $base.emptb \
+               -x 530 -y 220 -width 100 -height 26 -anchor nw -bordermode ignore 
+       place $base.maketbl \
+               -x 530 -y 365 -width 100 -height 26 -anchor nw -bordermode ignore 
+       place $base.lb \
+               -x 4 -y 121 -width 506 -height 269 -anchor nw -bordermode ignore 
+       place $base.helpbtn \
+               -x 530 -y 305 -width 100 -height 26 -anchor nw -bordermode ignore 
+       place $base.exitbtn \
+               -x 530 -y 335 -width 100 -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 -height 16 -anchor nw -bordermode ignore 
+       place $base.mvup \
+               -x 530 -y 120 -width 100 -height 26 -anchor nw -bordermode ignore 
+       place $base.mvdn \
+               -x 530 -y 150 -width 100 -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 105 -y 27 -width 136 -height 20 -anchor nw -bordermode ignore 
+       place $base.lch \
+               -x 245 -y 30 -anchor nw -bordermode ignore 
+       place $base.ech \
+               -x 300 -y 27 -width 308 -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 450 -y 83 -height 20 -anchor nw -bordermode ignore 
+       place $base.lpk \
+               -x 4 -y 105 -width 14 -height 18 -anchor nw -bordermode ignore 
+}
+
+
+proc vTclWindow.pgaw:TableInfo {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:TableInfo
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel \
+               -background #c7c3c7 
+       wm focusmodel $base passive
+       wm geometry $base 522x398+152+135
+       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 [intlmsg "Table information"]
+       bind $base <Key-F1> "Help::load view_table_structure"
+       label $base.l0 \
+               -borderwidth 1 -font $PgAcVar(pref,font_bold) \
+               -relief raised -text [intlmsg General]
+       bind $base.l0 <Button-1> {
+               Tables::tabSelect 0
+    }
+       label $base.l1 \
+               -borderwidth 1 \
+               -relief raised -text [intlmsg Columns]
+       bind $base.l1 <Button-1> {
+               Tables::tabSelect 1
+    }
+       label $base.l2 \
+               -borderwidth 1 \
+               -relief raised -text [intlmsg Indexes]
+       bind $base.l2 <Button-1> {
+               Tables::tabSelect 2
+    }
+       label $base.l3 \
+               -borderwidth 1 \
+               -relief raised -text [intlmsg Permissions]
+       bind $base.l3 <Button-1> {
+               Tables::tabSelect 3
+    }
+       label $base.l \
+               -relief raised 
+       button $base.btnclose \
+               -borderwidth 1 -command {Window destroy .pgaw:TableInfo} \
+               -highlightthickness 0 -padx 9 -pady 3 -text [intlmsg Close]
+       frame $base.f1 \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       frame $base.f1.ft \
+               -height 75 -relief groove -width 125 
+       label $base.f1.ft.t1 \
+               -relief groove -text [intlmsg {field name}]
+       label $base.f1.ft.t2 \
+               -relief groove -text [intlmsg type] -width 12 
+       label $base.f1.ft.t3 \
+               -relief groove -text [intlmsg size] -width 6 
+       label $base.f1.ft.lnn \
+               -relief groove -text [intlmsg {not null}] -width 18 
+       label $base.f1.ft.ls \
+               -borderwidth 0 \
+               -relief raised -text {    } 
+       frame $base.f1.fb \
+               -height 75 -relief groove -width 125 
+       button $base.f1.fb.addcolbtn \
+               -borderwidth 1 \
+               -command {Window show .pgaw:AddField
+                       set PgAcVar(addfield,name) {}
+                       set PgAcVar(addfield,type) {}
+                       wm transient .pgaw:AddField .pgaw:TableInfo
+                       focus .pgaw:AddField.e1} \
+                -padx 9 -pady 3 -text [intlmsg {Add new column}]
+       button $base.f1.fb.rencolbtn \
+               -borderwidth 1 \
+               -command {
+if {[set PgAcVar(tblinfo,col_id) [.pgaw:TableInfo.f1.lb curselection]]==""} then {
+       bell
+} else {
+       set PgAcVar(tblinfo,old_cn) [.pgaw:TableInfo.f1.lb get [.pgaw:TableInfo.f1.lb curselection]]
+       set PgAcVar(tblinfo,new_cn) {}
+       Window show .pgaw:RenameField
+       tkwait visibility .pgaw:RenameField
+       wm transient .pgaw:RenameField .pgaw:TableInfo
+       focus .pgaw:RenameField.e1
+}
+} \
+                -padx 9 -pady 3 -text [intlmsg {Rename column}]
+       button $base.f1.fb.addidxbtn \
+               -borderwidth 1 -command Tables::addNewIndex \
+                -padx 9 \
+               -pady 3 -text [intlmsg {Add new index}]
+       listbox $base.f1.lb \
+               -background #fefefe -borderwidth 1 -font $PgAcVar(pref,font_fix) \
+               -highlightthickness 0 -selectborderwidth 0 \
+               -selectmode extended \
+               -yscrollcommand {.pgaw:TableInfo.f1.vsb set} 
+       scrollbar $base.f1.vsb \
+               -borderwidth 1 -command {.pgaw:TableInfo.f1.lb yview} -orient vert -width 14 
+       frame $base.f2 \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       frame $base.f2.fl \
+               -height 75 -relief groove -width 182 
+       label $base.f2.fl.t \
+               -relief groove -text [intlmsg {Indexes defined}]
+       button $base.f2.fl.delidxbtn \
+               -borderwidth 1 -command Tables::deleteIndex \
+                -padx 9 \
+               -pady 3 -text [intlmsg {Delete index}]
+       listbox $base.f2.fl.ilb \
+               -background #fefefe -borderwidth 1 \
+               -highlightthickness 0 -selectborderwidth 0 -width 37 \
+               -yscrollcommand {.pgaw:TableInfo.f2.fl.vsb set} 
+       bind $base.f2.fl.ilb <ButtonRelease-1> {
+               Tables::showIndexInformation
+       }
+       scrollbar $base.f2.fl.vsb \
+               -borderwidth 1 -command {.pgaw:TableInfo.f2.fl.ilb yview} -orient vert -width 14 
+       frame $base.f2.fr \
+               -height 75 -relief groove -width 526 
+       label $base.f2.fr.t \
+               -relief groove -text [intlmsg {index properties}]
+       button $base.f2.fr.clusterbtn \
+               -borderwidth 1 -command Tables::clusterIndex \
+                -padx 9 -pady 3 -text [intlmsg {Cluster index}]
+       frame $base.f2.fr.fp \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       label $base.f2.fr.fp.lu \
+               -anchor w -borderwidth 0 \
+               -relief raised -text [intlmsg {Is unique ?}]
+       label $base.f2.fr.fp.vu \
+               -borderwidth 0 -textvariable PgAcVar(tblinfo,isunique) \
+               -foreground #000096 -relief raised -text {} 
+       label $base.f2.fr.fp.lc \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Is clustered ?}]
+       label $base.f2.fr.fp.vc -textvariable PgAcVar(tblinfo,isclustered) \
+               -borderwidth 0 \
+               -foreground #000096 -relief raised -text {}
+       label $base.f2.fr.lic \
+               -relief groove -text [intlmsg {index columns}]
+       listbox $base.f2.fr.lb \
+               -background #fefefe -borderwidth 1 \
+               -highlightthickness 0 -selectborderwidth 0 \
+               -yscrollcommand {.pgaw:TableInfo.f2.fr.vsb set} 
+       scrollbar $base.f2.fr.vsb \
+               -borderwidth 1 -command {.pgaw:TableInfo.f2.fr.lb yview} -orient vert -width 14 
+       frame $base.f3 \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       frame $base.f3.ft \
+               -height 75 -relief groove -width 125 
+       label $base.f3.ft.luser \
+               -relief groove -text [intlmsg {User name}]
+       label $base.f3.ft.lselect \
+               -relief groove -text [intlmsg select] -width 10 
+       label $base.f3.ft.lupdate \
+               -relief groove -text [intlmsg update] -width 10 
+       label $base.f3.ft.linsert \
+               -relief groove -text [intlmsg insert] -width 10 
+       label $base.f3.ft.lrule \
+               -relief groove -text [intlmsg rule] -width 10 
+       label $base.f3.ft.ls \
+               -borderwidth 0 \
+               -relief raised -text {    } 
+       frame $base.f3.fb \
+               -height 75 -relief groove -width 125 
+       button $base.f3.fb.adduserbtn \
+               -borderwidth 1 -command Tables::newPermissions \
+                -padx 9 -pady 3 -text [intlmsg {Add user}]
+       button $base.f3.fb.chguserbtn -command Tables::loadPermissions \
+               -borderwidth 1 -padx 9 -pady 3 -text [intlmsg {Change permissions}]
+       listbox $base.f3.plb \
+               -background #fefefe -borderwidth 1 -font $PgAcVar(pref,font_fix) \
+               -highlightthickness 0 -selectborderwidth 0 \
+               -yscrollcommand {.pgaw:TableInfo.f3.vsb set} 
+       bind $base.f3.plb <Double-1> Tables::loadPermissions
+       scrollbar $base.f3.vsb \
+               -borderwidth 1 -command {.pgaw:TableInfo.f3.plb yview} -orient vert -width 14 
+       label $base.lline \
+               -borderwidth 0 \
+               -relief raised -text {   } 
+       frame $base.f0 \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       frame $base.f0.fi \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       label $base.f0.fi.l1 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Table name}]
+       label $base.f0.fi.l2 \
+               -anchor w -borderwidth 1 \
+               -relief sunken -text {} -textvariable PgAcVar(tblinfo,tablename) \
+               -width 200 
+       label $base.f0.fi.l3 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Table OID}]
+       label $base.f0.fi.l4 \
+               -anchor w -borderwidth 1 \
+               -relief sunken -text {} -textvariable PgAcVar(tblinfo,tableoid) \
+               -width 200 
+       label $base.f0.fi.l5 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg Owner]
+       label $base.f0.fi.l6 \
+               -anchor w -borderwidth 1 \
+               -relief sunken -text {} -textvariable PgAcVar(tblinfo,owner) \
+               -width 200 
+       label $base.f0.fi.l7 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Owner ID}]
+       label $base.f0.fi.l8 \
+               -anchor w -borderwidth 1 \
+               -relief sunken -text {} -textvariable PgAcVar(tblinfo,ownerid) \
+               -width 200 
+       label $base.f0.fi.l9 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Has primary key ?}]
+       label $base.f0.fi.l10 \
+               -anchor w -borderwidth 1 \
+               -relief sunken -text {} \
+               -textvariable PgAcVar(tblinfo,hasprimarykey) -width 200 
+       label $base.f0.fi.l11 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Has rules ?}]
+       label $base.f0.fi.l12 \
+               -anchor w -borderwidth 1 \
+               -relief sunken -text {} -textvariable PgAcVar(tblinfo,hasrules) \
+               -width 200 
+       label $base.f0.fi.last \
+               -borderwidth 0 \
+               -relief raised -text {         } 
+       frame $base.f0.fs \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       label $base.f0.fs.l1 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Number of tuples}]
+       label $base.f0.fs.l2 \
+               -anchor e -borderwidth 1 \
+               -relief sunken -text 0 -textvariable PgAcVar(tblinfo,numtuples) \
+               -width 200 
+       label $base.f0.fs.l3 \
+               -borderwidth 0 \
+               -relief raised -text [intlmsg {Number of pages}]
+       label $base.f0.fs.l4 \
+               -anchor e -borderwidth 1 \
+               -relief sunken -text 0 -textvariable PgAcVar(tblinfo,numpages) \
+               -width 200 
+       label $base.f0.fs.last \
+               -borderwidth 0 \
+               -relief raised -text { } 
+       label $base.f0.lstat \
+               -borderwidth 0 -font $PgAcVar(pref,font_bold) -relief raised \
+               -text " [intlmsg Statistics] "
+       label $base.f0.lid \
+               -borderwidth 0 -font $PgAcVar(pref,font_bold) -relief raised \
+               -text " [intlmsg Identification] "
+       place $base.l0 \
+               -x 15 -y 13 -width 96 -height 23 -anchor nw -bordermode ignore 
+       place $base.l1 \
+               -x 111 -y 15 -width 96 -height 23 -anchor nw -bordermode ignore 
+       place $base.l2 \
+               -x 207 -y 15 -width 96 -height 23 -anchor nw -bordermode ignore 
+       place $base.l3 \
+               -x 303 -y 15 -width 96 -height 23 -anchor nw -bordermode ignore 
+       place $base.l \
+               -x 5 -y 35 -width 511 -height 357 -anchor nw -bordermode ignore 
+       place $base.btnclose \
+               -x 425 -y 5 -width 91 -height 26 -anchor nw -bordermode ignore 
+       place $base.f1 \
+               -x 15 -y 500 -width 490 -height 335 -anchor nw -bordermode ignore 
+       pack $base.f1.ft \
+               -in .pgaw:TableInfo.f1 -anchor center -expand 0 -fill x -side top 
+       pack $base.f1.ft.t1 \
+               -in .pgaw:TableInfo.f1.ft -anchor center -expand 1 -fill x -side left 
+       pack $base.f1.ft.t2 \
+               -in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f1.ft.t3 \
+               -in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f1.ft.lnn \
+               -in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f1.ft.ls \
+               -in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side top 
+       pack $base.f1.fb \
+               -in .pgaw:TableInfo.f1 -anchor center -expand 0 -fill x -side bottom 
+       grid $base.f1.fb.addcolbtn \
+               -in .pgaw:TableInfo.f1.fb -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f1.fb.rencolbtn \
+               -in .pgaw:TableInfo.f1.fb -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f1.fb.addidxbtn \
+               -in .pgaw:TableInfo.f1.fb -column 2 -row 0 -columnspan 1 -rowspan 1 
+       pack $base.f1.lb \
+               -in .pgaw:TableInfo.f1 -anchor center -expand 1 -fill both -pady 1 -side left 
+       pack $base.f1.vsb \
+               -in .pgaw:TableInfo.f1 -anchor center -expand 0 -fill y -side right 
+       place $base.f2 \
+               -x 15 -y 500 -width 490 -height 335 -anchor nw -bordermode ignore 
+       pack $base.f2.fl \
+               -in .pgaw:TableInfo.f2 -anchor center -expand 0 -fill both -side left 
+       pack $base.f2.fl.t \
+               -in .pgaw:TableInfo.f2.fl -anchor center -expand 0 -fill x -pady 1 -side top 
+       pack $base.f2.fl.delidxbtn \
+               -in .pgaw:TableInfo.f2.fl -anchor center -expand 0 -fill none -side bottom 
+       pack $base.f2.fl.ilb \
+               -in .pgaw:TableInfo.f2.fl -anchor center -expand 1 -fill both -pady 1 -side left 
+       pack $base.f2.fl.vsb \
+               -in .pgaw:TableInfo.f2.fl -anchor center -expand 0 -fill y -side right 
+       pack $base.f2.fr \
+               -in .pgaw:TableInfo.f2 -anchor center -expand 1 -fill both -padx 1 -side right 
+       pack $base.f2.fr.t \
+               -in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill x -pady 1 -side top 
+       pack $base.f2.fr.clusterbtn \
+               -in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill none -side bottom 
+       pack $base.f2.fr.fp \
+               -in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill x -pady 1 -side top 
+       grid $base.f2.fr.fp.lu \
+               -in .pgaw:TableInfo.f2.fr.fp -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f2.fr.fp.vu \
+               -in .pgaw:TableInfo.f2.fr.fp -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 5 \
+               -sticky w 
+       grid $base.f2.fr.fp.lc \
+               -in .pgaw:TableInfo.f2.fr.fp -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f2.fr.fp.vc \
+               -in .pgaw:TableInfo.f2.fr.fp -column 1 -row 2 -columnspan 1 -rowspan 1 -padx 5 \
+               -sticky w 
+       pack $base.f2.fr.lic \
+               -in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill x -side top 
+       pack $base.f2.fr.lb \
+               -in .pgaw:TableInfo.f2.fr -anchor center -expand 1 -fill both -pady 1 -side left 
+       pack $base.f2.fr.vsb \
+               -in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill y -side right 
+       place $base.f3 \
+               -x 15 -y 500 -width 490 -height 335 -anchor nw -bordermode ignore 
+       pack $base.f3.ft \
+               -in .pgaw:TableInfo.f3 -anchor center -expand 0 -fill x -pady 1 -side top 
+       pack $base.f3.ft.luser \
+               -in .pgaw:TableInfo.f3.ft -anchor center -expand 1 -fill x -side left 
+       pack $base.f3.ft.lselect \
+               -in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.ft.lupdate \
+               -in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.ft.linsert \
+               -in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.ft.lrule \
+               -in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left 
+       pack $base.f3.ft.ls \
+               -in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side top 
+       pack $base.f3.fb \
+               -in .pgaw:TableInfo.f3 -anchor center -expand 0 -fill x -side bottom 
+       grid $base.f3.fb.adduserbtn \
+               -in .pgaw:TableInfo.f3.fb -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f3.fb.chguserbtn \
+               -in .pgaw:TableInfo.f3.fb -column 1 -row 0 -columnspan 1 -rowspan 1 
+       pack $base.f3.plb \
+               -in .pgaw:TableInfo.f3 -anchor center -expand 1 -fill both -pady 1 -side left 
+       pack $base.f3.vsb \
+               -in .pgaw:TableInfo.f3 -anchor center -expand 0 -fill y -side right 
+       place $base.lline \
+               -x 16 -y 32 -width 94 -height 6 -anchor nw -bordermode ignore 
+       place $base.f0 \
+               -x 15 -y 45 -width 490 -height 335 -anchor nw -bordermode ignore 
+       place $base.f0.fi \
+               -x 5 -y 15 -width 300 -height 140 -anchor nw -bordermode ignore 
+       grid columnconf $base.f0.fi 1 -weight 1
+       grid rowconf $base.f0.fi 6 -weight 1
+       grid $base.f0.fi.l1 \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fi.l2 \
+               -in .pgaw:TableInfo.f0.fi -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 
+       grid $base.f0.fi.l3 \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fi.l4 \
+               -in .pgaw:TableInfo.f0.fi -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 
+       grid $base.f0.fi.l5 \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fi.l6 \
+               -in .pgaw:TableInfo.f0.fi -column 1 -row 2 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 
+       grid $base.f0.fi.l7 \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 3 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fi.l8 \
+               -in .pgaw:TableInfo.f0.fi -column 1 -row 3 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 
+       grid $base.f0.fi.l9 \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fi.l10 \
+               -in .pgaw:TableInfo.f0.fi -column 1 -row 4 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 
+       grid $base.f0.fi.l11 \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 5 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fi.l12 \
+               -in .pgaw:TableInfo.f0.fi -column 1 -row 5 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 
+       grid $base.f0.fi.last \
+               -in .pgaw:TableInfo.f0.fi -column 0 -row 6 -columnspan 1 -rowspan 1 
+       place $base.f0.fs \
+               -x 310 -y 15 -width 175 -height 50 -anchor nw -bordermode ignore 
+       grid columnconf $base.f0.fs 1 -weight 1
+       grid rowconf $base.f0.fs 2 -weight 1
+       grid $base.f0.fs.l1 \
+               -in .pgaw:TableInfo.f0.fs -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fs.l2 \
+               -in .pgaw:TableInfo.f0.fs -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 -sticky w 
+       grid $base.f0.fs.l3 \
+               -in .pgaw:TableInfo.f0.fs -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f0.fs.l4 \
+               -in .pgaw:TableInfo.f0.fs -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2 \
+               -pady 2 -sticky w 
+       grid $base.f0.fs.last \
+               -in .pgaw:TableInfo.f0.fs -column 0 -row 2 -columnspan 1 -rowspan 1 
+       place $base.f0.lstat \
+               -x 315 -y 5 -height 18 -anchor nw -bordermode ignore 
+       place $base.f0.lid \
+               -x 10 -y 5 -height 16 -anchor nw -bordermode ignore 
+}
+
+
+proc vTclWindow.pgaw:AddIndex {base} {
+       if {$base == ""} {
+               set base .pgaw:AddIndex
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 334x203+265+266
+       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 [intlmsg "Add new index"]
+       frame $base.f \
+               -borderwidth 2 -height 75 -relief groove -width 125 
+       frame $base.f.fin \
+               -height 75 -relief groove -width 125 
+       label $base.f.fin.lin \
+               -borderwidth 0 -relief raised -text [intlmsg {Index name}]
+       entry $base.f.fin.ein \
+               -background #fefefe -borderwidth 1 -width 28 -textvariable PgAcVar(addindex,indexname) 
+       checkbutton $base.f.cbunique -borderwidth 1 \
+               -offvalue { } -onvalue unique -text [intlmsg {Is unique ?}] -variable PgAcVar(addindex,unique)
+       label $base.f.ls1 \
+               -anchor w -background #dfdbdf -borderwidth 0 -foreground #000086 \
+               -justify left -relief raised -textvariable PgAcVar(addindex,indexfields) \
+               -wraplength 300 
+       label $base.f.lif \
+               -borderwidth 0 -relief raised -text "[intlmsg {Index fields}]:"
+       label $base.f.ls2 \
+               -borderwidth 0 -relief raised -text { } 
+       label $base.f.ls3 \
+               -borderwidth 0 -relief raised -text { } 
+       frame $base.fb \
+               -height 75 -relief groove -width 125 
+       button $base.fb.btncreate -command Tables::createNewIndex \
+               -padx 9 -pady 3 -text [intlmsg Create]
+       button $base.fb.btncancel \
+               -command {Window destroy .pgaw:AddIndex} -padx 9 -pady 3 -text [intlmsg Cancel]
+       pack $base.f \
+               -in .pgaw:AddIndex -anchor center -expand 1 -fill both -side top 
+       grid $base.f.fin \
+               -in .pgaw:AddIndex.f -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f.fin.lin \
+               -in .pgaw:AddIndex.f.fin -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f.fin.ein \
+               -in .pgaw:AddIndex.f.fin -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f.cbunique \
+               -in .pgaw:AddIndex.f -column 0 -row 5 -columnspan 1 -rowspan 1 
+       grid $base.f.ls1 \
+               -in .pgaw:AddIndex.f -column 0 -row 3 -columnspan 1 -rowspan 1 
+       grid $base.f.lif \
+               -in .pgaw:AddIndex.f -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f.ls2 \
+               -in .pgaw:AddIndex.f -column 0 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.f.ls3 \
+               -in .pgaw:AddIndex.f -column 0 -row 4 -columnspan 1 -rowspan 1 
+       pack $base.fb \
+               -in .pgaw:AddIndex -anchor center -expand 0 -fill x -side bottom 
+       grid $base.fb.btncreate \
+               -in .pgaw:AddIndex.fb -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fb.btncancel \
+               -in .pgaw:AddIndex.fb -column 1 -row 0 -columnspan 1 -rowspan 1 
+}
+
+
+proc vTclWindow.pgaw:AddField {base} {
+       if {$base == ""} {
+               set base .pgaw:AddField
+       }
+       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 [intlmsg "Add new column"]
+       label $base.l1 \
+               -borderwidth 0 -text [intlmsg {Field name}]
+       entry $base.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(addfield,name) 
+       bind $base.e1 <Key-KP_Enter> {
+               focus .pgaw:AddField.e2
+       }
+       bind $base.e1 <Key-Return> {
+               focus .pgaw:AddField.e2
+       }
+       label $base.l2 \
+               -borderwidth 0 \
+               -text [intlmsg {Field type}]
+       entry $base.e2 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(addfield,type) 
+       bind $base.e2 <Key-KP_Enter> {
+               Tables::addNewColumn
+       }
+       bind $base.e2 <Key-Return> {
+               Tables::addNewColumn
+       }
+       button $base.b1 \
+               -borderwidth 1 -command Tables::addNewColumn -text [intlmsg {Add field}]
+       button $base.b2 \
+               -borderwidth 1 -command {Window destroy .pgaw:AddField} -text [intlmsg 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.pgaw:RenameField {base} {
+       if {$base == ""} {
+               set base .pgaw:RenameField
+       }
+       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 [intlmsg "Rename column"]
+       label $base.l1 \
+               -borderwidth 0 -text [intlmsg {New name}]
+       entry $base.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(tblinfo,new_cn)
+       bind $base.e1 <Key-KP_Enter> "Tables::renameColumn"
+       bind $base.e1 <Key-Return> "Tables::renameColumn"
+       frame $base.f \
+               -height 75 -relief groove -width 147 
+       button $base.f.b1 \
+               -borderwidth 1 -command Tables::renameColumn -text [intlmsg Rename]
+       button $base.f.b2 \
+               -borderwidth 1 -command {Window destroy .pgaw:RenameField} -text [intlmsg Cancel]
+       label $base.l2 -borderwidth 0 
+       grid $base.l1 \
+               -in .pgaw:RenameField -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.e1 \
+               -in .pgaw:RenameField -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f \
+               -in .pgaw:RenameField -column 0 -row 4 -columnspan 2 -rowspan 1 
+       grid $base.f.b1 \
+               -in .pgaw:RenameField.f -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f.b2 \
+               -in .pgaw:RenameField.f -column 1 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.l2 \
+               -in .pgaw:RenameField -column 0 -row 3 -columnspan 1 -rowspan 1 
+}
+
+proc vTclWindow.pgaw:Permissions {base} {
+       if {$base == ""} {
+               set base .pgaw:Permissions
+       }
+       if {[winfo exists $base]} {
+               wm deiconify $base; return
+       }
+       toplevel $base -class Toplevel
+       wm focusmodel $base passive
+       wm geometry $base 273x147+256+266
+       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 [intlmsg "Permissions"]
+       frame $base.f1 \
+               -height 103 -relief groove -width 125 
+       label $base.f1.l \
+               -borderwidth 0 -relief raised -text [intlmsg {User name}]
+       entry $base.f1.ename -textvariable PgAcVar(permission,username) \
+               -background #fefefe -borderwidth 1 
+       label $base.f1.l2 \
+               -borderwidth 0 -relief raised -text { } 
+       label $base.f1.l3 \
+               -borderwidth 0 -relief raised -text { } 
+       frame $base.f2 \
+               -height 75 -relief groove -borderwidth 2 -width 125 
+       checkbutton $base.f2.cb1 -borderwidth 1 -padx 4 -pady 4 \
+               -text [intlmsg select] -variable PgAcVar(permission,select) 
+       checkbutton $base.f2.cb2 -borderwidth 1 -padx 4 -pady 4 \
+               -text [intlmsg update] -variable PgAcVar(permission,update)
+       checkbutton $base.f2.cb3 -borderwidth 1 -padx 4 -pady 4 \
+               -text [intlmsg insert] -variable PgAcVar(permission,insert)
+       checkbutton $base.f2.cb4 -borderwidth 1 -padx 4 -pady 4 \
+               -text [intlmsg rule] -variable PgAcVar(permission,rule)
+       frame $base.fb \
+               -height 75 -relief groove -width 125 
+       button $base.fb.btnsave -command Tables::savePermissions \
+               -padx 9 -pady 3 -text [intlmsg Save]
+       button $base.fb.btncancel -command {Window destroy .pgaw:Permissions} \
+               -padx 9 -pady 3 -text [intlmsg Cancel]
+       pack $base.f1 \
+               -in .pgaw:Permissions -anchor center -expand 0 -fill none -side top 
+       grid $base.f1.l \
+               -in .pgaw:Permissions.f1 -column 0 -row 1 -columnspan 1 -rowspan 1 
+       grid $base.f1.ename \
+               -in .pgaw:Permissions.f1 -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2 
+       grid $base.f1.l2 \
+               -in .pgaw:Permissions.f1 -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.f1.l3 \
+               -in .pgaw:Permissions.f1 -column 0 -row 2 -columnspan 1 -rowspan 1 
+       pack $base.f2 \
+               -in .pgaw:Permissions -anchor center -expand 0 -fill none -side top 
+       grid $base.f2.cb1 \
+               -in .pgaw:Permissions.f2 -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f2.cb2 \
+               -in .pgaw:Permissions.f2 -column 1 -row 1 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f2.cb3 \
+               -in .pgaw:Permissions.f2 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       grid $base.f2.cb4 \
+               -in .pgaw:Permissions.f2 -column 1 -row 2 -columnspan 1 -rowspan 1 -sticky w 
+       pack $base.fb \
+               -in .pgaw:Permissions -anchor center -expand 0 -fill none -pady 3 -side bottom 
+       grid $base.fb.btnsave \
+               -in .pgaw:Permissions.fb -column 0 -row 0 -columnspan 1 -rowspan 1 
+       grid $base.fb.btncancel \
+               -in .pgaw:Permissions.fb -column 1 -row 0 -columnspan 1 -rowspan 1 
+}
diff --git a/src/bin/pgaccess/lib/users.tcl b/src/bin/pgaccess/lib/users.tcl
new file mode 100644 (file)
index 0000000..18204e0
--- /dev/null
@@ -0,0 +1,155 @@
+namespace eval Users {
+
+proc {new} {} {
+global PgAcVar
+       Window show .pgaw:User
+       wm transient .pgaw:User .pgaw:Main
+       set PgAcVar(user,action) "CREATE"
+       set PgAcVar(user,name) {}
+       set PgAcVar(user,password) {}
+       set PgAcVar(user,createdb) NOCREATEDB
+       set PgAcVar(user,createuser) NOCREATEUSER
+       set PgAcVar(user,verifypassword) {}
+       set PgAcVar(user,validuntil) {}
+       focus .pgaw:User.e1
+}
+
+proc {design} {username} {
+global PgAcVar CurrentDB
+       Window show .pgaw:User
+       tkwait visibility .pgaw:User
+       wm transient .pgaw:User .pgaw:Main
+       wm title .pgaw:User [intlmsg "Change user"]
+       set PgAcVar(user,action) "ALTER"
+       set PgAcVar(user,name) $username
+       set PgAcVar(user,password) {} ; set PgAcVar(user,verifypassword) {}
+       pg_select $CurrentDB "select *,date(valuntil) as valdata from pg_user where usename='$username'" tup {
+               if {$tup(usesuper)=="t"} {
+                       set PgAcVar(user,createuser) CREATEUSER
+               } else {
+                       set PgAcVar(user,createuser) NOCREATEUSER
+               }
+               if {$tup(usecreatedb)=="t"} {
+                       set PgAcVar(user,createdb) CREATEDB
+               } else {
+                       set PgAcVar(user,createdb) NOCREATEDB
+               }
+               if {$tup(valuntil)!=""} {
+                       set PgAcVar(user,validuntil) $tup(valdata)
+               } else {
+                       set PgAcVar(user,validuntil) {}
+               }
+       }
+       .pgaw:User.e1 configure -state disabled
+       .pgaw:User.b1 configure -text [intlmsg Save]
+       focus .pgaw:User.e2
+}
+
+proc {save} {} {
+global PgAcVar CurrentDB
+       set PgAcVar(user,name) [string trim $PgAcVar(user,name)]
+       set PgAcVar(user,password) [string trim $PgAcVar(user,password)]
+       set PgAcVar(user,verifypassword) [string trim $PgAcVar(user,verifypassword)]
+       if {$PgAcVar(user,name)==""} {
+               showError [intlmsg "User without name?"]
+               focus .pgaw:User.e1
+               return
+       }
+       if {$PgAcVar(user,password)!=$PgAcVar(user,verifypassword)} {
+               showError [intlmsg "Passwords do not match!"]
+               set PgAcVar(user,password) {} ; set PgAcVar(user,verifypassword) {}
+               focus .pgaw:User.e2
+               return
+       }
+       set cmd "$PgAcVar(user,action) user \"$PgAcVar(user,name)\""
+       if {$PgAcVar(user,password)!=""} {
+               set cmd "$cmd WITH PASSWORD \"$PgAcVar(user,password)\" "
+       }
+       set cmd "$cmd $PgAcVar(user,createdb) $PgAcVar(user,createuser)"
+       if {$PgAcVar(user,validuntil)!=""} {
+               set cmd "$cmd VALID UNTIL '$PgAcVar(user,validuntil)'"
+       }
+       if {[sql_exec noquiet $cmd]} {
+               Window destroy .pgaw:User
+               Mainlib::cmd_Users
+       }
+}
+
+}
+
+proc vTclWindow.pgaw:User {base} {
+       if {$base == ""} {
+               set base .pgaw:User
+       }
+       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 [intlmsg "Define new user"]
+       label $base.l1 \
+               -borderwidth 0 -anchor w -text [intlmsg "User name"]
+       entry $base.e1 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(user,name) 
+       bind $base.e1 <Key-Return> "focus .pgaw:User.e2"
+       bind $base.e1 <Key-KP_Enter> "focus .pgaw:User.e2"
+       label $base.l2 \
+               -borderwidth 0 -text [intlmsg Password]
+       entry $base.e2 \
+               -background #fefefe -borderwidth 1 -show * -textvariable PgAcVar(user,password) 
+       bind $base.e2 <Key-Return> "focus .pgaw:User.e3"
+       bind $base.e2 <Key-KP_Enter> "focus .pgaw:User.e3"
+       label $base.l3 \
+               -borderwidth 0 -text [intlmsg {verify password}]
+       entry $base.e3 \
+               -background #fefefe -borderwidth 1 -show * -textvariable PgAcVar(user,verifypassword) 
+       bind $base.e3 <Key-Return> "focus .pgaw:User.cb1"
+       bind $base.e3 <Key-KP_Enter> "focus .pgaw:User.cb1"
+       checkbutton $base.cb1 \
+               -borderwidth 1 -offvalue NOCREATEDB -onvalue CREATEDB \
+               -text [intlmsg {Allow user to create databases}] -variable PgAcVar(user,createdb) 
+       checkbutton $base.cb2 \
+               -borderwidth 1 -offvalue NOCREATEUSER -onvalue CREATEUSER \
+               -text [intlmsg {Allow user to create other users}] -variable PgAcVar(user,createuser) 
+       label $base.l4 \
+               -borderwidth 0 -anchor w -text [intlmsg {Valid until (date)}]
+       entry $base.e4 \
+               -background #fefefe -borderwidth 1 -textvariable PgAcVar(user,validuntil)
+       bind $base.e4 <Key-Return> "focus .pgaw:User.b1"
+       bind $base.e4 <Key-KP_Enter> "focus .pgaw:User.b1"
+       button $base.b1 \
+               -borderwidth 1 -command Users::save -text [intlmsg Create]
+       button $base.b2 \
+               -borderwidth 1 -command {Window destroy .pgaw:User} -text [intlmsg Cancel]
+       place $base.l1 \
+               -x 5 -y 7 -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 -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 
+}
+
diff --git a/src/bin/pgaccess/lib/views.tcl b/src/bin/pgaccess/lib/views.tcl
new file mode 100644 (file)
index 0000000..dc520a5
--- /dev/null
@@ -0,0 +1,45 @@
+namespace eval Views {
+
+proc {new} {} {
+global PgAcVar
+       set PgAcVar(query,oid) 0
+       set PgAcVar(query,name) {}
+       Window show .pgaw:QueryBuilder
+       set PgAcVar(query,asview) 1
+       .pgaw:QueryBuilder.saveAsView configure -state disabled
+}
+
+
+proc {open} {viewname} {
+global PgAcVar
+       if {$viewname==""} return;
+       set wn [Tables::getNewWindowName]
+       Tables::createWindow
+       set PgAcVar(mw,$wn,query) "select * from \"$viewname\""
+       set PgAcVar(mw,$wn,isaquery) 0
+       set PgAcVar(mw,$wn,updatable) 0
+       Tables::loadLayout $wn $viewname
+       Tables::selectRecords $wn $PgAcVar(mw,$wn,query)
+}
+
+
+proc {design} {viewname} {
+global PgAcVar CurrentDB
+       set vd {}
+       wpg_select $CurrentDB "select pg_get_viewdef('$viewname')as vd" tup {
+               set vd $tup(vd)
+       }
+       if {$vd==""} {
+               showError "[intlmsg {Error retrieving view definition for}] '$viewname'!"
+               return
+       }
+       Window show .pgaw:QueryBuilder
+       .pgaw:QueryBuilder.text1 delete 0.0 end
+       .pgaw:QueryBuilder.text1 insert end $vd
+       set PgAcVar(query,asview) 1
+       .pgaw:QueryBuilder.saveAsView configure -state disabled
+       set PgAcVar(query,name) $viewname
+}
+
+
+}
diff --git a/src/bin/pgaccess/lib/visualqb.tcl b/src/bin/pgaccess/lib/visualqb.tcl
new file mode 100644 (file)
index 0000000..dc4189e
--- /dev/null
@@ -0,0 +1,776 @@
+namespace eval VisualQueryBuilder {
+
+# The following array will hold all the local variables
+
+variable vqb
+
+proc {addNewTable} {{tabx 0} {taby 0} {alias -1}} {
+global PgAcVar CurrentDB
+variable vqb
+if {$vqb(newtablename)==""} return
+set fldlist {}
+setCursor CLOCK
+wpg_select $CurrentDB "select attnum,attname from pg_class,pg_attribute where (pg_class.relname='$vqb(newtablename)') and (pg_class.oid=pg_attribute.attrelid) and (attnum>0) order by attnum" rec {
+               lappend fldlist $rec(attname)
+}
+setCursor DEFAULT
+if {$fldlist==""} {
+       showError [format [intlmsg "Table '%s' not found!"] $vqb(newtablename)]
+       return
+}
+if {$alias==-1} {
+       set tabnum $vqb(ntables)
+} else {
+       regsub t $alias "" tabnum
+}
+set vqb(tablename$tabnum) $vqb(newtablename)
+set vqb(tablestruct$tabnum) $fldlist
+set vqb(tablealias$tabnum) "t$tabnum"
+set vqb(ali_t$tabnum) $vqb(newtablename)
+set vqb(tablex$tabnum) $tabx
+set vqb(tabley$tabnum) $taby
+
+incr vqb(ntables)
+if {$vqb(ntables)==1} {
+       repaintAll
+} else {
+       drawTable [expr $vqb(ntables)-1]
+}
+set vqb(newtablename) {}
+focus .pgaw:VisualQuery.fb.entt
+}
+
+proc {computeSQL} {} {
+global PgAcVar
+variable vqb
+set sqlcmd "select "
+#rjr 8Mar1999 added logical return state for results
+for {set i 0} {$i<[llength $vqb(resfields)]} {incr i} {
+       if {[lindex $vqb(resreturn) $i]==[intlmsg Yes]} {
+               if {$sqlcmd!="select "} {set sqlcmd "$sqlcmd, "}
+               set sqlcmd "$sqlcmd[lindex $vqb(restables) $i].\"[lindex $vqb(resfields) $i]\""
+       }
+}
+set tables {}
+for {set i 0} {$i<$vqb(ntables)} {incr i} {
+       set thename {}
+       catch {set thename $vqb(tablename$i)}
+       if {$thename!=""} {lappend tables "\"$vqb(tablename$i)\" $vqb(tablealias$i)"}
+}
+set sqlcmd "$sqlcmd from [join $tables ,] "
+set sup1 {}
+if {[llength $vqb(links)]>0} {
+       set sup1 "where "
+       foreach link $vqb(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 $vqb(resfields)]} {incr i} {
+       set crit [lindex $vqb(rescriteria) $i]
+       if {$crit!=""} {
+               if {$sup1==""} {set sup1 "where "}
+               if {[string length $sup1]>6} {set sup1 "$sup1 and "}
+               set sup1 "$sup1 ([lindex $vqb(restables) $i].\"[lindex $vqb(resfields) $i]\" $crit) "        
+       }        
+}
+set sqlcmd "$sqlcmd $sup1"
+set sup2 {}
+for {set i 0} {$i<[llength $vqb(ressort)]} {incr i} {
+       set how [lindex $vqb(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 $vqb(restables) $i].\"[lindex $vqb(resfields) $i]\" $how "
+       }
+}
+set sqlcmd "$sqlcmd $sup2"
+set vqb(qcmd) $sqlcmd
+return $sqlcmd
+}
+
+proc {deleteObject} {} {
+global PgAcVar
+variable vqb
+# Checking if there is a highlighted object (i.e. is selected)
+set obj [.pgaw:VisualQuery.c find withtag hili]
+if {$obj==""} return
+#
+# Is object a link ?
+if {[getTagInfo $obj link]=="s"} {
+       if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:VisualQuery -message [intlmsg "Remove link ?"] -type yesno -default no]=="no"} return
+       set linkid [getTagInfo $obj lkid]
+       set vqb(links) [lreplace $vqb(links) $linkid $linkid]
+       .pgaw:VisualQuery.c delete links
+       drawLinks
+       return
+}
+#
+# Is object a result field ?
+if {[getTagInfo $obj res]=="f"} {
+       set col [getTagInfo $obj col]
+       if {$col==""} return
+       if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:VisualQuery -message [intlmsg "Remove field from result ?"] -type yesno -default no]=="no"} return
+       set vqb(resfields) [lreplace $vqb(resfields) $col $col]
+       set vqb(ressort) [lreplace $vqb(ressort) $col $col]
+       set vqb(resreturn) [lreplace $vqb(resreturn) $col $col]
+       set vqb(restables) [lreplace $vqb(restables) $col $col]
+       set vqb(rescriteria) [lreplace $vqb(rescriteria) $col $col]
+       drawResultPanel
+       return
+}
+#
+# Is object a table ?
+set tablealias [getTagInfo $obj tab]
+set tablename $vqb(ali_$tablealias)
+if {"$tablename"==""} return
+if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:VisualQuery -message [format [intlmsg "Remove table %s from query?"] $tablename] -type yesno -default no]=="no"} return
+for {set i [expr [llength $vqb(restables)]-1]} {$i>=0} {incr i -1} {
+       if {"$tablealias"==[lindex $vqb(restables) $i]} {
+          set vqb(resfields) [lreplace $vqb(resfields) $i $i]
+          set vqb(ressort) [lreplace $vqb(ressort) $i $i]
+          set vqb(resreturn) [lreplace $vqb(resreturn) $i $i]
+          set vqb(restables) [lreplace $vqb(restables) $i $i]
+          set vqb(rescriteria) [lreplace $vqb(rescriteria) $i $i]
+       }
+}
+for {set i [expr [llength $vqb(links)]-1]} {$i>=0} {incr i -1} {
+       set thelink [lindex $vqb(links) $i]
+       if {($tablealias==[lindex $thelink 0]) || ($tablealias==[lindex $thelink 2])} {
+               set vqb(links) [lreplace $vqb(links) $i $i]
+       }
+}
+for {set i 0} {$i<$vqb(ntables)} {incr i} {
+       set temp {}
+       catch {set temp $vqb(tablename$i)}
+       if {"$temp"=="$tablename"} {
+               unset vqb(tablename$i)
+               unset vqb(tablestruct$i)
+               unset vqb(tablealias$i)
+               break
+       }
+}
+unset vqb(ali_$tablealias)
+#incr vqb(ntables) -1
+.pgaw:VisualQuery.c delete tab$tablealias
+.pgaw:VisualQuery.c delete links
+drawLinks
+drawResultPanel
+}
+
+
+proc {dragObject} {w x y} {
+global PgAcVar
+variable vqb
+       if {"$PgAcVar(draginfo,obj)" == ""} {return}
+       set dx [expr $x - $PgAcVar(draginfo,x)]
+       set dy [expr $y - $PgAcVar(draginfo,y)]
+       if {$PgAcVar(draginfo,is_a_table)} {
+               $w move $PgAcVar(draginfo,tabletag) $dx $dy
+               drawLinks
+       } else {
+               $w move $PgAcVar(draginfo,obj) $dx $dy
+       }
+       set PgAcVar(draginfo,x) $x
+       set PgAcVar(draginfo,y) $y
+}
+
+
+proc {dragStart} {w x y} {
+global PgAcVar
+variable vqb
+PgAcVar:clean draginfo,*
+set PgAcVar(draginfo,obj) [$w find closest $x $y]
+if {[getTagInfo $PgAcVar(draginfo,obj) r]=="ect"} {
+       # If it'a a rectangle, exit
+       set PgAcVar(draginfo,obj) {}
+       return
+}
+.pgaw:VisualQuery configure -cursor hand1
+.pgaw:VisualQuery.c raise $PgAcVar(draginfo,obj)
+set PgAcVar(draginfo,table) 0
+if {[getTagInfo $PgAcVar(draginfo,obj) table]=="header"} {
+       set PgAcVar(draginfo,is_a_table) 1
+       set taglist [.pgaw:VisualQuery.c gettags $PgAcVar(draginfo,obj)]
+       set PgAcVar(draginfo,tabletag) [lindex $taglist [lsearch -regexp $taglist "^tab\[0-9\]*"]]
+       .pgaw:VisualQuery.c raise $PgAcVar(draginfo,tabletag)
+       .pgaw:VisualQuery.c itemconfigure [.pgaw:VisualQuery.c find withtag hili] -fill black
+       .pgaw:VisualQuery.c dtag [.pgaw:VisualQuery.c find withtag hili] hili
+       .pgaw:VisualQuery.c addtag hili withtag $PgAcVar(draginfo,obj)
+       .pgaw:VisualQuery.c itemconfigure hili -fill blue
+} else {
+       set PgAcVar(draginfo,is_a_table) 0
+}
+set PgAcVar(draginfo,x) $x
+set PgAcVar(draginfo,y) $y
+set PgAcVar(draginfo,sx) $x
+set PgAcVar(draginfo,sy) $y
+}
+
+
+proc {dragStop} {x y} {
+global PgAcVar
+variable vqb
+# when click Close, ql window is destroyed but event ButtonRelease-1 is fired
+if {![winfo exists .pgaw:VisualQuery]} return;
+.pgaw:VisualQuery configure -cursor left_ptr
+set este {}
+catch {set este $PgAcVar(draginfo,obj)}
+if {$este==""} return
+# Re-establish the normal paint order so
+# information won't be overlapped by table rectangles
+# or link lines
+.pgaw:VisualQuery.c lower $PgAcVar(draginfo,obj)
+.pgaw:VisualQuery.c lower rect
+.pgaw:VisualQuery.c lower links
+set vqb(panstarted) 0
+if {$PgAcVar(draginfo,is_a_table)} {
+       set tabnum [getTagInfo $PgAcVar(draginfo,obj) tabt]
+       foreach w [.pgaw:VisualQuery.c find withtag $PgAcVar(draginfo,tabletag)] {
+               if {[lsearch [.pgaw:VisualQuery.c gettags $w] outer] != -1} {
+                       foreach [list vqb(tablex$tabnum) vqb(tabley$tabnum) x1 y1] [.pgaw:VisualQuery.c coords $w] {}
+               }
+       }
+       set PgAcVar(draginfo,obj) {}
+       .pgaw:VisualQuery.c delete links
+       drawLinks
+       return
+}
+.pgaw:VisualQuery.c move $PgAcVar(draginfo,obj) [expr $PgAcVar(draginfo,sx)-$x] [expr $PgAcVar(draginfo,sy)-$y]
+if {($y>$vqb(yoffs)) && ($x>$vqb(xoffs))} {
+       # Drop position : inside the result panel
+       # Compute the offset of the result panel due to panning
+       set resoffset [expr [lindex [.pgaw:VisualQuery.c bbox resmarker] 0]-$vqb(xoffs)]
+       set newfld [.pgaw:VisualQuery.c itemcget $PgAcVar(draginfo,obj) -text]
+       set tabtag [getTagInfo $PgAcVar(draginfo,obj) tab]
+       set col [expr int(($x-$vqb(xoffs)-$resoffset)/$vqb(reswidth))]
+       set vqb(resfields) [linsert $vqb(resfields) $col $newfld]
+       set vqb(ressort) [linsert $vqb(ressort) $col unsorted]
+       set vqb(rescriteria) [linsert $vqb(rescriteria) $col {}]
+       set vqb(restables) [linsert $vqb(restables) $col $tabtag]
+       set vqb(resreturn) [linsert $vqb(resreturn) $col [intlmsg Yes]]
+       drawResultPanel    
+} else {
+       # Drop position : in the table panel
+       set droptarget [.pgaw:VisualQuery.c find overlapping $x $y $x $y]
+       set targettable {}
+       foreach item $droptarget {
+               set targettable [getTagInfo $item tab]
+               set targetfield [getTagInfo $item f-]
+               if {($targettable!="") && ($targetfield!="")} {
+                       set droptarget $item
+                       break
+               }
+       }
+       # check if target object isn't a rectangle
+       if {[getTagInfo $droptarget rec]=="t"} {set targettable {}}
+       if {$targettable!=""} {
+               # Target has a table
+               # See about originate table
+               set sourcetable [getTagInfo $PgAcVar(draginfo,obj) tab]
+               if {$sourcetable!=""} {
+                       # Source has also a tab .. tag
+                       set sourcefield [getTagInfo $PgAcVar(draginfo,obj) f-]
+                       if {$sourcetable!=$targettable} {
+                               lappend vqb(links) [list $sourcetable $sourcefield $targettable $targetfield]
+                               drawLinks
+                       }
+               }
+       }
+}
+# Erase information about onbject beeing dragged
+set PgAcVar(draginfo,obj) {}
+}
+
+
+proc {getTableList} {} {
+global PgAcVar
+variable vqb
+       set tablelist {}
+       foreach name [array names vqb tablename*] {
+               regsub tablename $name "" num
+               lappend tablelist $vqb($name) $vqb(tablex$num) $vqb(tabley$num) t$num
+       }
+       return $tablelist
+}
+
+
+proc {getLinkList} {} {
+global PgAcVar
+variable vqb
+       set linklist {}
+       foreach l $vqb(links) {
+               lappend linklist [lindex $l 0] [lindex $l 1] [lindex $l 2] [lindex $l 3] 
+               }
+       return $linklist
+}
+
+
+proc {loadVisualLayout} {} {
+global PgAcVar
+variable vqb
+       init
+       foreach {t x y a} $PgAcVar(query,tables) {set vqb(newtablename) $t; addNewTable $x $y $a}
+       foreach {t0 f0 t1 f1} $PgAcVar(query,links) {lappend vqb(links) [list $t0 $f0 $t1 $f1]}
+       foreach {f t s c r} $PgAcVar(query,results) {addResultColumn $f $t $s $c $r}
+       repaintAll
+}
+
+
+proc {findField} {alias field} {
+       foreach obj [.pgaw:VisualQuery.c find withtag f-${field}] {
+               if {[lsearch [.pgaw:VisualQuery.c gettags $obj] tab$alias] != -1} {return $obj}
+       }
+       return -1
+}
+
+
+proc {getResultList} {} {
+global PgAcVar
+variable vqb
+       set reslist {}
+       for {set i 0} {$i < [llength $vqb(resfields)]} {incr i} {
+               lappend reslist [lindex $vqb(resfields) $i]
+               lappend reslist [lindex $vqb(restables) $i]
+               lappend reslist [lindex $vqb(ressort) $i]
+               lappend reslist [lindex $vqb(rescriteria) $i]
+               lappend reslist [lindex $vqb(resreturn) $i]
+       }
+       return $reslist
+}
+
+
+proc {addResultColumn} {f t s c r} {
+global PgAcVar
+variable vqb
+       lappend vqb(resfields) $f
+       lappend vqb(restables) $t
+       lappend vqb(ressort) $s
+       lappend vqb(rescriteria) $c
+       lappend vqb(resreturn) $r
+}
+
+
+proc {drawLinks} {} {
+global PgAcVar
+variable vqb
+.pgaw:VisualQuery.c delete links
+set i 0
+foreach link $vqb(links) {
+       # Compute the source and destination right edge
+       set sre [lindex [.pgaw:VisualQuery.c bbox tab[lindex $link 0]] 2]
+       set dre [lindex [.pgaw:VisualQuery.c bbox tab[lindex $link 2]] 2]
+       # Compute field bound boxes
+       set sbbox [.pgaw:VisualQuery.c bbox [findField [lindex $link 0] [lindex $link 1]]]
+       set dbbox [.pgaw:VisualQuery.c bbox [findField [lindex $link 2] [lindex $link 3]]]
+       # 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]
+               .pgaw:VisualQuery.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]
+               .pgaw:VisualQuery.c create line [expr $x2-10] $y2 $x2 $y2 -tags [subst {links lkid$i}] -width 3
+               .pgaw:VisualQuery.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]
+               .pgaw:VisualQuery.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]
+               .pgaw:VisualQuery.c create line $x2 $y2 [expr $x2+10] $y2 -width 3 -tags [subst {links lkid$i}]
+               .pgaw:VisualQuery.c create line [expr $x1-10] $y1 [expr $x2+10] $y2 -tags [subst {links lkid$i}] -width 2
+       }
+       incr i
+}
+.pgaw:VisualQuery.c lower links
+.pgaw:VisualQuery.c bind links <Button-1> {VisualQueryBuilder::linkClick %x %y}
+}
+
+
+proc {repaintAll} {} {
+global PgAcVar
+variable vqb
+.pgaw:VisualQuery.c delete all
+set posx 20
+foreach tn [array names vqb tablename*] {
+       regsub tablename $tn "" it
+       drawTable $it
+}
+.pgaw:VisualQuery.c lower rect
+.pgaw:VisualQuery.c create line 0 $vqb(yoffs) 10000 $vqb(yoffs) -width 3
+.pgaw:VisualQuery.c create rectangle 0 $vqb(yoffs) 10000 5000 -fill #FFFFFF
+for {set i [expr 15+$vqb(yoffs)]} {$i<500} {incr i 15} {
+       .pgaw:VisualQuery.c create line $vqb(xoffs) $i 10000 $i -fill #CCCCCC -tags {resgrid}
+}    
+for {set i $vqb(xoffs)} {$i<10000} {incr i $vqb(reswidth)} {
+       .pgaw:VisualQuery.c create line $i [expr 1+$vqb(yoffs)] $i 10000 -fill #cccccc -tags {resgrid}
+}
+# Make a marker for result panel offset calculations (due to panning)
+.pgaw:VisualQuery.c create line $vqb(xoffs) $vqb(yoffs) $vqb(xoffs) 500 -tags {resmarker resgrid}
+.pgaw:VisualQuery.c create rectangle 0 $vqb(yoffs) $vqb(xoffs) 5000 -fill #EEEEEE -tags {reshdr}
+.pgaw:VisualQuery.c create text 5 [expr 1+$vqb(yoffs)]  -text [intlmsg Field] -anchor nw -font $PgAcVar(pref,font_normal) -tags {reshdr}
+.pgaw:VisualQuery.c create text 5 [expr 16+$vqb(yoffs)] -text [intlmsg Table] -anchor nw -font $PgAcVar(pref,font_normal) -tags {reshdr}
+.pgaw:VisualQuery.c create text 5 [expr 31+$vqb(yoffs)] -text [intlmsg Sort] -anchor nw -font $PgAcVar(pref,font_normal) -tags {reshdr}
+.pgaw:VisualQuery.c create text 5 [expr 46+$vqb(yoffs)] -text [intlmsg Criteria] -anchor nw -font $PgAcVar(pref,font_normal) -tags {reshdr}
+.pgaw:VisualQuery.c create text 5 [expr 61+$vqb(yoffs)] -text [intlmsg Return] -anchor nw -font $PgAcVar(pref,font_normal) -tags {reshdr}
+
+drawLinks
+drawResultPanel
+
+.pgaw:VisualQuery.c bind mov <Button-1> {VisualQueryBuilder::dragStart %W %x %y}
+.pgaw:VisualQuery.c bind mov <B1-Motion> {VisualQueryBuilder::dragObject %W %x %y}
+bind .pgaw:VisualQuery <ButtonRelease-1> {VisualQueryBuilder::dragStop %x %y}
+bind .pgaw:VisualQuery <Button-1> {VisualQueryBuilder::canvasClick %x %y %W}
+bind .pgaw:VisualQuery <B1-Motion> {VisualQueryBuilder::panning %x %y}
+bind .pgaw:VisualQuery <Key-Delete> {VisualQueryBuilder::deleteObject}
+}
+
+
+proc {drawResultPanel} {} {
+global PgAcVar
+variable vqb
+# Compute the offset of the result panel due to panning
+set resoffset [expr [lindex [.pgaw:VisualQuery.c bbox resmarker] 0]-$vqb(xoffs)]
+.pgaw:VisualQuery.c delete resp
+for {set i 0} {$i<[llength $vqb(resfields)]} {incr i} {
+       .pgaw:VisualQuery.c create text [expr $resoffset+4+$vqb(xoffs)+$i*$vqb(reswidth)] [expr 1+$vqb(yoffs)] -text [lindex $vqb(resfields) $i] -anchor nw -tags [subst {resf resp col$i}] -font $PgAcVar(pref,font_normal)
+       .pgaw:VisualQuery.c create text [expr $resoffset+4+$vqb(xoffs)+$i*$vqb(reswidth)] [expr 16+$vqb(yoffs)] -text $vqb(ali_[lindex $vqb(restables) $i]) -anchor nw -tags {resp rest} -font $PgAcVar(pref,font_normal)
+       .pgaw:VisualQuery.c create text [expr $resoffset+4+$vqb(xoffs)+$i*$vqb(reswidth)] [expr 31+$vqb(yoffs)] -text [lindex $vqb(ressort) $i] -anchor nw -tags {resp sort} -font $PgAcVar(pref,font_normal)
+       if {[lindex $vqb(rescriteria) $i]!=""} {
+               .pgaw:VisualQuery.c create text [expr $resoffset+4+$vqb(xoffs)+$i*$vqb(reswidth)]  [expr $vqb(yoffs)+46+15*0] -anchor nw -text [lindex $vqb(rescriteria) $i]  -font $PgAcVar(pref,font_normal) -tags [subst {resp cr-c$i-r0}]
+       }
+       .pgaw:VisualQuery.c create text [expr $resoffset+4+$vqb(xoffs)+$i*$vqb(reswidth)] [expr 61+$vqb(yoffs)] -text [lindex $vqb(resreturn) $i] -anchor nw -tags {resp retval} -font $PgAcVar(pref,font_normal)
+}
+.pgaw:VisualQuery.c raise reshdr
+.pgaw:VisualQuery.c bind resf <Button-1> {VisualQueryBuilder::resultFieldClick %x %y}
+.pgaw:VisualQuery.c bind sort <Button-1> {VisualQueryBuilder::toggleSortMode %W %x %y}
+.pgaw:VisualQuery.c bind retval <Button-1> {VisualQueryBuilder::toggleReturn %W %x %y}
+}
+
+
+proc {drawTable} {it} {
+global PgAcVar
+variable vqb
+if {$vqb(tablex$it)==0} {
+       set posy 10
+       set allbox [.pgaw:VisualQuery.c bbox rect]
+       if {$allbox==""} {set posx 10} else {set posx [expr 20+[lindex $allbox 2]]}
+       set vqb(tablex$it) $posx
+       set vqb(tabley$it) $posy
+} else {
+       set posx [expr int($vqb(tablex$it))]
+       set posy [expr int($vqb(tabley$it))]
+}
+set tablename $vqb(tablename$it)
+set tablealias $vqb(tablealias$it)
+.pgaw:VisualQuery.c create text $posx $posy -text "$tablename" -anchor nw -tags [subst {tab$tablealias f-oid mov tableheader}] -font $PgAcVar(pref,font_bold)
+incr posy 16
+foreach fld $vqb(tablestruct$it) {
+   .pgaw:VisualQuery.c create text $posx $posy -text $fld -fill #010101 -anchor nw -tags [subst {f-$fld tab$tablealias mov}] -font $PgAcVar(pref,font_normal)
+   incr posy 14
+}
+set reg [.pgaw:VisualQuery.c bbox tab$tablealias]
+.pgaw:VisualQuery.c create rectangle [lindex $reg 0] [lindex $reg 1] [lindex $reg 2] [lindex $reg 3] -fill #EEEEEE -tags [subst {rect outer tab$tablealias}]
+.pgaw:VisualQuery.c create line [lindex $reg 0] [expr [lindex $reg 1]+15] [lindex $reg 2] [expr [lindex $reg 1]+15] -tags [subst {rect tab$tablealias}]
+.pgaw:VisualQuery.c lower tab$tablealias
+.pgaw:VisualQuery.c lower rect
+}
+
+
+proc {getTagInfo} {obj prefix} {
+variable vqb
+       set taglist [.pgaw:VisualQuery.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 {init} {} {
+global PgAcVar
+variable vqb
+       catch { unset vqb }
+       set vqb(yoffs) 360
+       set vqb(xoffs) 50
+       set vqb(reswidth) 150
+       set vqb(resfields) {}
+       set vqb(resreturn) {}
+       set vqb(ressort) {}
+       set vqb(rescriteria) {}
+       set vqb(restables) {}
+       set vqb(critedit) 0
+       set vqb(links) {}
+       set vqb(ntables) 0
+       set vqb(newtablename) {}
+}
+
+
+proc {linkClick} {x y} {
+global PgAcVar
+variable vqb
+       set obj [.pgaw:VisualQuery.c find closest $x $y 1 links]
+       if {[getTagInfo $obj link]!="s"} return
+       .pgaw:VisualQuery.c itemconfigure [.pgaw:VisualQuery.c find withtag hili] -fill black
+       .pgaw:VisualQuery.c dtag [.pgaw:VisualQuery.c find withtag hili] hili
+       .pgaw:VisualQuery.c addtag hili withtag $obj
+       .pgaw:VisualQuery.c itemconfigure $obj -fill blue
+}
+
+
+proc {panning} {x y} {
+global PgAcVar
+variable vqb
+       set panstarted 0
+       catch {set panstarted $vqb(panstarted) }
+       if {!$panstarted} return
+       set dx [expr $x-$vqb(panstartx)]
+       set dy [expr $y-$vqb(panstarty)]
+       set vqb(panstartx) $x
+       set vqb(panstarty) $y
+       if {$vqb(panobject)=="tables"} {
+               .pgaw:VisualQuery.c move mov $dx $dy
+               .pgaw:VisualQuery.c move links $dx $dy
+               .pgaw:VisualQuery.c move rect $dx $dy
+       } else {
+               .pgaw:VisualQuery.c move resp $dx 0
+               .pgaw:VisualQuery.c move resgrid $dx 0
+               .pgaw:VisualQuery.c raise reshdr
+       }
+}
+
+
+proc {resultFieldClick} {x y} {
+global PgAcVar
+variable vqb
+       set obj [.pgaw:VisualQuery.c find closest $x $y]
+       if {[getTagInfo $obj res]!="f"} return
+       .pgaw:VisualQuery.c itemconfigure [.pgaw:VisualQuery.c find withtag hili] -fill black
+       .pgaw:VisualQuery.c dtag [.pgaw:VisualQuery.c find withtag hili] hili
+       .pgaw:VisualQuery.c addtag hili withtag $obj
+       .pgaw:VisualQuery.c itemconfigure $obj -fill blue
+}
+
+
+proc {showSQL} {} {
+global PgAcVar
+variable vqb
+       set sqlcmd [computeSQL]
+       .pgaw:VisualQuery.c delete sqlpage
+       .pgaw:VisualQuery.c create rectangle 0 0 2000 [expr $vqb(yoffs)-1] -fill #ffffff -tags {sqlpage}
+       .pgaw:VisualQuery.c create text 10 10 -text $sqlcmd -anchor nw -width 550 -tags {sqlpage} -font $PgAcVar(pref,font_normal)
+       .pgaw:VisualQuery.c bind sqlpage <Button-1> {.pgaw:VisualQuery.c delete sqlpage}
+}
+
+
+proc {toggleSortMode} {w x y} {
+global PgAcVar
+variable vqb
+       set obj [$w find closest $x $y]
+       set taglist [.pgaw:VisualQuery.c gettags $obj]
+       if {[lsearch $taglist sort]==-1} return
+       set how [.pgaw:VisualQuery.c itemcget $obj -text]
+       if {$how=="unsorted"} {
+               set how Ascending
+       } elseif {$how=="Ascending"} {
+               set how Descending
+       } else {
+               set how unsorted
+       }
+       set col [expr int(($x-$vqb(xoffs))/$vqb(reswidth))]
+       set vqb(ressort) [lreplace $vqb(ressort) $col $col $how]
+       .pgaw:VisualQuery.c itemconfigure $obj -text $how
+}
+
+
+#rjr 8Mar1999 toggle logical return state for result
+proc {toggleReturn} {w x y} {
+global PgAcVar
+variable vqb
+       set obj [$w find closest $x $y]
+       set taglist [.pgaw:VisualQuery.c gettags $obj]
+       if {[lsearch $taglist retval]==-1} return
+       set how [.pgaw:VisualQuery.c itemcget $obj -text]
+       if {$how==[intlmsg Yes]} {
+               set how [intlmsg No]
+       } else {
+               set how [intlmsg Yes]
+       } 
+       set col [expr int(($x-$vqb(xoffs))/$vqb(reswidth))]
+       set vqb(resreturn) [lreplace $vqb(resreturn) $col $col $how]
+       .pgaw:VisualQuery.c itemconfigure $obj -text $how
+}
+
+
+proc {canvasClick} {x y w} {
+global PgAcVar
+variable vqb
+set vqb(panstarted) 0
+if {$w==".pgaw:VisualQuery.c"} {
+       set canpan 1
+       if {$y<$vqb(yoffs)} {
+               if {[llength [.pgaw:VisualQuery.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
+                       set vqb(panobject) tables
+       } else {
+               set vqb(panobject) result
+       }
+       if {$canpan} {
+               .pgaw:VisualQuery configure -cursor hand1
+               set vqb(panstartx) $x
+               set vqb(panstarty) $y
+               set vqb(panstarted) 1
+       }
+}
+set isedit 0
+catch {set isedit $vqb(critedit)}
+# Compute the offset of the result panel due to panning
+set resoffset [expr [lindex [.pgaw:VisualQuery.c bbox resmarker] 0]-$vqb(xoffs)]
+if {$isedit} {
+       set vqb(rescriteria) [lreplace $vqb(rescriteria) $vqb(critcol) $vqb(critcol) $vqb(critval)]
+       .pgaw:VisualQuery.c delete cr-c$vqb(critcol)-r$vqb(critrow)
+       .pgaw:VisualQuery.c create text [expr $resoffset+4+$vqb(xoffs)+$vqb(critcol)*$vqb(reswidth)] [expr $vqb(yoffs)+46+15*$vqb(critrow)] -anchor nw -text $vqb(critval) -font $PgAcVar(pref,font_normal) -tags [subst {resp cr-c$vqb(critcol)-r$vqb(critrow)}]
+       set vqb(critedit) 0
+}
+catch {destroy .pgaw:VisualQuery.entc}
+if {$y<[expr $vqb(yoffs)+46]} return
+if {$x<[expr $vqb(xoffs)+5]} return
+set col [expr int(($x-$vqb(xoffs)-$resoffset)/$vqb(reswidth))]
+if {$col>=[llength $vqb(resfields)]} return
+set nx [expr $col*$vqb(reswidth)+8+$vqb(xoffs)+$resoffset]
+set ny [expr $vqb(yoffs)+76]
+# Get the old criteria value
+set vqb(critval) [lindex $vqb(rescriteria) $col]
+entry .pgaw:VisualQuery.entc -textvar VisualQueryBuilder::vqb(critval) -borderwidth 0 -background #FFFFFF -highlightthickness 0 -selectborderwidth 0  -font $PgAcVar(pref,font_normal)
+place .pgaw:VisualQuery.entc -x $nx -y $ny -height 14
+focus .pgaw:VisualQuery.entc
+bind .pgaw:VisualQuery.entc <Button-1> {set VisualQueryBuilder::vqb(panstarted) 0}
+set vqb(critcol) $col
+set vqb(critrow) 0
+set vqb(critedit) 1
+}
+
+
+proc {saveToQueryBuilder} {} {
+global PgAcVar
+variable vqb
+       Window show .pgaw:QueryBuilder
+       .pgaw:QueryBuilder.text1 delete 1.0 end
+       set vqb(qcmd) [computeSQL]
+       set PgAcVar(query,tables) [getTableList]
+       set PgAcVar(query,links) [getLinkList]
+       set PgAcVar(query,results) [getResultList]
+       .pgaw:QueryBuilder.text1 insert end $vqb(qcmd)
+       focus .pgaw:QueryBuilder
+}
+
+
+proc {executeSQL} {} {
+global PgAcVar
+variable vqb
+       set vqb(qcmd) [computeSQL]
+       set wn [Tables::getNewWindowName]
+       set PgAcVar(mw,$wn,query) [subst $vqb(qcmd)]
+       set PgAcVar(mw,$wn,updatable) 0
+       set PgAcVar(mw,$wn,isaquery) 1
+       Tables::createWindow
+       Tables::loadLayout $wn nolayoutneeded
+       Tables::selectRecords $wn $PgAcVar(mw,$wn,query)
+}
+
+
+proc {createDropDown} {} {
+global PgAcVar
+variable vqb
+       if {[winfo exists .pgaw:VisualQuery.ddf]} {
+               destroy .pgaw:VisualQuery.ddf
+       } else {
+               create_drop_down .pgaw:VisualQuery 70 27 200
+               focus .pgaw:VisualQuery.ddf.sb
+               foreach tbl [Database::getTablesList] {.pgaw:VisualQuery.ddf.lb insert end $tbl}
+               bind .pgaw:VisualQuery.ddf.lb <ButtonRelease-1> {
+                       set i [.pgaw:VisualQuery.ddf.lb curselection]
+                       if {$i!=""} {
+                               set VisualQueryBuilder::vqb(newtablename) [.pgaw:VisualQuery.ddf.lb get $i]
+                               VisualQueryBuilder::addNewTable
+                       }
+                       destroy .pgaw:VisualQuery.ddf
+                       break
+               }
+       }
+}
+
+}
+
+proc vTclWindow.pgaw:VisualQuery {base} {
+global PgAcVar
+       if {$base == ""} {
+               set base .pgaw:VisualQuery
+       }
+       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 [intlmsg "Visual query designer"]
+       bind $base <B1-Motion> {
+               VisualQueryBuilder::panning %x %y
+       }
+       bind $base <Button-1> {
+               VisualQueryBuilder::canvasClick %x %y %W
+       }
+       bind $base <ButtonRelease-1> {
+               VisualQueryBuilder::dragStop %x %y
+       }
+       bind $base <Key-Delete> {
+               VisualQueryBuilder::deleteObject
+       }
+       bind $base <Key-F1> "Help::load visual_designer"
+       canvas $base.c  -background #fefefe -borderwidth 2 -height 207 -relief ridge  -takefocus 0 -width 295 
+       frame $base.fb -height 75 -width 125 
+       label $base.fb.l12  -borderwidth 0 -text "[intlmsg {Add table}] "
+       entry $base.fb.entt  -background #fefefe -borderwidth 1 -highlightthickness 1 \
+               -selectborderwidth 0 -textvariable VisualQueryBuilder::vqb(newtablename) 
+       bind $base.fb.entt <Key-Return> {
+               VisualQueryBuilder::addNewTable
+       }
+       button $base.fb.bdd  -borderwidth 1 \
+               -command VisualQueryBuilder::createDropDown -image dnarw 
+       button $base.fb.showbtn \
+               -command VisualQueryBuilder::showSQL \
+               -text [intlmsg {Show SQL}]
+       button $base.fb.execbtn \
+               -command VisualQueryBuilder::executeSQL \
+               -text [intlmsg {Execute SQL}]
+       button $base.fb.stoqb \
+               -command VisualQueryBuilder::saveToQueryBuilder \
+               -text [intlmsg {Save to query builder}]
+       button $base.fb.exitbtn \
+               -command {Window destroy .pgaw:VisualQuery} \
+               -text [intlmsg Close]
+       place $base.c  -x 5 -y 30 -width 750 -height 500 -anchor nw -bordermode ignore 
+       place $base.fb \
+               -x 5 -y 0 -width 753 -height 31 -anchor nw -bordermode ignore 
+       pack $base.fb.l12 \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.entt \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.bdd \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side left 
+       pack $base.fb.exitbtn \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side right 
+       pack $base.fb.stoqb \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side right 
+       pack $base.fb.execbtn \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side right 
+       pack $base.fb.showbtn \
+               -in .pgaw:VisualQuery.fb -anchor center -expand 0 -fill none -side right 
+}
+
diff --git a/src/bin/pgaccess/main.tcl b/src/bin/pgaccess/main.tcl
new file mode 100644 (file)
index 0000000..1a3d84e
--- /dev/null
@@ -0,0 +1,250 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+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 {intlmsg} {msg} {
+global PgAcVar Messages
+       if {$PgAcVar(pref,language)=="english"} { return $msg }
+       if { ! [array exists Messages] } { return $msg }
+       if { ! [info exists Messages($msg)] } { return $msg }
+       return $Messages($msg)
+}
+
+proc {PgAcVar:clean} {prefix} {
+global PgAcVar
+       foreach key [array names PgAcVar $prefix] {
+               set PgAcVar($key) {}
+               unset PgAcVar($key)
+       }
+}
+
+
+proc {find_PGACCESS_HOME} {} {
+global PgAcVar env
+       if {! [info exists env(PGACCESS_HOME)]} {
+               set home [file dirname [info script]]
+               switch [file pathtype $home] {
+                       absolute {set env(PGACCESS_HOME) $home}
+                       relative {set env(PGACCESS_HOME) [file join [pwd] $home]}
+                       volumerelative {
+                               set curdir [pwd]
+                               cd $home
+                               set env(PGACCESS_HOME) [file join [pwd] [file dirname [file join [lrange [file split $home] 1 end]]]]
+                               cd $curdir
+                       }
+               }
+       }
+       if {![file isdir $env(PGACCESS_HOME)]} {
+               set PgAcVar(PGACCESS_HOME) [pwd]
+       } else {
+               set PgAcVar(PGACCESS_HOME) $env(PGACCESS_HOME)
+       }
+}
+
+
+proc init {argc argv} {
+global PgAcVar CurrentDB
+       find_PGACCESS_HOME
+       # Loading all defined namespaces
+       foreach module {mainlib database tables queries visualqb forms views functions reports scripts users sequences schema help preferences} {
+               source [file join $PgAcVar(PGACCESS_HOME) lib $module.tcl]
+       }
+       set PgAcVar(currentdb,host) localhost
+       set PgAcVar(currentdb,pgport) 5432
+       set CurrentDB {}
+       set PgAcVar(tablist) [list Tables Queries Views Sequences Functions Reports Forms Scripts Users Schema]
+       set PgAcVar(activetab) {}
+       set PgAcVar(query,tables) {}
+       set PgAcVar(query,links) {}
+       set PgAcVar(query,results) {}
+       set PgAcVar(mwcount) 0
+       Preferences::load
+}
+
+proc {wpg_exec} {db cmd} {
+global PgAcVar
+       set PgAcVar(pgsql,cmd) "never executed"
+       set PgAcVar(pgsql,status) "no status yet"
+       set PgAcVar(pgsql,errmsg) "no error message yet"
+       if {[catch {
+               Mainlib::sqlw_display $cmd
+               set PgAcVar(pgsql,cmd) $cmd
+               set PgAcVar(pgsql,res) [pg_exec $db $cmd]
+               set PgAcVar(pgsql,status) [pg_result $PgAcVar(pgsql,res) -status]
+               set PgAcVar(pgsql,errmsg) [pg_result $PgAcVar(pgsql,res) -error]
+       } tclerrmsg]} {
+               showError [format [intlmsg "Tcl error executing pg_exec %s\n\n%s"] $cmd $tclerrmsg]
+               return 0
+       }
+       return $PgAcVar(pgsql,res)
+}
+
+
+proc {wpg_select} {args} {
+       Mainlib::sqlw_display "[lindex $args 1]"
+       uplevel pg_select $args
+}
+
+
+proc {create_drop_down} {base x y w} {
+global PgAcVar
+       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 $PgAcVar(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 {setCursor} {{type NORMAL}} {
+       if {[lsearch -exact "CLOCK WAIT WATCH" [string toupper $type]] != -1} {
+               set type watch
+       } else {
+               set type left_ptr
+       }
+       foreach wn [winfo children .] {
+               catch {$wn configure -cursor $type}
+       }
+       update ; update idletasks 
+}
+
+
+proc {parameter} {msg} {
+global PgAcVar
+       Window show .pgaw:GetParameter
+       focus .pgaw:GetParameter.e1
+       set PgAcVar(getqueryparam,var) ""
+       set PgAcVar(getqueryparam,flag) 0
+       set PgAcVar(getqueryparam,msg) $msg
+       bind .pgaw:GetParameter <Destroy> "set PgAcVar(getqueryparam,flag) 1"
+       grab .pgaw:GetParameter
+       tkwait variable PgAcVar(getqueryparam,flag)
+       if {$PgAcVar(getqueryparam,result)} {
+               return $PgAcVar(getqueryparam,var)
+       } else {
+               return ""
+       }
+}
+
+
+proc {showError} {emsg} {
+   bell ; tk_messageBox -title [intlmsg Error] -icon error -message $emsg
+}
+
+
+proc {sql_exec} {how cmd} {
+global PgAcVar CurrentDB
+       if {[set pgr [wpg_exec $CurrentDB $cmd]]==0} {
+               return 0
+       }
+       if {($PgAcVar(pgsql,status)=="PGRES_COMMAND_OK") || ($PgAcVar(pgsql,status)=="PGRES_TUPLES_OK")} {
+               pg_result $pgr -clear
+               return 1
+       }       
+       if {$how != "quiet"} {
+               showError [format [intlmsg "Error executing query\n\n%s\n\nPostgreSQL error message:\n%s\nPostgreSQL status:%s"] $cmd $PgAcVar(pgsql,errmsg) $PgAcVar(pgsql,status)]
+       }
+       pg_result $pgr -clear
+       return 0
+}
+
+
+
+proc {main} {argc argv} {
+global PgAcVar CurrentDB tcl_platform
+       load libpgtcl[info sharedlibextension]
+       catch {Mainlib::draw_tabs}
+       set PgAcVar(opendb,username) {}
+       set PgAcVar(opendb,password) {}
+       if {$argc>0} {
+               set PgAcVar(opendb,dbname) [lindex $argv 0]
+               set PgAcVar(opendb,host) localhost
+               set PgAcVar(opendb,pgport) 5432
+               Mainlib::open_database
+       } elseif {$PgAcVar(pref,autoload) && ($PgAcVar(pref,lastdb)!="")} {
+               set PgAcVar(opendb,dbname) $PgAcVar(pref,lastdb)
+               set PgAcVar(opendb,host) $PgAcVar(pref,lasthost)
+               set PgAcVar(opendb,pgport) $PgAcVar(pref,lastport)
+               catch {set PgAcVar(opendb,username) $PgAcVar(pref,lastusername)}
+               if {[set openmsg [Mainlib::open_database]]!=""} {
+                       if {[regexp "no password supplied" $openmsg]} {
+                               Window show .pgaw:OpenDB
+                               focus .pgaw:OpenDB.f1.e5
+                               wm transient .pgaw:OpenDB .pgaw:Main
+                       }
+               }
+               
+       }
+       wm protocol .pgaw:Main WM_DELETE_WINDOW {
+               catch {pg_disconnect $CurrentDB}
+               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"
+}
+
+
+init $argc $argv
+
+Window show .
+Window show .pgaw:Main
+
+main $argc $argv
+
diff --git a/src/bin/pgaccess/pgaccess b/src/bin/pgaccess/pgaccess
new file mode 100755 (executable)
index 0000000..41fd5ca
--- /dev/null
@@ -0,0 +1,10 @@
+#!/bin/sh
+
+PATH_TO_WISH=/usr/bin/wish
+PGACCESS_HOME=/usr/local/pgaccess
+
+export PATH_TO_WISH
+export PGACCESS_HOME
+
+exec ${PATH_TO_WISH} ${PGACCESS_HOME}/main.tcl "$@"
+