From 09b187598cce0f23e4e8d5587e193ceca26c6afd Mon Sep 17 00:00:00 2001
From: Bruce Momjian <bruce@momjian.us>
Date: Sun, 1 Mar 1998 21:13:30 +0000
Subject: [PATCH] Install new 0.81 pgaccess release.
---
src/bin/pgaccess/README.pga | 6 +-
src/bin/pgaccess/forms.html | 104 +++++
src/bin/pgaccess/index.html | 124 +++++
src/bin/pgaccess/maillist.html | 43 ++
src/bin/pgaccess/pga-rad.html | 198 ++++++++
src/bin/pgaccess/pgaccess.tcl | 819 ++++++++++++++++++++++++++++++++-
src/bin/pgaccess/qbtclet.html | 45 ++
7 files changed, 1321 insertions(+), 18 deletions(-)
create mode 100644 src/bin/pgaccess/forms.html
create mode 100644 src/bin/pgaccess/index.html
create mode 100644 src/bin/pgaccess/maillist.html
create mode 100644 src/bin/pgaccess/pga-rad.html
create mode 100644 src/bin/pgaccess/qbtclet.html
diff --git a/src/bin/pgaccess/README.pga b/src/bin/pgaccess/README.pga
index 4eb30de2d00..3f798fc9b39 100644
--- a/src/bin/pgaccess/README.pga
+++ b/src/bin/pgaccess/README.pga
@@ -24,7 +24,7 @@ PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
-PGACCESS 0.76 , 12 January 1998
+PGACCESS 0.81 1 March 1998
================================
I dedicate this program to my little 4 year daughter Ana-Maria and my wife
for their understanding. I hope they will forgive me for spending so many
@@ -126,7 +126,9 @@ Reports
- table previews, sample postscript print
Forms
-- open user defined forms, form design module not yet available
+- open user defined forms
+- form design module available
+- query widget qlowing access to a recordset
Scripts
- define, modify and call user defined scripts
diff --git a/src/bin/pgaccess/forms.html b/src/bin/pgaccess/forms.html
new file mode 100644
index 00000000000..12fc3f0e8ad
--- /dev/null
+++ b/src/bin/pgaccess/forms.html
@@ -0,0 +1,104 @@
+<!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="#FFEBCD" LINK="#0000EF" VLINK="#51188E" ALINK="#FF0000">
+
+<H1>FORMS</H1>
+
+<P>
+<HR WIDTH="100%"></P>
+
+<P>This version (0.81) of PgAccess introduce the visual form builder.</P>
+
+<P>For the moment, it has only some basic widgets : labels, entries, buttons
+, listboxes , checkboxes and radiobuttons.</P>
+
+<P>Also there is a query widget that allows you yo have access to a query
+results.</P>
+
+<P>In a manner very similar with Visual Tcl or Visual Basic, the user must
+select a widget from the toolbar and drags on the canvas the rectangle
+that would define the widget. It can also specify some attributes in a
+separate window. Renaming, resizing items are possible modifying parameters
+in attribute window. Do not forget to press Enter in the edit field after
+changing a value in order to be accepted.</P>
+
+<P>You can also move items by dragging them or delete them by pressing
+Del key.</P>
+
+<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>
+
+<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>
+
+<P>The field <B><TT><FONT SIZE=+1>Variable </FONT></TT></B>have meaning
+only for EditField , Label widgets and checkboxes and it is the name of
+the global variable that will hold the value for that widget. For checkboxes
+the values are 1 or 0.</P>
+
+<P>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!"<BR>
+</FONT></TT>and then define a button who's command is <B><TT><FONT SIZE=+1>execute_script
+"My first script"</FONT></TT></B>.</P>
+
+<H2>Database manipulation</H2>
+
+<P>Let's presume that our form have the internal name <B><TT>mf </TT></B>(my
+form). He wil be referred inside the Tcl/Tk source as <B><TT>.mf<BR>
+</TT></B>If you want to close the form in run-time you have to issue the
+command <B><TT>destroy .mf</TT></B></P>
+
+<P>Also, any widget will have the name prefixed by <B><TT>.mf </TT></B> We
+will have <B><TT>.mf.button1</TT></B> or <B><TT>.mf.listbox1</TT></B> .</P>
+
+<P>We can name the query widget <B><TT>qry</TT></B> for example. The complete
+name will be <B><TT>.mf.qry</TT></B> then.<BR>
+The <B><TT>Command </TT></B>property of the query widget must contain the
+SQL command that will be executed.<BR>
+When the form will be in run-time, automatically you will have acces to
+the following methods :</P>
+
+<P><TT>.mf.qry:execute</TT> - opens the connection and execute the query
+(returns nothing)<BR>
+<TT>.mf.qry:nrecords</TT> - returns the number of records in the selected
+query<BR>
+<TT>.mf.qry:fields</TT> - returns a list of the fields in the result set<BR>
+<TT>.mf.qry:movefirst</TT> - move the cursor to the first record in the
+recordset<BR>
+<TT>.mf.qry:movelast , .mf.qry:movenext , .mf.qry:moveprevious </TT>- moves
+the cursor <BR>
+<TT>.mf.qry:updatecontrols</TT> - update the variables inside the designed
+form that have a particular name (I'll explain later)<BR>
+<TT>.mf.qry:close</TT> - close the connection (<B><FONT COLOR="#FF0000">if
+you don't close the query result, you will loose memory</FONT></B>)</P>
+
+<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>
+
+<P><TT>.mf.qry.salary</TT> to get the "salary" field , or <TT>.mf.qry.name</TT>
+to get the "name" field.</P>
+
+<P>It's simple, isn't it ? It's just like a new widget that have some properties
+and methods that can be accesed.<BR>
+Also, the name convention is just like in Tcl/Tk.</P>
+
+<P>
+<HR WIDTH="25%"></P>
+
+<P>Please feel free to send me your oppinion at <B>teo@flex.ro</B> on forms
+designing and usage.<BR>
+</P>
+
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/index.html b/src/bin/pgaccess/index.html
new file mode 100644
index 00000000000..9456d4543e8
--- /dev/null
+++ b/src/bin/pgaccess/index.html
@@ -0,0 +1,124 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<HTML>
+<HEAD>
+ <TITLE>PgAccess - a Tcl/Tk PostgreSQL interface</TITLE>
+ <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+ <META NAME="GENERATOR" CONTENT="Mozilla/3.04Gold (X11; I; Linux 2.0.32 i586) [Netscape]">
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+
+<H1>PgAccess - a database management tool for <A HREF="http://www.postgreSQL.org">PostgreSQL</A></H1>
+
+<P>
+<HR></P>
+
+<P>This program is protected by the following <A HREF="copyright.html">copyright</A>
+</P>
+
+<LI><A HREF="pgaccess-0.81.tar.gz">Download the last version of Pgaccess
+(press shift and click this link)</A>.</LI>
+
+<P>Latest version of PgAccess is 0.81 , 1 March 1998 ! </P>
+
+<CENTER><TABLE BORDER=3 CELLSPACING=0 CELLPADDING=0 WIDTH="100%" BGCOLOR="#FFB6C1" >
+<TR>
+<TD>
+<CENTER><P><BR>
+<B><FONT SIZE=+2>PgAccess can now design <A HREF="forms.html">Forms</A></FONT></B>,
+<B><FONT SIZE=+2><A HREF="pga-rad.html">Reports and Scripts</A></FONT></B></P></CENTER>
+</TD>
+</TR>
+</TABLE></CENTER>
+
+<P>I think that there were some problems loading libpgtcl library. <BR>
+I invite you to read a <A HREF="index.html#libpgtcl">special section concerning
+<B>libpgtcl</B></A> </P>
+
+<H3><FONT COLOR="#191970">What does PgAccess now!</FONT></H3>
+
+<P>Here are some images 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>
+
+<P><B>Tables</B> <BR>
+- opening tables for viewing, max 200 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 <BR>
+- viewing of select type queries result <BR>
+- query deleting and renaming <BR>
+- <B><BLINK><FONT COLOR="#FF0000">NEW !!!</FONT></BLINK></B> Visual query
+builder with drag & 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 language <BR>
+<B>Reports<BR>
+</B>- 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<BR>
+</B>- 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<BR>
+</B>- define, modify and call user defined scripts<BR>
+Here is <A HREF="pga-rad.html">a special section concerning forms and scripts</A>
+.</P>
+
+<P>On the TODO list! <BR>
+- table design (add new fields, renaming, etc.) <BR>
+<BR>
+ </P>
+
+<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> <BR>
+</P>
+
+<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>
+
+<P>
+<HR></P>
+
+<H1>More information about libgtcl</H1>
+
+<P>Also, you will need the PostgreSQL to Tcl interface library, lined as
+a Tcl/Tk 'load'-able module. It is called libpgtcl and the source is located
+in the PostgreSQL directory /src/interfaces/libpgtcl. Specifically, you
+will need a libpgtcl library that is 'load'-able from Tcl/Tk. This is technically
+different from an ordinary PostgreSQL loadable object file, because libpgtcl
+is a collection of object files. Under Linux, this is called libpgtcl.so.
+<BR>
+You can download <A HREF="libpgtcl.so">from here </A>a version already
+compiled for Linux i386 systems. Just copy libpgtcl.so into your system
+library director (/usr/lib) and go for it. 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! </P>
+
+<P>If you have installed RedHat 5.0, you should get the last distribution
+kit of postgreSQL and compile it from scratch. RedHat 5.0 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>
+
+<P>However, the application should work without problems! </P>
+
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/maillist.html b/src/bin/pgaccess/maillist.html
new file mode 100644
index 00000000000..4e0ce850c96
--- /dev/null
+++ b/src/bin/pgaccess/maillist.html
@@ -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 : <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 :</P>
+
+<P> <B><TT><FONT SIZE=+1>pgsql-interfaces-request@postgresql.org
+</FONT></TT></B> </P>
+
+<P>having a single line in the body message : <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 <Majordomo@hub.org> 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/pga-rad.html b/src/bin/pgaccess/pga-rad.html
new file mode 100644
index 00000000000..af4160b0c74
--- /dev/null
+++ b/src/bin/pgaccess/pga-rad.html
@@ -0,0 +1,198 @@
+<!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">
+
+<H1>PgAccess - Scripts and Forms
+<HR WIDTH="100%"></H1>
+
+<P>Beginning with 0.70 version, I have introduced in PgAccess two new modules
+for operating with scripts and forms.</P>
+
+<P> 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>
+ Both scripts and forms are containing in fact sources
+of code written in Tcl/Tk and when the user has choose to "open"
+one of them, either by double-clicking in the main window or pressing the
+"Open" button PgAccess is searching for them in pga_forms or
+pga_scripts table, get the code and simply "<B>eval</B>" it !<BR>
+ 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" would be invoked.</P>
+
+<P> This mechanism and the extremely versatile scripting
+mode of Tcl/Tk would give PgAccess a great power for creating end user
+application using PosgreSQL. The most important thing is that the user
+could call procedures and functions that I have used for building up PgAccess
+!</P>
+
+<H3>Forms</H3>
+
+<P> Forms are special Tcl/Tk source code that is used
+for creating windows and placing widgets inside it. When Tcl/Tk is "eval"
+them, a new window appears, with buttons as defined that could call "user
+defined scripts", "user defined procedures" or "internal
+PgAccess procedures".<BR>
+ For the moment, 0.70 version of PgAccess does not have
+a module for designing forms. It is intended to make an interface to the
+most powerful program of designing applications under Tcl/Tk , Visual Tcl
+, so it could handle forms designed to be used inside PgAccess.<BR>
+ 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.</P>
+
+<H3>Scripts</H3>
+
+<P> 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>
+ The most important thing is that you have total access
+to the PgAccess's 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>
+ 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>
+
+<P>
+<HR WIDTH="100%"></P>
+
+<H2>Examples :</H2>
+
+<P>We would like to give you some examples for using forms and scripts.
+First of all, get your PgAccess 0.70 version NOW !</P>
+
+<P><IMG SRC="a_right.gif" HEIGHT=20 WIDTH=20> Define your first
+form. Remember, the form design module hasn't arrived yet :-( , so you
+will have to define your first form using an action query :<BR>
+1. Click on Query tab and press "New" button<BR>
+2. Enter "<TT>Generate my first form</TT>" in Query name field<BR>
+3. Copy and paste from your browser window into query definition area the
+next text :<BR>
+<BR>
+<TT>insert into pga_forms values('My first form',' set base .pga_win_1;
+if {[winfo exists $base]} { wm deiconify $base; return }; toplevel $base
+-class Toplevel; wm focusmodel $base passive; wm geometry $base 395x389+325+188;
+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 "User
+defined Form No.1"; button $base.b1 -command {execute_script "My
+first script"} -text "My first button" ; button $base.bexit
+-command {destroy [focus]} -padx 9 -pady 3 -text Exit ; place $base.bexit
+-x 340 -y 355 -anchor nw -bordermode ignore ; place $base.b1 -x 10 -y 10
+-anchor nw;'); </TT></P>
+
+<P>4. Press "Save query definition button" and then "Close"<BR>
+5. In the mai window, select by clicking the query "Generate my first
+form" and press "Open" button.</P>
+
+<P>Your query must have been executed without errors! If you will check
+now the "Forms" tab, you will find there your first form. Press
+"Open" button and enjoy it! For the moment, if you will press
+"My first button" you will get an error message. Of course :
+we haven't yet defined our first script ! </P>
+
+<P><IMG SRC="a_right.gif" HEIGHT=20 WIDTH=20> Defining our first
+script :<BR>
+1. Click on Scripts tab and pres "New" button<BR>
+2. Enter "My first script" in script's name field<BR>
+3. Enter the body as the script the following statements :<BR>
+<BR>
+<TT>MsgBox "Warning" "PgAccess unleashed!"<BR>
+open_table pga_scripts<BR>
+<BR>
+</TT>4. Press "Save" button then "Cancel"</P>
+
+<P>It's now the time to define our first library script. I am defining
+not because I need it. I could write directly in "My first script"
+the instructions for creating that warning window but I only wanted to
+show you how you can mix PgAccess script execution with Tcl/Tk code and
+so on.</P>
+
+<P><IMG SRC="a_right.gif" HEIGHT=20 WIDTH=20> Define our first
+library that will contain your "user defined" Tcl/Tk procedures
+and functions :<BR>
+1. Click on Scripts tab and pres "New" button<BR>
+2. Enter "My first library" in script's name field<BR>
+3. Enter the body of the script the following statements :<BR>
+<BR>
+<TT>proc MsgBox {title msg} {<BR>
+ tk_messageBox -title $title -message
+$msg<BR>
+}<BR>
+<BR>
+</TT>4. Press "Save" button then "Cancel"</P>
+
+<P><IMG SRC="file:/home/teo/a_right.gif" HEIGHT=20 WIDTH=20> Define
+our first autoexec script that will contain commands that will be executed
+when opening database :<BR>
+1. Click on Scripts tab and pres "New" button<BR>
+2. Enter "Autoexec" in script's name field<BR>
+3. Enter the body of the script the following statements :<BR>
+<BR>
+<TT>execute_script "My first library"<BR>
+open_form "My first form"<BR>
+<BR>
+</TT>4. Press "Save" button then "Cancel"</P>
+
+<P>Everything is OK now! You will have to exit PgAccess and enter it again
+opening the same database ! Voila , your first form will pop-up on the
+screen, a message box is displayed and after clicking Ok button the table
+pga_scripts will be opened in table viewer revealing what's inside ! With
+this occasion I have shown how you could open in table view mode a "pga_..."
+system table that is hidden by PgAccess in main view mode!</P>
+
+<P>I am stopping here, asking you to try this new features and sending
+me as more feed-backs as you can! What do you think about this new features
+? How would you like to be developed PgAccess in future ? In this
+moment, I am working in recoding the main part of PgAccess in order to
+give to the user more "system" functions that would help him
+creating new applications very easy.<BR>
+<BR>
+Remember : I'm waiting your messages at <A HREF="mailto:teo@flex.ro">teo@flex.ro</A>
+</P>
+
+<P>
+<HR WIDTH="50%"></P>
+
+<P>You will also have the ability of hiding the main window of PgAccess
+at the beginning of "Autoexec" script execution and showing it
+before destroying "My first form". For this example, delete the
+previously defined "My first form" and create it with another
+action query with this code :<BR>
+<BR>
+<TT>insert into pga_forms values('My first form',' set base .pga_win_1;
+if {[winfo exists $base]} { wm deiconify $base; return }; toplevel $base
+-class Toplevel; wm focusmodel $base passive; wm geometry $base 395x389+325+188;
+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 "User
+defined Form No.1"; button $base.b1 -command {execute_script "My
+first script"} -text "My first button" ; button $base.bexit
+-command {Window show .dw ; destroy [focus]} -padx 9 -pady 3 -text Exit
+; place $base.bexit -x 340 -y 355 -anchor nw -bordermode ignore ; place
+$base.b1 -x 10 -y 10 -anchor nw;'); <BR>
+<BR>
+</TT>This new one is just showing main window (.dw) before destroying the
+"user defined window" . <BR>
+Also make "Autoexec" script to show like this :<BR>
+<BR>
+<TT>execute_script "My first library"<BR>
+Window hide .dw<BR>
+open_form "My first form"</TT><BR>
+</P>
+
+</BODY>
+</HTML>
diff --git a/src/bin/pgaccess/pgaccess.tcl b/src/bin/pgaccess/pgaccess.tcl
index 3dddf5ad9e5..3dfef34bae9 100644
--- a/src/bin/pgaccess/pgaccess.tcl
+++ b/src/bin/pgaccess/pgaccess.tcl
@@ -164,6 +164,7 @@ set tablename $objname
switch $activetab {
Queries {open_query design}
Scripts {design_script $objname}
+ Forms {fd_load_form $objname design}
Reports {
Window show .rb
tkwait visibility .rb
@@ -261,6 +262,13 @@ switch $activetab {
Window show .rb ; tkwait visibility .rb ; rb_init ; set rbvar(reportname) {} ; set rbvar(justpreview) 0
focus .rb.e2
}
+ Forms {
+ Window show .fd
+ Window show .fdtb
+ Window show .fdmenu
+ Window show .fda
+ fd_init
+ }
Scripts {
design_script {}
}
@@ -317,7 +325,7 @@ if {$activetab=="Sequences"} return;
if {$activetab=="Functions"} return;
set temp [get_dwlb_Selection]
if {$temp==""} {
- tk_messageBox -title Warning -message "Please select first an object!"
+ tk_messageBox -title Warning -message "Please select an object first !"
return;
}
set oldobjname $temp
@@ -326,21 +334,25 @@ Window show .rf
proc {cmd_Reports} {} {
global dbc
+cursor_watch .dw
catch {
pg_select $dbc "select * from pga_reports order by reportname" rec {
.dw.lb insert end "$rec(reportname)"
}
}
+cursor_arrow .dw
}
proc {cmd_Scripts} {} {
global dbc
+cursor_watch .dw
.dw.lb delete 0 end
catch {
pg_select $dbc "select * from pga_scripts order by scriptname" rec {
.dw.lb insert end $rec(scriptname)
}
}
+cursor_arrow .dw
}
proc {cmd_Sequences} {} {
@@ -502,6 +514,371 @@ global dbc
# }
}
+proc {fd_change_coord} {} {
+global fdvar fdobj
+set i $fdvar(moveitemobj)
+set c $fdobj($i,c)
+set c [list $fdvar(c_left) $fdvar(c_top) [expr $fdvar(c_left)+$fdvar(c_width)] [expr $fdvar(c_top)+$fdvar(c_height)]]
+set fdobj($i,c) $c
+.fd.c delete o$i
+fd_draw_object $i
+fd_draw_hookers $i
+}
+
+proc {fd_delete_object} {} {
+global fdvar
+set i $fdvar(moveitemobj)
+.fd.c delete o$i
+.fd.c delete hook
+set j [lsearch $fdvar(objlist) $i]
+set fdvar(objlist) [lreplace $fdvar(objlist) $j $j]
+}
+
+proc {fd_draw_hook} {x y} {
+.fd.c create rectangle [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] -fill black -tags hook
+}
+
+proc {fd_draw_hookers} {i} {
+global fdobj
+foreach {x1 y1 x2 y2} $fdobj($i,c) {}
+.fd.c delete hook
+fd_draw_hook $x1 $y1
+fd_draw_hook $x1 $y2
+fd_draw_hook $x2 $y1
+fd_draw_hook $x2 $y2
+}
+
+proc {fd_draw_object} {i} {
+global fdvar fdobj
+set c $fdobj($i,c)
+foreach {x1 y1 x2 y2} $c {}
+.fd.c delete o$i
+switch $fdobj($i,t) {
+ button {
+ fd_draw_rectangle $x1 $y1 $x2 $y2 raised #a0a0a0 o$i
+ .fd.c create text [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] -text $fdobj($i,l) -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags o$i
+ }
+ entry {
+ fd_draw_rectangle $x1 $y1 $x2 $y2 sunken white o$i
+ }
+ label {
+ .fd.c create text $x1 $y1 -text $fdobj($i,l) -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -tags o$i
+ }
+ checkbox {
+ fd_draw_rectangle [expr $x1+2] [expr $y1+5] [expr $x1+12] [expr $y1+15] raised #a0a0a0 o$i
+ .fd.c create text [expr $x1+20] [expr $y1+3] -text $fdobj($i,l) -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags o$i
+ }
+ radio {
+ .fd.c create oval [expr $x1+4] [expr $y1+5] [expr $x1+14] [expr $y1+15] -fill white -tags o$i
+ .fd.c create text [expr $x1+24] [expr $y1+3] -text $fdobj($i,l) -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags o$i
+ }
+ query {
+ .fd.c create oval $x1 $y1 [expr $x1+20] [expr $y1+20] -fill white -tags o$i
+ .fd.c create text [expr $x1+5] [expr $y1+4] -text Q -anchor nw -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-* -tags o$i
+ }
+ listbox {
+ fd_draw_rectangle $x1 $y1 [expr $x2-12] $y2 sunken white o$i
+ fd_draw_rectangle [expr $x2-11] $y1 $x2 $y2 sunken gray o$i
+ .fd.c create line [expr $x2-5] $y1 $x2 [expr $y1+10] -fill #808080 -tags o$i
+ .fd.c create line [expr $x2-10] [expr $y1+9] $x2 [expr $y1+9] -fill #808080 -tags o$i
+ .fd.c create line [expr $x2-10] [expr $y1+9] [expr $x2-5] $y1 -fill white -tags o$i
+ .fd.c create line [expr $x2-5] $y2 $x2 [expr $y2-10] -fill #808080 -tags o$i
+ .fd.c create line [expr $x2-10] [expr $y2-9] $x2 [expr $y2-9] -fill white -tags o$i
+ .fd.c create line [expr $x2-10] [expr $y2-9] [expr $x2-5] $y2 -fill white -tags o$i
+ }
+}
+.fd.c raise hook
+}
+
+proc {fd_draw_rectangle} {x1 y1 x2 y2 relief color tag} {
+if {$relief=="raised"} {
+ set c1 white
+ set c2 #606060
+} else {
+ set c1 #606060
+ set c2 white
+}
+if {$color != "none"} {
+ .fd.c create rectangle $x1 $y1 $x2 $y2 -outline "" -fill $color -tags $tag
+}
+.fd.c create line $x1 $y1 $x2 $y1 -fill $c1 -tags $tag
+.fd.c create line $x1 $y1 $x1 $y2 -fill $c1 -tags $tag
+.fd.c create line $x1 $y2 $x2 $y2 -fill $c2 -tags $tag
+.fd.c create line $x2 $y1 $x2 [expr 1+$y2] -fill $c2 -tags $tag
+}
+
+proc {fd_init} {} {
+global fdvar fdobj
+catch {unset fdvar}
+catch {unset fdobj}
+catch {.fd.c delete all}
+set fdvar(forminame) {udf0}
+set fdvar(formname) "New form"
+set fdvar(objnum) 0
+set fdvar(objlist) {}
+set fdvar(oper) none
+set fdvar(tool) point
+}
+
+proc {fd_item_click} {x y} {
+global fdvar fdobj
+set fdvar(oper) none
+set fdvar(moveitemobj) {}
+set il [.fd.c find overlapping $x $y $x $y]
+if {[llength $il]==0} return
+set tl [.fd.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 fdvar(moveitemobj) $objnum
+set fdvar(moveitemx) $x
+set fdvar(moveitemy) $y
+set fdvar(oper) move
+fd_show_attributes $objnum
+fd_draw_hookers $objnum
+}
+
+proc {fd_load_form} {name mode} {
+global fdvar fdobj dbc
+fd_init
+set fdvar(formname) $name
+if {$mode=="design"} {
+ Window show .fd
+ Window show .fdmenu
+ Window show .fda
+ Window show .fdtb
+}
+#set fid [open "$name.form" r]
+#set info [gets $fid]
+#close $fid
+set res [pg_exec $dbc "select * from pga_forms where formname='$fdvar(formname)'"]
+set info [lindex [pg_result $res -getTuple 0] 1]
+pg_result $res -clear
+set fdvar(forminame) [lindex $info 0]
+set fdvar(objnum) [lindex $info 1]
+set fdvar(objlist) [lindex $info 2]
+set fdvar(geometry) [lindex $info 3]
+set j 0
+foreach objinfo [lrange $info 4 end] {
+ foreach {t n c x l v} $objinfo {}
+ set i [lindex $fdvar(objlist) $j]
+ set fdobj($i,t) $t
+ set fdobj($i,n) $n
+ set fdobj($i,c) $c
+ set fdobj($i,l) $l
+ set fdobj($i,x) $x
+ set fdobj($i,v) $v
+ if {$mode=="design"} {fd_draw_object $i}
+ incr j
+}
+}
+
+proc {fd_mouse_down} {x y} {
+global fdvar
+set x [expr 3*int($x/3)]
+set y [expr 3*int($y/3)]
+set fdvar(xstart) $x
+set fdvar(ystart) $y
+if {$fdvar(tool)=="point"} {
+ fd_item_click $x $y
+ return
+}
+set fdvar(oper) draw
+}
+
+proc {fd_mouse_move} {x y} {
+global fdvar
+#set 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 $fdvar(oper)}
+if {$oper=="draw"} {
+ catch {.fd.c delete curdraw}
+ .fd.c create rectangle $fdvar(xstart) $fdvar(ystart) $x $y -tags curdraw
+ return
+}
+if {$oper=="move"} {
+ set dx [expr $x-$fdvar(moveitemx)]
+ set dy [expr $y-$fdvar(moveitemy)]
+ .fd.c move o$fdvar(moveitemobj) $dx $dy
+ .fd.c move hook $dx $dy
+ set fdvar(moveitemx) $x
+ set fdvar(moveitemy) $y
+}
+}
+
+proc {fd_mouse_up} {x y} {
+global fdvar fdobj
+set x [expr 3*int($x/3)]
+set y [expr 3*int($y/3)]
+if {$fdvar(oper)=="move"} {
+ set fdvar(moveitem) {}
+ set fdvar(oper) none
+ set oc $fdobj($fdvar(moveitemobj),c)
+ set dx [expr $x - $fdvar(xstart)]
+ set dy [expr $y - $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 fdobj($fdvar(moveitemobj),c) $newcoord
+ fd_show_attributes $fdvar(moveitemobj)
+ fd_draw_hookers $fdvar(moveitemobj)
+ return
+}
+if {$fdvar(oper)!="draw"} return
+set fdvar(oper) none
+.fd.c delete curdraw
+incr fdvar(objnum)
+set i $fdvar(objnum)
+lappend fdvar(objlist) $i
+# t=type , c=coords , n=name , l=label
+set fdobj($i,t) $fdvar(tool)
+set fdobj($i,c) [list $fdvar(xstart) $fdvar(ystart) $x $y]
+set fdobj($i,n) $fdvar(tool)$i
+set fdobj($i,l) $fdvar(tool)$i
+set fdobj($i,x) {}
+set fdobj($i,v) {}
+fd_draw_object $i
+fd_show_attributes $i
+set fdvar(moveitemobj) $i
+fd_draw_hookers $i
+set fdvar(tool) point
+}
+
+proc {fd_save_form} {name} {
+global fdvar fdobj dbc
+if {[tk_messageBox -title Warning -message "Do you want to save the form into the database ?" -type yesno -default yes]=="no"} {return 1}
+if {[string length $fdvar(forminame)]==0} {
+ tk_messageBox -title Warning -message "Forms need an internal name, only literals, low case"
+ return 0
+}
+if {[string length $fdvar(formname)]==0} {
+ tk_messageBox -title Warning -message "Form must have a name"
+ return 0
+}
+#set fid [open "$name.form" w]
+set info [list $fdvar(forminame) $fdvar(objnum) $fdvar(objlist) [wm geometry .fd]]
+foreach i $fdvar(objlist) {
+ lappend info [list $fdobj($i,t) $fdobj($i,n) $fdobj($i,c) $fdobj($i,x) $fdobj($i,l) $fdobj($i,v)]
+}
+#puts $fid $info
+#close $fid
+set res [pg_exec $dbc "delete from pga_forms where formname='$fdvar(formname)'"]
+pg_result $res -clear
+set res [pg_exec $dbc "insert into pga_forms values ('$fdvar(formname)','$info')"]
+pg_result $res -clear
+cmd_Forms
+return 1
+}
+
+proc {fd_set_command} {} {
+global fdobj fdvar
+set i $fdvar(moveitemobj)
+set fdobj($i,x) $fdvar(c_cmd)
+}
+
+proc {fd_set_name} {} {
+global fdvar fdobj
+set i $fdvar(moveitemobj)
+foreach k $fdvar(objlist) {
+ if {($fdobj($k,n)==$fdvar(c_name)) && ($i!=$k)} {
+ tk_messageBox -title Warning -message "There is another object (a $fdobj($k,t)) with the same name. Please change it!"
+ return
+ }
+}
+set fdobj($i,n) $fdvar(c_name)
+fd_show_attributes $i
+}
+
+proc {fd_set_text} {} {
+global fdvar fdobj
+set fdobj($fdvar(moveitemobj),l) $fdvar(c_text)
+fd_draw_object $fdvar(moveitemobj)
+}
+
+proc {fd_show_attributes} {i} {
+global fdvar fdobj
+set fdvar(c_info) "$fdobj($i,t) .$fdvar(forminame).$fdobj($i,n)"
+set fdvar(c_name) $fdobj($i,n)
+set c $fdobj($i,c)
+set fdvar(c_top) [lindex $c 1]
+set fdvar(c_left) [lindex $c 0]
+set fdvar(c_width) [expr [lindex $c 2]-[lindex $c 0]]
+set fdvar(c_height) [expr [lindex $c 3]-[lindex $c 1]]
+set fdvar(c_cmd) {}
+catch {set fdvar(c_cmd) $fdobj($i,x)}
+set fdvar(c_var) {}
+catch {set fdvar(c_var) $fdobj($i,v)}
+set fdvar(c_text) {}
+catch {set fdvar(c_text) $fdobj($i,l)}
+}
+
+proc {fd_test} {} {
+global fdvar fdobj dbc datasets
+set base .$fdvar(forminame)
+if {[winfo exists $base]} {
+ wm deiconify $base; return
+}
+toplevel $base -class Toplevel
+wm focusmodel $base passive
+wm geometry $base $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 $fdvar(formname)
+foreach item $fdvar(objlist) {
+set coord $fdobj($item,c)
+set name $fdobj($item,n)
+set wh "-width [expr 3+[lindex $coord 2]-[lindex $coord 0]] -height [expr 3+[lindex $coord 3]-[lindex $coord 1]]"
+set visual 1
+switch $fdobj($item,t) {
+ button {
+ set cmd {}
+ catch {set cmd $fdobj($item,x)}
+ button $base.$name -borderwidth 1 -padx 0 -pady 0 -text "$fdobj($item,l)" -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -command [subst {$cmd}]
+ }
+ checkbox {
+ checkbutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1
+ set wh {}
+ }
+ query { set visual 0
+ set procbody "proc $base.$name:execute {} {global dbc datasets ; set datasets($base.$name) \[pg_exec \$dbc \"$fdobj($item,x)\"\] ; set ceva \[$base.$name:fields\]}"
+ eval $procbody
+# tk_messageBox -message $procbody
+ set procbody "proc $base.$name:nrecords {} {global datasets ; return \[pg_result \$datasets($base.$name) -numTuples\]}"
+ eval $procbody
+# tk_messageBox -message $procbody
+ set procbody "proc $base.$name:close {} {global datasets ; pg_result \$datasets($base.$name) -clear}"
+ eval $procbody
+# tk_messageBox -message $procbody
+ set procbody "proc $base.$name:fields {} {global datasets ; set fl {} ; foreach fd \[pg_result \$datasets($base.$name) -lAttributes\] {lappend fl \[lindex \$fd 0\]} ; set datasets($base.$name,fields) \$fl ; return \$fl}"
+# tk_messageBox -message $procbody
+ eval $procbody
+ eval "proc $base.$name:movefirst {} {global datasets ; set datasets($base.$name,recno) 0}"
+ eval "proc $base.$name:movenext {} {global datasets ; incr datasets($base.$name,recno)}"
+ eval "proc $base.$name:moveprevious {} {global datasets ; incr datasets($base.$name,recno) -1 ; if {\$datasets($base.$name,recno)==-1} {$base.$name:movefirst}}"
+ eval "proc $base.$name:movelast {} {global datasets ; set datasets($base.$name,recno) \[expr \[$base.$name:nrecords\] -1\]}"
+ eval "proc $base.$name:updatecontrols {} {global datasets ; set i 0 ; foreach fld \$datasets($base.$name,fields) {catch {upvar $base.$name.\$fld dbvar ; set dbvar \[lindex \[pg_result \$datasets($base.$name) -getTuple \$datasets($base.$name,recno)\] \$i\]} ; incr i}}"
+ }
+ radio {
+ radiobutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1
+ set wh {}
+ }
+ entry {
+ set var {} ; catch {set var $fdobj($item,v)}
+ entry $base.$name -bo 1 -ba white -selectborderwidth 0 -highlightthickness 0
+ if {$var!=""} {$base.$name configure -textvar $var}
+ }
+ label {set wh {} ; label $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -padx 0 -pady 0 -text $fdobj($item,l)}
+ listbox {listbox $base.$name -borderwidth 1 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*}
+}
+if $visual {eval [subst "place $base.$name -x [expr [lindex $coord 0]-1] -y [expr [lindex $coord 1]-1] -anchor nw $wh -bordermode ignore"]}
+}
+}
+
+
+
proc {get_dwlb_Selection} {} {
set temp [.dw.lb curselection]
if {$temp==""} return "";
@@ -554,6 +931,9 @@ if {$retval} {
}
}
+
+
+
proc {mw_canvas_click} {x y} {
global mw msg
if {![mw_exit_edit]} return
@@ -1069,13 +1449,8 @@ if {[catch {set newdbc [pg_connect $newdbname -host $newhost -port $newpport]} m
}
proc {open_form} {formname} {
-global dbc
-
-set frmsrc {}
-pg_select $dbc "select * from pga_forms where formname='$formname'" rec {
- set frmsrc $rec(formsource)
-}
-eval $frmsrc
+ fd_load_form $formname run
+ fd_test
}
proc {open_function} {objname} {
@@ -1960,12 +2335,6 @@ sql_exec noquiet "delete from pga_reports where reportname='$rbvar(reportname)'"
sql_exec noquiet "insert into pga_reports (reportname,reportsource,reportbody) values ('$rbvar(reportname)','$rbvar(tablename)','$prog')"
}
-proc {main} {argc argv} {
-global dbc
-set dbc [pg_connect ultex]
-rb_init
-}
-
proc {save_pref} {} {
global pref
catch {
@@ -2043,7 +2412,7 @@ place $w -x 7
place .dw.lmask -x 80 -y [expr 86+25*[lsearch -exact $tablist $curtab]]
set activetab $curtab
# Tabs where button Design is enabled
-if {[lsearch {Scripts Queries Reports} $activetab]!=-1} {
+if {[lsearch {Scripts Queries Reports Forms} $activetab]!=-1} {
.dw.btndesign configure -state normal
}
.dw.lb delete 0 end
@@ -2190,7 +2559,7 @@ proc vTclWindow.about {base} {
label $base.l2 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {A Tcl/Tk interface to
PostgreSQL
by Constantin Teodorescu}
- label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.76}
+ label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.81}
label $base.l4 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {You will always get the latest version at:
http://www.flex.ro/pgaccess
@@ -3642,6 +4011,424 @@ proc vTclWindow.tiw {base} {
place $base.fr11.lif -x 10 -y 70 -width 178 -height 68 -anchor nw -bordermode ignore
}
+proc vTclWindow.fd {base} {
+ if {$base == ""} {
+ set base .fd
+ }
+ if {[winfo exists $base]} {
+ wm deiconify $base; return
+ }
+ ###################
+ # CREATING WIDGETS
+ ###################
+ toplevel $base -class Toplevel
+ wm focusmodel $base passive
+ wm geometry $base 377x315+185+234
+ 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 "Form design"
+ bind $base <Key-Delete> {
+ fd_delete_object
+ }
+ canvas $base.c \
+ -background #828282 -height 207 -highlightthickness 0 -relief ridge \
+ -selectborderwidth 0 -width 295
+ bind $base.c <Button-1> {
+ fd_mouse_down %x %y
+ }
+ bind $base.c <ButtonRelease-1> {
+ fd_mouse_up %x %y
+ }
+ bind $base.c <Motion> {
+ fd_mouse_move %x %y
+ }
+ ###################
+ # SETTING GEOMETRY
+ ###################
+ pack $base.c \
+ -in .fd -anchor center -expand 1 -fill both -side top
+}
+
+proc vTclWindow.fda {base} {
+ if {$base == ""} {
+ set base .fda
+ }
+ if {[winfo exists $base]} {
+ wm deiconify $base; return
+ }
+ ###################
+ # CREATING WIDGETS
+ ###################
+ toplevel $base -class Toplevel
+ wm focusmodel $base passive
+ wm geometry $base 225x197+589+29
+ 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 "Attributes"
+ label $base.l1 \
+ -anchor nw -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -justify left -text Name -width 8
+ entry $base.e1 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_name)
+ bind $base.e1 <Key-Return> {
+ fd_set_name
+ }
+ label $base.l2 \
+ -anchor nw -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -justify left -text Top -width 8
+ entry $base.e2 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_top)
+ bind $base.e2 <Key-Return> {
+ fd_change_coord
+ }
+ label $base.l3 \
+ -anchor w -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text Left \
+ -width 8
+ entry $base.e3 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_left)
+ bind $base.e3 <Key-Return> {
+ fd_change_coord
+ }
+ label $base.l4 \
+ -anchor w -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text Width \
+ -width 8
+ entry $base.e4 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_width)
+ bind $base.e4 <Key-Return> {
+ fd_change_coord
+ }
+ label $base.l5 \
+ -anchor w -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 0 \
+ -text Height -width 8
+ entry $base.e5 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_height)
+ bind $base.e5 <Key-Return> {
+ fd_change_coord
+ }
+ label $base.l6 \
+ -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 0 \
+ -text Command
+ entry $base.e6 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_cmd)
+ bind $base.e6 <Key-Return> {
+ fd_set_command
+ }
+ button $base.bcmd \
+ -borderwidth 1 \
+ -command {Window show .fdcmd
+.fdcmd.f.txt delete 1.0 end
+.fdcmd.f.txt insert end $fdvar(c_cmd)} \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 3 \
+ -pady 3 -text ... -width 1
+ label $base.l7 \
+ -anchor w -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -text Variable -width 8
+ entry $base.e7 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_var)
+ bind $base.e7 <Key-Return> {
+ set fdobj($fdvar(moveitemobj),v) $fdvar(c_var)
+ }
+ label $base.l8 \
+ -anchor w -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -text Text \
+ -width 8
+ entry $base.e8 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(c_text)
+ bind $base.e8 <Key-Return> {
+ fd_set_text
+ }
+ label $base.l0 \
+ -borderwidth 1 -relief raised -text {checkbox .udf0.checkbox17} \
+ -textvariable fdvar(c_info) -width 28
+ ###################
+ # SETTING GEOMETRY
+ ###################
+ grid $base.l1 \
+ -in .fda -column 0 -row 1 -columnspan 1 -rowspan 1
+ grid $base.e1 \
+ -in .fda -column 1 -row 1 -columnspan 1 -rowspan 1 -pady 2
+ grid $base.l2 \
+ -in .fda -column 0 -row 2 -columnspan 1 -rowspan 1
+ grid $base.e2 \
+ -in .fda -column 1 -row 2 -columnspan 1 -rowspan 1
+ grid $base.l3 \
+ -in .fda -column 0 -row 3 -columnspan 1 -rowspan 1
+ grid $base.e3 \
+ -in .fda -column 1 -row 3 -columnspan 1 -rowspan 1 -pady 2
+ grid $base.l4 \
+ -in .fda -column 0 -row 4 -columnspan 1 -rowspan 1
+ grid $base.e4 \
+ -in .fda -column 1 -row 4 -columnspan 1 -rowspan 1
+ grid $base.l5 \
+ -in .fda -column 0 -row 5 -columnspan 1 -rowspan 1
+ grid $base.e5 \
+ -in .fda -column 1 -row 5 -columnspan 1 -rowspan 1 -pady 2
+ grid $base.l6 \
+ -in .fda -column 0 -row 6 -columnspan 1 -rowspan 1
+ grid $base.e6 \
+ -in .fda -column 1 -row 6 -columnspan 1 -rowspan 1
+ grid $base.bcmd \
+ -in .fda -column 2 -row 6 -columnspan 1 -rowspan 1
+ grid $base.l7 \
+ -in .fda -column 0 -row 7 -columnspan 1 -rowspan 1
+ grid $base.e7 \
+ -in .fda -column 1 -row 7 -columnspan 1 -rowspan 1
+ grid $base.l8 \
+ -in .fda -column 0 -row 8 -columnspan 1 -rowspan 1
+ grid $base.e8 \
+ -in .fda -column 1 -row 8 -columnspan 1 -rowspan 1 -pady 2
+ grid $base.l0 \
+ -in .fda -column 0 -row 0 -columnspan 2 -rowspan 1
+}
+
+proc vTclWindow.fdcmd {base} {
+ if {$base == ""} {
+ set base .fdcmd
+ }
+ if {[winfo exists $base]} {
+ wm deiconify $base; return
+ }
+ ###################
+ # CREATING WIDGETS
+ ###################
+ toplevel $base -class Toplevel
+ wm focusmodel $base passive
+ wm geometry $base 282x274+616+367
+ wm maxsize $base 785 570
+ wm minsize $base 1 19
+ wm overrideredirect $base 0
+ wm resizable $base 1 1
+ wm title $base "Command"
+ frame $base.f \
+ -borderwidth 2 -height 75 -relief groove -width 125
+ scrollbar $base.f.sb \
+ -borderwidth 1 -command {.fdcmd.f.txt yview} -orient vert -width 12
+ text $base.f.txt \
+ -font -*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-* -height 1 \
+ -width 115 -yscrollcommand {.fdcmd.f.sb set}
+ frame $base.fb \
+ -height 75 -width 125
+ button $base.fb.b1 \
+ -borderwidth 1 \
+ -command {set fdvar(c_cmd) [.fdcmd.f.txt get 1.0 "end - 1 chars"]
+Window hide .fdcmd
+fd_set_command} \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+ -pady 3 -text Ok -width 5
+ button $base.fb.b2 \
+ -borderwidth 1 -command {Window hide .fdcmd} \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+ -pady 3 -text Cancel
+ ###################
+ # SETTING GEOMETRY
+ ###################
+ pack $base.f \
+ -in .fdcmd -anchor center -expand 1 -fill both -side top
+ pack $base.f.sb \
+ -in .fdcmd.f -anchor e -expand 1 -fill y -side right
+ pack $base.f.txt \
+ -in .fdcmd.f -anchor center -expand 1 -fill both -side top
+ pack $base.fb \
+ -in .fdcmd -anchor center -expand 0 -fill none -side top
+ pack $base.fb.b1 \
+ -in .fdcmd.fb -anchor center -expand 0 -fill none -side left
+ pack $base.fb.b2 \
+ -in .fdcmd.fb -anchor center -expand 0 -fill none -side top
+}
+
+proc vTclWindow.fdmenu {base} {
+ if {$base == ""} {
+ set base .fdmenu
+ }
+ if {[winfo exists $base]} {
+ wm deiconify $base; return
+ }
+ ###################
+ # CREATING WIDGETS
+ ###################
+ toplevel $base -class Toplevel
+ wm focusmodel $base passive
+ wm geometry $base 288x70+193+129
+ 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 "Commands"
+ button $base.but17 \
+ -borderwidth 1 \
+ -command {if {[tk_messageBox -title Warning -message "Delete all objects ?" -type yesno -default no]=="no"} return
+fd_init} \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+ -pady 3 -text {Delete all}
+ button $base.but18 \
+ -borderwidth 1 -command {set fdvar(geometry) [wm geometry .fd] ; fd_test } \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+ -pady 3 -text {Test form}
+ button $base.but19 \
+ -borderwidth 1 -command {destroy .$fdvar(forminame)} \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+ -pady 3 -text {Close test form}
+ button $base.bex \
+ -borderwidth 1 \
+ -command {if {[fd_save_form $fdvar(formname)]==1} {
+catch {Window destroy .fd}
+catch {Window destroy .fdtb}
+catch {Window destroy .fdmenu}
+catch {Window destroy .fda}
+catch {Window destroy .fdcmd}
+catch {Window destroy .$fdvar(forminame)}
+}} \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \
+ -pady 3 -text Close
+ button $base.bload \
+ -borderwidth 1 -command {fd_load_form nimic design} \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -padx 9 \
+ -pady 3 -text {Load from database}
+ button $base.button17 \
+ -borderwidth 1 -command {fd_save_form nimic} \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -padx 9 \
+ -pady 3 -text Save
+ label $base.l1 \
+ -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
+ -text {Form name}
+ entry $base.e1 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(formname)
+ label $base.l2 \
+ -borderwidth 0 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
+ -text {Form's window internal name}
+ entry $base.e2 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -selectborderwidth 0 -textvariable fdvar(forminame)
+ ###################
+ # SETTING GEOMETRY
+ ###################
+ place $base.but17 \
+ -x 5 -y 80 -width 62 -height 24 -anchor nw -bordermode ignore
+ place $base.but18 \
+ -x 5 -y 45 -width 62 -height 24 -anchor nw -bordermode ignore
+ place $base.but19 \
+ -x 70 -y 45 -width 94 -height 24 -anchor nw -bordermode ignore
+ place $base.bex \
+ -x 230 -y 45 -height 24 -anchor nw -bordermode ignore
+ place $base.bload \
+ -x 75 -y 80 -width 114 -height 23 -anchor nw -bordermode ignore
+ place $base.button17 \
+ -x 165 -y 45 -width 44 -height 24 -anchor nw -bordermode ignore
+ place $base.l1 \
+ -x 5 -y 5 -anchor nw -bordermode ignore
+ place $base.e1 \
+ -x 75 -y 5 -width 193 -height 17 -anchor nw -bordermode ignore
+ place $base.l2 \
+ -x 5 -y 25 -anchor nw -bordermode ignore
+ place $base.e2 \
+ -x 175 -y 25 -width 60 -height 17 -anchor nw -bordermode ignore
+}
+
+proc vTclWindow.fdtb {base} {
+ if {$base == ""} {
+ set base .fdtb
+ }
+ if {[winfo exists $base]} {
+ wm deiconify $base; return
+ }
+ ###################
+ # CREATING WIDGETS
+ ###################
+ toplevel $base -class Toplevel
+ wm focusmodel $base passive
+ wm geometry $base 90x152+65+180
+ 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 "Toolbar"
+ radiobutton $base.rb1 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -highlightthickness 0 -text Point -value point -variable fdvar(tool) \
+ -width 9
+ radiobutton $base.rb2 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -foreground #000000 -highlightthickness 0 -selectcolor #0000ee \
+ -text Label -value label -variable fdvar(tool) -width 9
+ radiobutton $base.rb3 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -highlightthickness 0 -text Entry -value entry -variable fdvar(tool) \
+ -width 9
+ radiobutton $base.rb4 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -highlightthickness 0 -text Button -value button \
+ -variable fdvar(tool) -width 9
+ radiobutton $base.rb5 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \
+ -highlightthickness 0 -text {List box} -value listbox \
+ -variable fdvar(tool) -width 9
+ radiobutton $base.rb6 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
+ -highlightthickness 0 -text {Check box} -value checkbox \
+ -variable fdvar(tool) -width 9
+ radiobutton $base.rb7 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
+ -highlightthickness 0 -text {Radio btn} -value radio \
+ -variable fdvar(tool) -width 9
+ radiobutton $base.rb8 \
+ -anchor w -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
+ -highlightthickness 0 -text Query -value query -variable fdvar(tool) \
+ -width 9
+ ###################
+ # SETTING GEOMETRY
+ ###################
+ grid $base.rb1 \
+ -in .fdtb -column 0 -row 0 -columnspan 1 -rowspan 1
+ grid $base.rb2 \
+ -in .fdtb -column 0 -row 1 -columnspan 1 -rowspan 1
+ grid $base.rb3 \
+ -in .fdtb -column 0 -row 2 -columnspan 1 -rowspan 1
+ grid $base.rb4 \
+ -in .fdtb -column 0 -row 3 -columnspan 1 -rowspan 1
+ grid $base.rb5 \
+ -in .fdtb -column 0 -row 4 -columnspan 1 -rowspan 1
+ grid $base.rb6 \
+ -in .fdtb -column 0 -row 5 -columnspan 1 -rowspan 1
+ grid $base.rb7 \
+ -in .fdtb -column 0 -row 6 -columnspan 1 -rowspan 1
+ grid $base.rb8 \
+ -in .fdtb -column 0 -row 7 -columnspan 1 -rowspan 1
+}
+
Window show .
Window show .dw
diff --git a/src/bin/pgaccess/qbtclet.html b/src/bin/pgaccess/qbtclet.html
new file mode 100644
index 00000000000..b990c0f15c3
--- /dev/null
+++ b/src/bin/pgaccess/qbtclet.html
@@ -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>
--
GitLab