mirror of
https://github.com/postgres/postgres.git
synced 2025-05-29 16:21:20 +03:00
Update to pgaccess 0.91.
This commit is contained in:
Bruce Momjian
parent
f4590995c9
commit
22347d69c9
@ -2,10 +2,10 @@
|
||||
#
|
||||
# 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
|
||||
#
|
||||
# $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 $
|
||||
#
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -1,82 +1,28 @@
|
||||
---------------------------------------------------------------------------
|
||||
Hi,
|
||||
|
||||
Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group
|
||||
Portions Copyright (c) 1994, Regents of the University of California
|
||||
I've made a few changes in the pgaccess source to make it work with overloaded functions too.
|
||||
|
||||
Permission to use, copy, modify, and distribute this software and its
|
||||
documentation for any purpose, without fee, and without a written agreement
|
||||
is hereby granted, provided that the above copyright notice and this
|
||||
paragraph and the following two paragraphs appear in all copies.
|
||||
The files that I changed are:
|
||||
|
||||
IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
|
||||
DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING
|
||||
LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS
|
||||
DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
pgaccess: to run the modified version from the actual directory
|
||||
/lib/functions.old: bugfix for working with overloaded functions, and another one: if somebody has made a mistake
|
||||
in the editing process, the function was deleted, and recreation was not possibble, because the
|
||||
program returned an error message. Now the error message is still persists, but the procedure
|
||||
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,
|
||||
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
|
||||
AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
|
||||
ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO
|
||||
PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
|
||||
So, in spite of the fact that this "hacking" is my first juorney in the tcl scripting language, I think
|
||||
I've made a good job after all. I hope, this changes will be reflected in the future release of the pgaccess.
|
||||
|
||||
---------------------------------------------------------------------------
|
||||
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
|
||||
================================
|
||||
I dedicate this program to my little daughters Ana-Maria and Emilia and to my
|
||||
wife for their understanding. I hope they will forgive me for spending so many
|
||||
time far from them.
|
||||
|
||||
|
||||
|
||||
1. How to INSTALL ?
|
||||
|
||||
You will need a Tcl/Tk package 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>
|
||||
|
||||
Best regards,
|
||||
Bartus Levente (bartus.l at bitel.hu)
|
||||
@ -9,8 +9,7 @@
|
||||
<BR><TT></TT>
|
||||
<BR><TT></TT> <TT></TT>
|
||||
|
||||
<P><TT>Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group</TT>
|
||||
<P><TT>Portions Copyright (c) 1994, Regents of the University of California</TT>
|
||||
<P><TT>Copyright (c) 1994-7 Regents of the University of California</TT><TT></TT>
|
||||
|
||||
<P><TT>Permission to use, copy, modify, and distribute this software and
|
||||
its</TT>
|
||||
@ -18,7 +17,7 @@ its</TT>
|
||||
agreement</TT>
|
||||
<BR><TT>is hereby granted, provided that the above copyright notice and
|
||||
this</TT>
|
||||
<BR><TT>paragraph and the following two paragraphs appear in all copies.</TT>
|
||||
<BR><TT>paragraph and the following two paragraphs appear in all copies.</TT><TT></TT>
|
||||
|
||||
<P><TT>IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
|
||||
PARTY FOR</TT>
|
||||
@ -27,7 +26,7 @@ INCLUDING</TT>
|
||||
<BR><TT>LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS</TT>
|
||||
<BR><TT>DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED
|
||||
OF THE</TT>
|
||||
<BR><TT>POSSIBILITY OF SUCH DAMAGE.</TT>
|
||||
<BR><TT>POSSIBILITY OF SUCH DAMAGE.</TT><TT></TT>
|
||||
|
||||
<P><TT>THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,</TT>
|
||||
<BR><TT>INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY</TT>
|
||||
|
||||
@ -9,7 +9,7 @@
|
||||
<BR><TT></TT>
|
||||
<BR><TT></TT> <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>Permission to use, copy, modify, and distribute this software and
|
||||
|
||||
@ -9,7 +9,7 @@
|
||||
<BR><TT></TT>
|
||||
<BR><TT></TT> <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>Permission to use, copy, modify, and distribute this software and
|
||||
|
||||
Binary file not shown.
@ -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
|
||||
particular entry doesn't have anything in the <b>Editor</b> field.
|
||||
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>
|
||||
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
|
||||
|
||||
@ -1,5 +1,10 @@
|
||||
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} {} {
|
||||
global CurrentDB PgAcVar
|
||||
set tlist {}
|
||||
@ -16,10 +21,10 @@ global CurrentDB PgAcVar
|
||||
} else {
|
||||
set sysconstraint ""
|
||||
}
|
||||
wpg_select $CurrentDB "select relname from pg_class where (relkind='r') $sysconstraint order by relname" rec {
|
||||
if {![info exists itsaview($rec(relname))]} {
|
||||
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))]} {
|
||||
lappend tlist $rec(relname)
|
||||
}
|
||||
# }
|
||||
}
|
||||
} gterrmsg]} {
|
||||
showError $gterrmsg
|
||||
|
||||
@ -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 \]
|
||||
FROM { 'filename' | stdin }
|
||||
\[ WITH DELIMITER 'delimiter' \]
|
||||
\[ USING DELIMITERS 'delimiter' \]
|
||||
COPY \[ BINARY \] table \[ WITH OIDS \]
|
||||
TO { 'filename' | stdout }
|
||||
\[ WITH DELIMITER 'delimiter' \]
|
||||
\[ USING DELIMITERS 'delimiter' \]
|
||||
|
||||
" {code} "Inputs" {bold} "
|
||||
|
||||
@ -44,7 +44,7 @@ COPY \[ BINARY \] table \[ WITH OIDS \]
|
||||
" {} "Usage" {bold} "
|
||||
|
||||
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\":
|
||||
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
|
||||
|
||||
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 \
|
||||
\(\"\\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 \
|
||||
" {} "COPY" {bold} ". The backend also needs appropriate Unix permissions for any file read or written by \
|
||||
" {} "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. "
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
.pgaw:Help.f.t insert end \
|
||||
"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.
|
||||
|
||||
|
||||
@ -1,10 +1,37 @@
|
||||
.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\
|
||||
or from an existing query.
|
||||
DONE:
|
||||
# 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.
|
||||
Report output can be printed as a Postscript file.
|
||||
DOING:
|
||||
# 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
|
||||
"
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -105,18 +105,12 @@ global CurrentDB
|
||||
|
||||
|
||||
proc {cmd_Functions} {} {
|
||||
global PgAcVar CurrentDB
|
||||
global CurrentDB
|
||||
set maxim 16384
|
||||
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 {
|
||||
wpg_select $CurrentDB "select oid from pg_database where datname='template1'" rec {
|
||||
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
|
||||
@ -301,17 +295,19 @@ catch {
|
||||
}
|
||||
|
||||
proc {cmd_Views} {} {
|
||||
global CurrentDB PgAcVar
|
||||
global CurrentDB
|
||||
setCursor CLOCK
|
||||
.pgaw:Main.lb delete 0 end
|
||||
catch {
|
||||
if {! $PgAcVar(pref,systemtables)} {
|
||||
set sysconstraint "where (viewname !~ '^pg_') and (viewname !~ '^pga_')"
|
||||
} else {
|
||||
set sysconstraint ""
|
||||
wpg_select $CurrentDB "select c.relname,count(c.relname) from pg_class C, pg_rewrite R where (relname !~ '^pg_') and (r.ev_class = C.oid) and (r.ev_type = '1') group by relname" rec {
|
||||
if {$rec(count)!=0} {
|
||||
set itsaview($rec(relname)) 1
|
||||
}
|
||||
}
|
||||
wpg_select $CurrentDB "select viewname from pg_views $sysconstraint order by viewname" rec {
|
||||
.pgaw:Main.lb insert end $rec(viewname)
|
||||
wpg_select $CurrentDB "select relname from pg_class where (relname !~ '^pg_') and (relkind='r') and (relhasrules) order by relname" rec {
|
||||
if {[info exists itsaview($rec(relname))]} {
|
||||
.pgaw:Main.lb insert end $rec(relname)
|
||||
}
|
||||
}
|
||||
}
|
||||
setCursor DEFAULT
|
||||
@ -636,8 +632,6 @@ proc vTclWindow.pgaw:ImportExport {base} {
|
||||
if {$PgAcVar(impexp,delimiter)==""} {
|
||||
set sup ""
|
||||
} else {
|
||||
# now we use WITH DELIMITER, but keep old syntax for
|
||||
# backward compatibility. 2002-06-15
|
||||
set sup " USING DELIMITERS '$PgAcVar(impexp,delimiter)'"
|
||||
}
|
||||
if {[.pgaw:ImportExport.expbtn cget -text]=="Import"} {
|
||||
@ -695,6 +689,7 @@ proc vTclWindow.pgaw:RenameObject {base} {
|
||||
showError [intlmsg "You must give object a new name!"]
|
||||
} elseif {$PgAcVar(activetab)=="Tables"} {
|
||||
set retval [sql_exec noquiet "alter table \"$PgAcVar(Old_Object_Name)\" rename to \"$PgAcVar(New_Object_Name)\""]
|
||||
Schema::tbl_rename $PgAcVar(Old_Object_Name) $PgAcVar(New_Object_Name)
|
||||
if {$retval} {
|
||||
sql_exec quiet "update pga_layout set tablename='$PgAcVar(New_Object_Name)' where tablename='$PgAcVar(Old_Object_Name)'"
|
||||
Mainlib::cmd_Tables
|
||||
@ -909,11 +904,11 @@ proc vTclWindow.pgaw:About {base} {
|
||||
wm title $base [intlmsg "About"]
|
||||
label $base.l1 -borderwidth 3 -font -Adobe-Helvetica-Bold-R-Normal-*-*-180-*-*-*-*-* -relief ridge -text PgAccess
|
||||
label $base.l2 -relief groove -text [intlmsg "A Tcl/Tk interface to\nPostgreSQL\nby Constantin Teodorescu"]
|
||||
label $base.l3 -borderwidth 0 -relief sunken -text {v 0.98.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:}]
|
||||
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
|
||||
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
|
||||
|
||||
@ -10,8 +10,8 @@ global PgAcVar
|
||||
set PgAcVar(pref,autoload) 1
|
||||
set PgAcVar(pref,systemtables) 0
|
||||
set PgAcVar(pref,lastdb) {}
|
||||
set PgAcVar(pref,lasthost) {}
|
||||
set PgAcVar(pref,lastport) {}
|
||||
set PgAcVar(pref,lasthost) localhost
|
||||
set PgAcVar(pref,lastport) 5432
|
||||
set PgAcVar(pref,username) {}
|
||||
set PgAcVar(pref,password) {}
|
||||
set PgAcVar(pref,language) english
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,5 +1,91 @@
|
||||
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} {} {
|
||||
global PgAcVar
|
||||
@ -39,8 +125,10 @@ global PgAcVar CurrentDB
|
||||
}
|
||||
set PgAcVar(schema,links) $links
|
||||
drawLinks
|
||||
drawCoord
|
||||
#### This makes new page size
|
||||
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} {
|
||||
} else {
|
||||
drawTable [expr $PgAcVar(schema,ntables)-1]
|
||||
}
|
||||
#lappend PgAcVar(schema,tables) $PgAcVar(schema,newtablename) $PgAcVar(schema,tablex[expr $PgAcVar(schema,ntables)-1]) $PgAcVar(schema,tabley[expr $PgAcVar(schema,ntables)-1])
|
||||
lappend PgAcVar(schema,tables) $PgAcVar(schema,newtablename) $PgAcVar(schema,tablex[expr $PgAcVar(schema,ntables)-1]) $PgAcVar(schema,tabley[expr $PgAcVar(schema,ntables)-1])
|
||||
set PgAcVar(schema,newtablename) {}
|
||||
focus .pgaw:Schema.f.e
|
||||
@ -116,8 +205,11 @@ proc {drawTable} {it} {
|
||||
global PgAcVar
|
||||
|
||||
if {$PgAcVar(schema,tablex$it)==0} {
|
||||
set posy $PgAcVar(schema,nexty)
|
||||
set posx $PgAcVar(schema,nextx)
|
||||
set posx 380
|
||||
set posy 265
|
||||
|
||||
# set posy $PgAcVar(schema,nexty)
|
||||
# set posx $PgAcVar(schema,nextx)
|
||||
set PgAcVar(schema,tablex$it) $posx
|
||||
set PgAcVar(schema,tabley$it) $posy
|
||||
} else {
|
||||
@ -149,7 +241,11 @@ if {$nextx > [winfo width .pgaw:Schema.c] } {
|
||||
}
|
||||
set PgAcVar(schema,nextx) $nextx
|
||||
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} {} {
|
||||
@ -207,6 +303,7 @@ global PgAcVar
|
||||
} else {
|
||||
$w move $PgAcVar(draginfo,obj) $dx $dy
|
||||
}
|
||||
# showError [intlmsg "$dx\n$dy"]
|
||||
set PgAcVar(draginfo,x) $x
|
||||
set PgAcVar(draginfo,y) $y
|
||||
}
|
||||
@ -268,8 +365,11 @@ set PgAcVar(schema,panstarted) 0
|
||||
if {$PgAcVar(draginfo,is_a_table)} {
|
||||
set tabnum [getTagInfo $PgAcVar(draginfo,obj) tab]
|
||||
foreach w [.pgaw:Schema.c find withtag $PgAcVar(draginfo,tabletag)] {
|
||||
# $PgAcVar(schema,coordx)\n$PgAcVar(schema,coordy)
|
||||
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] {}
|
||||
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
|
||||
}
|
||||
}
|
||||
@ -408,6 +508,8 @@ global PgAcVar
|
||||
set PgAcVar(schema,links) {}
|
||||
set PgAcVar(schema,ntables) 0
|
||||
set PgAcVar(schema,newtablename) {}
|
||||
set PgAcVar(schema,coordx) 0
|
||||
set PgAcVar(schema,coordy) 0
|
||||
}
|
||||
|
||||
|
||||
@ -431,6 +533,8 @@ global PgAcVar
|
||||
set dy [expr $y-$PgAcVar(schema,panstarty)]
|
||||
set PgAcVar(schema,panstartx) $x
|
||||
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"} {
|
||||
.pgaw:Schema.c move mov $dx $dy
|
||||
.pgaw:Schema.c move links $dx $dy
|
||||
@ -461,22 +565,24 @@ proc print {c} {
|
||||
proc {canvasClick} {x y w} {
|
||||
global PgAcVar
|
||||
set PgAcVar(schema,panstarted) 0
|
||||
if {$w==".pgaw:Schema.c"} {
|
||||
set canpan 1
|
||||
if {[llength [.pgaw:Schema.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
|
||||
set PgAcVar(schema,panobject) tables
|
||||
if {$canpan} {
|
||||
if {[.pgaw:Schema.c find withtag hili]!=""} {
|
||||
.pgaw:Schema.c itemconfigure hili -fill black
|
||||
.pgaw:Schema.c dtag hili
|
||||
if {$w==".pgaw:Schema.c"} {
|
||||
set canpan 1
|
||||
if {[llength [.pgaw:Schema.c find overlapping $x $y $x $y]]!=0} {set canpan 0}
|
||||
set PgAcVar(schema,panobject) tables
|
||||
if {$canpan} {
|
||||
if {[.pgaw:Schema.c find withtag hili]!=""} {
|
||||
.pgaw:Schema.c itemconfigure hili -fill black
|
||||
.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
|
||||
}
|
||||
toplevel $base -class Toplevel
|
||||
wm focusmodel $base passive
|
||||
wm geometry $base 759x530+10+13
|
||||
wm geometry $base 760x530+10+13
|
||||
wm maxsize $base [winfo screenwidth .] [winfo screenheight .]
|
||||
wm minsize $base 1 1
|
||||
wm overrideredirect $base 0
|
||||
wm resizable $base 1 1
|
||||
wm title $base [intlmsg "Visual schema designer"]
|
||||
bind $base <B1-Motion> {
|
||||
|
||||
|
||||
canvas $base.c -background #fefefe -borderwidth 2 -relief ridge -takefocus 0 -width 295 -height 300
|
||||
bind $base.c <B1-Motion> {
|
||||
Schema::canvasPanning %x %y
|
||||
}
|
||||
bind $base <Button-1> {
|
||||
bind $base.c <Button-1> {
|
||||
Schema::canvasClick %x %y %W
|
||||
}
|
||||
bind $base <ButtonRelease-1> {
|
||||
bind $base.c <ButtonRelease-1> {
|
||||
Schema::dragStop %x %y
|
||||
}
|
||||
bind $base <Key-Delete> {
|
||||
bind $base.c <Key-Delete> {
|
||||
Schema::deleteObject
|
||||
}
|
||||
canvas $base.c -background #fefefe -borderwidth 2 -height 207 -relief ridge -takefocus 0 -width 295
|
||||
frame $base.f \
|
||||
-height 75 -relief groove -width 125
|
||||
label $base.f.l -text [intlmsg {Add table}]
|
||||
@ -523,7 +631,7 @@ global PgAcVar
|
||||
-command {if {[winfo exists .pgaw:Schema.ddf]} {
|
||||
destroy .pgaw:Schema.ddf
|
||||
} else {
|
||||
create_drop_down .pgaw:Schema 70 27 200
|
||||
create_drop_down .pgaw:Schema 50 27 200
|
||||
focus .pgaw:Schema.ddf.sb
|
||||
foreach tbl [Database::getTablesList] {.pgaw:Schema.ddf.lb insert end $tbl}
|
||||
bind .pgaw:Schema.ddf.lb <ButtonRelease-1> {
|
||||
@ -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)')"]
|
||||
} 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)"]
|
||||
# showError [intlmsg "$tables"]
|
||||
}
|
||||
setCursor DEFAULT
|
||||
if {$PgAcVar(pgsql,status)!="PGRES_COMMAND_OK"} then {
|
||||
@ -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
|
||||
pack $base.f.lsn \
|
||||
-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
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -80,8 +80,8 @@ global PgAcVar CurrentDB
|
||||
}
|
||||
}
|
||||
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 {
|
||||
lappend PgAcVar(tblinfo,indexlist) $rec(indexrelid)
|
||||
wpg_select $CurrentDB "select oid,indexrelid from pg_index where (pg_class.relname='$PgAcVar(tblinfo,tablename)') and (pg_class.oid=pg_index.indrelid)" rec {
|
||||
lappend PgAcVar(tblinfo,indexlist) $rec(oid)
|
||||
wpg_select $CurrentDB "select relname from pg_class where oid=$rec(indexrelid)" rec1 {
|
||||
.pgaw:TableInfo.f2.fl.ilb insert end $rec1(relname)
|
||||
}
|
||||
@ -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]
|
||||
}
|
||||
lappend PgAcVar(mw,$wn,newrec_fields) "\"$fld\""
|
||||
regsub -all {'} $fldval '' fldvalfixed
|
||||
lappend PgAcVar(mw,$wn,newrec_values) '$fldvalfixed'
|
||||
lappend PgAcVar(mw,$wn,newrec_values) '$fldval'
|
||||
# Remove the untouched tag from the object
|
||||
$wn.c dtag $PgAcVar(mw,$wn,id_edited) unt
|
||||
$wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -fill red
|
||||
@ -814,10 +813,6 @@ set PgAcVar(mw,$wn,toprec) 0
|
||||
setScrollbar $wn
|
||||
if {$PgAcVar(mw,$wn,updatable)} then {
|
||||
$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 {
|
||||
$wn.c bind q <Key> {}
|
||||
}
|
||||
@ -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)\""]} {
|
||||
Schema::clm_rename $PgAcVar(tblinfo,tablename) $old_name $PgAcVar(tblinfo,new_cn)
|
||||
refreshTableInformation
|
||||
Window destroy .pgaw:RenameField
|
||||
}
|
||||
@ -2176,7 +2172,7 @@ proc vTclWindow.pgaw:Permissions {base} {
|
||||
#
|
||||
# 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.
|
||||
#
|
||||
|
||||
@ -61,8 +61,8 @@ global PgAcVar CurrentDB
|
||||
foreach module {mainlib database tables queries visualqb forms views functions reports scripts users sequences schema help preferences} {
|
||||
source [file join $PgAcVar(PGACCESS_HOME) lib $module.tcl]
|
||||
}
|
||||
set PgAcVar(currentdb,host) [default_pg_host]
|
||||
set PgAcVar(currentdb,pgport) [default_pg_port]
|
||||
set PgAcVar(currentdb,host) localhost
|
||||
set PgAcVar(currentdb,pgport) 5432
|
||||
set CurrentDB {}
|
||||
set PgAcVar(tablist) [list Tables Queries Views Sequences Functions Reports Forms Scripts Users Schema]
|
||||
set PgAcVar(activetab) {}
|
||||
@ -73,19 +73,6 @@ global PgAcVar CurrentDB
|
||||
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} {
|
||||
global PgAcVar
|
||||
set PgAcVar(pgsql,cmd) "never executed"
|
||||
@ -178,20 +165,15 @@ global PgAcVar CurrentDB
|
||||
|
||||
|
||||
proc {main} {argc argv} {
|
||||
global PgAcVar CurrentDB tcl_platform env
|
||||
if {[info exists env(PGLIB)]} {
|
||||
set libpgtclpath [file join $env(PGLIB) libpgtcl]
|
||||
} else {
|
||||
set libpgtclpath {libpgtcl}
|
||||
}
|
||||
load ${libpgtclpath}[info sharedlibextension]
|
||||
global PgAcVar CurrentDB tcl_platform
|
||||
load libpgtcl[info sharedlibextension]
|
||||
catch {Mainlib::draw_tabs}
|
||||
set PgAcVar(opendb,username) {}
|
||||
set PgAcVar(opendb,password) {}
|
||||
if {$argc>0} {
|
||||
set PgAcVar(opendb,dbname) [lindex $argv 0]
|
||||
set PgAcVar(opendb,host) [default_pg_host]
|
||||
set PgAcVar(opendb,pgport) [default_pg_port]
|
||||
set PgAcVar(opendb,host) localhost
|
||||
set PgAcVar(opendb,pgport) 5432
|
||||
Mainlib::open_database
|
||||
} elseif {$PgAcVar(pref,autoload) && ($PgAcVar(pref,lastdb)!="")} {
|
||||
set PgAcVar(opendb,dbname) $PgAcVar(pref,lastdb)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user