Skip to content

P
Postgres FD Implementation
Commit 8175eb34 authored by Marc G. Fournier's avatar Marc G. Fournier
Browse files
Options

Update Pgaccess to 0.83

parent c24ed701
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 494 additions and 175 deletions
src/bin/pgaccess/README.pga
View file @ 8175eb34
...@@ -24,7 +24,7 @@ PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. ...@@ -24,7 +24,7 @@ PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
PGACCESS 0.82 1 March 1998 PGACCESS 0.83 11 March 1998
================================ ================================
I dedicate this program to my little 4 year daughter Ana-Maria and my wife I dedicate this program to my little 4 year daughter Ana-Maria and my wife
for their understanding. I hope they will forgive me for spending so many for their understanding. I hope they will forgive me for spending so many
...@@ -128,7 +128,7 @@ Reports ...@@ -128,7 +128,7 @@ Reports
Forms Forms
- open user defined forms - open user defined forms
- form design module available - form design module available
- query widget qlowing access to a recordset - query widget allowing access to a recordset
Scripts Scripts
- define, modify and call user defined scripts - define, modify and call user defined scripts
......
src/bin/pgaccess/formdemo.sql 0 → 100644
View file @ 8175eb34
CREATE TABLE pga_queries (queryname varchar(64), querytype char(1), querycommand text);
CREATE TABLE pga_forms (formname varchar(64), formsource text);
CREATE TABLE pga_scripts (scriptname varchar(64), scriptsource text);
CREATE TABLE pga_reports (reportname varchar(64), reportsource text, reportbody text, reportprocs text, reportoptions text);
CREATE TABLE phonebook (name varchar(32), phone_nr varchar(16), city varchar(32), company bool, continent char16);
CREATE TABLE pga_layout (tablename varchar(64), nrcols int2, colnames text, colwidth text);
COPY pga_queries FROM stdin;
\.
COPY pga_forms FROM stdin;
Phone book pb 26 {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26} 444x310+284+246 {label label1 {33 12 63 30} {} Name {}} {entry name_entry {87 9 217 30} {} entry2 pbqs(name)} {label label3 {33 39 73 54} {} Phone {}} {entry entry4 {87 36 195 57} {} entry4 pbqs(phone_nr)} {label label5 {33 66 78 84} {} City {}} {entry entry6 {87 63 195 84} {} entry6 pbqs(city)} {query qs {3 6 33 33} {} query7 {}} {button button8 {126 177 198 203} {.pb.qs:setsql "select oid,* from phonebook where name ~* '$what' order by name"\
.pb.qs:open\
set nrecs [.pb.qs:nrecords]\
.pb.qs:updatecontrols\
.pb.qs:fill .pb.allnames name} Find {}} {button button9 {159 276 229 302} {.pb.qs:close\
.pb.qs:clearcontrols\
set nrecs {}\
set what {}\
destroy .pb\
} Exit {}} {button button10 {102 249 124 269} {.pb.qs:movefirst\
.pb.qs:updatecontrols\
} |< {}} {button button11 {129 249 151 269} {.pb.qs:moveprevious\
.pb.qs:updatecontrols\
} << {}} {button button12 {156 249 178 269} {.pb.qs:movenext\
.pb.qs:updatecontrols} >> {}} {button button13 {183 249 205 269} {.pb.qs:movelast\
.pb.qs:updatecontrols\
} >| {}} {checkbox checkbox14 {33 87 126 105} {} {Is it a company ?} pbqs(company)} {radio usa {63 108 201 120} {} U.S.A. pbqs(continent)} {radio europe {63 126 204 141} {} Europe pbqs(continent)} {radio africa {63 144 210 159} {} Africa pbqs(continent)} {entry entry18 {30 180 117 198} {} entry18 what} {label label19 {108 219 188 234} {} {records found} {}} {label label20 {90 219 105 234} {} { } nrecs} {label label21 {3 252 33 267} {} OID= {}} {label label22 {39 252 87 267} {} { } pbqs(oid)} {button button23 {9 276 79 302} {set oid {}\
catch {set oid $pbqs(oid)}\
if {[string trim $oid]!=""} {\
sql_exec noquiet "update phonebook set name='$pbqs(name)', phone_nr='$pbqs(phone_nr)',city='$pbqs(city)',company='$pbqs(company)',continent='$pbqs(continent)' where oid=$oid"\
} else {\
tk_messageBox -title Error -message "No record is displayed!"\
}\
\
} Update {}} {button button24 {84 276 154 302} {set thisname {}\
catch {set thisname $pbqs(name)}\
if {[string trim $thisname]!=""} {\
sql_exec noquiet "insert into phonebook values ('$pbqs(name)','$pbqs(phone_nr)','$pbqs(city)','$pbqs(company)','$pbqs(continent)')"\
tk_messageBox -title Information -message "A new record has been added!"\
} else {\
tk_messageBox -title Error -message "This one doesn't have a name ?\
}\
\
} {Add new} {}} {button button25 {168 111 231 135} {.pb.qs:clearcontrols\
# clearcontrols stillinitialise\
# incorectly booleans controls to {}\
# so I force it to 'f' (false)\
set pbqs(company) f\
focus .pb.name_entry} New {}} {listbox allnames {246 12 432 240} {} listbox26 {}}
A simple demo form asdf 14 {1 2 3 4 5 6 7 8 9 10 11 12 13 14} 377x315+170+155 {label label1 {15 36 99 57} {} {Selected color} {}} {entry entry2 {111 36 225 54} {} entry2 color} {radio red {249 21 342 36} {} {Red as cherry} color} {radio green {249 45 342 60} {} {Green as a melon} color} {radio blue {249 69 342 84} {} {Blue as the sky} color} {button button6 {45 69 198 99} {set color spooky} {Set a weird color} {}} {label label7 {24 129 138 147} {} {The checkbox's value} {}} {entry entry8 {162 129 172 147} {} entry8 cbvalue} {checkbox checkbox9 {180 126 279 150} {} {Check me :-)} cbvalue} {button button10 {219 273 366 303} {destroy .asdf} {Close that simple form} {}} {button button11 {219 237 366 267} {open_form "Phone book"} {Open my phone book} {}} {listbox lb {12 192 162 267} {} listbox12 {}} {button button13 {12 156 162 186} {.asdf.lb insert end red green blue cyan white navy black purple maroon violet} {Add some information} {}} {button button14 {12 273 162 303} {.asdf.lb delete 0 end} {Clear this listbox} {}}
\.
COPY pga_scripts FROM stdin;
How are forms keeped inside ? open_table pga_forms\
\
\.
COPY pga_reports FROM stdin;
\.
COPY phonebook FROM stdin;
IBM 623346234 \N t usa
John Doe +44 35 2993825 Washington f usa
Bill Clinton +44 35 9283845 New York f usa
Monica Levintchi +44 38 5234526 Dallas f usa
Bill Gates +42 64 4523454 Los Angeles f usa
COMPAQ 623462345 \N t usa
SUN 784563253 \N t usa
DIGITAL 922644516 \N t usa
FIAT 623463445 \N t europe
MUGADUMBU +92 534662634 \N t africa
Frank Zappa 6734567 Montreal f usa
Jimmy Page 66323452 f europe
Constantin Teodorescu +40 39 611820 Braila f europe
NGBENDU Wazabanga 34577345 \N f africa
\.
COPY pga_layout FROM stdin;
pga_forms 2 formname formsource 82 713
phonebook 5 name phone_nr city company continent 150 105 80 66 85
\.
src/bin/pgaccess/forms.html
View file @ 8175eb34
This diff is collapsed.
src/bin/pgaccess/index.html
View file @ 8175eb34
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML> <HTML>
<HEAD> <HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<META NAME="GENERATOR" CONTENT="Mozilla/4.04 [en] (X11; I; Linux 2.0.32 i586) [Netscape]">
<TITLE>PgAccess - a Tcl/Tk PostgreSQL interface</TITLE> <TITLE>PgAccess - a Tcl/Tk PostgreSQL interface</TITLE>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<META NAME="GENERATOR" CONTENT="Mozilla/3.04Gold (X11; I; Linux 2.0.32 i586) [Netscape]">
</HEAD> </HEAD>
<BODY BGCOLOR="#FFFFFF"> <BODY BGCOLOR="#FFFFFF">
<H1> <H1>PgAccess - a database management tool for <A HREF="http://www.postgreSQL.org">PostgreSQL</A></H1>
PgAccess - a database management tool for <A HREF="http://www.postgreSQL.org">PostgreSQL</A></H1>
<HR> <P>
<HR></P>
<P>This program is protected by the following <A HREF="copyright.html">copyright</A> <P>This program is protected by the following <A HREF="copyright.html">copyright</A>
<LI> </P>
<A HREF="pgaccess-0.82.tar.gz">Download the last version of Pgaccess (press
shift and click this link)</A>.</LI> <LI><A HREF="pgaccess-0.83.tar.gz">Download the last version of Pgaccess
(press shift and click this link)</A>.</LI>
<P>Latest version of PgAccess is 0.83 , 11 March 1998 ! <BR>
&nbsp; </P>
<P>Latest version of PgAccess is 0.82 , 1 March 1998 !
<BR>&nbsp;
<CENTER><TABLE BORDER=3 CELLSPACING=0 CELLPADDING=0 WIDTH="100%" BGCOLOR="#FFB6C1" > <CENTER><TABLE BORDER=3 CELLSPACING=0 CELLPADDING=0 WIDTH="100%" BGCOLOR="#FFB6C1" >
<TR> <TR>
<TD> <TD>
<CENTER></CENTER> <CENTER><P><B><FONT SIZE=+2>PgAccess can now design <A HREF="forms.html">Forms</A></FONT></B>,
<B><FONT SIZE=+2><A HREF="pga-rad.html">Reports and Scripts</A></FONT></B>
<CENTER><B><FONT SIZE=+2>PgAccess can now design <A HREF="forms.html">Forms</A></FONT></B>, </P></CENTER>
<B><FONT SIZE=+2><A HREF="pga-rad.html">Reports and Scripts</A></FONT></B></CENTER>
</TD> </TD>
</TR> </TR>
</TABLE></CENTER> </TABLE></CENTER>
I think that there were some problems loading libpgtcl library.
<BR>I invite you to read a <A HREF="index.html#libpgtcl">special section <H3><FONT COLOR="#000080">Installation problems</FONT></H3>
concerning <B>libpgtcl</B></A>
<H3> <UL>
<FONT COLOR="#191970">What does PgAccess now!</FONT></H3> <LI>Some problems related with locale special characters could be solved
Here are some images from PgAccess windows : <A HREF="pic-pga-1.gif">Main by this <A HREF="specialchars.html">simple patch</A></LI>
<LI>I think that there were some problems loading libpgtcl library. I invite
you to read a <A HREF="index.html#libpgtcl">special section concerning
libpgtcl</A> </LI>
</UL>
<H3><FONT COLOR="#191970">What does PgAccess now!</FONT></H3>
<P>Here are some images from PgAccess windows : <A HREF="pic-pga-1.gif">Main
window </A>, <A HREF="pic-pga-2.gif">table builder </A>, <A HREF="pic-pga-4.gif">table(query) window </A>, <A HREF="pic-pga-2.gif">table builder </A>, <A HREF="pic-pga-4.gif">table(query)
view </A>, <A HREF="pic-pga-3.gif">visual query builder </A>. view </A>, <A HREF="pic-pga-3.gif">visual query builder </A>. </P>
<P><B>Tables</B> <P><B>Tables</B> <BR>
<BR>- opening tables for viewing, max 200 records (changed by preferences - opening tables for viewing, max 200 records (changed by preferences menu)
menu) <BR>
<BR>- column resizing, dragging the vertical grid line (better in table - column resizing, dragging the vertical grid line (better in table space
space rather than in the table header) rather than in the table header) <BR>
<BR>- text wrap in cells - layout saved for every table - text wrap in cells - layout saved for every table <BR>
<BR>- import/export to external files (SDF,CSV) - import/export to external files (SDF,CSV) <BR>
<BR>- filter capabilities (enter filter like (price>3.14) - filter capabilities (enter filter like (price&gt;3.14) <BR>
<BR>- sort order capabilities (enter manually the sort field(s)) - sort order capabilities (enter manually the sort field(s)) <BR>
<BR>- editing in place - editing in place <BR>
<BR>- improved table generator assistant - improved table generator assistant <BR>
<BR>- improved field editing - improved field editing <BR>
<BR><B>Queries</B> <B>Queries</B> <BR>
<BR>- define , edit and stores "user defined queries" - define , edit and stores &quot;user defined queries&quot; <BR>
<BR>- store queries as views - store queries as views <BR>
<BR>- execution of queries - execution of queries <BR>
<BR>- viewing of select type queries result - viewing of select type queries result <BR>
<BR>- query deleting and renaming - query deleting and renaming <BR>
<BR>- <B><BLINK><FONT COLOR="#FF0000">NEW !!!</FONT></BLINK></B> Visual - visual query builder with drag &amp; drop capabilities. For any of you
query builder with drag &amp; drop capabilities. For any of you who had who had installed the Tcl/Tk plugin for Netscape Navigator, you can see
installed the Tcl/Tk plugin for Netscape Navigator, you can see it at work it at work <A HREF="qbtclet.html">clicking here</A> <BR>
<A HREF="qbtclet.html">clicking here</A> <B>Sequences</B> <BR>
<BR><B>Sequences</B> - defines sequences, delete them and inspect them <BR>
<BR>- defines sequences, delete them and inspect them <B>Functions</B> <BR>
<BR><B>Functions</B> - define, inspect and delete functions in SQL language <BR>
<BR>- define, inspect and delete functions in SQL language <B>Reports</B> <BR>
<BR><B>Reports</B> - design and display simple reports from tables <BR>
<BR>- design and display simple reports from tables - fields and labels, font changing, style and size <BR>
<BR>- fields and labels, font changing, style and size - saves and loads report description from database <BR>
<BR>- saves and loads report description from database - show report previews, sample postscript output file <BR>
<BR>- show report previews, sample postscript output file <B>Forms</B> <BR>
<BR><B>Forms</B> - open user defined forms <BR>
<BR>- open user defined forms - form design module available <BR>
<BR>- form design module available - query widget available, controls bound to query results <BR>
<BR>- query widget available, controls bound to query results - <A HREF="forms.html">click here</A> for a description of forms and how
<BR>- <A HREF="forms.html">click here</A> for a description of forms and they can be used <BR>
how they can be used <B>Scripts</B> <BR>
<BR><B>Scripts</B> - define, modify and call user defined scripts <BR>
<BR>- define, modify and call user defined scripts Here is <A HREF="pga-rad.html">a special section concerning forms and scripts</A>
<BR>Here is <A HREF="pga-rad.html">a special section concerning forms and . </P>
scripts</A> .
<P>On the TODO list! <BR>
<P>On the TODO list! - table design (add new fields, renaming, etc.) </P>
<BR>- table design (add new fields, renaming, etc.)
<P>&nbsp; </P>
<P>&nbsp;
<P>If you have any comment, suggestion for improvements, please feel free <P>If you have any comment, suggestion for improvements, please feel free
to e-mail to : <A HREF="mailto:teo@flex.ro">teo@flex.ro&nbsp;</A> to e-mail to : <A HREF="mailto:teo@flex.ro">teo@flex.ro&nbsp;</A> </P>
<P><B><FONT COLOR="#FF1493"><FONT SIZE=+2>Mailing list for PgAccess </FONT></FONT></B><A HREF="maillist.html">Here <P><B><FONT COLOR="#FF1493"><FONT SIZE=+2>Mailing list for PgAccess </FONT></FONT></B><A HREF="maillist.html">Here
you will find how to subscribe to this mailing list</A>. you will find how to subscribe to this mailing list</A>. </P>
<P> <P>
<HR> <HR></P>
<H1>
More information about libgtcl</H1> <H1>More information about libgtcl</H1>
Also, you will need the PostgreSQL to Tcl interface library, lined as a
Tcl/Tk 'load'-able module. It is called libpgtcl and the source is located <P>Also, you will need the PostgreSQL to Tcl interface library, lined as
a Tcl/Tk 'load'-able module. It is called libpgtcl and the source is located
in the PostgreSQL directory /src/interfaces/libpgtcl. Specifically, you in the PostgreSQL directory /src/interfaces/libpgtcl. Specifically, you
will need a libpgtcl library that is 'load'-able from Tcl/Tk. This is technically will need a libpgtcl library that is 'load'-able from Tcl/Tk. This is technically
different from an ordinary PostgreSQL loadable object file, because libpgtcl different from an ordinary PostgreSQL loadable object file, because libpgtcl
is a collection of object files. Under Linux, this is called libpgtcl.so. is a collection of object files. Under Linux, this is called libpgtcl.so.
<BR>You can download <A HREF="libpgtcl.so">from here </A>a version already <BR>
compiled for Linux i386 systems. Just copy libpgtcl.so into your system You can download <A HREF="libpgtcl.so">from here </A>a version already
library director (/usr/lib) and go for it. One of the solutions is to remove compiled for Linux RedHat 4.2 i386 systems. Just copy libpgtcl.so into
from the source the line containing <B>load libpgtcl.so </B>and to load your system library directory (/usr/lib or /lib) and go for it. One of
pgaccess.tcl not with wish, but with pgwish (or wishpg) that wish that the solutions is to remove from the source the line containing <B>load
was linked with libpgtcl library! libpgtcl.so </B>and to load pgaccess.tcl not with wish, but with pgwish
(or wishpg) that wish that was linked with libpgtcl library! </P>
<P>If you have installed RedHat 5.0, you should get the last distribution <P>If you have installed RedHat 5.0, you should get the last distribution
kit of postgreSQL and compile it from scratch. RedHat 5.0 is using some kit of postgreSQL and compile it from scratch. RedHat 5.0 is using some
new versions of libraries and you have to compile and install again at new versions of libraries and you have to compile and install again at
least <B>libpq </B>and <B><TT>libpgtcl </TT></B>libraries. least <B>libpq </B>and <B><TT>libpgtcl </TT></B>libraries. </P>
<P>However, the application should work without problems! </P>
<P>However, the application should work without problems!
</BODY> </BODY>
</HTML> </HTML>
src/bin/pgaccess/pgaccess.tcl
View file @ 8175eb34
...@@ -728,6 +728,12 @@ if {$fdvar(oper)=="move"} { ...@@ -728,6 +728,12 @@ if {$fdvar(oper)=="move"} {
if {$fdvar(oper)!="draw"} return if {$fdvar(oper)!="draw"} return
set fdvar(oper) none set fdvar(oper) none
.fd.c delete curdraw .fd.c delete curdraw
# Check for x2<x1 or y2<y1
if {$x<$fdvar(xstart)} {set temp $x ; set x $fdvar(xstart) ; set fdvar(xstart) $temp}
if {$y<$fdvar(ystart)} {set temp $y ; set y $fdvar(ystart) ; set fdvar(ystart) $temp}
# Check for too small sizes
if {[expr $x-$fdvar(xstart)]<20} {set x [expr $fdvar(xstart)+20]}
if {[expr $y-$fdvar(ystart)]<10} {set y [expr $fdvar(ystart)+10]}
incr fdvar(objnum) incr fdvar(objnum)
set i $fdvar(objnum) set i $fdvar(objnum)
lappend fdvar(objlist) $i lappend fdvar(objlist) $i
...@@ -765,6 +771,7 @@ foreach i $fdvar(objlist) { ...@@ -765,6 +771,7 @@ foreach i $fdvar(objlist) {
#close $fid #close $fid
set res [pg_exec $dbc "delete from pga_forms where formname='$fdvar(formname)'"] set res [pg_exec $dbc "delete from pga_forms where formname='$fdvar(formname)'"]
pg_result $res -clear pg_result $res -clear
regsub -all "'" $info "''" info
set res [pg_exec $dbc "insert into pga_forms values ('$fdvar(formname)','$info')"] set res [pg_exec $dbc "insert into pga_forms values ('$fdvar(formname)','$info')"]
pg_result $res -clear pg_result $res -clear
cmd_Forms cmd_Forms
...@@ -815,6 +822,7 @@ catch {set fdvar(c_text) $fdobj($i,l)} ...@@ -815,6 +822,7 @@ catch {set fdvar(c_text) $fdobj($i,l)}
proc {fd_test} {} { proc {fd_test} {} {
global fdvar fdobj dbc datasets global fdvar fdobj dbc datasets
set basewp $fdvar(forminame)
set base .$fdvar(forminame) set base .$fdvar(forminame)
if {[winfo exists $base]} { if {[winfo exists $base]} {
wm deiconify $base; return wm deiconify $base; return
...@@ -840,30 +848,82 @@ switch $fdobj($item,t) { ...@@ -840,30 +848,82 @@ switch $fdobj($item,t) {
button $base.$name -borderwidth 1 -padx 0 -pady 0 -text "$fdobj($item,l)" -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -command [subst {$cmd}] button $base.$name -borderwidth 1 -padx 0 -pady 0 -text "$fdobj($item,l)" -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -command [subst {$cmd}]
} }
checkbox { checkbox {
checkbutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1 checkbutton $base.$name -onvalue t -offvalue f -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1
set wh {} set wh {}
} }
query { set visual 0 query {
set procbody "proc $base.$name:execute {} {global dbc datasets ; set datasets($base.$name) \[pg_exec \$dbc \"$fdobj($item,x)\"\] ; set ceva \[$base.$name:fields\]}" set visual 0
eval $procbody set datasets($base.$name,sql) $fdobj($item,x)
# tk_messageBox -message $procbody eval "proc $base.$name:open {} {\
set procbody "proc $base.$name:nrecords {} {global datasets ; return \[pg_result \$datasets($base.$name) -numTuples\]}" global dbc datasets tup$basewp$name ;\
eval $procbody catch {unset tup$basewp$name} ;\
# tk_messageBox -message $procbody set wn \[focus\] ; cursor_watch \$wn ;\
set procbody "proc $base.$name:close {} {global datasets ; pg_result \$datasets($base.$name) -clear}" set res \[pg_exec \$dbc \"\$datasets($base.$name,sql)\"\] ;\
eval $procbody pg_result \$res -assign tup$basewp$name ;\
# tk_messageBox -message $procbody set fl {} ;\
set procbody "proc $base.$name:fields {} {global datasets ; set fl {} ; foreach fd \[pg_result \$datasets($base.$name) -lAttributes\] {lappend fl \[lindex \$fd 0\]} ; set datasets($base.$name,fields) \$fl ; return \$fl}" foreach fd \[pg_result \$res -lAttributes\] {lappend fl \[lindex \$fd 0\]} ;\
# tk_messageBox -message $procbody set datasets($base.$name,fields) \$fl ;\
eval $procbody set datasets($base.$name,recno) 0 ;\
set datasets($base.$name,nrecs) \[pg_result \$res -numTuples\] ;\
cursor_arrow \$wn ;\
}"
eval "proc $base.$name:setsql {sqlcmd} {\
global datasets ;\
set datasets($base.$name,sql) \$sqlcmd ;\
}"
eval "proc $base.$name:nrecords {} {\
global datasets ;\
return \$datasets($base.$name,nrecs) ;\
}"
eval "proc $base.$name:crtrecord {} {\
global datasets ;\
return \$datasets($base.$name,recno) ;\
}"
eval "proc $base.$name:moveto {newrecno} {\
global datasets ;\
set datasets($base.$name,recno) \$newrecno ;\
}"
eval "proc $base.$name:close {} {
global tup$basewp$name ;\
catch {unset tup$basewp$name };\
}"
eval "proc $base.$name:fields {} {\
global datasets ;\
return \$datasets($base.$name,fields) ;\
}"
eval "proc $base.$name:fill {lb fld} {\
global datasets tup$basewp$name ;\
\$lb delete 0 end ;\
for {set i 0} {\$i<\$datasets($base.$name,nrecs)} {incr i} {\
\$lb insert end \$tup$basewp$name\(\$i,\$fld\) ;\
}
}"
eval "proc $base.$name:movefirst {} {global datasets ; set datasets($base.$name,recno) 0}" eval "proc $base.$name:movefirst {} {global datasets ; set datasets($base.$name,recno) 0}"
eval "proc $base.$name:movenext {} {global datasets ; incr datasets($base.$name,recno)}" eval "proc $base.$name:movenext {} {global datasets ; incr datasets($base.$name,recno) ; if {\$datasets($base.$name,recno)==\[$base.$name:nrecords\]} {$base.$name:movelast}}"
eval "proc $base.$name:moveprevious {} {global datasets ; incr datasets($base.$name,recno) -1 ; if {\$datasets($base.$name,recno)==-1} {$base.$name:movefirst}}" eval "proc $base.$name:moveprevious {} {global datasets ; incr datasets($base.$name,recno) -1 ; if {\$datasets($base.$name,recno)==-1} {$base.$name:movefirst}}"
eval "proc $base.$name:movelast {} {global datasets ; set datasets($base.$name,recno) \[expr \[$base.$name:nrecords\] -1\]}" eval "proc $base.$name:movelast {} {global datasets ; set datasets($base.$name,recno) \[expr \[$base.$name:nrecords\] -1\]}"
eval "proc $base.$name:updatecontrols {} {global datasets ; set i 0 ; foreach fld \$datasets($base.$name,fields) {catch {upvar $base.$name.\$fld dbvar ; set dbvar \[lindex \[pg_result \$datasets($base.$name) -getTuple \$datasets($base.$name,recno)\] \$i\]} ; incr i}}" eval "proc $base.$name:updatecontrols {} {\
global datasets tup$basewp$name ;\
set i \$datasets($base.$name,recno) ;\
foreach fld \$datasets($base.$name,fields) {\
catch {\
upvar $basewp$name\(\$fld\) dbvar ;\
set dbvar \$tup$basewp$name\(\$i,\$fld\) ;\
}\
}\
}"
eval "proc $base.$name:clearcontrols {} {\
global datasets ;\
catch { foreach fld \$datasets($base.$name,fields) {\
catch {\
upvar $basewp$name\(\$fld\) dbvar ;\
set dbvar {} ;\
}\
}}\
}"
} }
radio { radio {
radiobutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1 radiobutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -value "$name" -borderwidth 1
set wh {} set wh {}
} }
entry { entry {
...@@ -877,7 +937,11 @@ switch $fdobj($item,t) { ...@@ -877,7 +937,11 @@ switch $fdobj($item,t) {
set var {} ; catch {set var $fdobj($item,v)} set var {} ; catch {set var $fdobj($item,v)}
if {$var!=""} {$base.$name configure -textvar $var} if {$var!=""} {$base.$name configure -textvar $var}
} }
listbox {listbox $base.$name -borderwidth 1 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*} listbox {
listbox $base.$name -borderwidth 1 -background white -highlightthickness 0 -selectborderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -yscrollcommand [subst {$base.sb$name set}]
scrollbar $base.sb$name -borderwidth 1 -command [subst {$base.$name yview}] -orient vert -highlightthickness 0
eval [subst "place $base.sb$name -x [expr [lindex $coord 2]-14] -y [expr [lindex $coord 1]-1] -width 16 -height [expr 3+[lindex $coord 3]-[lindex $coord 1]] -anchor nw -bordermode ignore"]
}
} }
if $visual {eval [subst "place $base.$name -x [expr [lindex $coord 0]-1] -y [expr [lindex $coord 1]-1] -anchor nw $wh -bordermode ignore"]} if $visual {eval [subst "place $base.$name -x [expr [lindex $coord 0]-1] -y [expr [lindex $coord 1]-1] -anchor nw $wh -bordermode ignore"]}
} }
...@@ -2565,7 +2629,7 @@ proc vTclWindow.about {base} { ...@@ -2565,7 +2629,7 @@ proc vTclWindow.about {base} {
label $base.l2 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {A Tcl/Tk interface to label $base.l2 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {A Tcl/Tk interface to
PostgreSQL PostgreSQL
by Constantin Teodorescu} by Constantin Teodorescu}
label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.82} label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.83}
label $base.l4 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {You will always get the latest version at: label $base.l4 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {You will always get the latest version at:
http://www.flex.ro/pgaccess http://www.flex.ro/pgaccess
...@@ -2883,7 +2947,7 @@ proc vTclWindow.iew {base} { ...@@ -2883,7 +2947,7 @@ proc vTclWindow.iew {base} {
tk_messageBox -title Information -message "Operation completed!" tk_messageBox -title Information -message "Operation completed!"
Window destroy .iew Window destroy .iew
} }
cursor_arrow .iew catch {cursor_arrow .iew}
}} -padx 9 -pady 3 -text Export }} -padx 9 -pady 3 -text Export
button $base.cancelbtn -borderwidth 1 -command {Window destroy .iew} -padx 9 -pady 3 -text Cancel button $base.cancelbtn -borderwidth 1 -command {Window destroy .iew} -padx 9 -pady 3 -text Cancel
checkbutton $base.oicb -borderwidth 1 -text {with OIDs} -variable oicb checkbutton $base.oicb -borderwidth 1 -text {with OIDs} -variable oicb
......
src/bin/pgaccess/specialchars.html 0 → 100644
View file @ 8175eb34
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>Special locale characters</TITLE>
<META NAME="GENERATOR" CONTENT="Mozilla/3.04Gold (X11; I; Linux 2.0.32 i586) [Netscape]">
</HEAD>
<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000EF" VLINK="#51188E" ALINK="#FF0000">
<H1>Special locale characters and PgAccess
<HR WIDTH="100%"></H1>
<P>The problem is related with some special characters used in different
countries because PgAccess did not use fonts with `-ISO8859-1' encoding
-- </P>
<P>The sollution was proposed by H.P.Heidinger ( hph@hphbbs.ruhr.de) and
it's very simple.</P>
<P>If you look into PgAccess, you will find fonts declared as follows :</P>
<P><TT>$ grep -e '-font' -i pgaccess.tcl<BR>
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \<BR>
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \<BR>
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \<BR>
-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \</TT></P>
<P>It should be something like: -adobe-helvetica-medium-r-normal-*-*-120-*-*-*-*-iso8859-1</P>
<P>You can achieve this by running the following script :</P>
<P><TT>#!/bin/sh<BR>
cp pgaccess.tcl pgaccess.tcl-org<BR>
cat pgaccess.tcl |\<BR>
sed -e's/\-\*\-\*\ /\-iso8859\-1\ /g' |\<BR>
sed -e's/\-\*\-\*\}/\-iso8859\-1}/g' |\<BR>
sed -e's/\-\*\-\*\]/\-iso8859\-1]/g' |\<BR>
sed -e's/\-\*\-\*$/\-iso8859\-1/g' |\<BR>
sed -e's/\-Clean\-/\-Fixed\-/g' |\<BR>
sed -e's/clean/fixed/g' &gt;pgaccess.iso<BR>
mv pgaccess.iso pgaccess.tcl<BR>
chmod +x pgaccess.tcl</TT></P>
<P>The final version of PgAccess (1.0) will let the user decide what fonts
will be used through a &quot;preferences&quot; dialog window.</P>
</BODY>
</HTML>
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