Commit 22347d69 authored by Bruce Momjian's avatar Bruce Momjian

Update to pgaccess 0.91.

parent f4590995
...@@ -2,10 +2,10 @@ ...@@ -2,10 +2,10 @@
# #
# Makefile for src/bin/pgaccess # Makefile for src/bin/pgaccess
# #
# Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group # Portions Copyright (c) 1996-2001, PostgreSQL Global Development Group
# Portions Copyright (c) 1994, Regents of the University of California # Portions Copyright (c) 1994, Regents of the University of California
# #
# $Header: /cvsroot/pgsql/src/bin/pgaccess/Attic/Makefile,v 1.17 2002/06/20 20:29:42 momjian Exp $ # $Header: /cvsroot/pgsql/src/bin/pgaccess/Attic/Makefile,v 1.18 2002/07/02 06:11:23 momjian Exp $
# #
#------------------------------------------------------------------------- #-------------------------------------------------------------------------
......
--------------------------------------------------------------------------- Hi,
Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group I've made a few changes in the pgaccess source to make it work with overloaded functions too.
Portions Copyright (c) 1994, Regents of the University of California
Permission to use, copy, modify, and distribute this software and its The files that I changed are:
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 pgaccess: to run the modified version from the actual directory
DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING /lib/functions.old: bugfix for working with overloaded functions, and another one: if somebody has made a mistake
LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS in the editing process, the function was deleted, and recreation was not possibble, because the
DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE program returned an error message. Now the error message is still persists, but the procedure
POSSIBILITY OF SUCH DAMAGE. doesn't take this into consideration.
Added "Save as" button to create a new function with the same source. Very usefull when one needs
a new function with slight modification to the source code.
Then default window size is increased to let the larger source code visible without resizing.
/lib/mainlib.tcl: for the same bugfix, now the functionnames are represented with the parameters too, I think, that
the structure is more visible now. Bugfix for the introduced functionalities, at deleteing object
(function).
/lib/tables.tcl: I don't know how, but there is a difference. Maybe this is one of the misteries of the universe :)
THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, So, in spite of the fact that this "hacking" is my first juorney in the tcl scripting language, I think
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY I've made a good job after all. I hope, this changes will be reflected in the future release of the pgaccess.
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.
--------------------------------------------------------------------------- There can be several hidden bugs introduced by the changes, if you find one of them please let me know.
At this time I am using the changed software that helps me much more in the actual project.
PGACCESS 0.98.7 27 January 2001 Best regards,
================================ Bartus Levente (bartus.l at bitel.hu)
I dedicate this program to my little daughters Ana-Maria and Emilia and to my \ No newline at end of file
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 greater than 8.0
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>
...@@ -9,8 +9,7 @@ ...@@ -9,8 +9,7 @@
<BR><TT></TT>&nbsp; <BR><TT></TT>&nbsp;
<BR><TT></TT>&nbsp;<TT></TT> <BR><TT></TT>&nbsp;<TT></TT>
<P><TT>Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group</TT> <P><TT>Copyright (c) 1994-7 Regents of the University of California</TT><TT></TT>
<P><TT>Portions Copyright (c) 1994, Regents of the University of California</TT>
<P><TT>Permission to use, copy, modify, and distribute this software and <P><TT>Permission to use, copy, modify, and distribute this software and
its</TT> its</TT>
...@@ -18,7 +17,7 @@ its</TT> ...@@ -18,7 +17,7 @@ its</TT>
agreement</TT> agreement</TT>
<BR><TT>is hereby granted, provided that the above copyright notice and <BR><TT>is hereby granted, provided that the above copyright notice and
this</TT> this</TT>
<BR><TT>paragraph and the following two paragraphs appear in all copies.</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 <P><TT>IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
PARTY FOR</TT> PARTY FOR</TT>
...@@ -27,7 +26,7 @@ INCLUDING</TT> ...@@ -27,7 +26,7 @@ INCLUDING</TT>
<BR><TT>LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS</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 <BR><TT>DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED
OF THE</TT> OF THE</TT>
<BR><TT>POSSIBILITY OF SUCH DAMAGE.</TT> <BR><TT>POSSIBILITY OF SUCH DAMAGE.</TT><TT></TT>
<P><TT>THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,</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>INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY</TT>
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
<BR><TT></TT>&nbsp; <BR><TT></TT>&nbsp;
<BR><TT></TT>&nbsp;<TT></TT> <BR><TT></TT>&nbsp;<TT></TT>
<P><TT>Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group</TT> <P><TT>Portions Copyright (c) 1996-2001, PostgreSQL Global Development Group</TT>
<P><TT>Portions Copyright (c) 1994, Regents of the University of California</TT> <P><TT>Portions Copyright (c) 1994, Regents of the University of California</TT>
<P><TT>Permission to use, copy, modify, and distribute this software and <P><TT>Permission to use, copy, modify, and distribute this software and
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
<BR><TT></TT>&nbsp; <BR><TT></TT>&nbsp;
<BR><TT></TT>&nbsp;<TT></TT> <BR><TT></TT>&nbsp;<TT></TT>
<P><TT>Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group</TT> <P><TT>Portions Copyright (c) 1996-2001, PostgreSQL Global Development Group</TT>
<P><TT>Portions Copyright (c) 1994, Regents of the University of California</TT> <P><TT>Portions Copyright (c) 1994, Regents of the University of California</TT>
<P><TT>Permission to use, copy, modify, and distribute this software and <P><TT>Permission to use, copy, modify, and distribute this software and
......
...@@ -29,7 +29,7 @@ a text file named <samp>newref.txt</samp> that starts like this:<p> ...@@ -29,7 +29,7 @@ a text file named <samp>newref.txt</samp> that starts like this:<p>
Notice that there are two consecutive tildes to allow for the fact that this Notice that there are two consecutive tildes to allow for the fact that this
particular entry doesn't have anything in the <b>Editor</b> field. particular entry doesn't have anything in the <b>Editor</b> field.
You can then perform a <em>Query</em> as follows:<p> You can then perform a <em>Query</em> as follows:<p>
<samp>COPY psyref FROM '/home/jim/newref.txt' WITH DELIMITER <samp>COPY psyref FROM '/home/jim/newref.txt' USING DELIMITERS
'~';</samp><p> '~';</samp><p>
This will read the records from <samp>newref.txt</samp> and insert them into the This will read the records from <samp>newref.txt</samp> and insert them into the
table <samp>psyref</samp>. See the PostgreSQL documentation under the headings table <samp>psyref</samp>. See the PostgreSQL documentation under the headings
......
namespace eval Database { namespace eval Database {
# i have no idea why views were being discriminated against here
# when i first touched the code you could only make reports from tables
# i just commented out two lines below
# -cmaj
proc {getTablesList} {} { proc {getTablesList} {} {
global CurrentDB PgAcVar global CurrentDB PgAcVar
set tlist {} set tlist {}
...@@ -16,10 +21,10 @@ global CurrentDB PgAcVar ...@@ -16,10 +21,10 @@ global CurrentDB PgAcVar
} else { } else {
set sysconstraint "" set sysconstraint ""
} }
wpg_select $CurrentDB "select relname from pg_class where (relkind='r') $sysconstraint order by relname" rec { wpg_select $CurrentDB "select relname from pg_class where (relkind='r') or (relkind='v') $sysconstraint order by relname" rec {
if {![info exists itsaview($rec(relname))]} { # if {![info exists itsaview($rec(relname))]} {
lappend tlist $rec(relname) lappend tlist $rec(relname)
} # }
} }
} gterrmsg]} { } gterrmsg]} {
showError $gterrmsg showError $gterrmsg
......
...@@ -5,10 +5,10 @@ and the name must be specified from the viewpoint of the backend. If stdin or st ...@@ -5,10 +5,10 @@ and the name must be specified from the viewpoint of the backend. If stdin or st
" {} " " {} "
COPY \[ BINARY \] table \[ WITH OIDS \] COPY \[ BINARY \] table \[ WITH OIDS \]
FROM { 'filename' | stdin } FROM { 'filename' | stdin }
\[ WITH DELIMITER 'delimiter' \] \[ USING DELIMITERS 'delimiter' \]
COPY \[ BINARY \] table \[ WITH OIDS \] COPY \[ BINARY \] table \[ WITH OIDS \]
TO { 'filename' | stdout } TO { 'filename' | stdout }
\[ WITH DELIMITER 'delimiter' \] \[ USING DELIMITERS 'delimiter' \]
" {code} "Inputs" {bold} " " {code} "Inputs" {bold} "
...@@ -44,7 +44,7 @@ COPY \[ BINARY \] table \[ WITH OIDS \] ...@@ -44,7 +44,7 @@ COPY \[ BINARY \] table \[ WITH OIDS \]
" {} "Usage" {bold} " " {} "Usage" {bold} "
The following example copies a table to standard output, using a vertical bar \(\"|\"\) as the field delimiter: The following example copies a table to standard output, using a vertical bar \(\"|\"\) as the field delimiter:
COPY country TO stdout WITH DELIMITER '|'; COPY country TO stdout USING DELIMITERS '|';
To copy data from a Unix file into a table \"country\": To copy data from a Unix file into a table \"country\":
COPY country FROM '/usr1/proj/bray/sql/country_data'; COPY country FROM '/usr1/proj/bray/sql/country_data';
...@@ -93,12 +93,13 @@ The format for each instance in the file is as follows. Note that this format mu ...@@ -93,12 +93,13 @@ The format for each instance in the file is as follows. Note that this format mu
The " {} "BINARY" {bold} " keyword will force all data to be stored/read as binary objects rather than as text. It is somewhat faster than the normal copy command, but is not generally portable, and the files \ The " {} "BINARY" {bold} " keyword will force all data to be stored/read as binary objects rather than as text. It is somewhat faster than the normal copy command, but is not generally portable, and the files \
generated are somewhat larger, although this factor is highly dependent on the data itself. By default, a text copy uses a tab \ generated are somewhat larger, although this factor is highly dependent on the data itself. By default, a text copy uses a tab \
\(\"\\t\"\) character as a delimiter. The delimiter may also be changed to any other single character with the keyword phrase WITH DELIMITER. Characters in data fields which happen to match the delimiter character will be quoted. \(\"\\t\"\) character as a delimiter. The delimiter may also be changed to any other single character with the keyword phrase USING DELIMITERS. Characters in data fields which happen to match the delimiter character will be quoted.
You must have select access on any table whose values are read by " {} "COPY" {bold} ", and either insert or update access to a table into which values are being inserted by \ You must have select access on any table whose values are read by " {} "COPY" {bold} ", and either insert or update access to a table into which values are being inserted by \
" {} "COPY" {bold} ". The backend also needs appropriate Unix permissions for any file read or written by \ " {} "COPY" {bold} ". The backend also needs appropriate Unix permissions for any file read or written by \
" {} "COPY" {bold} ". " {} "COPY" {bold} ".
The keyword phrase " {} "WITH DELIMITER" {bold} " specifies a single character to be used for all delimiters between columns. The keyword phrase " {} "USING DELIMITERS" {bold} " specifies a single character to be used for all delimiters between columns. If multiple characters are specified in the delimiter string, only the first \
character is used.
Tip: Do not confuse " {} "COPY" {bold} " with the psql instruction \\copy. " Tip: Do not confuse " {} "COPY" {bold} " with the psql instruction \\copy. "
.pgaw:Help.f.t insert end \ .pgaw:Help.f.t insert end \
"Copyrights\n\n" {title} \ "Copyrights\n\n" {title} \
" "
PostgreSQL is Copyright © 1996-2002, PostgreSQL Global Development Group. PostgreSQL is Copyright © 1996-2001, PostgreSQL Global Development Group.
Postgres95 is Copyright © 1994, Regents of the University of California. Postgres95 is Copyright © 1994, Regents of the University of California.
......
.pgaw:Help.f.t insert end "The Reports module is still in alpha stage. .pgaw:Help.f.t insert end "The Reports module is still in alpha stage.
The module should be able to design and execute a report based on a table\ DONE:
or from an existing query. # Allows for reports based on tables or views.
# Formulas are just Tcl evals, where column names are available as variables.
Try: concat \$colname1 \$colname2
# Pictures must be gif or bmp files (and not stored in the database).
# Page header is the first record on a page, page footer is the last.
# Detail section is all the records that can fit on a page, row by row.
# Multiple pages.
# Printing puts the report into a Postscript file.\
The pages printed are the ones in and between the boxes on preview mode.
You can also pipe the output by entering it in the dialog when prompted.\
Try: |lpr
# Page resizing can be done by typing in the Page size boxes.
# Report resizing can be done by typing in the Report size boxes and hitting\
enter or dragging the window and clicking in it with the mouse.
Grouping, sorting, subtotals, expressions should be implemented. DOING:
Report output can be printed as a Postscript file. # Allow for reports based on queries.
# Report headers and footers.
# Grouping, sorting, subtotals.
# Drawing simple shapes like lines or circles.
# Font choice needs expanding.
# Putting stuff into columns when the page is wider than the report.
For the moment I have no time to do that so volunteers are welcome. Also, there are a couple Postscript items to be addressed:
# Since the Tk canvas widget outputs Encapsulated Postscript,\
each page printed is a separate piece of Encapsulated Postscript.\
Putting all those pieces together into one Postscript file was\
a bit of a kluge, so right now you get every other page blank. Doh.
# Each time a picture is displayed, the Postscript grows by about 10 times\
the size of the picture. It seems in general Postscript gets enormous\
fast, at least with the Tk canvas widget's method of outputting it.
Please send patches, proposals, problems, pickles, etc., to Chris Maj <cmaj@freedomcorpse.info> or visit pgaccess.org
" "
...@@ -105,20 +105,14 @@ global CurrentDB ...@@ -105,20 +105,14 @@ global CurrentDB
proc {cmd_Functions} {} { proc {cmd_Functions} {} {
global PgAcVar CurrentDB global CurrentDB
set maxim 16384 set maxim 16384
setCursor CLOCK setCursor CLOCK
set dbname $PgAcVar(opendb,dbname)
if [catch {wpg_select $CurrentDB "select datlastsysoid from pg_database where datname='$dbname'" rec {
set maxim $rec(datlastsysoid)
}
}] {
catch { catch {
wpg_select $CurrentDB "select oid from pg_database where datname='template1'" rec { wpg_select $CurrentDB "select oid from pg_database where datname='template1'" rec {
set maxim $rec(oid) set maxim $rec(oid)
} }
} }
}
.pgaw:Main.lb delete 0 end .pgaw:Main.lb delete 0 end
catch { catch {
wpg_select $CurrentDB "select proname from pg_proc where oid>$maxim order by proname" rec { wpg_select $CurrentDB "select proname from pg_proc where oid>$maxim order by proname" rec {
...@@ -301,17 +295,19 @@ catch { ...@@ -301,17 +295,19 @@ catch {
} }
proc {cmd_Views} {} { proc {cmd_Views} {} {
global CurrentDB PgAcVar global CurrentDB
setCursor CLOCK setCursor CLOCK
.pgaw:Main.lb delete 0 end .pgaw:Main.lb delete 0 end
catch { catch {
if {! $PgAcVar(pref,systemtables)} { 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 {
set sysconstraint "where (viewname !~ '^pg_') and (viewname !~ '^pga_')" if {$rec(count)!=0} {
} else { set itsaview($rec(relname)) 1
set sysconstraint "" }
}
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)
} }
wpg_select $CurrentDB "select viewname from pg_views $sysconstraint order by viewname" rec {
.pgaw:Main.lb insert end $rec(viewname)
} }
} }
setCursor DEFAULT setCursor DEFAULT
...@@ -636,8 +632,6 @@ proc vTclWindow.pgaw:ImportExport {base} { ...@@ -636,8 +632,6 @@ proc vTclWindow.pgaw:ImportExport {base} {
if {$PgAcVar(impexp,delimiter)==""} { if {$PgAcVar(impexp,delimiter)==""} {
set sup "" set sup ""
} else { } else {
# now we use WITH DELIMITER, but keep old syntax for
# backward compatibility. 2002-06-15
set sup " USING DELIMITERS '$PgAcVar(impexp,delimiter)'" set sup " USING DELIMITERS '$PgAcVar(impexp,delimiter)'"
} }
if {[.pgaw:ImportExport.expbtn cget -text]=="Import"} { if {[.pgaw:ImportExport.expbtn cget -text]=="Import"} {
...@@ -695,6 +689,7 @@ proc vTclWindow.pgaw:RenameObject {base} { ...@@ -695,6 +689,7 @@ proc vTclWindow.pgaw:RenameObject {base} {
showError [intlmsg "You must give object a new name!"] showError [intlmsg "You must give object a new name!"]
} elseif {$PgAcVar(activetab)=="Tables"} { } elseif {$PgAcVar(activetab)=="Tables"} {
set retval [sql_exec noquiet "alter table \"$PgAcVar(Old_Object_Name)\" rename to \"$PgAcVar(New_Object_Name)\""] set retval [sql_exec noquiet "alter table \"$PgAcVar(Old_Object_Name)\" rename to \"$PgAcVar(New_Object_Name)\""]
Schema::tbl_rename $PgAcVar(Old_Object_Name) $PgAcVar(New_Object_Name)
if {$retval} { if {$retval} {
sql_exec quiet "update pga_layout set tablename='$PgAcVar(New_Object_Name)' where tablename='$PgAcVar(Old_Object_Name)'" sql_exec quiet "update pga_layout set tablename='$PgAcVar(New_Object_Name)' where tablename='$PgAcVar(Old_Object_Name)'"
Mainlib::cmd_Tables Mainlib::cmd_Tables
...@@ -909,11 +904,11 @@ proc vTclWindow.pgaw:About {base} { ...@@ -909,11 +904,11 @@ proc vTclWindow.pgaw:About {base} {
wm title $base [intlmsg "About"] wm title $base [intlmsg "About"]
label $base.l1 -borderwidth 3 -font -Adobe-Helvetica-Bold-R-Normal-*-*-180-*-*-*-*-* -relief ridge -text PgAccess 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.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.7} label $base.l3 -borderwidth 0 -relief sunken -text {v 0.99.1}
label $base.l4 -relief groove -text "[intlmsg {You will always get the latest version at:}] label $base.l4 -relief groove -text "[intlmsg {You will always get the latest version at:}]
http://www.flex.ro/pgaccess http://www.pgaccess.org/
[intlmsg {Suggestions at}] : teo@flex.ro" [intlmsg {Suggestions at}] : developers@pgaccess.org"
button $base.b1 -borderwidth 1 -command {Window destroy .pgaw:About} -text Ok 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.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.l2 -x 10 -y 115 -width 198 -height 55 -anchor nw -bordermode ignore
......
...@@ -10,8 +10,8 @@ global PgAcVar ...@@ -10,8 +10,8 @@ global PgAcVar
set PgAcVar(pref,autoload) 1 set PgAcVar(pref,autoload) 1
set PgAcVar(pref,systemtables) 0 set PgAcVar(pref,systemtables) 0
set PgAcVar(pref,lastdb) {} set PgAcVar(pref,lastdb) {}
set PgAcVar(pref,lasthost) {} set PgAcVar(pref,lasthost) localhost
set PgAcVar(pref,lastport) {} set PgAcVar(pref,lastport) 5432
set PgAcVar(pref,username) {} set PgAcVar(pref,username) {}
set PgAcVar(pref,password) {} set PgAcVar(pref,password) {}
set PgAcVar(pref,language) english set PgAcVar(pref,language) english
......
namespace eval Reports { namespace eval Reports {
proc {new} {} { proc {new} {} {
global PgAcVar global PgAcVar
Window show .pgaw:ReportBuilder Window show .pgaw:ReportBuilder:draft
tkwait visibility .pgaw:ReportBuilder tkwait visibility .pgaw:ReportBuilder:draft
init Window show .pgaw:ReportBuilder:menu
tkwait visibility .pgaw:ReportBuilder:menu
design:init
set PgAcVar(report,reportname) {} set PgAcVar(report,reportname) {}
set PgAcVar(report,justpreview) 0 set PgAcVar(report,justpreview) 0
focus .pgaw:ReportBuilder.e2 focus .pgaw:ReportBuilder:menu.e2
} }
proc {open} {reportname} { proc {open} {reportname} {
global PgAcVar CurrentDB global PgAcVar CurrentDB
Window show .pgaw:ReportBuilder Window show .pgaw:ReportBuilder:draft
#tkwait visibility .pgaw:ReportBuilder #tkwait visibility .pgaw:ReportBuilder:draft
Window hide .pgaw:ReportBuilder Window hide .pgaw:ReportBuilder:draft
Window show .pgaw:ReportBuilder:menu
Window hide .pgaw:ReportBuilder:menu
Window show .pgaw:ReportPreview Window show .pgaw:ReportPreview
init design:init
set PgAcVar(report,reportname) $reportname set PgAcVar(report,reportname) $reportname
loadReport design:loadReport
tkwait visibility .pgaw:ReportPreview tkwait visibility .pgaw:ReportPreview
set PgAcVar(report,justpreview) 1 set PgAcVar(report,justpreview) 1
preview design:preview
} }
proc {design} {reportname} { proc {design} {reportname} {
global PgAcVar global PgAcVar
Window show .pgaw:ReportBuilder Window show .pgaw:ReportBuilder:draft
tkwait visibility .pgaw:ReportBuilder tkwait visibility .pgaw:ReportBuilder:draft
init Window show .pgaw:ReportBuilder:menu
tkwait visibility .pgaw:ReportBuilder:menu
design:init
set PgAcVar(report,reportname) $reportname set PgAcVar(report,reportname) $reportname
loadReport design:loadReport
set PgAcVar(report,justpreview) 0 set PgAcVar(report,justpreview) 0
} }
proc {drawReportAreas} {} { proc {design:close} {} {
global PgAcVar
catch {Window destroy .pgaw:ReportBuilder:draft}
catch {Window destroy .pgaw:ReportBuilder:menu}
}
proc {design:drawReportAreas} {} {
global PgAcVar global PgAcVar
foreach rg $PgAcVar(report,regions) { foreach rg $PgAcVar(report,regions) {
.pgaw:ReportBuilder.c delete bg_$rg .pgaw:ReportBuilder:draft.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:draft.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:draft.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 .pgaw:ReportBuilder:draft.c lower bg_$rg
} }
} }
proc {toggleAlignMode} {} { proc {design:toggleAlignMode} {} {
set bb [.pgaw:ReportBuilder.c bbox hili] set bb [.pgaw:ReportBuilder:draft.c bbox hili]
if {[.pgaw:ReportBuilder.balign cget -text]=="left"} then { if {[.pgaw:ReportBuilder:menu.balign cget -text]=="left"} then {
.pgaw:ReportBuilder.balign configure -text right .pgaw:ReportBuilder:menu.balign configure -text right
.pgaw:ReportBuilder.c itemconfigure hili -anchor ne .pgaw:ReportBuilder:draft.c itemconfigure hili -anchor ne
.pgaw:ReportBuilder.c move hili [expr [lindex $bb 2]-[lindex $bb 0]-3] 0 .pgaw:ReportBuilder:draft.c move hili [expr [lindex $bb 2]-[lindex $bb 0]-3] 0
} else { } else {
.pgaw:ReportBuilder.balign configure -text left .pgaw:ReportBuilder:menu.balign configure -text left
.pgaw:ReportBuilder.c itemconfigure hili -anchor nw .pgaw:ReportBuilder:draft.c itemconfigure hili -anchor nw
.pgaw:ReportBuilder.c move hili [expr [lindex $bb 0]-[lindex $bb 2]+3] 0 .pgaw:ReportBuilder:draft.c move hili [expr [lindex $bb 0]-[lindex $bb 2]+3] 0
} }
} }
proc {getBoldStatus} {} { proc {design:getBoldStatus} {} {
if {[.pgaw:ReportBuilder.lbold cget -relief]=="raised"} then {return Medium} else {return Bold} if {[.pgaw:ReportBuilder:menu.lbold cget -relief]=="raised"} then {return Medium} else {return Bold}
} }
proc {getItalicStatus} {} { proc {design:getItalicStatus} {} {
if {[.pgaw:ReportBuilder.lita cget -relief]=="raised"} then {return R} else {return O} if {[.pgaw:ReportBuilder:menu.lita cget -relief]=="raised"} then {return R} else {return O}
} }
proc {toggleBold} {} { proc {design:toggleBold} {} {
if {[getBoldStatus]=="Bold"} { if {[design:getBoldStatus]=="Bold"} {
.pgaw:ReportBuilder.lbold configure -relief raised .pgaw:ReportBuilder:menu.lbold configure -relief raised
} else { } else {
.pgaw:ReportBuilder.lbold configure -relief sunken .pgaw:ReportBuilder:menu.lbold configure -relief sunken
} }
setObjectFont design:setObjectFont
} }
proc {toggleItalic} {} { proc {design:toggleItalic} {} {
if {[getItalicStatus]=="O"} { if {[design:getItalicStatus]=="O"} {
.pgaw:ReportBuilder.lita configure -relief raised .pgaw:ReportBuilder:menu.lita configure -relief raised
} else { } else {
.pgaw:ReportBuilder.lita configure -relief sunken .pgaw:ReportBuilder:menu.lita configure -relief sunken
} }
setObjectFont design:setObjectFont
} }
proc {setFont} {} { # fonts remain an issue to be dealt with
set temp [.pgaw:ReportBuilder.bfont cget -text] proc {design:setFont} {} {
if {$temp=="Courier"} then { set temp [.pgaw:ReportBuilder:menu.bfont cget -text]
.pgaw:ReportBuilder.bfont configure -text Helvetica switch $temp {
} else {
.pgaw:ReportBuilder.bfont configure -text Courier Courier
{.pgaw:ReportBuilder:menu.bfont configure -text Helvetica}
Helvetica
{.pgaw:ReportBuilder:menu.bfont configure -text Times}
Times
{.pgaw:ReportBuilder:menu.bfont configure -text Newcenturyschlbk}
#Newcenturyschlbk
#{.pgaw:ReportBuilder:menu.bfont configure -text Palatino}
#Palatino
#{.pgaw:ReportBuilder:menu.bfont configure -text Utopia}
default
{.pgaw:ReportBuilder:menu.bfont configure -text Courier}
} }
setObjectFont
design:setObjectFont
} }
# fills in an array with columns so formulas can access them
proc {design:getSourceFieldsForPreview} {} {
global PgAcVar CurrentDB
set PgAcVar(report,source_fields) {}
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 {
lappend PgAcVar(report,source_fields) $rec(attname)
}
}
proc {getSourceFields} {} { # fills in the drop box with column names
proc {design:getSourceFields} {} {
global PgAcVar CurrentDB global PgAcVar CurrentDB
.pgaw:ReportBuilder.lb delete 0 end .pgaw:ReportBuilder:menu.lb delete 0 end
if {$PgAcVar(report,tablename)==""} return ; if {$PgAcVar(report,tablename)==""} return ;
#setCursor CLOCK #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 { 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) .pgaw:ReportBuilder:menu.lb insert end $rec(attname)
} }
#setCursor DEFAULT #setCursor DEFAULT
} }
proc {hasTag} {id tg} { proc {design:hasTag} {id tg} {
if {[lsearch [.pgaw:ReportBuilder.c itemcget $id -tags] $tg]==-1} then {return 0 } else {return 1} if {[lsearch [.pgaw:ReportBuilder:draft.c itemcget $id -tags] $tg]==-1} then {return 0 } else {return 1}
} }
proc {init} {} { proc {design:init} {} {
global PgAcVar global PgAcVar
set PgAcVar(report,xl_auto) 10 set PgAcVar(report,xl_auto) 10
set PgAcVar(report,xf_auto) 10 set PgAcVar(report,xf_auto) 10
set PgAcVar(report,xp_auto) 10
set PgAcVar(report,xo_auto) 10
set PgAcVar(report,regions) {rpthdr pghdr detail pgfoo rptfoo} set PgAcVar(report,regions) {rpthdr pghdr detail pgfoo rptfoo}
set PgAcVar(report,y_rpthdr) 30 set PgAcVar(report,y_rpthdr) 30
set PgAcVar(report,y_pghdr) 60 set PgAcVar(report,y_pghdr) 60
...@@ -132,81 +173,262 @@ global PgAcVar ...@@ -132,81 +173,262 @@ global PgAcVar
set PgAcVar(report,e_detail) [intlmsg {Detail record}] set PgAcVar(report,e_detail) [intlmsg {Detail record}]
set PgAcVar(report,e_pgfoo) [intlmsg {Page footer}] set PgAcVar(report,e_pgfoo) [intlmsg {Page footer}]
set PgAcVar(report,e_rptfoo) [intlmsg {Report footer}] set PgAcVar(report,e_rptfoo) [intlmsg {Report footer}]
drawReportAreas design:drawReportAreas
} }
proc {loadReport} {} { proc {design:loadReport} {} {
global PgAcVar CurrentDB global PgAcVar CurrentDB
.pgaw:ReportBuilder.c delete all .pgaw:ReportBuilder:draft.c delete all
wpg_select $CurrentDB "select * from pga_reports where reportname='$PgAcVar(report,reportname)'" rcd { wpg_select $CurrentDB "select * from pga_reports where reportname='$PgAcVar(report,reportname)'" rcd {
eval $rcd(reportbody) eval $rcd(reportbody)
} }
getSourceFields design:changeDraftCoords
drawReportAreas design:getSourceFields
design:drawReportAreas
}
# get the preview cranking
proc {design:preview} {} {
global PgAcVar
design:previewInit
set PgAcVar(report,curr_page) 1
if {$PgAcVar(report,last_page)>0} {
design:previewPage
}
}
# finds the record and page counts
proc {design:previewInit} {} {
global PgAcVar CurrentDB
Window show .pgaw:ReportPreview
set ol [.pgaw:ReportBuilder:draft.c find withtag ro]
set PgAcVar(report,prev_fields) {}
# set up the fields we need to fill with data
foreach objid $ol {
set tags [.pgaw:ReportBuilder:draft.c itemcget $objid -tags]
lappend PgAcVar(report,prev_fields) [string range [lindex $tags [lsearch -glob $tags f-*]] 2 64]
lappend PgAcVar(report,prev_fields) [lindex [.pgaw:ReportBuilder:draft.c coords $objid] 0]
lappend PgAcVar(report,prev_fields) [lindex [.pgaw:ReportBuilder:draft.c coords $objid] 1]
lappend PgAcVar(report,prev_fields) $objid
lappend PgAcVar(report,prev_fields) [lindex $tags [lsearch -glob $tags t_*]]
}
# set up all the source fields - needed for formulas
design:getSourceFieldsForPreview
# get number of records (thus the number of detail sections)
set res [pg_exec $CurrentDB "select * from \"$PgAcVar(report,tablename)\""]
set PgAcVar(report,prev_num_recs) [pg_result $res -numTuples]
# get number of detail sections per page (screw report head/foot for now)
# first: page height - (page header height + page footer height)
set pgdiff [expr {$PgAcVar(report,ph)-(($PgAcVar(report,y_pghdr)-$PgAcVar(report,y_rpthdr))+($PgAcVar(report,y_pgfoo)-$PgAcVar(report,y_detail)))}]
# second: result of first / detail height
set PgAcVar(report,prev_recs_page) [expr {round(double($pgdiff)/double($PgAcVar(report,y_detail)-$PgAcVar(report,y_pghdr)))}]
# get number of pages
set PgAcVar(report,last_page) [expr {int(ceil(double($PgAcVar(report,prev_num_recs))/double($PgAcVar(report,prev_recs_page))))}]
set PgAcVar(report,total_page) $PgAcVar(report,last_page)
}
# displays one section
proc {design:previewSection} {x y objid objtype py recfield} {
global PgAcVar CurrentDB
# for fields
if {$objtype=="t_f"} {
.pgaw:ReportPreview.fr.c create text $x [expr $py+$y] -text $recfield -font [.pgaw:ReportBuilder:draft.c itemcget $objid -font] -anchor [.pgaw:ReportBuilder:draft.c itemcget $objid -anchor]
}
# for labels
if {$objtype=="t_l"} {
.pgaw:ReportPreview.fr.c create text $x [expr $py+$y] -text [.pgaw:ReportBuilder:draft.c itemcget $objid -text] -font [.pgaw:ReportBuilder:draft.c itemcget $objid -font] -anchor nw
}
# for pictures
if {$objtype=="t_p"} {
.pgaw:ReportPreview.fr.c create image $x [expr $py+$y] -image [image create photo -file [.pgaw:ReportBuilder:draft.c itemcget $objid -image]] -anchor nw
}
# for formulas
if {$objtype=="t_o"} {
wpg_select $CurrentDB "select * from \"$PgAcVar(report,tablename)\" limit $PgAcVar(report,prev_recs_page) offset [expr {(($PgAcVar(report,curr_page)-1)*$PgAcVar(report,prev_recs_page))}]" frec {
# assign each source field to a variable
foreach {ffield} $PgAcVar(report,source_fields) {
variable $ffield $frec($ffield)
}
}
# now flesh out and evaluate the formula
.pgaw:ReportPreview.fr.c create text $x [expr $py+$y] -text [eval [.pgaw:ReportBuilder:draft.c itemcget $objid -text]] -font [.pgaw:ReportBuilder:draft.c itemcget $objid -font] -anchor nw
}
} }
proc {preview} {} { # displays the current page
# for now we worry about the page head/foot and detail, not report head/foot
proc {design:previewPage} {} {
global PgAcVar CurrentDB global PgAcVar CurrentDB
Window show .pgaw:ReportPreview
set sql ""
set recfield ""
.pgaw:ReportPreview.fr.c delete all .pgaw:ReportPreview.fr.c delete all
set ol [.pgaw:ReportBuilder.c find withtag ro]
set fields {} # parse the page header
foreach objid $ol { set py $PgAcVar(report,y_rpthdr)
set tags [.pgaw:ReportBuilder.c itemcget $objid -tags] # now get the data for the section, which is the first record on the page
lappend fields [string range [lindex $tags [lsearch -glob $tags f-*]] 2 64] wpg_select $CurrentDB "select * from \"$PgAcVar(report,tablename)\" limit 1 offset [expr {(($PgAcVar(report,curr_page)-1)*$PgAcVar(report,prev_recs_page))}]" rec {
lappend fields [lindex [.pgaw:ReportBuilder.c coords $objid] 0] foreach {field x y objid objtype} $PgAcVar(report,prev_fields) {
lappend fields [lindex [.pgaw:ReportBuilder.c coords $objid] 1] if {$y < $PgAcVar(report,y_pghdr)} {
lappend fields $objid # make sure we line up the section where it was designed to go
lappend fields [lindex $tags [lsearch -glob $tags t_*]] set y [expr $y-$PgAcVar(report,y_rpthdr)]
} # looking for formulas
# 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"} { 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] set recfield $rec($field)
} else {
set recfield ""
} }
if {$objtype=="t_l"} { design:previewSection $x $y $objid $objtype $py $recfield
.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 }
}
}
# Parsing detail group
set shownrecs 1
set py $PgAcVar(report,y_pghdr)
# keep the records on the page
# and do not repeat the last record on the last page
while {($py < [expr ($PgAcVar(report,rh)-($PgAcVar(report,y_detail)-$PgAcVar(report,y_pghdr)))]) && ([expr $shownrecs*$PgAcVar(report,last_page)]<=$PgAcVar(report,prev_num_recs))} {
# now lets get some data for a record
wpg_select $CurrentDB "select * from \"$PgAcVar(report,tablename)\" limit $PgAcVar(report,prev_recs_page) offset [expr {(($PgAcVar(report,curr_page)-1)*$PgAcVar(report,prev_recs_page))}]" rec {
foreach {field x y objid objtype} $PgAcVar(report,prev_fields) {
if {$y > $PgAcVar(report,y_pghdr) && $y < $PgAcVar(report,y_detail)} {
set y [expr $y-$PgAcVar(report,y_pghdr)]
if {$objtype=="t_f"} {
set recfield $rec($field)
} else {
set recfield ""
} }
design:previewSection $x $y $objid $objtype $py $recfield
} }
} }
incr py [expr $PgAcVar(report,y_detail)-$PgAcVar(report,y_pghdr)] incr py [expr $PgAcVar(report,y_detail)-$PgAcVar(report,y_pghdr)]
incr shownrecs
}
} }
.pgaw:ReportPreview.fr.c configure -scrollregion [subst {0 0 1000 $py}]
# parse the page footer
# put it in the same place on each page
set py [expr {(($PgAcVar(report,y_detail)-$PgAcVar(report,y_pghdr))*$PgAcVar(report,prev_recs_page))+$PgAcVar(report,y_pghdr)}]
# get the data for the section, which is the last record on the page
# pay attention to the case when we are looking at the last page
if {$PgAcVar(report,curr_page)==$PgAcVar(report,last_page)} {
set sql "select * from \"$PgAcVar(report,tablename)\" limit 1 offset [expr {$PgAcVar(report,prev_num_recs)-1}]"
} else {
set sql "select * from \"$PgAcVar(report,tablename)\" limit 1 offset [expr {(($PgAcVar(report,curr_page)-1)*$PgAcVar(report,prev_recs_page))+($PgAcVar(report,prev_recs_page)-1)}]"
} }
wpg_select $CurrentDB $sql rec {
foreach {field x y objid objtype} $PgAcVar(report,prev_fields) {
if {$y > $PgAcVar(report,y_detail) && $y < $PgAcVar(report,y_pgfoo)} {
set y [expr $y-$PgAcVar(report,y_detail)]
if {$objtype=="t_f"} {
set recfield $rec($field)
} else {
set recfield ""
}
design:previewSection $x $y $objid $objtype $py $recfield
}
}
}
design:changePreviewCoords $py
}
# this postscript stuff needs some work but it sort of works
# since the tk canvas widget produces encapsulated postscript
# we need to wrap it inside of regular postscript
proc {design:printPostscriptStart} {c} {
global PgAcVar
puts $c "%!PS-Adobe-3.0"
puts $c "%%Creator: PgAccess"
puts $c "%%LanguageLevel: 2"
puts $c "%%Title: Report"
puts $c "%%CreationDate: [clock format [clock seconds]]"
puts -nonewline $c "%%Pages: "
puts $c "[expr $PgAcVar(report,last_page)-$PgAcVar(report,curr_page)+1]"
puts $c "%%PageOrder: Ascend"
puts $c "%%BoundingBox: 0 0 $PgAcVar(report,pw) $PgAcVar(report,ph)"
puts $c "%%EndComments"
puts $c "%%BeginProlog"
puts $c "%%EndProlog"
puts $c "%%BeginSetup"
puts $c "%%EndSetup"
puts $c ""
}
proc {design:printPostscriptStop} {c} {
global PgAcVar
puts $c "%%EOF"
}
proc {print} {} { proc {design:printPostscriptStartPage} {c} {
set bb [.pgaw:ReportPreview.fr.c bbox all] global PgAcVar
.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]] puts $c "%%Page: $PgAcVar(report,curr_page) $PgAcVar(report,curr_page)"
tk_messageBox -title Information -parent .pgaw:ReportBuilder -message "The printed image in Postscript is in the file pgaccess-report.ps" puts $c "%%BeginPageSetup"
puts $c "/pagesave save def"
puts $c "%%EndPageSetup"
puts $c "%%BeginDocument"
} }
proc {design:printPostscriptStopPage} {c} {
global PgAcVar
puts $c "%%EndDocument"
puts $c "pagesave restore"
}
proc {save} {} { # prints all pages between and including those in the entry boxes
# opens a stream and just starts feeding it postscript from the canvas
# there must be a cleaner way to do this
proc {design:print} {} {
global PgAcVar
set rpt [parameter "Enter file name or pipe for Postscript output:"]
set fid [::open $rpt w]
design:printPostscriptStart $fid
set start_page $PgAcVar(report,curr_page)
for {} {$PgAcVar(report,curr_page)<=$PgAcVar(report,last_page)} {incr PgAcVar(report,curr_page)} {
design:previewPage
design:printPostscriptStartPage $fid
.pgaw:ReportPreview.fr.c postscript -channel $fid -width $PgAcVar(report,pw) -height $PgAcVar(report,ph) -pagex 0 -pagey 0 -pageanchor sw
design:printPostscriptStopPage $fid
}
design:printPostscriptStop $fid
::close $fid
# reset current page to the page we started printing on
set PgAcVar(report,curr_page) $start_page
design:previewPage
tk_messageBox -title Information -parent .pgaw:ReportBuilder:draft -message "Done printing $rpt"
}
proc {design:save} {} {
global PgAcVar global PgAcVar
set prog "set PgAcVar(report,tablename) \"$PgAcVar(report,tablename)\"" set prog "set PgAcVar(report,tablename) \"$PgAcVar(report,tablename)\""
set prog "$prog ; set PgAcVar(report,rw) $PgAcVar(report,rw)"
set prog "$prog ; set PgAcVar(report,rh) $PgAcVar(report,rh)"
set prog "$prog ; set PgAcVar(report,pw) $PgAcVar(report,pw)"
set prog "$prog ; set PgAcVar(report,ph) $PgAcVar(report,ph)"
foreach region $PgAcVar(report,regions) { foreach region $PgAcVar(report,regions) {
set prog "$prog ; set PgAcVar(report,y_$region) $PgAcVar(report,y_$region)" set prog "$prog ; set PgAcVar(report,y_$region) $PgAcVar(report,y_$region)"
} }
foreach obj [.pgaw:ReportBuilder.c find all] { foreach obj [.pgaw:ReportBuilder:draft.c find all] {
if {[.pgaw:ReportBuilder.c type $obj]=="text"} { if {[.pgaw:ReportBuilder:draft.c type $obj]=="text"} {
set bb [.pgaw:ReportBuilder.c bbox $obj] set bb [.pgaw:ReportBuilder:draft.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]} if {[.pgaw:ReportBuilder:draft.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]}" set prog "$prog ; .pgaw:ReportBuilder:draft.c create text $x [lindex $bb 1] -font [.pgaw:ReportBuilder:draft.c itemcget $obj -font] -anchor [.pgaw:ReportBuilder:draft.c itemcget $obj -anchor] -text {[.pgaw:ReportBuilder:draft.c itemcget $obj -text]} -tags {[.pgaw:ReportBuilder:draft.c itemcget $obj -tags]}"
}
if {[.pgaw:ReportBuilder:draft.c type $obj]=="image"} {
set bb [.pgaw:ReportBuilder:draft.c bbox $obj]
if {[.pgaw:ReportBuilder:draft.c itemcget $obj -anchor]=="nw"} then {set x [expr [lindex $bb 0]+1]} else {set x [expr [lindex $bb 2]-2]}
set prog "$prog ; image create photo [.pgaw:ReportBuilder:draft.c itemcget $obj -image] -file [.pgaw:ReportBuilder:draft.c itemcget $obj -image] ; .pgaw:ReportBuilder:draft.c create image $x [lindex $bb 1] -anchor [.pgaw:ReportBuilder:draft.c itemcget $obj -anchor] -image {[.pgaw:ReportBuilder:draft.c itemcget $obj -image]} -tags {[.pgaw:ReportBuilder:draft.c itemcget $obj -tags]}"
} }
} }
sql_exec noquiet "delete from pga_reports where reportname='$PgAcVar(report,reportname)'" sql_exec noquiet "delete from pga_reports where reportname='$PgAcVar(report,reportname)'"
...@@ -214,38 +436,56 @@ sql_exec noquiet "insert into pga_reports (reportname,reportsource,reportbody) v ...@@ -214,38 +436,56 @@ sql_exec noquiet "insert into pga_reports (reportname,reportsource,reportbody) v
} }
proc {addField} {} { proc {design:addField} {} {
global PgAcVar global PgAcVar
set fldname [.pgaw:ReportBuilder.lb get [.pgaw:ReportBuilder.lb curselection]] set fldname [.pgaw:ReportBuilder:menu.lb get [.pgaw:ReportBuilder:menu.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)] set newid [.pgaw:ReportBuilder:draft.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) .pgaw:ReportBuilder:draft.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] set bb [.pgaw:ReportBuilder:draft.c bbox $newid]
incr PgAcVar(report,xf_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]] incr PgAcVar(report,xf_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
} }
proc {addLabel} {} { proc {design:addLabel} {} {
global PgAcVar global PgAcVar
set fldname $PgAcVar(report,labeltext) 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 newid [.pgaw:ReportBuilder:draft.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] set bb [.pgaw:ReportBuilder:draft.c bbox $newid]
incr PgAcVar(report,xl_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]] incr PgAcVar(report,xl_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
} }
# pictures are from files and not the database, maybe this should be different
proc {design:addPicture} {} {
global PgAcVar
set fldname $PgAcVar(report,picture)
set newid [.pgaw:ReportBuilder:draft.c create image $PgAcVar(report,xp_auto) [expr $PgAcVar(report,y_rpthdr)+5] -image [image create photo $fldname -file $fldname] -tags [subst {t_p mov ro}] -anchor nw]
set bb [.pgaw:ReportBuilder:draft.c bbox $newid]
incr PgAcVar(report,xp_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
}
proc {setObjectFont} {} { # formulas are tcl snippets right now, but should allow scripts in the future
proc {design:addFormula} {} {
global PgAcVar global PgAcVar
.pgaw:ReportBuilder.c itemconfigure hili -font -Adobe-[.pgaw:ReportBuilder.bfont cget -text]-[getBoldStatus]-[getItalicStatus]-Normal--*-$PgAcVar(report,pointsize)-*-*-*-*-*-* set fldname $PgAcVar(report,formula)
set newid [.pgaw:ReportBuilder:draft.c create text $PgAcVar(report,xo_auto) [expr $PgAcVar(report,y_rpthdr)+5] -text $fldname -tags [subst {t_o mov ro}] -anchor nw -font $PgAcVar(pref,font_normal)]
set bb [.pgaw:ReportBuilder:draft.c bbox $newid]
incr PgAcVar(report,xo_auto) [expr 5+[lindex $bb 2]-[lindex $bb 0]]
} }
proc {deleteObject} {} { proc {design:setObjectFont} {} {
if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:ReportBuilder -message "Delete current report object?" -type yesno -default no]=="no"} return; global PgAcVar
.pgaw:ReportBuilder.c delete hili .pgaw:ReportBuilder:draft.c itemconfigure hili -font -Adobe-[.pgaw:ReportBuilder:menu.bfont cget -text]-[design:getBoldStatus]-[design:getItalicStatus]-Normal--*-$PgAcVar(report,pointsize)-*-*-*-*-*-*
} }
proc {dragMove} {w x y} { proc {design:deleteObject} {} {
if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:ReportBuilder:draft -message "Delete current report object?" -type yesno -default no]=="no"} return;
.pgaw:ReportBuilder:draft.c delete hili
}
proc {design:dragMove} {w x y} {
global PgAcVar global PgAcVar
# Showing current region # Showing current region
foreach rg $PgAcVar(report,regions) { foreach rg $PgAcVar(report,regions) {
...@@ -268,54 +508,68 @@ global PgAcVar ...@@ -268,54 +508,68 @@ global PgAcVar
} }
proc {dragStart} {w x y} { proc {design:dragStart} {w x y} {
global PgAcVar global PgAcVar
focus .pgaw:ReportBuilder.c focus .pgaw:ReportBuilder:draft.c
catch {unset draginfo} catch {unset draginfo}
set obj {} set obj {}
# Only movable objects start dragging # Only movable objects start dragging
foreach id [$w find overlapping $x $y $x $y] { foreach id [$w find overlapping $x $y $x $y] {
if {[hasTag $id mov]} { if {[design:hasTag $id mov]} {
set obj $id set obj $id
break break
} }
} }
if {$obj==""} return; # mouse resize does update after a click
if {$obj==""} {
.pgaw:ReportBuilder:draft configure -cursor watch
set c [split [winfo geometry .pgaw:ReportBuilder:draft] x+]
set PgAcVar(report,rw) [lindex $c 0]
set PgAcVar(report,rh) [lindex $c 1]
Reports::design:changeDraftCoords
return
}
set PgAcVar(draginfo,obj) $obj set PgAcVar(draginfo,obj) $obj
set taglist [.pgaw:ReportBuilder.c itemcget $obj -tags] set taglist [.pgaw:ReportBuilder:draft.c itemcget $obj -tags]
set i [lsearch -glob $taglist bg_*] set i [lsearch -glob $taglist bg_*]
if {$i==-1} { if {$i==-1} {
set PgAcVar(draginfo,region) {} set PgAcVar(draginfo,region) {}
} else { } else {
set PgAcVar(draginfo,region) [string range [lindex $taglist $i] 3 64] set PgAcVar(draginfo,region) [string range [lindex $taglist $i] 3 64]
} }
.pgaw:ReportBuilder configure -cursor hand1 .pgaw:ReportBuilder:draft configure -cursor hand1
.pgaw:ReportBuilder.c itemconfigure [.pgaw:ReportBuilder.c find withtag hili] -fill black # dont highlight pictures when moving them, it just wont work
.pgaw:ReportBuilder.c dtag [.pgaw:ReportBuilder.c find withtag hili] hili if {![design:hasTag [.pgaw:ReportBuilder:draft.c find withtag hili] t_p]} {
.pgaw:ReportBuilder.c addtag hili withtag $PgAcVar(draginfo,obj) .pgaw:ReportBuilder:draft.c itemconfigure [.pgaw:ReportBuilder:draft.c find withtag hili] -fill black
.pgaw:ReportBuilder.c itemconfigure hili -fill blue }
.pgaw:ReportBuilder:draft.c dtag [.pgaw:ReportBuilder:draft.c find withtag hili] hili
.pgaw:ReportBuilder:draft.c addtag hili withtag $PgAcVar(draginfo,obj)
if {![design:hasTag $obj t_p]} {
.pgaw:ReportBuilder:draft.c itemconfigure hili -fill blue
}
set PgAcVar(draginfo,x) $x set PgAcVar(draginfo,x) $x
set PgAcVar(draginfo,y) $y set PgAcVar(draginfo,y) $y
set PgAcVar(draginfo,sx) $x set PgAcVar(draginfo,sx) $x
set PgAcVar(draginfo,sy) $y set PgAcVar(draginfo,sy) $y
# Setting font information # Setting font information
if {[.pgaw:ReportBuilder.c type hili]=="text"} { if {[.pgaw:ReportBuilder:draft.c type hili]=="text"} {
set fnta [split [.pgaw:ReportBuilder.c itemcget hili -font] -] set fnta [split [.pgaw:ReportBuilder:draft.c itemcget hili -font] -]
.pgaw:ReportBuilder.bfont configure -text [lindex $fnta 2] .pgaw:ReportBuilder:menu.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 3]=="Medium"} then {.pgaw:ReportBuilder:menu.lbold configure -relief raised} else {.pgaw:ReportBuilder:menu.lbold configure -relief sunken}
if {[lindex $fnta 4]=="R"} then {.pgaw:ReportBuilder.lita configure -relief raised} else {.pgaw:ReportBuilder.lita configure -relief sunken} if {[lindex $fnta 4]=="R"} then {.pgaw:ReportBuilder:menu.lita configure -relief raised} else {.pgaw:ReportBuilder:menu.lita configure -relief sunken}
set PgAcVar(report,pointsize) [lindex $fnta 8] set PgAcVar(report,pointsize) [lindex $fnta 8]
if {[hasTag $obj t_f]} {set PgAcVar(report,info) "Database field"} if {[design:hasTag $obj t_f]} {set PgAcVar(report,info) "Database field"}
if {[hasTag $obj t_l]} {set PgAcVar(report,info) "Label"} if {[design: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} if {[design:hasTag $obj t_o]} {set PgAcVar(report,info) "Formula"}
if {[.pgaw:ReportBuilder:draft.c itemcget $obj -anchor]=="nw"} then {.pgaw:ReportBuilder:menu.balign configure -text left} else {.pgaw:ReportBuilder:menu.balign configure -text right}
} }
} }
proc {dragStop} {x y} { proc {design:dragStop} {x y} {
global PgAcVar global PgAcVar
# when click Close, ql window is destroyed but event ButtonRelease-1 is fired # when click Close, ql window is destroyed but event ButtonRelease-1 is fired
if {![winfo exists .pgaw:ReportBuilder]} return; if {![winfo exists .pgaw:ReportBuilder:draft]} return;
.pgaw:ReportBuilder configure -cursor left_ptr .pgaw:ReportBuilder:draft configure -cursor left_ptr
set este {} set este {}
catch {set este $PgAcVar(draginfo,obj)} catch {set este $PgAcVar(draginfo,obj)}
if {$este==""} return if {$este==""} return
...@@ -323,20 +577,20 @@ if {$este==""} return ...@@ -323,20 +577,20 @@ if {$este==""} return
if {$PgAcVar(draginfo,region)!=""} { if {$PgAcVar(draginfo,region)!=""} {
set dy 0 set dy 0
foreach rg $PgAcVar(report,regions) { foreach rg $PgAcVar(report,regions) {
.pgaw:ReportBuilder.c move rg_$rg 0 $dy .pgaw:ReportBuilder:draft.c move rg_$rg 0 $dy
if {$rg==$PgAcVar(draginfo,region)} { if {$rg==$PgAcVar(draginfo,region)} {
set dy [expr $y-$PgAcVar(report,y_$PgAcVar(draginfo,region))] set dy [expr $y-$PgAcVar(report,y_$PgAcVar(draginfo,region))]
} }
incr PgAcVar(report,y_$rg) $dy incr PgAcVar(report,y_$rg) $dy
} }
# .pgaw:ReportBuilder.c move det 0 [expr $y-$PgAcVar(report,y_$PgAcVar(draginfo,region))] # .pgaw:ReportBuilder:menu.c move det 0 [expr $y-$PgAcVar(report,y_$PgAcVar(draginfo,region))]
set PgAcVar(report,y_$PgAcVar(draginfo,region)) $y set PgAcVar(report,y_$PgAcVar(draginfo,region)) $y
drawReportAreas design:drawReportAreas
} else { } else {
# Check if object beeing dragged is inside the canvas # Check if object beeing dragged is inside the canvas
set bb [.pgaw:ReportBuilder.c bbox $PgAcVar(draginfo,obj)] set bb [.pgaw:ReportBuilder:draft.c bbox $PgAcVar(draginfo,obj)]
if {[lindex $bb 0] < 5} { if {[lindex $bb 0] < 5} {
.pgaw:ReportBuilder.c move $PgAcVar(draginfo,obj) [expr 5-[lindex $bb 0]] 0 .pgaw:ReportBuilder:draft.c move $PgAcVar(draginfo,obj) [expr 5-[lindex $bb 0]] 0
} }
} }
set PgAcVar(draginfo,obj) {} set PgAcVar(draginfo,obj) {}
...@@ -344,73 +598,143 @@ PgAcVar:clean draginfo,* ...@@ -344,73 +598,143 @@ PgAcVar:clean draginfo,*
} }
proc {deleteAllObjects} {} { proc {design: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 { if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:ReportBuilder:draft -message [intlmsg "All report information will be deleted.\n\nProceed ?"] -type yesno -default no]=="yes"} then {
.pgaw:ReportBuilder.c delete all .pgaw:ReportBuilder:draft.c delete all
init design:init
drawReportAreas design:drawReportAreas
} }
} }
proc {design:changeDraftCoords} {} {
global PgAcVar
wm geometry .pgaw:ReportBuilder:draft $PgAcVar(report,rw)x$PgAcVar(report,rh)
place .pgaw:ReportBuilder:draft.c -x 0 -y 0 -width $PgAcVar(report,rw) -height $PgAcVar(report,rh) -anchor nw -bordermode ignore
} }
################################################################ proc {design:changePreviewCoords} {scroller} {
global PgAcVar
wm geometry .pgaw:ReportPreview $PgAcVar(report,rw)x$PgAcVar(report,rh)
place .pgaw:ReportPreview.fr.c -x 0 -y 0 -width $PgAcVar(report,rw) -height $PgAcVar(report,rh) -anchor nw -bordermode ignore
}
}
proc vTclWindow.pgaw:ReportBuilder {base} { ################################################################
# handmade but call it vTcl for continuity, someday use visualtcl again
proc vTclWindow.pgaw:ReportBuilder:draft {base} {
global PgAcVar global PgAcVar
if {$base == ""} { if {$base == ""} {
set base .pgaw:ReportBuilder set base .pgaw:ReportBuilder:draft
} }
if {[winfo exists $base]} { if {[winfo exists $base]} {
wm deiconify $base; return wm deiconify $base; return
} }
toplevel $base -class Toplevel toplevel $base -class Toplevel
wm focusmodel $base passive wm focusmodel $base passive
wm geometry $base 652x426+96+120 wm geometry $base 508x345+406+120
wm maxsize $base 1280 1024 wm maxsize $base 1280 1024
wm minsize $base 1 1 wm minsize $base 1 1
wm overrideredirect $base 0 wm overrideredirect $base 0
wm resizable $base 0 0 wm resizable $base 1 1
wm deiconify $base wm deiconify $base
wm title $base [intlmsg "Report builder"] wm title $base [intlmsg "Report draft"]
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 \ canvas $base.c \
-background #fffeff -borderwidth 2 -height 207 -highlightthickness 0 \ -background #fffeff -borderwidth 2 -height 207 -highlightthickness 0 \
-relief ridge -takefocus 1 -width 295 -relief ridge -takefocus 1 -width 295
place $base.c \
-x 0 -y 0 -width 508 -height 345 -anchor nw -bordermode ignore
bind $base.c <Button-1> { bind $base.c <Button-1> {
Reports::dragStart %W %x %y Reports::design:dragStart %W %x %y
} }
bind $base.c <ButtonRelease-1> { bind $base.c <ButtonRelease-1> {
Reports::dragStop %x %y Reports::design:dragStop %x %y
} }
bind $base.c <Key-Delete> { bind $base.c <Key-Delete> {
Reports::deleteObject Reports::design:deleteObject
} }
bind $base.c <Motion> { bind $base.c <Motion> {
Reports::dragMove %W %x %y Reports::design:dragMove %W %x %y
}
}
proc vTclWindow.pgaw:ReportBuilder:menu {base} {
global PgAcVar
if {$base == ""} {
set base .pgaw:ReportBuilder:menu
}
if {[winfo exists $base]} {
wm deiconify $base; return
}
toplevel $base -class Toplevel
wm focusmodel $base passive
wm geometry $base 307x426+96+120
wm maxsize $base 1280 1024
wm minsize $base 1 1
wm overrideredirect $base 0
wm resizable $base 0 0
wm deiconify $base
wm title $base [intlmsg "Report menu"]
# report size
label $base.lrsize \
-borderwidth 0 \
-text [intlmsg {Report size}]
entry $base.erw \
-background #fefefe -highlightthickness 0 -relief groove \
-textvariable PgAcVar(report,rw)
label $base.lrwbyh \
-borderwidth 0 \
-text x
entry $base.erh \
-background #fefefe -highlightthickness 0 -relief groove \
-textvariable PgAcVar(report,rh)
bind $base.erw <Key-Return> {
Reports::design:changeDraftCoords
}
bind $base.erh <Key-Return> {
Reports::design:changeDraftCoords
}
# page size
label $base.lpsize \
-borderwidth 0 \
-text [intlmsg {Page size}]
entry $base.epw \
-background #fefefe -highlightthickness 0 -relief groove \
-textvariable PgAcVar(report,pw)
label $base.lpwbyh \
-borderwidth 0 \
-text x
entry $base.eph \
-background #fefefe -highlightthickness 0 -relief groove \
-textvariable PgAcVar(report,ph)
label $base.l1 \
-borderwidth 1 \
-relief raised -text [intlmsg {Report fields}]
scrollbar $base.sb \
-borderwidth 1 -command {.pgaw:ReportBuilder:menu.lb yview} -orient vert
listbox $base.lb \
-background #fefefe -foreground #000000 -borderwidth 1 \
-selectbackground #c3c3c3 \
-highlightthickness 1 -selectborderwidth 0 \
-yscrollcommand {.pgaw:ReportBuilder:menu.sb set}
bind $base.lb <ButtonRelease-1> {
Reports::design:addField
} }
button $base.bt2 \ button $base.bt2 \
-command Reports::deleteAllObjects \ -command Reports::design:deleteAllObjects \
-text [intlmsg {Delete all}] -text [intlmsg {Delete all}]
button $base.bt4 \ button $base.bt4 \
-command Reports::preview \ -command Reports::design:preview \
-text [intlmsg Preview] -text [intlmsg Preview]
button $base.bt5 \ button $base.bt5 \
-borderwidth 1 -command {Window destroy .pgaw:ReportBuilder} \ -borderwidth 1 \
-command Reports::design:close \
-text [intlmsg Close] -text [intlmsg Close]
scrollbar $base.sb \
-borderwidth 1 -command {.pgaw:ReportBuilder.lb yview} -orient vert
label $base.lmsg \ label $base.lmsg \
-anchor w \ -anchor w \
-relief groove -text [intlmsg {Report header}] -textvariable PgAcVar(report,msg) -relief groove -text [intlmsg {Report header}] -textvariable PgAcVar(report,msg)
...@@ -418,31 +742,31 @@ global PgAcVar ...@@ -418,31 +742,31 @@ global PgAcVar
-background #fefefe -borderwidth 1 -highlightthickness 0 \ -background #fefefe -borderwidth 1 -highlightthickness 0 \
-textvariable PgAcVar(report,tablename) -textvariable PgAcVar(report,tablename)
bind $base.e2 <Key-Return> { bind $base.e2 <Key-Return> {
Reports::getSourceFields Reports::design:getSourceFields
} }
entry $base.elab \ entry $base.elab \
-background #fefefe -borderwidth 1 -highlightthickness 0 \ -background #fefefe -borderwidth 1 -highlightthickness 0 \
-textvariable PgAcVar(report,labeltext) -textvariable PgAcVar(report,labeltext)
button $base.badl \ button $base.badl \
-borderwidth 1 -command Reports::addLabel \ -borderwidth 1 -command Reports::design:addLabel \
-text [intlmsg {Add label}] -text [intlmsg {Add label}]
label $base.lbold \ label $base.lbold \
-borderwidth 1 -relief raised -text B -borderwidth 1 -relief raised -text B
bind $base.lbold <Button-1> { bind $base.lbold <Button-1> {
Reports::toggleBold Reports::design:toggleBold
} }
label $base.lita \ label $base.lita \
-borderwidth 1 \ -borderwidth 1 \
-font $PgAcVar(pref,font_italic) \ -font $PgAcVar(pref,font_italic) \
-relief raised -text i -relief raised -text i
bind $base.lita <Button-1> { bind $base.lita <Button-1> {
Reports::toggleItalic Reports::design:toggleItalic
} }
entry $base.eps \ entry $base.eps \
-background #fefefe -highlightthickness 0 -relief groove \ -background #fefefe -highlightthickness 0 -relief groove \
-textvariable PgAcVar(report,pointsize) -textvariable PgAcVar(report,pointsize)
bind $base.eps <Key-Return> { bind $base.eps <Key-Return> {
Reports::setObjectFont Reports::design:setObjectFont
} }
label $base.linfo \ label $base.linfo \
-anchor w \ -anchor w \
...@@ -450,30 +774,30 @@ global PgAcVar ...@@ -450,30 +774,30 @@ global PgAcVar
label $base.llal \ label $base.llal \
-borderwidth 0 -text Align -borderwidth 0 -text Align
button $base.balign \ button $base.balign \
-borderwidth 0 -command Reports::toggleAlignMode \ -borderwidth 0 -command Reports::design:toggleAlignMode \
-relief groove -text right -relief groove -text right
button $base.savebtn \ button $base.savebtn \
-borderwidth 1 -command Reports::save \ -borderwidth 1 -command Reports::design:save \
-text [intlmsg Save] -text [intlmsg Save]
label $base.lfn \ label $base.lfn \
-borderwidth 0 -text Font -borderwidth 0 -text Font
button $base.bfont \ button $base.bfont \
-borderwidth 0 \ -borderwidth 0 \
-command Reports::setFont \ -command Reports::design:setFont \
-relief groove -text Courier -relief groove -text Courier
button $base.bdd \ button $base.bdd \
-borderwidth 1 \ -borderwidth 1 \
-command {if {[winfo exists .pgaw:ReportBuilder.ddf]} { -command {if {[winfo exists .pgaw:ReportBuilder:menu.ddf]} {
destroy .pgaw:ReportBuilder.ddf destroy .pgaw:ReportBuilder:menu.ddf
} else { } else {
create_drop_down .pgaw:ReportBuilder 405 22 200 create_drop_down .pgaw:ReportBuilder:menu 100 45 200
focus .pgaw:ReportBuilder.ddf.sb focus .pgaw:ReportBuilder:menu.ddf.sb
foreach tbl [Database::getTablesList] {.pgaw:ReportBuilder.ddf.lb insert end $tbl} foreach tbl [Database::getTablesList] {.pgaw:ReportBuilder:menu.ddf.lb insert end $tbl}
bind .pgaw:ReportBuilder.ddf.lb <ButtonRelease-1> { bind .pgaw:ReportBuilder:menu.ddf.lb <ButtonRelease-1> {
set i [.pgaw:ReportBuilder.ddf.lb curselection] set i [.pgaw:ReportBuilder:menu.ddf.lb curselection]
if {$i!=""} {set PgAcVar(report,tablename) [.pgaw:ReportBuilder.ddf.lb get $i]} if {$i!=""} {set PgAcVar(report,tablename) [.pgaw:ReportBuilder:menu.ddf.lb get $i]}
destroy .pgaw:ReportBuilder.ddf destroy .pgaw:ReportBuilder:menu.ddf
Reports::getSourceFields Reports::design:getSourceFields
break break
} }
}} \ }} \
...@@ -494,14 +818,37 @@ global PgAcVar ...@@ -494,14 +818,37 @@ global PgAcVar
-background #fefefe -borderwidth 1 -highlightthickness 0 \ -background #fefefe -borderwidth 1 -highlightthickness 0 \
-textvariable PgAcVar(report,formula) -textvariable PgAcVar(report,formula)
button $base.baf \ button $base.baf \
-borderwidth 1 \ -borderwidth 1 -command Reports::design:addFormula \
-text [intlmsg {Add formula}] -text [intlmsg {Add formula}]
entry $base.ep \
-background #fefefe -borderwidth 1 -highlightthickness 0 \
-textvariable PgAcVar(report,picture)
button $base.bap \
-borderwidth 1 -command Reports::design:addPicture \
-text [intlmsg {Add picture}]
place $base.lrsize \
-x 142 -y 58 -anchor nw -bordermode ignore
place $base.erw \
-x 142 -y 75 -width 35 -height 18 -anchor nw -bordermode ignore
place $base.lrwbyh \
-x 177 -y 75 -anchor nw -bordermode ignore
place $base.erh \
-x 186 -y 75 -width 35 -height 18 -anchor nw -bordermode ignore
place $base.lpsize \
-x 225 -y 58 -anchor nw -bordermode ignore
place $base.epw \
-x 225 -y 75 -width 35 -height 18 -anchor nw -bordermode ignore
place $base.lpwbyh \
-x 260 -y 75 -anchor nw -bordermode ignore
place $base.eph \
-x 269 -y 75 -width 35 -height 18 -anchor nw -bordermode ignore
place $base.l1 \ place $base.l1 \
-x 5 -y 55 -width 131 -height 18 -anchor nw -bordermode ignore -x 5 -y 55 -width 131 -height 18 -anchor nw -bordermode ignore
place $base.lb \ place $base.lb \
-x 5 -y 70 -width 118 -height 121 -anchor nw -bordermode ignore -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 \ place $base.bt2 \
-x 5 -y 365 -width 64 -height 26 -anchor nw -bordermode ignore -x 5 -y 365 -width 64 -height 26 -anchor nw -bordermode ignore
place $base.bt4 \ place $base.bt4 \
...@@ -511,48 +858,51 @@ global PgAcVar ...@@ -511,48 +858,51 @@ global PgAcVar
place $base.sb \ place $base.sb \
-x 120 -y 70 -width 18 -height 122 -anchor nw -bordermode ignore -x 120 -y 70 -width 18 -height 122 -anchor nw -bordermode ignore
place $base.lmsg \ place $base.lmsg \
-x 142 -y 55 -width 151 -height 18 -anchor nw -bordermode ignore -x 142 -y 95 -width 151 -height 18 -anchor nw -bordermode ignore
place $base.e2 \ place $base.e2 \
-x 405 -y 4 -width 129 -height 18 -anchor nw -bordermode ignore -x 120 -y 25 -width 159 -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 \ place $base.lbold \
-x 535 -y 55 -width 18 -height 18 -anchor nw -bordermode ignore -x 252 -y 165 -width 18 -height 18 -anchor nw -bordermode ignore
place $base.lita \ place $base.lita \
-x 555 -y 55 -width 18 -height 18 -anchor nw -bordermode ignore -x 272 -y 165 -width 18 -height 18 -anchor nw -bordermode ignore
place $base.eps \ place $base.eps \
-x 500 -y 55 -width 30 -height 18 -anchor nw -bordermode ignore -x 252 -y 140 -width 40 -height 18 -anchor nw -bordermode ignore
place $base.linfo \ place $base.linfo \
-x 295 -y 55 -width 91 -height 18 -anchor nw -bordermode ignore -x 142 -y 115 -width 151 -height 18 -anchor nw -bordermode ignore
place $base.llal \ place $base.llal \
-x 575 -y 56 -anchor nw -bordermode ignore -x 142 -y 165 -anchor nw -bordermode ignore
place $base.balign \ place $base.balign \
-x 610 -y 54 -width 35 -height 21 -anchor nw -bordermode ignore -x 182 -y 165 -width 35 -height 21 -anchor nw -bordermode ignore
place $base.savebtn \ place $base.savebtn \
-x 5 -y 395 -width 64 -height 26 -anchor nw -bordermode ignore -x 5 -y 395 -width 64 -height 26 -anchor nw -bordermode ignore
place $base.lfn \ place $base.lfn \
-x 405 -y 56 -anchor nw -bordermode ignore -x 142 -y 140 -anchor nw -bordermode ignore
place $base.bfont \ place $base.bfont \
-x 435 -y 54 -width 65 -height 21 -anchor nw -bordermode ignore -x 182 -y 140 -width 65 -height 21 -anchor nw -bordermode ignore
place $base.bdd \ place $base.bdd \
-x 535 -y 4 -width 15 -height 20 -anchor nw -bordermode ignore -x 280 -y 25 -width 15 -height 20 -anchor nw -bordermode ignore
place $base.lrn \ place $base.lrn \
-x 5 -y 5 -anchor nw -bordermode ignore -x 5 -y 5 -anchor nw -bordermode ignore
place $base.ern \ place $base.ern \
-x 80 -y 4 -width 219 -height 18 -anchor nw -bordermode ignore -x 80 -y 4 -width 219 -height 18 -anchor nw -bordermode ignore
place $base.lrs \ place $base.lrs \
-x 320 -y 5 -anchor nw -bordermode ignore -x 5 -y 25 -anchor nw -bordermode ignore
place $base.ls \ place $base.elab \
-x 5 -y 30 -width 641 -height 2 -anchor nw -bordermode ignore -x 5 -y 200 -width 297 -height 18 -anchor nw -bordermode ignore
place $base.badl \
-x 5 -y 218 -width 132 -height 26 -anchor nw -bordermode ignore
place $base.ef \ place $base.ef \
-x 5 -y 280 -width 130 -height 18 -anchor nw -bordermode ignore -x 5 -y 255 -width 297 -height 18 -anchor nw -bordermode ignore
place $base.baf \ place $base.baf \
-x 5 -y 298 -width 132 -height 26 -anchor nw -bordermode ignore -x 5 -y 273 -width 132 -height 26 -anchor nw -bordermode ignore
place $base.ep \
-x 5 -y 310 -width 297 -height 18 -anchor nw -bordermode ignore
place $base.bap \
-x 5 -y 328 -width 132 -height 26 -anchor nw -bordermode ignore
} }
proc vTclWindow.pgaw:ReportPreview {base} { proc vTclWindow.pgaw:ReportPreview {base} {
global PgAcVar
if {$base == ""} { if {$base == ""} {
set base .pgaw:ReportPreview set base .pgaw:ReportPreview
} }
...@@ -576,24 +926,66 @@ proc vTclWindow.pgaw:ReportPreview {base} { ...@@ -576,24 +926,66 @@ proc vTclWindow.pgaw:ReportPreview {base} {
scrollbar $base.fr.sb \ scrollbar $base.fr.sb \
-borderwidth 1 -command {.pgaw:ReportPreview.fr.c yview} -highlightthickness 0 \ -borderwidth 1 -command {.pgaw:ReportPreview.fr.c yview} -highlightthickness 0 \
-orient vert -width 12 -orient vert -width 12
frame $base.f1 \ frame $base.fp \
-borderwidth 2 -height 75 -width 125 -borderwidth 2 -height 75 -width 125
button $base.f1.button18 \ button $base.fp.bclose \
-borderwidth 1 -command {if {$PgAcVar(report,justpreview)} then {Window destroy .pgaw:ReportBuilder} ; Window destroy .pgaw:ReportPreview} \ -borderwidth 1 -command {if {$PgAcVar(report,justpreview)} then {Window destroy .pgaw:ReportBuilder:draft} ; Window destroy .pgaw:ReportPreview} \
-text [intlmsg Close] -text [intlmsg Close]
button $base.f1.button17 \ button $base.fp.bprint \
-borderwidth 1 -command Reports::print \ -borderwidth 1 -command Reports::design:print \
-text Print -text Print
label $base.fp.ltexttotal -text "pages "
label $base.fp.ltotal -textvariable PgAcVar(report,total_page)
button $base.fp.bprev -text <
bind $base.fp.bprev <Button-1> {
if {$PgAcVar(report,curr_page)>1} {
set PgAcVar(report,curr_page) [expr $PgAcVar(report,curr_page)-1]
}
Reports::design:previewPage
}
button $base.fp.bnext -text >
bind $base.fp.bnext <Button-1> {
if {$PgAcVar(report,curr_page)<$PgAcVar(report,last_page)} {
set PgAcVar(report,curr_page) [expr $PgAcVar(report,curr_page)+1]
}
Reports::design:previewPage
}
entry $base.fp.estart -width 5 -textvariable PgAcVar(report,curr_page)
bind $base.fp.estart <Key-Return> {
Reports::design:previewPage
}
label $base.fp.lthru -text -
entry $base.fp.estop -width 5 -textvariable PgAcVar(report,last_page)
bind $base.fp.estop <Key-Return> {
Reports::design:previewPage
}
pack $base.fr \ pack $base.fr \
-in .pgaw:ReportPreview -anchor center -expand 1 -fill both -side top -in .pgaw:ReportPreview -anchor center -expand 1 -fill both -side top
pack $base.fr.c \ pack $base.fr.c \
-in .pgaw:ReportPreview.fr -anchor center -expand 1 -fill both -side left -in .pgaw:ReportPreview.fr -anchor center -expand 1 -fill both -side left
pack $base.fr.sb \ pack $base.fr.sb \
-in .pgaw:ReportPreview.fr -anchor center -expand 0 -fill y -side right -in .pgaw:ReportPreview.fr -anchor center -expand 0 -fill y -side right
pack $base.f1 \ pack $base.fp \
-in .pgaw:ReportPreview -anchor center -expand 0 -fill none -side top -in .pgaw:ReportPreview -anchor center -expand 0 -fill none -side bottom
pack $base.f1.button18 \
-in .pgaw:ReportPreview.f1 -anchor center -expand 0 -fill none -side right pack $base.fp.ltotal \
pack $base.f1.button17 \ -in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
-in .pgaw:ReportPreview.f1 -anchor center -expand 0 -fill none -side left pack $base.fp.ltexttotal \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.bprev \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.bnext \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.estart \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.lthru \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.estop \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.bprint \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
pack $base.fp.bclose \
-in .pgaw:ReportPreview.fp -expand 0 -fill none -side left
} }
namespace eval Schema { namespace eval Schema {
proc {clm_rename} {{tbl_name} {old_name} {new_name}} {
global PgAcVar CurrentDB
catch {
wpg_select $CurrentDB "select schemaname from pga_schema where (schematables like '%$tbl_name %') order by schemaname" rec {
set Names $rec(schemaname)
do_clm_rename $tbl_name $old_name $new_name $Names
}
}
}
proc {do_clm_rename} {{tbl_name} {old_name} {new_name} {schema}} {
global PgAcVar CurrentDB
init
set PgAcVar(schema,name) $schema
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 links [lindex $tuple 1]
pg_result $pgres -clear
set linkslist {}
set PgAcVar(schema,links) $links
foreach link $PgAcVar(schema,links) {
set linklist { }
foreach {tbl fld} $link {
if {$tbl==$tbl_name} {
if {$fld==$old_name} { set fld $new_name}
}
lappend linklist $tbl $fld
}
lappend linkslist $linklist
}
sql_exec noquiet "update pga_schema set schemalinks='$linkslist' where schemaname='$schema'"
}
proc {tbl_rename} {{old_name} {new_name}} {
global PgAcVar CurrentDB
catch {
wpg_select $CurrentDB "select schemaname from pga_schema where (schematables like '$old_name %') or (schematables like '% $old_name %') order by schemaname" rec {
set Names $rec(schemaname)
do_tbl_rename $old_name $new_name $Names
}
}
}
proc {do_tbl_rename} {{old_name} {new_name} {schema}} {
global PgAcVar CurrentDB
init
set PgAcVar(schema,name) $schema
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]
pg_result $pgres -clear
set tablelist {}
foreach {t x y} $tables {
if {$t==$old_name} { set t $new_name}
lappend tablelist $t $x $y
}
set linkslist {}
set PgAcVar(schema,links) $links
foreach link $PgAcVar(schema,links) {
set linklist { }
foreach {tbl fld} $link {
if {$tbl==$old_name} { set tbl $new_name}
lappend linklist $tbl $fld
}
lappend linkslist $linklist
}
sql_exec noquiet "update pga_schema set schematables='$tablelist', schemalinks='$linkslist' where schemaname='$schema'"
}
proc {new} {} { proc {new} {} {
global PgAcVar global PgAcVar
...@@ -39,8 +125,10 @@ global PgAcVar CurrentDB ...@@ -39,8 +125,10 @@ global PgAcVar CurrentDB
} }
set PgAcVar(schema,links) $links set PgAcVar(schema,links) $links
drawLinks drawLinks
drawCoord
#### This makes new page size
foreach {ulx uly lrx lry} [.pgaw:Schema.c bbox all] { foreach {ulx uly lrx lry} [.pgaw:Schema.c bbox all] {
wm geometry .pgaw:Schema [expr $lrx+30]x[expr $lry+30] # wm geometry .pgaw:Schema [expr $lrx+30]x[expr $lry+30]
} }
} }
...@@ -89,6 +177,7 @@ if {$PgAcVar(schema,ntables)==1} { ...@@ -89,6 +177,7 @@ if {$PgAcVar(schema,ntables)==1} {
} else { } else {
drawTable [expr $PgAcVar(schema,ntables)-1] 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])
lappend PgAcVar(schema,tables) $PgAcVar(schema,newtablename) $PgAcVar(schema,tablex[expr $PgAcVar(schema,ntables)-1]) $PgAcVar(schema,tabley[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) {} set PgAcVar(schema,newtablename) {}
focus .pgaw:Schema.f.e focus .pgaw:Schema.f.e
...@@ -116,8 +205,11 @@ proc {drawTable} {it} { ...@@ -116,8 +205,11 @@ proc {drawTable} {it} {
global PgAcVar global PgAcVar
if {$PgAcVar(schema,tablex$it)==0} { if {$PgAcVar(schema,tablex$it)==0} {
set posy $PgAcVar(schema,nexty) set posx 380
set posx $PgAcVar(schema,nextx) set posy 265
# set posy $PgAcVar(schema,nexty)
# set posx $PgAcVar(schema,nextx)
set PgAcVar(schema,tablex$it) $posx set PgAcVar(schema,tablex$it) $posx
set PgAcVar(schema,tabley$it) $posy set PgAcVar(schema,tabley$it) $posy
} else { } else {
...@@ -149,7 +241,11 @@ if {$nextx > [winfo width .pgaw:Schema.c] } { ...@@ -149,7 +241,11 @@ if {$nextx > [winfo width .pgaw:Schema.c] } {
} }
set PgAcVar(schema,nextx) $nextx set PgAcVar(schema,nextx) $nextx
set PgAcVar(schema,nexty) $nexty set PgAcVar(schema,nexty) $nexty
}
proc {drawCoord} {} {
global PgAcVar
.pgaw:Schema.c create line 365 265 395 265 -fill "#ff0000" -width "1.0" -tags .pgaw:Schema.c
.pgaw:Schema.c create line 380 250 380 280 -fill "#ff0000" -width "1.0" -tags .pgaw:Schema.c
} }
proc {deleteObject} {} { proc {deleteObject} {} {
...@@ -207,6 +303,7 @@ global PgAcVar ...@@ -207,6 +303,7 @@ global PgAcVar
} else { } else {
$w move $PgAcVar(draginfo,obj) $dx $dy $w move $PgAcVar(draginfo,obj) $dx $dy
} }
# showError [intlmsg "$dx\n$dy"]
set PgAcVar(draginfo,x) $x set PgAcVar(draginfo,x) $x
set PgAcVar(draginfo,y) $y set PgAcVar(draginfo,y) $y
} }
...@@ -268,8 +365,11 @@ set PgAcVar(schema,panstarted) 0 ...@@ -268,8 +365,11 @@ set PgAcVar(schema,panstarted) 0
if {$PgAcVar(draginfo,is_a_table)} { if {$PgAcVar(draginfo,is_a_table)} {
set tabnum [getTagInfo $PgAcVar(draginfo,obj) tab] set tabnum [getTagInfo $PgAcVar(draginfo,obj) tab]
foreach w [.pgaw:Schema.c find withtag $PgAcVar(draginfo,tabletag)] { foreach w [.pgaw:Schema.c find withtag $PgAcVar(draginfo,tabletag)] {
# $PgAcVar(schema,coordx)\n$PgAcVar(schema,coordy)
if {[lsearch [.pgaw:Schema.c gettags $w] outer] != -1} { 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] {} foreach [list PgAcVar(schema,tablex$tabnum) PgAcVar(schema,tabley$tabnum) x1 y1] [.pgaw:Schema.c coords $w] {}
set PgAcVar(schema,tablex$tabnum) [expr $PgAcVar(schema,tablex$tabnum)+$PgAcVar(schema,coordx)+1]
set PgAcVar(schema,tabley$tabnum) [expr $PgAcVar(schema,tabley$tabnum)+$PgAcVar(schema,coordy)-1]
break break
} }
} }
...@@ -408,6 +508,8 @@ global PgAcVar ...@@ -408,6 +508,8 @@ global PgAcVar
set PgAcVar(schema,links) {} set PgAcVar(schema,links) {}
set PgAcVar(schema,ntables) 0 set PgAcVar(schema,ntables) 0
set PgAcVar(schema,newtablename) {} set PgAcVar(schema,newtablename) {}
set PgAcVar(schema,coordx) 0
set PgAcVar(schema,coordy) 0
} }
...@@ -431,6 +533,8 @@ global PgAcVar ...@@ -431,6 +533,8 @@ global PgAcVar
set dy [expr $y-$PgAcVar(schema,panstarty)] set dy [expr $y-$PgAcVar(schema,panstarty)]
set PgAcVar(schema,panstartx) $x set PgAcVar(schema,panstartx) $x
set PgAcVar(schema,panstarty) $y set PgAcVar(schema,panstarty) $y
set PgAcVar(schema,coordx) [expr $PgAcVar(schema,coordx)-$dx]
set PgAcVar(schema,coordy) [expr $PgAcVar(schema,coordy)-$dy]
if {$PgAcVar(schema,panobject)=="tables"} { if {$PgAcVar(schema,panobject)=="tables"} {
.pgaw:Schema.c move mov $dx $dy .pgaw:Schema.c move mov $dx $dy
.pgaw:Schema.c move links $dx $dy .pgaw:Schema.c move links $dx $dy
...@@ -461,7 +565,7 @@ proc print {c} { ...@@ -461,7 +565,7 @@ proc print {c} {
proc {canvasClick} {x y w} { proc {canvasClick} {x y w} {
global PgAcVar global PgAcVar
set PgAcVar(schema,panstarted) 0 set PgAcVar(schema,panstarted) 0
if {$w==".pgaw:Schema.c"} { if {$w==".pgaw:Schema.c"} {
set canpan 1 set canpan 1
if {[llength [.pgaw:Schema.c find overlapping $x $y $x $y]]!=0} {set canpan 0} if {[llength [.pgaw:Schema.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
set PgAcVar(schema,panobject) tables set PgAcVar(schema,panobject) tables
...@@ -469,6 +573,8 @@ if {$w==".pgaw:Schema.c"} { ...@@ -469,6 +573,8 @@ if {$w==".pgaw:Schema.c"} {
if {[.pgaw:Schema.c find withtag hili]!=""} { if {[.pgaw:Schema.c find withtag hili]!=""} {
.pgaw:Schema.c itemconfigure hili -fill black .pgaw:Schema.c itemconfigure hili -fill black
.pgaw:Schema.c dtag hili .pgaw:Schema.c dtag hili
.pgaw:Schema.c dtag dragme
} }
.pgaw:Schema configure -cursor hand1 .pgaw:Schema configure -cursor hand1
...@@ -476,7 +582,7 @@ if {$w==".pgaw:Schema.c"} { ...@@ -476,7 +582,7 @@ if {$w==".pgaw:Schema.c"} {
set PgAcVar(schema,panstarty) $y set PgAcVar(schema,panstarty) $y
set PgAcVar(schema,panstarted) 1 set PgAcVar(schema,panstarted) 1
} }
} }
} }
} }
...@@ -491,25 +597,27 @@ global PgAcVar ...@@ -491,25 +597,27 @@ global PgAcVar
} }
toplevel $base -class Toplevel toplevel $base -class Toplevel
wm focusmodel $base passive wm focusmodel $base passive
wm geometry $base 759x530+10+13 wm geometry $base 760x530+10+13
wm maxsize $base [winfo screenwidth .] [winfo screenheight .] wm maxsize $base [winfo screenwidth .] [winfo screenheight .]
wm minsize $base 1 1 wm minsize $base 1 1
wm overrideredirect $base 0 wm overrideredirect $base 0
wm resizable $base 1 1 wm resizable $base 1 1
wm title $base [intlmsg "Visual schema designer"] wm title $base [intlmsg "Visual schema designer"]
bind $base <B1-Motion> {
canvas $base.c -background #fefefe -borderwidth 2 -relief ridge -takefocus 0 -width 295 -height 300
bind $base.c <B1-Motion> {
Schema::canvasPanning %x %y Schema::canvasPanning %x %y
} }
bind $base <Button-1> { bind $base.c <Button-1> {
Schema::canvasClick %x %y %W Schema::canvasClick %x %y %W
} }
bind $base <ButtonRelease-1> { bind $base.c <ButtonRelease-1> {
Schema::dragStop %x %y Schema::dragStop %x %y
} }
bind $base <Key-Delete> { bind $base.c <Key-Delete> {
Schema::deleteObject Schema::deleteObject
} }
canvas $base.c -background #fefefe -borderwidth 2 -height 207 -relief ridge -takefocus 0 -width 295
frame $base.f \ frame $base.f \
-height 75 -relief groove -width 125 -height 75 -relief groove -width 125
label $base.f.l -text [intlmsg {Add table}] label $base.f.l -text [intlmsg {Add table}]
...@@ -523,7 +631,7 @@ global PgAcVar ...@@ -523,7 +631,7 @@ global PgAcVar
-command {if {[winfo exists .pgaw:Schema.ddf]} { -command {if {[winfo exists .pgaw:Schema.ddf]} {
destroy .pgaw:Schema.ddf destroy .pgaw:Schema.ddf
} else { } else {
create_drop_down .pgaw:Schema 70 27 200 create_drop_down .pgaw:Schema 50 27 200
focus .pgaw:Schema.ddf.sb focus .pgaw:Schema.ddf.sb
foreach tbl [Database::getTablesList] {.pgaw:Schema.ddf.lb insert end $tbl} foreach tbl [Database::getTablesList] {.pgaw:Schema.ddf.lb insert end $tbl}
bind .pgaw:Schema.ddf.lb <ButtonRelease-1> { bind .pgaw:Schema.ddf.lb <ButtonRelease-1> {
...@@ -553,6 +661,7 @@ Window destroy .pgaw:Schema} -padx 2 -pady 3 -text [intlmsg Close] ...@@ -553,6 +661,7 @@ Window destroy .pgaw:Schema} -padx 2 -pady 3 -text [intlmsg Close]
set pgres [wpg_exec $CurrentDB "insert into pga_schema values ('$PgAcVar(schema,name)','$tables','$PgAcVar(schema,links)')"] set pgres [wpg_exec $CurrentDB "insert into pga_schema values ('$PgAcVar(schema,name)','$tables','$PgAcVar(schema,links)')"]
} else { } 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)"] set pgres [wpg_exec $CurrentDB "update pga_schema set schemaname='$PgAcVar(schema,name)',schematables='$tables',schemalinks='$PgAcVar(schema,links)' where oid=$PgAcVar(schema,oid)"]
# showError [intlmsg "$tables"]
} }
setCursor DEFAULT setCursor DEFAULT
if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} then { if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} then {
...@@ -586,9 +695,6 @@ Window destroy .pgaw:Schema} -padx 2 -pady 3 -text [intlmsg Close] ...@@ -586,9 +695,6 @@ Window destroy .pgaw:Schema} -padx 2 -pady 3 -text [intlmsg Close]
-in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right
pack $base.f.lsn \ pack $base.f.lsn \
-in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right -in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right
pack $base.f -side top -anchor ne -expand 0 -fill x pack $base.f -side top -anchor ne -expand 0 -fill x
pack $base.c -side bottom -fill both -expand 1 pack $base.c -side bottom -fill both -expand 1
} }
...@@ -80,8 +80,8 @@ global PgAcVar CurrentDB ...@@ -80,8 +80,8 @@ global PgAcVar CurrentDB
} }
} }
set PgAcVar(tblinfo,indexlist) {} set PgAcVar(tblinfo,indexlist) {}
wpg_select $CurrentDB "select indexrelid from pg_index, pg_class where (pg_class.relname='$PgAcVar(tblinfo,tablename)') and (pg_class.oid=pg_index.indrelid)" rec { 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(indexrelid) lappend PgAcVar(tblinfo,indexlist) $rec(oid)
wpg_select $CurrentDB "select relname from pg_class where oid=$rec(indexrelid)" rec1 { wpg_select $CurrentDB "select relname from pg_class where oid=$rec(indexrelid)" rec1 {
.pgaw:TableInfo.f2.fl.ilb insert end $rec1(relname) .pgaw:TableInfo.f2.fl.ilb insert end $rec1(relname)
} }
...@@ -544,8 +544,7 @@ if {$PgAcVar(mw,$wn,row_edited)==$PgAcVar(mw,$wn,last_rownum)} { ...@@ -544,8 +544,7 @@ if {$PgAcVar(mw,$wn,row_edited)==$PgAcVar(mw,$wn,last_rownum)} {
set PgAcVar(mw,$wn,newrec_values) [lreplace $PgAcVar(mw,$wn,newrec_values) $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_fields) "\"$fld\""
regsub -all {'} $fldval '' fldvalfixed lappend PgAcVar(mw,$wn,newrec_values) '$fldval'
lappend PgAcVar(mw,$wn,newrec_values) '$fldvalfixed'
# Remove the untouched tag from the object # Remove the untouched tag from the object
$wn.c dtag $PgAcVar(mw,$wn,id_edited) unt $wn.c dtag $PgAcVar(mw,$wn,id_edited) unt
$wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -fill red $wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -fill red
...@@ -814,10 +813,6 @@ set PgAcVar(mw,$wn,toprec) 0 ...@@ -814,10 +813,6 @@ set PgAcVar(mw,$wn,toprec) 0
setScrollbar $wn setScrollbar $wn
if {$PgAcVar(mw,$wn,updatable)} then { if {$PgAcVar(mw,$wn,updatable)} then {
$wn.c bind q <Key> "Tables::editText $wn %A %K" $wn.c bind q <Key> "Tables::editText $wn %A %K"
if {[info commands kanjiInput] == "kanjiInput"} then {
$wn.c bind q <Control-backslash> "pgaccess_kinput_start %W";
$wn.c bind q <Control-Kanji> "pgaccess_kinput_start %W";
}
} else { } else {
$wn.c bind q <Key> {} $wn.c bind q <Key> {}
} }
...@@ -1029,6 +1024,7 @@ global PgAcVar CurrentDB ...@@ -1029,6 +1024,7 @@ global PgAcVar CurrentDB
} }
} }
if {[sql_exec noquiet "alter table \"$PgAcVar(tblinfo,tablename)\" rename column \"$old_name\" to \"$PgAcVar(tblinfo,new_cn)\""]} { if {[sql_exec noquiet "alter table \"$PgAcVar(tblinfo,tablename)\" rename column \"$old_name\" to \"$PgAcVar(tblinfo,new_cn)\""]} {
Schema::clm_rename $PgAcVar(tblinfo,tablename) $old_name $PgAcVar(tblinfo,new_cn)
refreshTableInformation refreshTableInformation
Window destroy .pgaw:RenameField Window destroy .pgaw:RenameField
} }
...@@ -2176,7 +2172,7 @@ proc vTclWindow.pgaw:Permissions {base} { ...@@ -2176,7 +2172,7 @@ proc vTclWindow.pgaw:Permissions {base} {
# #
# This file contains Tcl procedures used to input Japanese text. # This file contains Tcl procedures used to input Japanese text.
# #
# $Header: /cvsroot/pgsql/src/bin/pgaccess/lib/Attic/tables.tcl,v 1.12 2002/04/04 06:27:45 momjian Exp $ # $Header: /cvsroot/pgsql/src/bin/pgaccess/lib/Attic/tables.tcl,v 1.13 2002/07/02 06:11:23 momjian Exp $
# #
# Copyright (c) 1993 Software Research Associates, Inc. # Copyright (c) 1993 Software Research Associates, Inc.
# #
......
...@@ -61,8 +61,8 @@ global PgAcVar CurrentDB ...@@ -61,8 +61,8 @@ global PgAcVar CurrentDB
foreach module {mainlib database tables queries visualqb forms views functions reports scripts users sequences schema help preferences} { 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] source [file join $PgAcVar(PGACCESS_HOME) lib $module.tcl]
} }
set PgAcVar(currentdb,host) [default_pg_host] set PgAcVar(currentdb,host) localhost
set PgAcVar(currentdb,pgport) [default_pg_port] set PgAcVar(currentdb,pgport) 5432
set CurrentDB {} set CurrentDB {}
set PgAcVar(tablist) [list Tables Queries Views Sequences Functions Reports Forms Scripts Users Schema] set PgAcVar(tablist) [list Tables Queries Views Sequences Functions Reports Forms Scripts Users Schema]
set PgAcVar(activetab) {} set PgAcVar(activetab) {}
...@@ -73,19 +73,6 @@ global PgAcVar CurrentDB ...@@ -73,19 +73,6 @@ global PgAcVar CurrentDB
Preferences::load Preferences::load
} }
proc default_pg_host {} {
return localhost
}
proc default_pg_port {} {
global env
if {[info exists env(PGPORT)]} {
return $env(PGPORT)
} else {
return 5432
}
}
proc {wpg_exec} {db cmd} { proc {wpg_exec} {db cmd} {
global PgAcVar global PgAcVar
set PgAcVar(pgsql,cmd) "never executed" set PgAcVar(pgsql,cmd) "never executed"
...@@ -178,20 +165,15 @@ global PgAcVar CurrentDB ...@@ -178,20 +165,15 @@ global PgAcVar CurrentDB
proc {main} {argc argv} { proc {main} {argc argv} {
global PgAcVar CurrentDB tcl_platform env global PgAcVar CurrentDB tcl_platform
if {[info exists env(PGLIB)]} { load libpgtcl[info sharedlibextension]
set libpgtclpath [file join $env(PGLIB) libpgtcl]
} else {
set libpgtclpath {libpgtcl}
}
load ${libpgtclpath}[info sharedlibextension]
catch {Mainlib::draw_tabs} catch {Mainlib::draw_tabs}
set PgAcVar(opendb,username) {} set PgAcVar(opendb,username) {}
set PgAcVar(opendb,password) {} set PgAcVar(opendb,password) {}
if {$argc>0} { if {$argc>0} {
set PgAcVar(opendb,dbname) [lindex $argv 0] set PgAcVar(opendb,dbname) [lindex $argv 0]
set PgAcVar(opendb,host) [default_pg_host] set PgAcVar(opendb,host) localhost
set PgAcVar(opendb,pgport) [default_pg_port] set PgAcVar(opendb,pgport) 5432
Mainlib::open_database Mainlib::open_database
} elseif {$PgAcVar(pref,autoload) && ($PgAcVar(pref,lastdb)!="")} { } elseif {$PgAcVar(pref,autoload) && ($PgAcVar(pref,lastdb)!="")} {
set PgAcVar(opendb,dbname) $PgAcVar(pref,lastdb) set PgAcVar(opendb,dbname) $PgAcVar(pref,lastdb)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment