aboutsummaryrefslogtreecommitdiff
path: root/src/bin/pgaccess/pgaccess.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'src/bin/pgaccess/pgaccess.tcl')
-rw-r--r--src/bin/pgaccess/pgaccess.tcl127
1 files changed, 102 insertions, 25 deletions
diff --git a/src/bin/pgaccess/pgaccess.tcl b/src/bin/pgaccess/pgaccess.tcl
index 9bbc037369b..a21edd072b4 100644
--- a/src/bin/pgaccess/pgaccess.tcl
+++ b/src/bin/pgaccess/pgaccess.tcl
@@ -106,7 +106,7 @@ set temp {}
switch $activetab {
Tables {
if {[tk_messageBox -title "FINAL WARNING" -message "You are going to delete table:\n\n$objtodelete\n\nProceed ?" -type yesno -default no]=="yes"} {
- sql_exec noquiet "drop table $objtodelete"
+ sql_exec noquiet "drop table \"$objtodelete\""
sql_exec quiet "delete from pga_layout where tablename='$objtodelete'"
cmd_Tables
}
@@ -1193,7 +1193,7 @@ if {$mw(row_edited)==$mw(last_rownum)} {
set msg "Updating record ..."
after 1000 {set msg ""}
regsub -all ' $fldval \\' sqlfldval
- set retval [sql_exec noquiet "update $tablename set $fld='$sqlfldval' where oid=$oid"]
+ set retval [sql_exec noquiet "update \"$tablename\" set $fld='$sqlfldval' where oid=$oid"]
}
cursor_arrow .mw
if {!$retval} {
@@ -1267,7 +1267,7 @@ if {$mw(newrec_fields)==""} {return 1}
set msg "Saving new record ..."
after 1000 {set msg ""}
set retval [catch {
- set sqlcmd "insert into $tablename ([join $mw(newrec_fields) ,]) values ([join $mw(newrec_values) ,])"
+ set sqlcmd "insert into \"$tablename\" ([join $mw(newrec_fields) ,]) values ([join $mw(newrec_values) ,])"
set pgres [pg_exec $dbc $sqlcmd]
} errmsg]
if {$retval} {
@@ -1596,13 +1596,13 @@ if {$how=="design"} {
.qb.text1 insert end $qcmd
} else {
if {$qtype=="S"} then {
+ set mw(query) [subst $qcmd]
+ set mw(updatable) 0
+ set mw(isaquery) 1
Window show .mw
wm title .mw "Query result: $queryname"
mw_load_layout $queryname
- set mw(query) $qcmd
- set mw(updatable) 0
- set mw(isaquery) 1
- mw_select_records $qcmd
+ mw_select_records $mw(query)
} else {
set answ [tk_messageBox -title Warning -type yesno -message "This query is an action query!\n\n[string range $qcmd 0 30] ...\n\nDo you want to execute it?"]
if {$answ} {
@@ -1646,7 +1646,7 @@ set filter {}
Window show .mw
set tablename $objname
mw_load_layout $objname
-set mw(query) "select oid,$tablename.* from $objname"
+set mw(query) "select oid,\"$tablename\".* from \"$objname\""
set mw(updatable) 1
set mw(isaquery) 0
mw_select_records $mw(query)
@@ -1665,6 +1665,23 @@ mw_load_layout $vn
mw_select_records $mw(query)
}
+proc {parameter} {msg} {
+global gpw
+Window show .gpw
+focus .gpw.e1
+set gpw(var) ""
+set gpw(flag) 0
+set gpw(msg) $msg
+bind .gpw <Destroy> "set gpw(flag) 1"
+grab .gpw
+tkwait variable gpw(flag)
+if {$gpw(result)} {
+ return $gpw(var)
+} else {
+ return ""
+}
+}
+
proc {ql_add_new_table} {} {
global qlvar dbc
@@ -1704,7 +1721,7 @@ set tables {}
for {set i 0} {$i<$qlvar(ntables)} {incr i} {
set thename {}
catch {set thename $qlvar(tablename$i)}
- if {$thename!=""} {lappend tables "$qlvar(tablename$i) $qlvar(tablealias$i)"}
+ if {$thename!=""} {lappend tables "\"$qlvar(tablename$i)\" $qlvar(tablealias$i)"}
}
set sqlcmd "$sqlcmd from [join $tables ,] "
set sup1 {}
@@ -1767,10 +1784,10 @@ if {[ql_get_tag_info $obj res]=="f"} {
# Is object a table ?
set tablealias [ql_get_tag_info $obj tab]
set tablename $qlvar(ali_$tablealias)
-if {$tablename==""} return
+if {"$tablename"==""} return
if {[tk_messageBox -title WARNING -icon question -message "Remove table $tablename from query ?" -type yesno -default no]=="no"} return
for {set i [expr [llength $qlvar(restables)]-1]} {$i>=0} {incr i -1} {
- if {$tablename==[lindex $qlvar(restables) $i]} {
+ if {"$tablename"==[lindex $qlvar(restables) $i]} {
set qlvar(resfields) [lreplace $qlvar(resfields) $i $i]
set qlvar(restables) [lreplace $qlvar(restables) $i $i]
set qlvar(rescriteria) [lreplace $qlvar(rescriteria) $i $i]
@@ -2004,7 +2021,7 @@ set allbox [.ql.c bbox rect]
if {$allbox==""} {set posx 10} else {set posx [expr 20+[lindex $allbox 2]]}
set tablename $qlvar(tablename$it)
set tablealias $qlvar(tablealias$it)
-.ql.c create text $posx $posy -text $tablename -anchor nw -tags [subst {tab$tablealias f-oid mov tableheader}] -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
+.ql.c create text $posx $posy -text "$tablename" -anchor nw -tags [subst {tab$tablealias f-oid mov tableheader}] -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*
incr posy 16
foreach fld $qlvar(tablestruct$it) {
.ql.c create text $posx $posy -text $fld -fill #010101 -anchor nw -tags [subst {f-$fld tab$tablealias mov}] -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*
@@ -2382,7 +2399,7 @@ incr py [expr $rbvar(y_pghdr)-$rbvar(y_rpthdr)]
set di [lsearch $rbvar(regions) detail]
set y_hi $rbvar(y_detail)
set y_lo $rbvar(y_[lindex $rbvar(regions) [expr $di-1]])
-pg_select $dbc "select * from $rbvar(tablename)" rec {
+pg_select $dbc "select * from \"$rbvar(tablename)\"" rec {
foreach {field x y objid objtype} $fields {
if {($y>=$y_lo) && ($y<=$y_hi)} then {
if {$objtype=="t_f"} {
@@ -2406,7 +2423,7 @@ tk_messageBox -title Information -message "The printed image in Postscript is in
proc {rb_save_report} {} {
global rbvar
-set prog "set rbvar(tablename) $rbvar(tablename)"
+set prog "set rbvar(tablename) \"$rbvar(tablename)\""
foreach region $rbvar(regions) {
set prog "$prog ; set rbvar(y_$region) $rbvar(y_$region)"
}
@@ -2652,7 +2669,7 @@ proc vTclWindow.about {base} {
label $base.l2 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {A Tcl/Tk interface to
PostgreSQL
by Constantin Teodorescu}
- label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.88}
+ label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.90}
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
@@ -3261,7 +3278,7 @@ proc vTclWindow.nt {base} {
show_error "Your table has no fields!"
focus .nt.e2
} else {
- set temp "create table $newtablename ([join [.nt.lb get 0 end] ,])"
+ set temp "create table \"$newtablename\" ([join [.nt.lb get 0 end] ,])"
if {$fathername!=""} then {set temp "$temp inherits ($fathername)"}
cursor_watch .nt
set retval [catch {
@@ -3539,13 +3556,13 @@ if {[lindex [split [string toupper $qcmd]] 0]!="SELECT"} {
sql_exec noquiet $qcmd
}
} else {
+ set mw(query) [subst $qcmd]
+ set mw(updatable) 0
+ set mw(isaquery) 1
Window show .mw
set mw(layout_name) $queryname
mw_load_layout $queryname
- set mw(query) $qcmd
- set mw(updatable) 0
- set mw(isaquery) 1
- mw_select_records $qcmd
+ mw_select_records $mw(query)
}
} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 -pady 3 -text {Execute query}
button $base.termbtn -borderwidth 1 -command {.qb.cbv configure -state normal
@@ -3612,14 +3629,15 @@ Window destroy .ql} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -p
bind $base.entt <Key-Return> {
ql_add_new_table
}
- button $base.execbtn -borderwidth 1 -command {Window show .mw
+ button $base.execbtn -borderwidth 1 -command {
set qcmd [ql_compute_sql]
set mw(layout_name) nolayoutneeded
-mw_load_layout $mw(layout_name)
-set mw(query) $qcmd
+set mw(query) [subst $qcmd]
set mw(updatable) 0
set mw(isaquery) 1
-mw_select_records $qcmd} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 -pady 3 -text {Execute SQL}
+Window show .mw
+mw_load_layout $mw(layout_name)
+mw_select_records $mw(query)} -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 -pady 3 -text {Execute SQL}
button $base.stoqb -borderwidth 1 -command {Window show .qb
.qb.text1 delete 1.0 end
.qb.text1 insert end [ql_compute_sql]
@@ -3675,7 +3693,7 @@ proc vTclWindow.rf {base} {
if {$newobjname==""} {
show_error "You must give object a new name!"
} elseif {$activetab=="Tables"} {
- set retval [sql_exec noquiet "alter table $oldobjname rename to $newobjname"]
+ set retval [sql_exec noquiet "alter table \"$oldobjname\" rename to \"$newobjname\""]
if {$retval} {
sql_exec quiet "update pga_layout set tablename='$newobjname' where tablename='$oldobjname'"
cmd_Tables
@@ -4520,6 +4538,65 @@ catch {Window destroy .$fdvar(forminame)}
-x 175 -y 25 -width 60 -height 17 -anchor nw -bordermode ignore
}
+proc vTclWindow.gpw {base} {
+ if {$base == ""} {
+ set base .gpw
+ }
+ if {[winfo exists $base]} {
+ wm deiconify $base; return
+ }
+ ###################
+ # CREATING WIDGETS
+ ###################
+ toplevel $base -class Toplevel
+ wm focusmodel $base passive
+ set sw [winfo screenwidth .]
+ set sh [winfo screenheight .]
+ set x [expr ($sw - 297)/2]
+ set y [expr ($sh - 98)/2]
+ wm geometry $base 297x98+$x+$y
+ wm maxsize $base 1009 738
+ wm minsize $base 1 1
+ wm overrideredirect $base 0
+ wm resizable $base 0 0
+ wm deiconify $base
+ wm title $base "Input parameter"
+ label $base.l1 \
+ -anchor nw -borderwidth 1 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \
+ -justify left -relief sunken -textvariable gpw(msg) -wraplength 200
+ entry $base.e1 \
+ -background #fefefe -borderwidth 1 -highlightthickness 0 \
+ -textvariable gpw(var)
+ bind $base.e1 <Key-KP_Enter> {
+ set gpw(result) 1
+destroy .gpw
+ }
+ bind $base.e1 <Key-Return> {
+ set gpw(result) 1
+destroy .gpw
+ }
+ button $base.bok \
+ -borderwidth 1 -command {set gpw(result) 1
+destroy .gpw} -padx 9 \
+ -pady 3 -text Ok
+ button $base.bcanc \
+ -borderwidth 1 -command {set gpw(result) 0
+destroy .gpw} -padx 9 \
+ -pady 3 -text Cancel
+ ###################
+ # SETTING GEOMETRY
+ ###################
+ place $base.l1 \
+ -x 10 -y 5 -width 201 -height 53 -anchor nw -bordermode ignore
+ place $base.e1 \
+ -x 10 -y 65 -width 200 -height 24 -anchor nw -bordermode ignore
+ place $base.bok \
+ -x 225 -y 5 -width 61 -height 26 -anchor nw -bordermode ignore
+ place $base.bcanc \
+ -x 225 -y 35 -width 61 -height 26 -anchor nw -bordermode ignore
+}
+
proc vTclWindow.fdtb {base} {
if {$base == ""} {
set base .fdtb