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
" "
This diff is collapsed.
This diff is collapsed.
...@@ -105,18 +105,12 @@ global CurrentDB ...@@ -105,18 +105,12 @@ 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) catch {
if [catch {wpg_select $CurrentDB "select datlastsysoid from pg_database where datname='$dbname'" rec { wpg_select $CurrentDB "select oid from pg_database where datname='template1'" rec {
set maxim $rec(datlastsysoid) set maxim $rec(oid)
}
}] {
catch {
wpg_select $CurrentDB "select oid from pg_database where datname='template1'" rec {
set maxim $rec(oid)
}
} }
} }
.pgaw:Main.lb delete 0 end .pgaw:Main.lb delete 0 end
...@@ -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 viewname from pg_views $sysconstraint order by viewname" rec { wpg_select $CurrentDB "select relname from pg_class where (relname !~ '^pg_') and (relkind='r') and (relhasrules) order by relname" rec {
.pgaw:Main.lb insert end $rec(viewname) if {[info exists itsaview($rec(relname))]} {
.pgaw:Main.lb insert end $rec(relname)
}
} }
} }
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
......
This diff is collapsed.
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,22 +565,24 @@ proc print {c} { ...@@ -461,22 +565,24 @@ 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
if {$canpan} { if {$canpan} {
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
set PgAcVar(schema,panstartx) $x
set PgAcVar(schema,panstarty) $y
set PgAcVar(schema,panstarted) 1
} }
}
.pgaw:Schema configure -cursor hand1
set PgAcVar(schema,panstartx) $x
set PgAcVar(schema,panstarty) $y
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