mirror of
https://github.com/postgres/postgres.git
synced 2025-10-20 00:04:28 -04:00
45c7c6067a
records containing apostrophes in text fields without altering the appearance of the entry in the GUI interface (by copying the fldval to fldvalfixed). This will alleviate the need for users to create a record and then go back to edit apostrophes into the text they entered. Ryan Grange
2246 lines
78 KiB
Tcl
2246 lines
78 KiB
Tcl
namespace eval Tables {
|
|
|
|
|
|
proc {new} {} {
|
|
PgAcVar:clean nt,*
|
|
Window show .pgaw:NewTable
|
|
focus .pgaw:NewTable.etabn
|
|
}
|
|
|
|
|
|
proc {open} {tablename {filter ""} {order ""}} {
|
|
global PgAcVar
|
|
set wn [getNewWindowName]
|
|
createWindow
|
|
set PgAcVar(mw,$wn,tablename) $tablename
|
|
loadLayout $wn $tablename
|
|
set PgAcVar(mw,$wn,sortfield) $order
|
|
set PgAcVar(mw,$wn,filter) $filter
|
|
set PgAcVar(mw,$wn,query) "select oid,\"$tablename\".* from \"$tablename\""
|
|
set PgAcVar(mw,$wn,updatable) 1
|
|
set PgAcVar(mw,$wn,isaquery) 0
|
|
initVariables $wn
|
|
refreshRecords $wn
|
|
catch {wm title $wn "$tablename"}
|
|
}
|
|
|
|
|
|
proc {design} {tablename} {
|
|
global PgAcVar CurrentDB
|
|
if {$CurrentDB==""} return;
|
|
set PgAcVar(tblinfo,tablename) $tablename
|
|
refreshTableInformation
|
|
}
|
|
|
|
|
|
proc {refreshTableInformation} {} {
|
|
global PgAcVar CurrentDB
|
|
Window show .pgaw:TableInfo
|
|
wm title .pgaw:TableInfo "[intlmsg {Table information}] : $PgAcVar(tblinfo,tablename)"
|
|
.pgaw:TableInfo.f1.lb delete 0 end
|
|
.pgaw:TableInfo.f2.fl.ilb delete 0 end
|
|
.pgaw:TableInfo.f2.fr.lb delete 0 end
|
|
.pgaw:TableInfo.f3.plb delete 0 end
|
|
set PgAcVar(tblinfo,isunique) {}
|
|
set PgAcVar(tblinfo,isclustered) {}
|
|
set PgAcVar(tblinfo,indexfields) {}
|
|
wpg_select $CurrentDB "select attnum,attname,typname,attlen,attnotnull,atttypmod,usename,usesysid,pg_class.oid,relpages,reltuples,relhaspkey,relhasrules,relacl from pg_class,pg_user,pg_attribute,pg_type where (pg_class.relname='$PgAcVar(tblinfo,tablename)') and (pg_class.oid=pg_attribute.attrelid) and (pg_class.relowner=pg_user.usesysid) and (pg_attribute.atttypid=pg_type.oid) order by attnum" rec {
|
|
set fsize $rec(attlen)
|
|
set fsize1 $rec(atttypmod)
|
|
set ftype $rec(typname)
|
|
if { $fsize=="-1" && $fsize1!="-1" } {
|
|
set fsize $rec(atttypmod)
|
|
incr fsize -4
|
|
}
|
|
if { $fsize1=="-1" && $fsize=="-1" } {
|
|
set fsize ""
|
|
}
|
|
if {$rec(attnotnull) == "t"} {
|
|
set notnull "NOT NULL"
|
|
} else {
|
|
set notnull {}
|
|
}
|
|
if {$rec(attnum)>0} {.pgaw:TableInfo.f1.lb insert end [format "%-33.33s %-14.14s %6.6s %-8.8s" $rec(attname) $ftype $fsize $notnull]}
|
|
set PgAcVar(tblinfo,owner) $rec(usename)
|
|
set PgAcVar(tblinfo,tableoid) $rec(oid)
|
|
set PgAcVar(tblinfo,ownerid) $rec(usesysid)
|
|
set PgAcVar(tblinfo,f$rec(attnum)) $rec(attname)
|
|
set PgAcVar(tblinfo,numtuples) $rec(reltuples)
|
|
set PgAcVar(tblinfo,numpages) $rec(relpages)
|
|
set PgAcVar(tblinfo,permissions) $rec(relacl)
|
|
if {$rec(relhaspkey)=="t"} {
|
|
set PgAcVar(tblinfo,hasprimarykey) [intlmsg Yes]
|
|
} else {
|
|
set PgAcVar(tblinfo,hasprimarykey) [intlmsg No]
|
|
}
|
|
if {$rec(relhasrules)=="t"} {
|
|
set PgAcVar(tblinfo,hasrules) [intlmsg Yes]
|
|
} else {
|
|
set PgAcVar(tblinfo,hasrules) [intlmsg No]
|
|
}
|
|
}
|
|
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 relname from pg_class where oid=$rec(indexrelid)" rec1 {
|
|
.pgaw:TableInfo.f2.fl.ilb insert end $rec1(relname)
|
|
}
|
|
}
|
|
#
|
|
# showing permissions
|
|
set temp $PgAcVar(tblinfo,permissions)
|
|
regsub "^\{" $temp {} temp
|
|
regsub "\}$" $temp {} temp
|
|
regsub -all "\"" $temp {} temp
|
|
foreach token [split $temp ,] {
|
|
set oli [split $token =]
|
|
set uname [lindex $oli 0]
|
|
set rights [lindex $oli 1]
|
|
if {$uname == ""} {set uname PUBLIC}
|
|
set r_select " "
|
|
set r_update " "
|
|
set r_insert " "
|
|
set r_rule " "
|
|
if {[string first r $rights] != -1} {set r_select x}
|
|
if {[string first w $rights] != -1} {set r_update x}
|
|
if {[string first a $rights] != -1} {set r_insert x}
|
|
if {[string first R $rights] != -1} {set r_rule x}
|
|
#
|
|
# changing the format of the following line can affect the loadPermissions procedure
|
|
# see below
|
|
.pgaw:TableInfo.f3.plb insert end [format "%-23.23s %11s %11s %11s %11s" $uname $r_select $r_update $r_insert $r_rule]
|
|
|
|
}
|
|
}
|
|
|
|
proc {loadPermissions} {} {
|
|
global PgAcVar
|
|
set sel [.pgaw:TableInfo.f3.plb curselection]
|
|
if {$sel == ""} {
|
|
bell
|
|
return
|
|
}
|
|
set line [.pgaw:TableInfo.f3.plb get $sel]
|
|
set uname [string trim [string range $line 0 22]]
|
|
Window show .pgaw:Permissions
|
|
wm transient .pgaw:Permissions .pgaw:TableInfo
|
|
set PgAcVar(permission,username) $uname
|
|
set PgAcVar(permission,select) [expr {"x"==[string range $line 34 34]}]
|
|
set PgAcVar(permission,update) [expr {"x"==[string range $line 46 46]}]
|
|
set PgAcVar(permission,insert) [expr {"x"==[string range $line 58 58]}]
|
|
set PgAcVar(permission,rule) [expr {"x"==[string range $line 70 70]}]
|
|
focus .pgaw:Permissions.f1.ename
|
|
}
|
|
|
|
|
|
proc {newPermissions} {} {
|
|
global PgAcVar
|
|
PgAcVar:clean permission,*
|
|
Window show .pgaw:Permissions
|
|
wm transient .pgaw:Permissions .pgaw:TableInfo
|
|
focus .pgaw:Permissions.f1.ename
|
|
}
|
|
|
|
|
|
proc {savePermissions} {} {
|
|
global PgAcVar
|
|
if {$PgAcVar(permission,username) == ""} {
|
|
showError [intlmsg "User without name?"]
|
|
return
|
|
}
|
|
if {$PgAcVar(permission,username)=="PUBLIC"} {
|
|
set usrname PUBLIC
|
|
} else {
|
|
set usrname "\"$PgAcVar(permission,username)\""
|
|
}
|
|
sql_exec noquiet "revoke all on \"$PgAcVar(tblinfo,tablename)\" from $usrname"
|
|
if {$PgAcVar(permission,select)} {
|
|
sql_exec noquiet "GRANT SELECT on \"$PgAcVar(tblinfo,tablename)\" to $usrname"
|
|
}
|
|
if {$PgAcVar(permission,insert)} {
|
|
sql_exec noquiet "GRANT INSERT on \"$PgAcVar(tblinfo,tablename)\" to $usrname"
|
|
}
|
|
if {$PgAcVar(permission,update)} {
|
|
sql_exec noquiet "GRANT UPDATE on \"$PgAcVar(tblinfo,tablename)\" to $usrname"
|
|
}
|
|
if {$PgAcVar(permission,rule)} {
|
|
sql_exec noquiet "GRANT RULE on \"$PgAcVar(tblinfo,tablename)\" to $usrname"
|
|
}
|
|
refreshTableInformation
|
|
}
|
|
|
|
|
|
proc {clusterIndex} {} {
|
|
global PgAcVar
|
|
set sel [.pgaw:TableInfo.f2.fl.ilb curselection]
|
|
if {$sel == ""} {
|
|
showError [intlmsg "You have to select an index!"]
|
|
return
|
|
}
|
|
bell
|
|
if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:TableInfo -message [format [intlmsg "You choose to cluster index\n\n %s \n\nAll other indices will be lost!\nProceed?"] [.pgaw:TableInfo.f2.fl.ilb get $sel]] -type yesno -default no]=="no"} {return}
|
|
if {[sql_exec noquiet "cluster \"[.pgaw:TableInfo.f2.fl.ilb get $sel]\" on \"$PgAcVar(tblinfo,tablename)\""]} {
|
|
refreshTableInformation
|
|
}
|
|
}
|
|
|
|
|
|
proc {get_tag_info} {wn itemid prefix} {
|
|
set taglist [$wn.c itemcget $itemid -tags]
|
|
set i [lsearch -glob $taglist $prefix*]
|
|
set thetag [lindex $taglist $i]
|
|
return [string range $thetag 1 end]
|
|
}
|
|
|
|
|
|
proc {dragMove} {w x y} {
|
|
global PgAcVar
|
|
set dlo ""
|
|
catch { set dlo $PgAcVar(draglocation,obj) }
|
|
if {$dlo != ""} {
|
|
set dx [expr $x - $PgAcVar(draglocation,x)]
|
|
set dy [expr $y - $PgAcVar(draglocation,y)]
|
|
$w move $dlo $dx $dy
|
|
set PgAcVar(draglocation,x) $x
|
|
set PgAcVar(draglocation,y) $y
|
|
}
|
|
}
|
|
|
|
|
|
proc {dragStart} {wn w x y} {
|
|
global PgAcVar
|
|
PgAcVar:clean draglocation,*
|
|
set object [$w find closest $x $y]
|
|
if {[lsearch [$wn.c gettags $object] movable]==-1} return;
|
|
$wn.c bind movable <Leave> {}
|
|
set PgAcVar(draglocation,obj) $object
|
|
set PgAcVar(draglocation,x) $x
|
|
set PgAcVar(draglocation,y) $y
|
|
set PgAcVar(draglocation,start) $x
|
|
}
|
|
|
|
|
|
proc {dragStop} {wn w x y} {
|
|
global PgAcVar CurrentDB
|
|
set dlo ""
|
|
catch { set dlo $PgAcVar(draglocation,obj) }
|
|
if {$dlo != ""} {
|
|
$wn.c bind movable <Leave> "$wn configure -cursor left_ptr"
|
|
$wn configure -cursor left_ptr
|
|
set ctr [get_tag_info $wn $PgAcVar(draglocation,obj) v]
|
|
set diff [expr $x-$PgAcVar(draglocation,start)]
|
|
if {$diff==0} return;
|
|
set newcw {}
|
|
for {set i 0} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
|
|
if {$i==$ctr} {
|
|
lappend newcw [expr [lindex $PgAcVar(mw,$wn,colwidth) $i]+$diff]
|
|
} else {
|
|
lappend newcw [lindex $PgAcVar(mw,$wn,colwidth) $i]
|
|
}
|
|
}
|
|
set PgAcVar(mw,$wn,colwidth) $newcw
|
|
$wn.c itemconfigure c$ctr -width [expr [lindex $PgAcVar(mw,$wn,colwidth) $ctr]-5]
|
|
drawHeaders $wn
|
|
drawHorizontalLines $wn
|
|
if {$PgAcVar(mw,$wn,crtrow)!=""} {showRecord $wn $PgAcVar(mw,$wn,crtrow)}
|
|
for {set i [expr $ctr+1]} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
|
|
$wn.c move c$i $diff 0
|
|
}
|
|
setCursor CLOCK
|
|
sql_exec quiet "update pga_layout set colwidth='$PgAcVar(mw,$wn,colwidth)' where tablename='$PgAcVar(mw,$wn,layout_name)'"
|
|
setCursor DEFAULT
|
|
}
|
|
}
|
|
|
|
|
|
proc {canvasClick} {wn x y} {
|
|
global PgAcVar
|
|
if {![finishEdit $wn]} return
|
|
# Determining row
|
|
for {set row 0} {$row<$PgAcVar(mw,$wn,nrecs)} {incr row} {
|
|
if {[lindex $PgAcVar(mw,$wn,rowy) $row]>$y} break
|
|
}
|
|
incr row -1
|
|
if {$y>[lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,last_rownum)]} {set row $PgAcVar(mw,$wn,last_rownum)}
|
|
if {$row<0} return
|
|
set PgAcVar(mw,$wn,row_edited) $row
|
|
set PgAcVar(mw,$wn,crtrow) $row
|
|
showRecord $wn $row
|
|
if {$PgAcVar(mw,$wn,errorsavingnew)} return
|
|
# Determining column
|
|
set posx [expr -$PgAcVar(mw,$wn,leftoffset)]
|
|
set col 0
|
|
foreach cw $PgAcVar(mw,$wn,colwidth) {
|
|
incr posx [expr $cw+2]
|
|
if {$x<$posx} break
|
|
incr col
|
|
}
|
|
set itlist [$wn.c find withtag r$row]
|
|
foreach item $itlist {
|
|
if {[get_tag_info $wn $item c]==$col} {
|
|
startEdit $wn $item $x $y
|
|
break
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
proc {deleteRecord} {wn} {
|
|
global PgAcVar CurrentDB
|
|
if {!$PgAcVar(mw,$wn,updatable)} return;
|
|
if {![finishEdit $wn]} return;
|
|
set taglist [$wn.c gettags hili]
|
|
if {[llength $taglist]==0} return;
|
|
set rowtag [lindex $taglist [lsearch -regexp $taglist "^r"]]
|
|
set row [string range $rowtag 1 end]
|
|
set oid [lindex $PgAcVar(mw,$wn,keylist) $row]
|
|
if {[tk_messageBox -title [intlmsg "FINAL WARNING"] -icon question -parent $wn -message [intlmsg "Delete current record ?"] -type yesno -default no]=="no"} return
|
|
if {[sql_exec noquiet "delete from \"$PgAcVar(mw,$wn,tablename)\" where oid=$oid"]} {
|
|
$wn.c delete hili
|
|
}
|
|
}
|
|
|
|
|
|
proc {drawHeaders} {wn} {
|
|
global PgAcVar
|
|
$wn.c delete header
|
|
set posx [expr 5-$PgAcVar(mw,$wn,leftoffset)]
|
|
for {set i 0} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
|
|
set xf [expr $posx+[lindex $PgAcVar(mw,$wn,colwidth) $i]]
|
|
$wn.c create rectangle $posx 1 $xf 22 -fill #CCCCCC -outline "" -width 0 -tags header
|
|
$wn.c create text [expr $posx+[lindex $PgAcVar(mw,$wn,colwidth) $i]*1.0/2] 14 -text [lindex $PgAcVar(mw,$wn,colnames) $i] -tags header -fill navy -font $PgAcVar(pref,font_normal)
|
|
$wn.c create line $posx 22 [expr $xf-1] 22 -fill #AAAAAA -tags header
|
|
$wn.c create line [expr $xf-1] 5 [expr $xf-1] 22 -fill #AAAAAA -tags header
|
|
$wn.c create line [expr $xf+1] 5 [expr $xf+1] 22 -fill white -tags header
|
|
$wn.c create line $xf -15000 $xf 15000 -fill #CCCCCC -tags [subst {header movable v$i}]
|
|
set posx [expr $xf+2]
|
|
}
|
|
set PgAcVar(mw,$wn,r_edge) $posx
|
|
$wn.c bind movable <Button-1> "Tables::dragStart $wn %W %x %y"
|
|
$wn.c bind movable <B1-Motion> {Tables::dragMove %W %x %y}
|
|
$wn.c bind movable <ButtonRelease-1> "Tables::dragStop $wn %W %x %y"
|
|
$wn.c bind movable <Enter> "$wn configure -cursor left_side"
|
|
$wn.c bind movable <Leave> "$wn configure -cursor left_ptr"
|
|
}
|
|
|
|
|
|
proc {drawHorizontalLines} {wn} {
|
|
global PgAcVar
|
|
$wn.c delete hgrid
|
|
set posx 10
|
|
for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
|
|
set ledge($j) $posx
|
|
incr posx [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]+2]
|
|
set textwidth($j) [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]-5]
|
|
}
|
|
incr posx -6
|
|
for {set i 0} {$i<$PgAcVar(mw,$wn,nrecs)} {incr i} {
|
|
$wn.c create line [expr -$PgAcVar(mw,$wn,leftoffset)] [lindex $PgAcVar(mw,$wn,rowy) [expr $i+1]] [expr $posx-$PgAcVar(mw,$wn,leftoffset)] [lindex $PgAcVar(mw,$wn,rowy) [expr $i+1]] -fill gray -tags [subst {hgrid g$i}]
|
|
}
|
|
if {$PgAcVar(mw,$wn,updatable)} {
|
|
set i $PgAcVar(mw,$wn,nrecs)
|
|
set posy [expr 14+[lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,nrecs)]]
|
|
$wn.c create line [expr -$PgAcVar(mw,$wn,leftoffset)] $posy [expr $posx-$PgAcVar(mw,$wn,leftoffset)] $posy -fill gray -tags [subst {hgrid g$i}]
|
|
}
|
|
}
|
|
|
|
|
|
proc {drawNewRecord} {wn} {
|
|
global PgAcVar
|
|
set posx [expr 10-$PgAcVar(mw,$wn,leftoffset)]
|
|
set posy [lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,last_rownum)]
|
|
if {$PgAcVar(pref,tvfont)=="helv"} {
|
|
set tvfont $PgAcVar(pref,font_normal)
|
|
} else {
|
|
set tvfont $PgAcVar(pref,font_fix)
|
|
}
|
|
if {$PgAcVar(mw,$wn,updatable)} {
|
|
for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
|
|
$wn.c create text $posx $posy -text * -tags [subst {r$PgAcVar(mw,$wn,nrecs) c$j q new unt}] -anchor nw -font $tvfont -width [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]-5]
|
|
incr posx [expr [lindex $PgAcVar(mw,$wn,colwidth) $j]+2]
|
|
}
|
|
incr posy 14
|
|
$wn.c create line [expr -$PgAcVar(mw,$wn,leftoffset)] $posy [expr $PgAcVar(mw,$wn,r_edge)-$PgAcVar(mw,$wn,leftoffset)] $posy -fill gray -tags [subst {hgrid g$PgAcVar(mw,$wn,nrecs)}]
|
|
}
|
|
}
|
|
|
|
|
|
proc {editMove} { wn {distance 1} {position end} } {
|
|
global PgAcVar
|
|
|
|
# This routine moves the cursor some relative distance
|
|
# from one cell being editted to another cell in the table.
|
|
# Typical distances are 1, +1, $PgAcVar(mw,$wn,colcount), and
|
|
# -$PgAcVar(mw,$wn,colcount). Position is where
|
|
# the cursor will be placed within the cell. The valid
|
|
# positions are 0 and end.
|
|
|
|
# get the current row and column
|
|
set current_cell_id $PgAcVar(mw,$wn,id_edited)
|
|
set tags [$wn.c gettags $current_cell_id]
|
|
regexp {r([0-9]+)} $tags match crow
|
|
regexp {c([0-9]+)} $tags match ccol
|
|
|
|
|
|
# calculate next row and column
|
|
set colcount $PgAcVar(mw,$wn,colcount)
|
|
set ccell [expr ($crow * $colcount) + $ccol]
|
|
set ncell [expr $ccell + $distance]
|
|
set nrow [expr $ncell / $colcount]
|
|
set ncol [expr $ncell % $colcount]
|
|
|
|
|
|
# find the row of the next cell
|
|
if {$distance < 0} {
|
|
set row_increment -1
|
|
} else {
|
|
set row_increment 1
|
|
}
|
|
set id_tuple [$wn.c find withtag r$nrow]
|
|
# skip over deleted rows...
|
|
while {[llength $id_tuple] == 0} {
|
|
# case above first row of table
|
|
if {$nrow < 0} {
|
|
return
|
|
# case at or beyond last row of table
|
|
} elseif {$nrow >= $PgAcVar(mw,$wn,nrecs)} {
|
|
if {![insertNewRecord $wn]} {
|
|
set PgAcVar(mw,$wn,errorsavingnew) 1
|
|
return
|
|
}
|
|
set id_tuple [$wn.c find withtag r$nrow]
|
|
break
|
|
}
|
|
incr nrow $row_increment
|
|
set id_tuple [$wn.c find withtag r$nrow]
|
|
}
|
|
|
|
# find the widget id of the next cell
|
|
set next_cell_id [lindex [lsort -integer $id_tuple] $ncol]
|
|
if {[string compare $next_cell_id {}] == 0} {
|
|
set next_cell_id [$wn.c find withtag $current_cell_id]
|
|
}
|
|
|
|
# make sure that the new cell is in the visible window
|
|
set toprec $PgAcVar(mw,$wn,toprec)
|
|
set numscreenrecs [getVisibleRecordsCount $wn]
|
|
if {$nrow < $toprec} {
|
|
# case nrow above visable window
|
|
scrollWindow $wn moveto \
|
|
[expr $nrow *[recordSizeInScrollbarUnits $wn]]
|
|
} elseif {$nrow > ($toprec + $numscreenrecs - 1)} {
|
|
# case nrow below visable window
|
|
scrollWindow $wn moveto \
|
|
[expr ($nrow - $numscreenrecs + 2) * [recordSizeInScrollbarUnits $wn]]
|
|
}
|
|
# I need to find a better way to pan -kk
|
|
foreach {x1 y1 x2 y2} [$wn.c bbox $next_cell_id] {break}
|
|
while {$x1 <= $PgAcVar(mw,$wn,leftoffset)} {
|
|
panRight $wn
|
|
foreach {x1 y1 x2 y2} [$wn.c bbox $next_cell_id] {break}
|
|
}
|
|
set rightedge [expr $x1 + [lindex $PgAcVar(mw,$wn,colwidth) $ncol]]
|
|
while {$rightedge > ($PgAcVar(mw,$wn,leftoffset) + [winfo width $wn.c])} {
|
|
panLeft $wn
|
|
}
|
|
|
|
# move to the next cell
|
|
foreach {x1 y1 x2 y2} [$wn.c bbox $next_cell_id] {break}
|
|
switch -exact -- $position {
|
|
0 {
|
|
canvasClick $wn [incr x1 ] [incr y1 ]
|
|
}
|
|
end -
|
|
default {
|
|
canvasClick $wn [incr x2 -1] [incr y2 -1]
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
proc {editText} {wn c k} {
|
|
global PgAcVar
|
|
set bbin [$wn.c bbox r$PgAcVar(mw,$wn,row_edited)]
|
|
switch $k {
|
|
BackSpace { set dp [expr [$wn.c index $PgAcVar(mw,$wn,id_edited) insert]-1];if {$dp>=0} {$wn.c dchars $PgAcVar(mw,$wn,id_edited) $dp $dp; set PgAcVar(mw,$wn,dirtyrec) 1}}
|
|
Home {$wn.c icursor $PgAcVar(mw,$wn,id_edited) 0}
|
|
End {$wn.c icursor $PgAcVar(mw,$wn,id_edited) end}
|
|
Left {
|
|
set position [expr [$wn.c index $PgAcVar(mw,$wn,id_edited) insert]-1]
|
|
if {$position < 0} {
|
|
editMove $wn -1 end
|
|
return
|
|
}
|
|
$wn.c icursor $PgAcVar(mw,$wn,id_edited) $position
|
|
}
|
|
Delete {}
|
|
Right {
|
|
set position [expr [$wn.c index $PgAcVar(mw,$wn,id_edited) insert]+1]
|
|
if {$position > [$wn.c index $PgAcVar(mw,$wn,id_edited) end] } {
|
|
editMove $wn 1 0
|
|
return
|
|
}
|
|
$wn.c icursor $PgAcVar(mw,$wn,id_edited) $position
|
|
}
|
|
Return -
|
|
Tab {editMove $wn; return}
|
|
ISO_Left_Tab {editMove $wn -1; return}
|
|
Up {editMove $wn -$PgAcVar(mw,$wn,colcount); return }
|
|
Down {editMove $wn $PgAcVar(mw,$wn,colcount); return }
|
|
Escape {set PgAcVar(mw,$wn,dirtyrec) 0; $wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -text $PgAcVar(mw,$wn,text_initial_value); $wn.c focus {}}
|
|
default {if {[string compare $c " "]>-1} {$wn.c insert $PgAcVar(mw,$wn,id_edited) insert $c;set PgAcVar(mw,$wn,dirtyrec) 1}}
|
|
}
|
|
set bbout [$wn.c bbox r$PgAcVar(mw,$wn,row_edited)]
|
|
set dy [expr [lindex $bbout 3]-[lindex $bbin 3]]
|
|
if {$dy==0} return
|
|
set re $PgAcVar(mw,$wn,row_edited)
|
|
$wn.c move g$re 0 $dy
|
|
for {set i [expr 1+$re]} {$i<=$PgAcVar(mw,$wn,nrecs)} {incr i} {
|
|
$wn.c move r$i 0 $dy
|
|
$wn.c move g$i 0 $dy
|
|
set rh [lindex $PgAcVar(mw,$wn,rowy) $i]
|
|
incr rh $dy
|
|
set PgAcVar(mw,$wn,rowy) [lreplace $PgAcVar(mw,$wn,rowy) $i $i $rh]
|
|
}
|
|
showRecord $wn $PgAcVar(mw,$wn,row_edited)
|
|
# Delete is trapped by window interpreted as record delete
|
|
# Delete {$wn.c dchars $PgAcVar(mw,$wn,id_edited) insert insert; set PgAcVar(mw,$wn,dirtyrec) 1}
|
|
}
|
|
|
|
|
|
proc {finishEdit} {wn} {
|
|
global PgAcVar CurrentDB
|
|
# User has edited the text ?
|
|
if {!$PgAcVar(mw,$wn,dirtyrec)} {
|
|
# No, unfocus text
|
|
$wn.c focus {}
|
|
# For restoring * to the new record position
|
|
if {$PgAcVar(mw,$wn,id_edited)!=""} {
|
|
if {[lsearch [$wn.c gettags $PgAcVar(mw,$wn,id_edited)] new]!=-1} {
|
|
$wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -text $PgAcVar(mw,$wn,text_initial_value)
|
|
}
|
|
}
|
|
set PgAcVar(mw,$wn,id_edited) {};set PgAcVar(mw,$wn,text_initial_value) {}
|
|
return 1
|
|
}
|
|
# Trimming the spaces
|
|
set fldval [string trim [$wn.c itemcget $PgAcVar(mw,$wn,id_edited) -text]]
|
|
$wn.c itemconfigure $PgAcVar(mw,$wn,id_edited) -text $fldval
|
|
if {[string compare $PgAcVar(mw,$wn,text_initial_value) $fldval]==0} {
|
|
set PgAcVar(mw,$wn,dirtyrec) 0
|
|
$wn.c focus {}
|
|
set PgAcVar(mw,$wn,id_edited) {};set PgAcVar(mw,$wn,text_initial_value) {}
|
|
return 1
|
|
}
|
|
setCursor CLOCK
|
|
set oid [lindex $PgAcVar(mw,$wn,keylist) $PgAcVar(mw,$wn,row_edited)]
|
|
set fld [lindex $PgAcVar(mw,$wn,colnames) [get_tag_info $wn $PgAcVar(mw,$wn,id_edited) c]]
|
|
set fillcolor black
|
|
if {$PgAcVar(mw,$wn,row_edited)==$PgAcVar(mw,$wn,last_rownum)} {
|
|
set fillcolor red
|
|
set sfp [lsearch $PgAcVar(mw,$wn,newrec_fields) "\"$fld\""]
|
|
if {$sfp>-1} {
|
|
set PgAcVar(mw,$wn,newrec_fields) [lreplace $PgAcVar(mw,$wn,newrec_fields) $sfp $sfp]
|
|
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'
|
|
# 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
|
|
set retval 1
|
|
} else {
|
|
set PgAcVar(mw,$wn,msg) "Updating record ..."
|
|
after 1000 "set PgAcVar(mw,$wn,msg) {}"
|
|
regsub -all ' $fldval \\' sqlfldval
|
|
|
|
#FIXME rjr 4/29/1999 special case null so it can be entered into tables
|
|
#really need to write a tcl sqlquote proc which quotes the string only
|
|
#if necessary, so it can be used all over pgaccess, instead of explicit 's
|
|
|
|
if {$sqlfldval == "null"} {
|
|
set retval [sql_exec noquiet "update \"$PgAcVar(mw,$wn,tablename)\" \
|
|
set \"$fld\"= null where oid=$oid"]
|
|
} else {
|
|
set retval [sql_exec noquiet "update \"$PgAcVar(mw,$wn,tablename)\" \
|
|
set \"$fld\"='$sqlfldval' where oid=$oid"]
|
|
}
|
|
}
|
|
setCursor DEFAULT
|
|
if {!$retval} {
|
|
set PgAcVar(mw,$wn,msg) ""
|
|
focus $wn.c
|
|
return 0
|
|
}
|
|
set PgAcVar(mw,$wn,dirtyrec) 0
|
|
$wn.c focus {}
|
|
set PgAcVar(mw,$wn,id_edited) {};set PgAcVar(mw,$wn,text_initial_value) {}
|
|
return 1
|
|
}
|
|
|
|
proc {loadLayout} {wn layoutname} {
|
|
global PgAcVar CurrentDB
|
|
setCursor CLOCK
|
|
set PgAcVar(mw,$wn,layout_name) $layoutname
|
|
catch {unset PgAcVar(mw,$wn,colcount) PgAcVar(mw,$wn,colnames) PgAcVar(mw,$wn,colwidth)}
|
|
set PgAcVar(mw,$wn,layout_found) 0
|
|
set pgres [wpg_exec $CurrentDB "select *,oid from pga_layout where tablename='$layoutname' order by oid desc"]
|
|
set pgs [pg_result $pgres -status]
|
|
if {$pgs!="PGRES_TUPLES_OK"} {
|
|
# Probably table pga_layout isn't yet defined
|
|
sql_exec noquiet "create table pga_layout (tablename varchar(64),nrcols int2,colnames text,colwidth text)"
|
|
sql_exec quiet "grant ALL on pga_layout to PUBLIC"
|
|
} else {
|
|
set nrlay [pg_result $pgres -numTuples]
|
|
if {$nrlay>=1} {
|
|
set layoutinfo [pg_result $pgres -getTuple 0]
|
|
set PgAcVar(mw,$wn,colcount) [lindex $layoutinfo 1]
|
|
set PgAcVar(mw,$wn,colnames) [lindex $layoutinfo 2]
|
|
set PgAcVar(mw,$wn,colwidth) [lindex $layoutinfo 3]
|
|
set goodoid [lindex $layoutinfo 4]
|
|
set PgAcVar(mw,$wn,layout_found) 1
|
|
}
|
|
if {$nrlay>1} {
|
|
showError "Multiple ($nrlay) layout info found\n\nPlease report the bug!"
|
|
sql_exec quiet "delete from pga_layout where (tablename='$PgAcVar(mw,$wn,tablename)') and (oid<>$goodoid)"
|
|
}
|
|
}
|
|
pg_result $pgres -clear
|
|
}
|
|
|
|
|
|
proc {panLeft} {wn } {
|
|
global PgAcVar
|
|
if {![finishEdit $wn]} return;
|
|
if {$PgAcVar(mw,$wn,leftcol)==[expr $PgAcVar(mw,$wn,colcount)-1]} return;
|
|
set diff [expr 2+[lindex $PgAcVar(mw,$wn,colwidth) $PgAcVar(mw,$wn,leftcol)]]
|
|
incr PgAcVar(mw,$wn,leftcol)
|
|
incr PgAcVar(mw,$wn,leftoffset) $diff
|
|
$wn.c move header -$diff 0
|
|
$wn.c move q -$diff 0
|
|
$wn.c move hgrid -$diff 0
|
|
}
|
|
|
|
|
|
proc {panRight} {wn} {
|
|
global PgAcVar
|
|
if {![finishEdit $wn]} return;
|
|
if {$PgAcVar(mw,$wn,leftcol)==0} return;
|
|
incr PgAcVar(mw,$wn,leftcol) -1
|
|
set diff [expr 2+[lindex $PgAcVar(mw,$wn,colwidth) $PgAcVar(mw,$wn,leftcol)]]
|
|
incr PgAcVar(mw,$wn,leftoffset) -$diff
|
|
$wn.c move header $diff 0
|
|
$wn.c move q $diff 0
|
|
$wn.c move hgrid $diff 0
|
|
}
|
|
|
|
|
|
proc {insertNewRecord} {wn} {
|
|
global PgAcVar CurrentDB
|
|
if {![finishEdit $wn]} {return 0}
|
|
if {$PgAcVar(mw,$wn,newrec_fields)==""} {return 1}
|
|
set PgAcVar(mw,$wn,msg) "Saving new record ..."
|
|
after 1000 "set PgAcVar(mw,$wn,msg) {}"
|
|
set pgres [wpg_exec $CurrentDB "insert into \"$PgAcVar(mw,$wn,tablename)\" ([join $PgAcVar(mw,$wn,newrec_fields) ,]) values ([join $PgAcVar(mw,$wn,newrec_values) ,])" ]
|
|
if {[pg_result $pgres -status]!="PGRES_COMMAND_OK"} {
|
|
set errmsg [pg_result $pgres -error]
|
|
showError "[intlmsg {Error inserting new record}]\n\n$errmsg"
|
|
return 0
|
|
}
|
|
set oid [pg_result $pgres -oid]
|
|
lappend PgAcVar(mw,$wn,keylist) $oid
|
|
pg_result $pgres -clear
|
|
# Get bounds of the last record
|
|
set lrbb [$wn.c bbox new]
|
|
lappend PgAcVar(mw,$wn,rowy) [lindex $lrbb 3]
|
|
$wn.c itemconfigure new -fill black
|
|
$wn.c dtag q new
|
|
# Replace * from untouched new row elements with " "
|
|
foreach item [$wn.c find withtag unt] {
|
|
$wn.c itemconfigure $item -text " "
|
|
}
|
|
$wn.c dtag q unt
|
|
incr PgAcVar(mw,$wn,last_rownum)
|
|
incr PgAcVar(mw,$wn,nrecs)
|
|
drawNewRecord $wn
|
|
set PgAcVar(mw,$wn,newrec_fields) {}
|
|
set PgAcVar(mw,$wn,newrec_values) {}
|
|
return 1
|
|
}
|
|
|
|
|
|
proc {scrollWindow} {wn par1 args} {
|
|
global PgAcVar
|
|
if {![finishEdit $wn]} return;
|
|
if {$par1=="scroll"} {
|
|
set newtop $PgAcVar(mw,$wn,toprec)
|
|
if {[lindex $args 1]=="units"} {
|
|
incr newtop [lindex $args 0]
|
|
} else {
|
|
incr newtop [expr [lindex $args 0]*25]
|
|
if {$newtop<0} {set newtop 0}
|
|
if {$newtop>=[expr $PgAcVar(mw,$wn,nrecs)-1]} {set newtop [expr $PgAcVar(mw,$wn,nrecs)-1]}
|
|
}
|
|
} elseif {$par1=="moveto"} {
|
|
set newtop [expr int([lindex $args 0]*$PgAcVar(mw,$wn,nrecs))]
|
|
} else {
|
|
return
|
|
}
|
|
if {$newtop<0} return;
|
|
if {$newtop>=[expr $PgAcVar(mw,$wn,nrecs)-1]} return;
|
|
set dy [expr [lindex $PgAcVar(mw,$wn,rowy) $PgAcVar(mw,$wn,toprec)]-[lindex $PgAcVar(mw,$wn,rowy) $newtop]]
|
|
$wn.c move q 0 $dy
|
|
$wn.c move hgrid 0 $dy
|
|
set newrowy {}
|
|
foreach y $PgAcVar(mw,$wn,rowy) {lappend newrowy [expr $y+$dy]}
|
|
set PgAcVar(mw,$wn,rowy) $newrowy
|
|
set PgAcVar(mw,$wn,toprec) $newtop
|
|
setScrollbar $wn
|
|
}
|
|
|
|
|
|
proc {initVariables} {wn} {
|
|
global PgAcVar
|
|
set PgAcVar(mw,$wn,newrec_fields) {}
|
|
set PgAcVar(mw,$wn,newrec_values) {}
|
|
}
|
|
|
|
proc {selectRecords} {wn sql} {
|
|
global PgAcVar CurrentDB
|
|
if {![finishEdit $wn]} return;
|
|
initVariables $wn
|
|
$wn.c delete q
|
|
$wn.c delete header
|
|
$wn.c delete hgrid
|
|
$wn.c delete new
|
|
set PgAcVar(mw,$wn,leftcol) 0
|
|
set PgAcVar(mw,$wn,leftoffset) 0
|
|
set PgAcVar(mw,$wn,crtrow) {}
|
|
set PgAcVar(mw,$wn,msg) [intlmsg "Accessing data. Please wait ..."]
|
|
catch {$wn.f1.b1 configure -state disabled}
|
|
setCursor CLOCK
|
|
set is_error 1
|
|
if {[sql_exec noquiet "BEGIN"]} {
|
|
if {[sql_exec noquiet "declare mycursor cursor for $sql"]} {
|
|
set pgres [wpg_exec $CurrentDB "fetch $PgAcVar(pref,rows) in mycursor"]
|
|
if {$PgAcVar(pgsql,status)=="PGRES_TUPLES_OK"} {
|
|
set is_error 0
|
|
}
|
|
}
|
|
}
|
|
if {$is_error} {
|
|
sql_exec quiet "END"
|
|
set PgAcVar(mw,$wn,msg) {}
|
|
catch {$wn.f1.b1 configure -state normal}
|
|
setCursor DEFAULT
|
|
set PgAcVar(mw,$wn,msg) "Error executing : $sql"
|
|
return
|
|
}
|
|
if {$PgAcVar(mw,$wn,updatable)} then {set shift 1} else {set shift 0}
|
|
#
|
|
# checking at least the numer of fields
|
|
set attrlist [pg_result $pgres -lAttributes]
|
|
if {$PgAcVar(mw,$wn,layout_found)} then {
|
|
if { ($PgAcVar(mw,$wn,colcount) != [expr [llength $attrlist]-$shift]) ||
|
|
($PgAcVar(mw,$wn,colcount) != [llength $PgAcVar(mw,$wn,colnames)]) ||
|
|
($PgAcVar(mw,$wn,colcount) != [llength $PgAcVar(mw,$wn,colwidth)]) } then {
|
|
# No. of columns don't match, something is wrong
|
|
# tk_messageBox -title [intlmsg Information] -message "Layout info changed !\nRescanning..."
|
|
set PgAcVar(mw,$wn,layout_found) 0
|
|
sql_exec quiet "delete from pga_layout where tablename='$PgAcVar(mw,$wn,layout_name)'"
|
|
}
|
|
}
|
|
# Always take the col. names from the result
|
|
set PgAcVar(mw,$wn,colcount) [llength $attrlist]
|
|
if {$PgAcVar(mw,$wn,updatable)} then {incr PgAcVar(mw,$wn,colcount) -1}
|
|
set PgAcVar(mw,$wn,colnames) {}
|
|
# In defPgAcVar(mw,$wn,colwidth) prepare PgAcVar(mw,$wn,colwidth) (in case that not layout_found)
|
|
set defPgAcVar(mw,$wn,colwidth) {}
|
|
for {set i 0} {$i<$PgAcVar(mw,$wn,colcount)} {incr i} {
|
|
lappend PgAcVar(mw,$wn,colnames) [lindex [lindex $attrlist [expr {$i+$shift}]] 0]
|
|
lappend defPgAcVar(mw,$wn,colwidth) 150
|
|
}
|
|
if {!$PgAcVar(mw,$wn,layout_found)} {
|
|
set PgAcVar(mw,$wn,colwidth) $defPgAcVar(mw,$wn,colwidth)
|
|
sql_exec quiet "insert into pga_layout values ('$PgAcVar(mw,$wn,layout_name)',$PgAcVar(mw,$wn,colcount),'$PgAcVar(mw,$wn,colnames)','$PgAcVar(mw,$wn,colwidth)')"
|
|
set PgAcVar(mw,$wn,layout_found) 1
|
|
}
|
|
set PgAcVar(mw,$wn,nrecs) [pg_result $pgres -numTuples]
|
|
if {$PgAcVar(mw,$wn,nrecs)>$PgAcVar(pref,rows)} {
|
|
set PgAcVar(mw,$wn,msg) "Only first $PgAcVar(pref,rows) records from $PgAcVar(mw,$wn,nrecs) have been loaded"
|
|
set PgAcVar(mw,$wn,nrecs) $PgAcVar(pref,rows)
|
|
}
|
|
set tagoid {}
|
|
if {$PgAcVar(pref,tvfont)=="helv"} {
|
|
set tvfont $PgAcVar(pref,font_normal)
|
|
} else {
|
|
set tvfont $PgAcVar(pref,font_fix)
|
|
}
|
|
# Computing column's left edge
|
|
set posx 10
|
|
for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
|
|
set ledge($j) $posx
|
|
incr posx [expr {[lindex $PgAcVar(mw,$wn,colwidth) $j]+2}]
|
|
set textwidth($j) [expr {[lindex $PgAcVar(mw,$wn,colwidth) $j]-5}]
|
|
}
|
|
incr posx -6
|
|
set posy 24
|
|
drawHeaders $wn
|
|
set PgAcVar(mw,$wn,updatekey) oid
|
|
set PgAcVar(mw,$wn,keylist) {}
|
|
set PgAcVar(mw,$wn,rowy) {24}
|
|
set PgAcVar(mw,$wn,msg) "Loading maximum $PgAcVar(pref,rows) records ..."
|
|
set wupdatable $PgAcVar(mw,$wn,updatable)
|
|
for {set i 0} {$i<$PgAcVar(mw,$wn,nrecs)} {incr i} {
|
|
set curtup [pg_result $pgres -getTuple $i]
|
|
if {$wupdatable} then {lappend PgAcVar(mw,$wn,keylist) [lindex $curtup 0]}
|
|
for {set j 0} {$j<$PgAcVar(mw,$wn,colcount)} {incr j} {
|
|
$wn.c create text $ledge($j) $posy -text [lindex $curtup [expr {$j+$shift}]] -tags [subst {r$i c$j q}] -anchor nw -font $tvfont -width $textwidth($j) -fill black
|
|
}
|
|
set bb [$wn.c bbox r$i]
|
|
incr posy [expr {[lindex $bb 3]-[lindex $bb 1]}]
|
|
lappend PgAcVar(mw,$wn,rowy) $posy
|
|
$wn.c create line 0 [lindex $bb 3] $posx [lindex $bb 3] -fill gray -tags [subst {hgrid g$i}]
|
|
if {$i==25} {update; update idletasks}
|
|
}
|
|
after 3000 "set PgAcVar(mw,$wn,msg) {}"
|
|
set PgAcVar(mw,$wn,last_rownum) $i
|
|
# Defining position for input data
|
|
drawNewRecord $wn
|
|
pg_result $pgres -clear
|
|
sql_exec quiet "END"
|
|
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> {}
|
|
}
|
|
set PgAcVar(mw,$wn,dirtyrec) 0
|
|
$wn.c raise header
|
|
catch {$wn.f1.b1 configure -state normal}
|
|
setCursor DEFAULT
|
|
}
|
|
|
|
|
|
proc recordSizeInScrollbarUnits {wn} {
|
|
# record size in scrollbar units
|
|
global PgAcVar
|
|
return [expr 1.0/$PgAcVar(mw,$wn,nrecs)]
|
|
}
|
|
|
|
|
|
proc getVisibleRecordsCount {wn} {
|
|
# number of records that fit in the window at its current size
|
|
expr [winfo height $wn.c]/14
|
|
}
|
|
|
|
|
|
proc {setScrollbar} {wn} {
|
|
global PgAcVar
|
|
if {$PgAcVar(mw,$wn,nrecs)==0} return;
|
|
# Fixes problem of window resizing messing up the scrollbar size.
|
|
set record_size [recordSizeInScrollbarUnits $wn];
|
|
$wn.sb set [expr $PgAcVar(mw,$wn,toprec)*$record_size] \
|
|
[expr ($PgAcVar(mw,$wn,toprec)+[getVisibleRecordsCount $wn])*$record_size]
|
|
}
|
|
|
|
|
|
proc {refreshRecords} {wn} {
|
|
global PgAcVar
|
|
set nq $PgAcVar(mw,$wn,query)
|
|
if {($PgAcVar(mw,$wn,isaquery)) && ("$PgAcVar(mw,$wn,filter)$PgAcVar(mw,$wn,sortfield)"!="")} {
|
|
showError [intlmsg "Sorting and filtering not (yet) available from queries!\n\nPlease enter them in the query definition!"]
|
|
set PgAcVar(mw,$wn,sortfield) {}
|
|
set PgAcVar(mw,$wn,filter) {}
|
|
} else {
|
|
if {$PgAcVar(mw,$wn,filter)!=""} {
|
|
set nq "$PgAcVar(mw,$wn,query) where ($PgAcVar(mw,$wn,filter))"
|
|
} else {
|
|
set nq $PgAcVar(mw,$wn,query)
|
|
}
|
|
if {$PgAcVar(mw,$wn,sortfield)!=""} {
|
|
set nq "$nq order by $PgAcVar(mw,$wn,sortfield)"
|
|
}
|
|
}
|
|
if {[insertNewRecord $wn]} {selectRecords $wn $nq}
|
|
}
|
|
|
|
|
|
proc {showRecord} {wn row} {
|
|
global PgAcVar
|
|
set PgAcVar(mw,$wn,errorsavingnew) 0
|
|
if {$PgAcVar(mw,$wn,newrec_fields)!=""} {
|
|
if {$row!=$PgAcVar(mw,$wn,last_rownum)} {
|
|
if {![insertNewRecord $wn]} {
|
|
set PgAcVar(mw,$wn,errorsavingnew) 1
|
|
return
|
|
}
|
|
}
|
|
}
|
|
set y1 [lindex $PgAcVar(mw,$wn,rowy) $row]
|
|
set y2 [lindex $PgAcVar(mw,$wn,rowy) [expr $row+1]]
|
|
if {$y2==""} {set y2 [expr $y1+14]}
|
|
$wn.c dtag hili hili
|
|
$wn.c addtag hili withtag r$row
|
|
# Making a rectangle arround the record
|
|
set x 3
|
|
foreach wi $PgAcVar(mw,$wn,colwidth) {incr x [expr $wi+2]}
|
|
$wn.c delete crtrec
|
|
$wn.c create rectangle [expr -1-$PgAcVar(mw,$wn,leftoffset)] $y1 [expr $x-$PgAcVar(mw,$wn,leftoffset)] $y2 -fill #EEEEEE -outline {} -tags {q crtrec}
|
|
$wn.c lower crtrec
|
|
}
|
|
|
|
|
|
proc {startEdit} {wn id x y} {
|
|
global PgAcVar
|
|
if {!$PgAcVar(mw,$wn,updatable)} return
|
|
set PgAcVar(mw,$wn,id_edited) $id
|
|
set PgAcVar(mw,$wn,dirtyrec) 0
|
|
set PgAcVar(mw,$wn,text_initial_value) [$wn.c itemcget $id -text]
|
|
focus $wn.c
|
|
$wn.c focus $id
|
|
$wn.c icursor $id @$x,$y
|
|
if {$PgAcVar(mw,$wn,row_edited)==$PgAcVar(mw,$wn,nrecs)} {
|
|
if {[$wn.c itemcget $id -text]=="*"} {
|
|
$wn.c itemconfigure $id -text ""
|
|
$wn.c icursor $id 0
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
proc {canvasPaste} {wn x y} {
|
|
global PgAcVar
|
|
$wn.c insert $PgAcVar(mw,$wn,id_edited) insert [selection get]
|
|
set PgAcVar(mw,$wn,dirtyrec) 1
|
|
}
|
|
|
|
proc {getNewWindowName} {} {
|
|
global PgAcVar
|
|
incr PgAcVar(mwcount)
|
|
return .pgaw:$PgAcVar(mwcount)
|
|
}
|
|
|
|
|
|
|
|
proc {createWindow} {{base ""}} {
|
|
global PgAcVar
|
|
if {$base == ""} {
|
|
set base .pgaw:$PgAcVar(mwcount)
|
|
set included 0
|
|
} else {
|
|
set included 1
|
|
}
|
|
set wn $base
|
|
set PgAcVar(mw,$wn,dirtyrec) 0
|
|
set PgAcVar(mw,$wn,id_edited) {}
|
|
set PgAcVar(mw,$wn,filter) {}
|
|
set PgAcVar(mw,$wn,sortfield) {}
|
|
if {! $included} {
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel
|
|
wm focusmodel $base passive
|
|
wm geometry $base 650x400
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 650 400
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 1 1
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Table"]
|
|
}
|
|
bind $base <Key-Delete> "Tables::deleteRecord $wn"
|
|
bind $base <Key-F1> "Help::load tables"
|
|
if {! $included} {
|
|
frame $base.f1 -borderwidth 2 -height 75 -relief groove -width 125
|
|
label $base.f1.l1 -borderwidth 0 -text [intlmsg {Sort field}]
|
|
entry $base.f1.e1 -background #fefefe -borderwidth 1 -width 14 -highlightthickness 1 -textvariable PgAcVar(mw,$wn,sortfield)
|
|
bind $base.f1.e1 <Key-Return> "Tables::refreshRecords $wn"
|
|
bind $base.f1.e1 <Key-KP_Enter> "Tables::refreshRecords $wn"
|
|
label $base.f1.lb1 -borderwidth 0 -text { }
|
|
label $base.f1.l2 -borderwidth 0 -text [intlmsg {Filter conditions}]
|
|
entry $base.f1.e2 -background #fefefe -borderwidth 1 -highlightthickness 1 -textvariable PgAcVar(mw,$wn,filter)
|
|
bind $base.f1.e2 <Key-Return> "Tables::refreshRecords $wn"
|
|
bind $base.f1.e2 <Key-KP_Enter> "Tables::refreshRecords $wn"
|
|
button $base.f1.b1 -borderwidth 1 -text [intlmsg Close] -command "
|
|
if {\[Tables::insertNewRecord $wn\]} {
|
|
$wn.c delete rows
|
|
$wn.c delete header
|
|
Window destroy $wn
|
|
PgAcVar:clean mw,$wn,*
|
|
}"
|
|
button $base.f1.b2 -borderwidth 1 -text [intlmsg Reload] -command "Tables::refreshRecords $wn"
|
|
}
|
|
frame $base.frame20 -borderwidth 2 -height 75 -relief groove -width 125
|
|
button $base.frame20.01 -borderwidth 1 -text < -command "Tables::panRight $wn"
|
|
label $base.frame20.02 -anchor w -borderwidth 1 -height 1 -relief sunken -text {} -textvariable PgAcVar(mw,$wn,msg)
|
|
button $base.frame20.03 -borderwidth 1 -text > -command "Tables::panLeft $wn"
|
|
canvas $base.c -background #fefefe -borderwidth 2 -height 207 -highlightthickness 0 -relief ridge -selectborderwidth 0 -takefocus 1 -width 295
|
|
scrollbar $base.sb -borderwidth 1 -orient vert -width 12 -command "Tables::scrollWindow $wn"
|
|
bind $base.c <Button-1> "Tables::canvasClick $wn %x %y"
|
|
bind $base.c <Button-2> "Tables::canvasPaste $wn %x %y"
|
|
bind $base.c <Button-3> "if {[Tables::finishEdit $wn]} \"Tables::insertNewRecord $wn\""
|
|
|
|
# Prevent Tab from moving focus out of canvas widget
|
|
bind $base.c <Tab> break
|
|
|
|
if {! $included} {
|
|
pack $base.f1 -in $wn -anchor center -expand 0 -fill x -side top
|
|
pack $base.f1.l1 -in $wn.f1 -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.e1 -in $wn.f1 -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.lb1 -in $wn.f1 -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.l2 -in $wn.f1 -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.e2 -in $wn.f1 -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.b1 -in $wn.f1 -anchor center -expand 0 -fill none -side right
|
|
pack $base.f1.b2 -in $wn.f1 -anchor center -expand 0 -fill none -side right
|
|
}
|
|
pack $base.frame20 -in $wn -anchor s -expand 0 -fill x -side bottom
|
|
pack $base.frame20.01 -in $wn.frame20 -anchor center -expand 0 -fill none -side left
|
|
pack $base.frame20.02 -in $wn.frame20 -anchor center -expand 1 -fill x -side left
|
|
pack $base.frame20.03 -in $wn.frame20 -anchor center -expand 0 -fill none -side right
|
|
pack $base.c -in $wn -anchor w -expand 1 -fill both -side left
|
|
pack $base.sb -in $wn -anchor e -expand 0 -fill y -side right
|
|
}
|
|
|
|
|
|
proc {renameColumn} {} {
|
|
global PgAcVar CurrentDB
|
|
if {[string length [string trim $PgAcVar(tblinfo,new_cn)]]==0} {
|
|
showError [intlmsg "Field name not entered!"]
|
|
return
|
|
}
|
|
set old_name [string trim [string range $PgAcVar(tblinfo,old_cn) 0 31]]
|
|
set PgAcVar(tblinfo,new_cn) [string trim $PgAcVar(tblinfo,new_cn)]
|
|
if {$old_name == $PgAcVar(tblinfo,new_cn)} {
|
|
showError [intlmsg "New name is the same as the old one!"]
|
|
return
|
|
}
|
|
foreach line [.pgaw:TableInfo.f1.lb get 0 end] {
|
|
if {[string trim [string range $line 0 31]]==$PgAcVar(tblinfo,new_cn)} {
|
|
showError [format [intlmsg {Column name '%s' already exists in this table!}] $PgAcVar(tblinfo,new_cn)]
|
|
return
|
|
}
|
|
}
|
|
if {[sql_exec noquiet "alter table \"$PgAcVar(tblinfo,tablename)\" rename column \"$old_name\" to \"$PgAcVar(tblinfo,new_cn)\""]} {
|
|
refreshTableInformation
|
|
Window destroy .pgaw:RenameField
|
|
}
|
|
}
|
|
|
|
|
|
|
|
proc {addNewIndex} {} {
|
|
global PgAcVar
|
|
set iflds [.pgaw:TableInfo.f1.lb curselection]
|
|
if {$iflds==""} {
|
|
showError [intlmsg "You have to select index fields!"]
|
|
return
|
|
}
|
|
set ifldslist {}
|
|
foreach i $iflds {lappend ifldslist "\"[string trim [string range [.pgaw:TableInfo.f1.lb get $i] 0 32]]\""}
|
|
set PgAcVar(addindex,indexname) $PgAcVar(tblinfo,tablename)_[join $ifldslist _]
|
|
# Replace the quotes with underlines
|
|
regsub -all {"} $PgAcVar(addindex,indexname) {_} PgAcVar(addindex,indexname)
|
|
# Replace the double underlines
|
|
while {[regsub -all {__} $PgAcVar(addindex,indexname) {_} PgAcVar(addindex,indexname)]} {}
|
|
# Replace the final underline
|
|
regsub -all {_$} $PgAcVar(addindex,indexname) {} PgAcVar(addindex,indexname)
|
|
set PgAcVar(addindex,indexfields) [join $ifldslist ,]
|
|
Window show .pgaw:AddIndex
|
|
wm transient .pgaw:AddIndex .pgaw:TableInfo
|
|
}
|
|
|
|
proc {deleteIndex} {} {
|
|
global PgAcVar
|
|
set sel [.pgaw:TableInfo.f2.fl.ilb curselection]
|
|
if {$sel == ""} {
|
|
showError [intlmsg "You have to select an index!"]
|
|
return
|
|
}
|
|
if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:TableInfo -message [format [intlmsg "You choose to delete index\n\n %s \n\nProceed?"] [.pgaw:TableInfo.f2.fl.ilb get $sel]] -type yesno -default no]=="no"} {return}
|
|
if {[sql_exec noquiet "drop index \"[.pgaw:TableInfo.f2.fl.ilb get $sel]\""]} {
|
|
refreshTableInformation
|
|
}
|
|
}
|
|
|
|
proc {createNewIndex} {} {
|
|
global PgAcVar
|
|
if {$PgAcVar(addindex,indexname)==""} {
|
|
showError [intlmsg "Index name cannot be null!"]
|
|
return
|
|
}
|
|
setCursor CLOCK
|
|
if {[sql_exec noquiet "CREATE $PgAcVar(addindex,unique) INDEX \"$PgAcVar(addindex,indexname)\" on \"$PgAcVar(tblinfo,tablename)\" ($PgAcVar(addindex,indexfields))"]} {
|
|
setCursor DEFAULT
|
|
Window destroy .pgaw:AddIndex
|
|
refreshTableInformation
|
|
}
|
|
setCursor DEFAULT
|
|
}
|
|
|
|
|
|
proc {showIndexInformation} {} {
|
|
global PgAcVar CurrentDB
|
|
set cs [.pgaw:TableInfo.f2.fl.ilb curselection]
|
|
if {$cs==""} return
|
|
set idxname [.pgaw:TableInfo.f2.fl.ilb get $cs]
|
|
wpg_select $CurrentDB "select pg_index.*,pg_class.oid from pg_index,pg_class where pg_class.relname='$idxname' and pg_class.oid=pg_index.indexrelid" rec {
|
|
if {$rec(indisunique)=="t"} {
|
|
set PgAcVar(tblinfo,isunique) [intlmsg Yes]
|
|
} else {
|
|
set PgAcVar(tblinfo,isunique) [intlmsg No]
|
|
}
|
|
if {$rec(indisclustered)=="t"} {
|
|
set PgAcVar(tblinfo,isclustered) [intlmsg Yes]
|
|
} else {
|
|
set PgAcVar(tblinfo,isclustered) [intlmsg No]
|
|
}
|
|
set PgAcVar(tblinfo,indexfields) {}
|
|
.pgaw:TableInfo.f2.fr.lb delete 0 end
|
|
foreach field $rec(indkey) {
|
|
if {$field!=0} {
|
|
# wpg_select $CurrentDB "select attname from pg_attribute where attrelid=$PgAcVar(tblinfo,tableoid) and attnum=$field" rec1 {
|
|
# set PgAcVar(tblinfo,indexfields) "$PgAcVar(tblinfo,indexfields) $rec1(attname)"
|
|
# }
|
|
set PgAcVar(tblinfo,indexfields) "$PgAcVar(tblinfo,indexfields) $PgAcVar(tblinfo,f$field)"
|
|
.pgaw:TableInfo.f2.fr.lb insert end $PgAcVar(tblinfo,f$field)
|
|
}
|
|
|
|
}
|
|
}
|
|
set PgAcVar(tblinfo,indexfields) [string trim $PgAcVar(tblinfo,indexfields)]
|
|
}
|
|
|
|
|
|
proc {addNewColumn} {} {
|
|
global PgAcVar
|
|
if {$PgAcVar(addfield,name)==""} {
|
|
showError [intlmsg "Empty field name ?"]
|
|
focus .pgaw:AddField.e1
|
|
return
|
|
}
|
|
if {$PgAcVar(addfield,type)==""} {
|
|
showError [intlmsg "No field type ?"]
|
|
focus .pgaw:AddField.e2
|
|
return
|
|
}
|
|
if {![sql_exec quiet "alter table \"$PgAcVar(tblinfo,tablename)\" add column \"$PgAcVar(addfield,name)\" $PgAcVar(addfield,type)"]} {
|
|
showError "[intlmsg {Cannot add column}]\n\n$PgAcVar(pgsql,errmsg)"
|
|
return
|
|
}
|
|
Window destroy .pgaw:AddField
|
|
sql_exec quiet "update pga_layout set colnames=colnames || ' {$PgAcVar(addfield,name)}', colwidth=colwidth || ' 150',nrcols=nrcols+1 where tablename='$PgAcVar(tblinfo,tablename)'"
|
|
refreshTableInformation
|
|
}
|
|
|
|
|
|
proc {newtable:add_new_field} {} {
|
|
global PgAcVar
|
|
if {$PgAcVar(nt,fieldname)==""} {
|
|
showError [intlmsg "Enter a field name"]
|
|
focus .pgaw:NewTable.e2
|
|
return
|
|
}
|
|
if {$PgAcVar(nt,fldtype)==""} {
|
|
showError [intlmsg "The field type is not specified!"]
|
|
return
|
|
}
|
|
if {($PgAcVar(nt,fldtype)=="varchar")&&($PgAcVar(nt,fldsize)=="")} {
|
|
focus .pgaw:NewTable.e3
|
|
showError [intlmsg "You must specify field size!"]
|
|
return
|
|
}
|
|
if {$PgAcVar(nt,fldsize)==""} then {set sup ""} else {set sup "($PgAcVar(nt,fldsize))"}
|
|
if {[regexp $PgAcVar(nt,fldtype) "varchartextdatetime"]} {set supc "'"} else {set supc ""}
|
|
# Don't put the ' arround default value if it contains the now() function
|
|
if {([regexp $PgAcVar(nt,fldtype) "datetime"]) && ([regexp now $PgAcVar(nt,defaultval)])} {set supc ""}
|
|
# Clear the notnull attribute if field type is serial
|
|
if {$PgAcVar(nt,fldtype)=="serial"} {set PgAcVar(nt,notnull) " "}
|
|
if {$PgAcVar(nt,defaultval)==""} then {set sup2 ""} else {set sup2 " DEFAULT $supc$PgAcVar(nt,defaultval)$supc"}
|
|
# Checking for field name collision
|
|
set inspos end
|
|
for {set i 0} {$i<[.pgaw:NewTable.lb size]} {incr i} {
|
|
set linie [.pgaw:NewTable.lb get $i]
|
|
if {$PgAcVar(nt,fieldname)==[string trim [string range $linie 2 33]]} {
|
|
if {[tk_messageBox -title [intlmsg Warning] -parent .pgaw:NewTable -message [format [intlmsg "There is another field with the same name: '%s'!\n\nReplace it ?"] $PgAcVar(nt,fieldname)] -type yesno -default yes]=="no"} return
|
|
.pgaw:NewTable.lb delete $i
|
|
set inspos $i
|
|
break
|
|
}
|
|
}
|
|
.pgaw:NewTable.lb insert $inspos [format "%1s %-32.32s %-14s%-16s" $PgAcVar(nt,primarykey) $PgAcVar(nt,fieldname) $PgAcVar(nt,fldtype)$sup $sup2$PgAcVar(nt,notnull)]
|
|
focus .pgaw:NewTable.e2
|
|
set PgAcVar(nt,fieldname) {}
|
|
set PgAcVar(nt,fldsize) {}
|
|
set PgAcVar(nt,defaultval) {}
|
|
set PgAcVar(nt,primarykey) " "
|
|
}
|
|
|
|
proc {newtable:create} {} {
|
|
global PgAcVar CurrentDB
|
|
if {$PgAcVar(nt,tablename)==""} then {
|
|
showError [intlmsg "You must supply a name for your table!"]
|
|
focus .pgaw:NewTable.etabn
|
|
return
|
|
}
|
|
if {([.pgaw:NewTable.lb size]==0) && ($PgAcVar(nt,inherits)=="")} then {
|
|
showError [intlmsg "Your table has no columns!"]
|
|
focus .pgaw:NewTable.e2
|
|
return
|
|
}
|
|
set fl {}
|
|
set pkf {}
|
|
foreach line [.pgaw:NewTable.lb get 0 end] {
|
|
set fldname "\"[string trim [string range $line 2 33]]\""
|
|
lappend fl "$fldname [string trim [string range $line 35 end]]"
|
|
if {[string range $line 0 0]=="*"} {
|
|
lappend pkf "$fldname"
|
|
}
|
|
}
|
|
set temp "create table \"$PgAcVar(nt,tablename)\" ([join $fl ,]"
|
|
if {$PgAcVar(nt,constraint)!=""} then {set temp "$temp, constraint \"$PgAcVar(nt,constraint)\""}
|
|
if {$PgAcVar(nt,check)!=""} then {set temp "$temp check ($PgAcVar(nt,check))"}
|
|
if {[llength $pkf]>0} then {set temp "$temp, primary key([join $pkf ,])"}
|
|
set temp "$temp)"
|
|
if {$PgAcVar(nt,inherits)!=""} then {set temp "$temp inherits ($PgAcVar(nt,inherits))"}
|
|
setCursor CLOCK
|
|
if {[sql_exec noquiet $temp]} {
|
|
Window destroy .pgaw:NewTable
|
|
Mainlib::cmd_Tables
|
|
}
|
|
setCursor DEFAULT
|
|
}
|
|
|
|
proc {tabSelect} {i} {
|
|
global PgAcVar
|
|
set base .pgaw:TableInfo
|
|
foreach tab {0 1 2 3} {
|
|
if {$i == $tab} {
|
|
place $base.l$tab -y 13
|
|
place $base.f$tab -x 15 -y 45
|
|
$base.l$tab configure -font $PgAcVar(pref,font_bold)
|
|
} else {
|
|
place $base.l$tab -y 15
|
|
place $base.f$tab -x 15 -y 500
|
|
$base.l$tab configure -font $PgAcVar(pref,font_normal)
|
|
}
|
|
}
|
|
array set coord [place info $base.l$i]
|
|
place $base.lline -x [expr {1+$coord(-x)}]
|
|
}
|
|
|
|
|
|
}
|
|
|
|
#################### END OF NAMESPACE TABLES ####################
|
|
|
|
proc vTclWindow.pgaw:NewTable {base} {
|
|
global PgAcVar
|
|
if {$base == ""} {
|
|
set base .pgaw:NewTable
|
|
}
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel
|
|
wm focusmodel $base passive
|
|
wm geometry $base 634x392+78+181
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 1 1
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 0 0
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Create new table"]
|
|
bind $base <Key-F1> "Help::load new_table"
|
|
entry $base.etabn \
|
|
-background #fefefe -borderwidth 1 -selectborderwidth 0 \
|
|
-textvariable PgAcVar(nt,tablename)
|
|
bind $base.etabn <Key-Return> {
|
|
focus .pgaw:NewTable.einh
|
|
}
|
|
label $base.li \
|
|
-anchor w -borderwidth 0 -text [intlmsg Inherits]
|
|
entry $base.einh \
|
|
-background #fefefe -borderwidth 1 -selectborderwidth 0 \
|
|
-textvariable PgAcVar(nt,inherits)
|
|
bind $base.einh <Key-Return> {
|
|
focus .pgaw:NewTable.e2
|
|
}
|
|
button $base.binh \
|
|
-borderwidth 1 \
|
|
-command {if {[winfo exists .pgaw:NewTable.ddf]} {
|
|
destroy .pgaw:NewTable.ddf
|
|
} else {
|
|
create_drop_down .pgaw:NewTable 386 23 220
|
|
focus .pgaw:NewTable.ddf.sb
|
|
foreach tbl [Database::getTablesList] {.pgaw:NewTable.ddf.lb insert end $tbl}
|
|
bind .pgaw:NewTable.ddf.lb <ButtonRelease-1> {
|
|
set i [.pgaw:NewTable.ddf.lb curselection]
|
|
if {$i!=""} {
|
|
if {$PgAcVar(nt,inherits)==""} {
|
|
set PgAcVar(nt,inherits) "\"[.pgaw:NewTable.ddf.lb get $i]\""
|
|
} else {
|
|
set PgAcVar(nt,inherits) "$PgAcVar(nt,inherits),\"[.pgaw:NewTable.ddf.lb get $i]\""
|
|
}
|
|
}
|
|
if {$i!=""} {focus .pgaw:NewTable.e2}
|
|
destroy .pgaw:NewTable.ddf
|
|
break
|
|
}
|
|
}} \
|
|
-highlightthickness 0 -takefocus 0 -image dnarw
|
|
entry $base.e2 \
|
|
-background #fefefe -borderwidth 1 -selectborderwidth 0 \
|
|
-textvariable PgAcVar(nt,fieldname)
|
|
bind $base.e2 <Key-Return> {
|
|
focus .pgaw:NewTable.e1
|
|
}
|
|
entry $base.e1 \
|
|
-background #fefefe -borderwidth 1 -selectborderwidth 0 \
|
|
-textvariable PgAcVar(nt,fldtype)
|
|
bind $base.e1 <Key-Return> {
|
|
focus .pgaw:NewTable.e5
|
|
}
|
|
entry $base.e3 \
|
|
-background #fefefe -borderwidth 1 -selectborderwidth 0 \
|
|
-textvariable PgAcVar(nt,fldsize)
|
|
bind $base.e3 <Key-Return> {
|
|
focus .pgaw:NewTable.e5
|
|
}
|
|
entry $base.e5 \
|
|
-background #fefefe -borderwidth 1 -selectborderwidth 0 \
|
|
-textvariable PgAcVar(nt,defaultval)
|
|
bind $base.e5 <Key-Return> {
|
|
focus .pgaw:NewTable.cb1
|
|
}
|
|
checkbutton $base.cb1 \
|
|
-borderwidth 1 \
|
|
-offvalue { } -onvalue { NOT NULL} -text [intlmsg {field cannot be null}] \
|
|
-variable PgAcVar(nt,notnull)
|
|
label $base.lab1 \
|
|
-borderwidth 0 -text [intlmsg type]
|
|
label $base.lab2 \
|
|
-borderwidth 0 -anchor w -text [intlmsg {field name}]
|
|
label $base.lab3 \
|
|
-borderwidth 0 -text [intlmsg size]
|
|
label $base.lab4 \
|
|
-borderwidth 0 -anchor w -text [intlmsg {Default value}]
|
|
button $base.addfld \
|
|
-borderwidth 1 -command Tables::newtable:add_new_field \
|
|
-text [intlmsg {Add field}]
|
|
button $base.delfld \
|
|
-borderwidth 1 -command {catch {.pgaw:NewTable.lb delete [.pgaw:NewTable.lb curselection]}} \
|
|
-text [intlmsg {Delete field}]
|
|
button $base.emptb \
|
|
-borderwidth 1 -command {.pgaw:NewTable.lb delete 0 [.pgaw:NewTable.lb size]} \
|
|
-text [intlmsg {Delete all}]
|
|
button $base.maketbl \
|
|
-borderwidth 1 -command Tables::newtable:create \
|
|
-text [intlmsg Create]
|
|
listbox $base.lb \
|
|
-background #fefefe -foreground #000000 -borderwidth 1 \
|
|
-selectbackground #c3c3c3 -font $PgAcVar(pref,font_fix) \
|
|
-selectborderwidth 0 -yscrollcommand {.pgaw:NewTable.sb set}
|
|
bind $base.lb <ButtonRelease-1> {
|
|
if {[.pgaw:NewTable.lb curselection]!=""} {
|
|
set fldname [string trim [lindex [split [.pgaw:NewTable.lb get [.pgaw:NewTable.lb curselection]]] 0]]
|
|
}
|
|
}
|
|
button $base.exitbtn \
|
|
-borderwidth 1 -command {Window destroy .pgaw:NewTable} \
|
|
-text [intlmsg Cancel]
|
|
button $base.helpbtn \
|
|
-borderwidth 1 -command {Help::load new_table} \
|
|
-text [intlmsg Help]
|
|
label $base.l1 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief raised -text " [intlmsg {field name}]"
|
|
label $base.l2 \
|
|
-borderwidth 1 \
|
|
-relief raised -text [intlmsg type]
|
|
label $base.l3 \
|
|
-borderwidth 1 \
|
|
-relief raised -text [intlmsg options]
|
|
scrollbar $base.sb \
|
|
-borderwidth 1 -command {.pgaw:NewTable.lb yview} -orient vert
|
|
label $base.l93 \
|
|
-anchor w -borderwidth 0 -text [intlmsg {Table name}]
|
|
button $base.mvup \
|
|
-borderwidth 1 \
|
|
-command {if {[.pgaw:NewTable.lb size]>1} {
|
|
set i [.pgaw:NewTable.lb curselection]
|
|
if {($i!="")&&($i>0)} {
|
|
.pgaw:NewTable.lb insert [expr $i-1] [.pgaw:NewTable.lb get $i]
|
|
.pgaw:NewTable.lb delete [expr $i+1]
|
|
.pgaw:NewTable.lb selection set [expr $i-1]
|
|
}
|
|
}} \
|
|
-text [intlmsg {Move up}]
|
|
button $base.mvdn \
|
|
-borderwidth 1 \
|
|
-command {if {[.pgaw:NewTable.lb size]>1} {
|
|
set i [.pgaw:NewTable.lb curselection]
|
|
if {($i!="")&&($i<[expr [.pgaw:NewTable.lb size]-1])} {
|
|
.pgaw:NewTable.lb insert [expr $i+2] [.pgaw:NewTable.lb get $i]
|
|
.pgaw:NewTable.lb delete $i
|
|
.pgaw:NewTable.lb selection set [expr $i+1]
|
|
}
|
|
}} \
|
|
-text [intlmsg {Move down}]
|
|
button $base.button17 \
|
|
-borderwidth 1 \
|
|
-command {
|
|
if {[winfo exists .pgaw:NewTable.ddf]} {
|
|
destroy .pgaw:NewTable.ddf
|
|
} else {
|
|
create_drop_down .pgaw:NewTable 291 80 97
|
|
focus .pgaw:NewTable.ddf.sb
|
|
.pgaw:NewTable.ddf.lb insert end char varchar text int2 int4 serial float4 float8 money abstime date datetime interval reltime time timespan timestamp boolean box circle line lseg path point polygon
|
|
bind .pgaw:NewTable.ddf.lb <ButtonRelease-1> {
|
|
set i [.pgaw:NewTable.ddf.lb curselection]
|
|
if {$i!=""} {set PgAcVar(nt,fldtype) [.pgaw:NewTable.ddf.lb get $i]}
|
|
destroy .pgaw:NewTable.ddf
|
|
if {$i!=""} {
|
|
if {[lsearch {char varchar} $PgAcVar(nt,fldtype)]==-1} {
|
|
set PgAcVar(nt,fldsize) {}
|
|
.pgaw:NewTable.e3 configure -state disabled
|
|
focus .pgaw:NewTable.e5
|
|
} else {
|
|
.pgaw:NewTable.e3 configure -state normal
|
|
focus .pgaw:NewTable.e3
|
|
}
|
|
}
|
|
break
|
|
}
|
|
}} \
|
|
-highlightthickness 0 -takefocus 0 -image dnarw
|
|
label $base.lco \
|
|
-borderwidth 0 -anchor w -text [intlmsg Constraint]
|
|
entry $base.eco \
|
|
-background #fefefe -borderwidth 1 -textvariable PgAcVar(nt,constraint)
|
|
label $base.lch \
|
|
-borderwidth 0 -text [intlmsg check]
|
|
entry $base.ech \
|
|
-background #fefefe -borderwidth 1 -textvariable PgAcVar(nt,check)
|
|
label $base.ll \
|
|
-borderwidth 1 \
|
|
-relief raised
|
|
checkbutton $base.pk \
|
|
-borderwidth 1 \
|
|
-offvalue { } -onvalue * -text [intlmsg {primary key}] -variable PgAcVar(nt,primarykey)
|
|
label $base.lpk \
|
|
-borderwidth 1 \
|
|
-relief raised -text K
|
|
place $base.etabn \
|
|
-x 105 -y 5 -width 136 -height 20 -anchor nw -bordermode ignore
|
|
place $base.li \
|
|
-x 245 -y 7 -height 16 -anchor nw -bordermode ignore
|
|
place $base.einh \
|
|
-x 300 -y 5 -width 308 -height 20 -anchor nw -bordermode ignore
|
|
place $base.binh \
|
|
-x 590 -y 7 -width 16 -height 16 -anchor nw -bordermode ignore
|
|
place $base.e2 \
|
|
-x 105 -y 60 -width 136 -height 20 -anchor nw -bordermode ignore
|
|
place $base.e1 \
|
|
-x 291 -y 60 -width 98 -height 20 -anchor nw -bordermode ignore
|
|
place $base.e3 \
|
|
-x 470 -y 60 -width 46 -height 20 -anchor nw -bordermode ignore
|
|
place $base.e5 \
|
|
-x 105 -y 82 -width 136 -height 20 -anchor nw -bordermode ignore
|
|
place $base.cb1 \
|
|
-x 245 -y 83 -height 20 -anchor nw -bordermode ignore
|
|
place $base.lab1 \
|
|
-x 247 -y 62 -height 16 -anchor nw -bordermode ignore
|
|
place $base.lab2 \
|
|
-x 4 -y 62 -height 16 -anchor nw -bordermode ignore
|
|
place $base.lab3 \
|
|
-x 400 -y 62 -height 16 -anchor nw -bordermode ignore
|
|
place $base.lab4 \
|
|
-x 5 -y 84 -height 16 -anchor nw -bordermode ignore
|
|
place $base.addfld \
|
|
-x 530 -y 58 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.delfld \
|
|
-x 530 -y 190 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.emptb \
|
|
-x 530 -y 220 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.maketbl \
|
|
-x 530 -y 365 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.lb \
|
|
-x 4 -y 121 -width 506 -height 269 -anchor nw -bordermode ignore
|
|
place $base.helpbtn \
|
|
-x 530 -y 305 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.exitbtn \
|
|
-x 530 -y 335 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.l1 \
|
|
-x 18 -y 105 -width 195 -height 18 -anchor nw -bordermode ignore
|
|
place $base.l2 \
|
|
-x 213 -y 105 -width 88 -height 18 -anchor nw -bordermode ignore
|
|
place $base.l3 \
|
|
-x 301 -y 105 -width 225 -height 18 -anchor nw -bordermode ignore
|
|
place $base.sb \
|
|
-x 509 -y 121 -width 18 -height 269 -anchor nw -bordermode ignore
|
|
place $base.l93 \
|
|
-x 4 -y 7 -height 16 -anchor nw -bordermode ignore
|
|
place $base.mvup \
|
|
-x 530 -y 120 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.mvdn \
|
|
-x 530 -y 150 -width 100 -height 26 -anchor nw -bordermode ignore
|
|
place $base.button17 \
|
|
-x 371 -y 62 -width 16 -height 16 -anchor nw -bordermode ignore
|
|
place $base.lco \
|
|
-x 5 -y 28 -width 58 -height 16 -anchor nw -bordermode ignore
|
|
place $base.eco \
|
|
-x 105 -y 27 -width 136 -height 20 -anchor nw -bordermode ignore
|
|
place $base.lch \
|
|
-x 245 -y 30 -anchor nw -bordermode ignore
|
|
place $base.ech \
|
|
-x 300 -y 27 -width 308 -height 22 -anchor nw -bordermode ignore
|
|
place $base.ll \
|
|
-x 5 -y 53 -width 603 -height 2 -anchor nw -bordermode ignore
|
|
place $base.pk \
|
|
-x 450 -y 83 -height 20 -anchor nw -bordermode ignore
|
|
place $base.lpk \
|
|
-x 4 -y 105 -width 14 -height 18 -anchor nw -bordermode ignore
|
|
}
|
|
|
|
|
|
proc vTclWindow.pgaw:TableInfo {base} {
|
|
global PgAcVar
|
|
if {$base == ""} {
|
|
set base .pgaw:TableInfo
|
|
}
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel \
|
|
-background #c7c3c7
|
|
wm focusmodel $base passive
|
|
wm geometry $base 522x398+152+135
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 1 1
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 0 0
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Table information"]
|
|
bind $base <Key-F1> "Help::load view_table_structure"
|
|
label $base.l0 \
|
|
-borderwidth 1 -font $PgAcVar(pref,font_bold) \
|
|
-relief raised -text [intlmsg General]
|
|
bind $base.l0 <Button-1> {
|
|
Tables::tabSelect 0
|
|
}
|
|
label $base.l1 \
|
|
-borderwidth 1 \
|
|
-relief raised -text [intlmsg Columns]
|
|
bind $base.l1 <Button-1> {
|
|
Tables::tabSelect 1
|
|
}
|
|
label $base.l2 \
|
|
-borderwidth 1 \
|
|
-relief raised -text [intlmsg Indexes]
|
|
bind $base.l2 <Button-1> {
|
|
Tables::tabSelect 2
|
|
}
|
|
label $base.l3 \
|
|
-borderwidth 1 \
|
|
-relief raised -text [intlmsg Permissions]
|
|
bind $base.l3 <Button-1> {
|
|
Tables::tabSelect 3
|
|
}
|
|
label $base.l \
|
|
-relief raised
|
|
button $base.btnclose \
|
|
-borderwidth 1 -command {Window destroy .pgaw:TableInfo} \
|
|
-highlightthickness 0 -padx 9 -pady 3 -text [intlmsg Close]
|
|
frame $base.f1 \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
frame $base.f1.ft \
|
|
-height 75 -relief groove -width 125
|
|
label $base.f1.ft.t1 \
|
|
-relief groove -text [intlmsg {field name}]
|
|
label $base.f1.ft.t2 \
|
|
-relief groove -text [intlmsg type] -width 12
|
|
label $base.f1.ft.t3 \
|
|
-relief groove -text [intlmsg size] -width 6
|
|
label $base.f1.ft.lnn \
|
|
-relief groove -text [intlmsg {not null}] -width 18
|
|
label $base.f1.ft.ls \
|
|
-borderwidth 0 \
|
|
-relief raised -text { }
|
|
frame $base.f1.fb \
|
|
-height 75 -relief groove -width 125
|
|
button $base.f1.fb.addcolbtn \
|
|
-borderwidth 1 \
|
|
-command {Window show .pgaw:AddField
|
|
set PgAcVar(addfield,name) {}
|
|
set PgAcVar(addfield,type) {}
|
|
wm transient .pgaw:AddField .pgaw:TableInfo
|
|
focus .pgaw:AddField.e1} \
|
|
-padx 9 -pady 3 -text [intlmsg {Add new column}]
|
|
button $base.f1.fb.rencolbtn \
|
|
-borderwidth 1 \
|
|
-command {
|
|
if {[set PgAcVar(tblinfo,col_id) [.pgaw:TableInfo.f1.lb curselection]]==""} then {
|
|
bell
|
|
} else {
|
|
set PgAcVar(tblinfo,old_cn) [.pgaw:TableInfo.f1.lb get [.pgaw:TableInfo.f1.lb curselection]]
|
|
set PgAcVar(tblinfo,new_cn) {}
|
|
Window show .pgaw:RenameField
|
|
tkwait visibility .pgaw:RenameField
|
|
wm transient .pgaw:RenameField .pgaw:TableInfo
|
|
focus .pgaw:RenameField.e1
|
|
}
|
|
} \
|
|
-padx 9 -pady 3 -text [intlmsg {Rename column}]
|
|
button $base.f1.fb.addidxbtn \
|
|
-borderwidth 1 -command Tables::addNewIndex \
|
|
-padx 9 \
|
|
-pady 3 -text [intlmsg {Add new index}]
|
|
listbox $base.f1.lb \
|
|
-background #fefefe -borderwidth 1 -font $PgAcVar(pref,font_fix) \
|
|
-highlightthickness 0 -selectborderwidth 0 \
|
|
-selectmode extended \
|
|
-yscrollcommand {.pgaw:TableInfo.f1.vsb set}
|
|
scrollbar $base.f1.vsb \
|
|
-borderwidth 1 -command {.pgaw:TableInfo.f1.lb yview} -orient vert -width 14
|
|
frame $base.f2 \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
frame $base.f2.fl \
|
|
-height 75 -relief groove -width 182
|
|
label $base.f2.fl.t \
|
|
-relief groove -text [intlmsg {Indexes defined}]
|
|
button $base.f2.fl.delidxbtn \
|
|
-borderwidth 1 -command Tables::deleteIndex \
|
|
-padx 9 \
|
|
-pady 3 -text [intlmsg {Delete index}]
|
|
listbox $base.f2.fl.ilb \
|
|
-background #fefefe -borderwidth 1 \
|
|
-highlightthickness 0 -selectborderwidth 0 -width 37 \
|
|
-yscrollcommand {.pgaw:TableInfo.f2.fl.vsb set}
|
|
bind $base.f2.fl.ilb <ButtonRelease-1> {
|
|
Tables::showIndexInformation
|
|
}
|
|
scrollbar $base.f2.fl.vsb \
|
|
-borderwidth 1 -command {.pgaw:TableInfo.f2.fl.ilb yview} -orient vert -width 14
|
|
frame $base.f2.fr \
|
|
-height 75 -relief groove -width 526
|
|
label $base.f2.fr.t \
|
|
-relief groove -text [intlmsg {index properties}]
|
|
button $base.f2.fr.clusterbtn \
|
|
-borderwidth 1 -command Tables::clusterIndex \
|
|
-padx 9 -pady 3 -text [intlmsg {Cluster index}]
|
|
frame $base.f2.fr.fp \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
label $base.f2.fr.fp.lu \
|
|
-anchor w -borderwidth 0 \
|
|
-relief raised -text [intlmsg {Is unique ?}]
|
|
label $base.f2.fr.fp.vu \
|
|
-borderwidth 0 -textvariable PgAcVar(tblinfo,isunique) \
|
|
-foreground #000096 -relief raised -text {}
|
|
label $base.f2.fr.fp.lc \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Is clustered ?}]
|
|
label $base.f2.fr.fp.vc -textvariable PgAcVar(tblinfo,isclustered) \
|
|
-borderwidth 0 \
|
|
-foreground #000096 -relief raised -text {}
|
|
label $base.f2.fr.lic \
|
|
-relief groove -text [intlmsg {index columns}]
|
|
listbox $base.f2.fr.lb \
|
|
-background #fefefe -borderwidth 1 \
|
|
-highlightthickness 0 -selectborderwidth 0 \
|
|
-yscrollcommand {.pgaw:TableInfo.f2.fr.vsb set}
|
|
scrollbar $base.f2.fr.vsb \
|
|
-borderwidth 1 -command {.pgaw:TableInfo.f2.fr.lb yview} -orient vert -width 14
|
|
frame $base.f3 \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
frame $base.f3.ft \
|
|
-height 75 -relief groove -width 125
|
|
label $base.f3.ft.luser \
|
|
-relief groove -text [intlmsg {User name}]
|
|
label $base.f3.ft.lselect \
|
|
-relief groove -text [intlmsg select] -width 10
|
|
label $base.f3.ft.lupdate \
|
|
-relief groove -text [intlmsg update] -width 10
|
|
label $base.f3.ft.linsert \
|
|
-relief groove -text [intlmsg insert] -width 10
|
|
label $base.f3.ft.lrule \
|
|
-relief groove -text [intlmsg rule] -width 10
|
|
label $base.f3.ft.ls \
|
|
-borderwidth 0 \
|
|
-relief raised -text { }
|
|
frame $base.f3.fb \
|
|
-height 75 -relief groove -width 125
|
|
button $base.f3.fb.adduserbtn \
|
|
-borderwidth 1 -command Tables::newPermissions \
|
|
-padx 9 -pady 3 -text [intlmsg {Add user}]
|
|
button $base.f3.fb.chguserbtn -command Tables::loadPermissions \
|
|
-borderwidth 1 -padx 9 -pady 3 -text [intlmsg {Change permissions}]
|
|
listbox $base.f3.plb \
|
|
-background #fefefe -borderwidth 1 -font $PgAcVar(pref,font_fix) \
|
|
-highlightthickness 0 -selectborderwidth 0 \
|
|
-yscrollcommand {.pgaw:TableInfo.f3.vsb set}
|
|
bind $base.f3.plb <Double-1> Tables::loadPermissions
|
|
scrollbar $base.f3.vsb \
|
|
-borderwidth 1 -command {.pgaw:TableInfo.f3.plb yview} -orient vert -width 14
|
|
label $base.lline \
|
|
-borderwidth 0 \
|
|
-relief raised -text { }
|
|
frame $base.f0 \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
frame $base.f0.fi \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
label $base.f0.fi.l1 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Table name}]
|
|
label $base.f0.fi.l2 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief sunken -text {} -textvariable PgAcVar(tblinfo,tablename) \
|
|
-width 200
|
|
label $base.f0.fi.l3 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Table OID}]
|
|
label $base.f0.fi.l4 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief sunken -text {} -textvariable PgAcVar(tblinfo,tableoid) \
|
|
-width 200
|
|
label $base.f0.fi.l5 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg Owner]
|
|
label $base.f0.fi.l6 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief sunken -text {} -textvariable PgAcVar(tblinfo,owner) \
|
|
-width 200
|
|
label $base.f0.fi.l7 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Owner ID}]
|
|
label $base.f0.fi.l8 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief sunken -text {} -textvariable PgAcVar(tblinfo,ownerid) \
|
|
-width 200
|
|
label $base.f0.fi.l9 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Has primary key ?}]
|
|
label $base.f0.fi.l10 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief sunken -text {} \
|
|
-textvariable PgAcVar(tblinfo,hasprimarykey) -width 200
|
|
label $base.f0.fi.l11 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Has rules ?}]
|
|
label $base.f0.fi.l12 \
|
|
-anchor w -borderwidth 1 \
|
|
-relief sunken -text {} -textvariable PgAcVar(tblinfo,hasrules) \
|
|
-width 200
|
|
label $base.f0.fi.last \
|
|
-borderwidth 0 \
|
|
-relief raised -text { }
|
|
frame $base.f0.fs \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
label $base.f0.fs.l1 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Number of tuples}]
|
|
label $base.f0.fs.l2 \
|
|
-anchor e -borderwidth 1 \
|
|
-relief sunken -text 0 -textvariable PgAcVar(tblinfo,numtuples) \
|
|
-width 200
|
|
label $base.f0.fs.l3 \
|
|
-borderwidth 0 \
|
|
-relief raised -text [intlmsg {Number of pages}]
|
|
label $base.f0.fs.l4 \
|
|
-anchor e -borderwidth 1 \
|
|
-relief sunken -text 0 -textvariable PgAcVar(tblinfo,numpages) \
|
|
-width 200
|
|
label $base.f0.fs.last \
|
|
-borderwidth 0 \
|
|
-relief raised -text { }
|
|
label $base.f0.lstat \
|
|
-borderwidth 0 -font $PgAcVar(pref,font_bold) -relief raised \
|
|
-text " [intlmsg Statistics] "
|
|
label $base.f0.lid \
|
|
-borderwidth 0 -font $PgAcVar(pref,font_bold) -relief raised \
|
|
-text " [intlmsg Identification] "
|
|
place $base.l0 \
|
|
-x 15 -y 13 -width 96 -height 23 -anchor nw -bordermode ignore
|
|
place $base.l1 \
|
|
-x 111 -y 15 -width 96 -height 23 -anchor nw -bordermode ignore
|
|
place $base.l2 \
|
|
-x 207 -y 15 -width 96 -height 23 -anchor nw -bordermode ignore
|
|
place $base.l3 \
|
|
-x 303 -y 15 -width 96 -height 23 -anchor nw -bordermode ignore
|
|
place $base.l \
|
|
-x 5 -y 35 -width 511 -height 357 -anchor nw -bordermode ignore
|
|
place $base.btnclose \
|
|
-x 425 -y 5 -width 91 -height 26 -anchor nw -bordermode ignore
|
|
place $base.f1 \
|
|
-x 15 -y 500 -width 490 -height 335 -anchor nw -bordermode ignore
|
|
pack $base.f1.ft \
|
|
-in .pgaw:TableInfo.f1 -anchor center -expand 0 -fill x -side top
|
|
pack $base.f1.ft.t1 \
|
|
-in .pgaw:TableInfo.f1.ft -anchor center -expand 1 -fill x -side left
|
|
pack $base.f1.ft.t2 \
|
|
-in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.ft.t3 \
|
|
-in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.ft.lnn \
|
|
-in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f1.ft.ls \
|
|
-in .pgaw:TableInfo.f1.ft -anchor center -expand 0 -fill none -side top
|
|
pack $base.f1.fb \
|
|
-in .pgaw:TableInfo.f1 -anchor center -expand 0 -fill x -side bottom
|
|
grid $base.f1.fb.addcolbtn \
|
|
-in .pgaw:TableInfo.f1.fb -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f1.fb.rencolbtn \
|
|
-in .pgaw:TableInfo.f1.fb -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f1.fb.addidxbtn \
|
|
-in .pgaw:TableInfo.f1.fb -column 2 -row 0 -columnspan 1 -rowspan 1
|
|
pack $base.f1.lb \
|
|
-in .pgaw:TableInfo.f1 -anchor center -expand 1 -fill both -pady 1 -side left
|
|
pack $base.f1.vsb \
|
|
-in .pgaw:TableInfo.f1 -anchor center -expand 0 -fill y -side right
|
|
place $base.f2 \
|
|
-x 15 -y 500 -width 490 -height 335 -anchor nw -bordermode ignore
|
|
pack $base.f2.fl \
|
|
-in .pgaw:TableInfo.f2 -anchor center -expand 0 -fill both -side left
|
|
pack $base.f2.fl.t \
|
|
-in .pgaw:TableInfo.f2.fl -anchor center -expand 0 -fill x -pady 1 -side top
|
|
pack $base.f2.fl.delidxbtn \
|
|
-in .pgaw:TableInfo.f2.fl -anchor center -expand 0 -fill none -side bottom
|
|
pack $base.f2.fl.ilb \
|
|
-in .pgaw:TableInfo.f2.fl -anchor center -expand 1 -fill both -pady 1 -side left
|
|
pack $base.f2.fl.vsb \
|
|
-in .pgaw:TableInfo.f2.fl -anchor center -expand 0 -fill y -side right
|
|
pack $base.f2.fr \
|
|
-in .pgaw:TableInfo.f2 -anchor center -expand 1 -fill both -padx 1 -side right
|
|
pack $base.f2.fr.t \
|
|
-in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill x -pady 1 -side top
|
|
pack $base.f2.fr.clusterbtn \
|
|
-in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill none -side bottom
|
|
pack $base.f2.fr.fp \
|
|
-in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill x -pady 1 -side top
|
|
grid $base.f2.fr.fp.lu \
|
|
-in .pgaw:TableInfo.f2.fr.fp -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f2.fr.fp.vu \
|
|
-in .pgaw:TableInfo.f2.fr.fp -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 5 \
|
|
-sticky w
|
|
grid $base.f2.fr.fp.lc \
|
|
-in .pgaw:TableInfo.f2.fr.fp -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f2.fr.fp.vc \
|
|
-in .pgaw:TableInfo.f2.fr.fp -column 1 -row 2 -columnspan 1 -rowspan 1 -padx 5 \
|
|
-sticky w
|
|
pack $base.f2.fr.lic \
|
|
-in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill x -side top
|
|
pack $base.f2.fr.lb \
|
|
-in .pgaw:TableInfo.f2.fr -anchor center -expand 1 -fill both -pady 1 -side left
|
|
pack $base.f2.fr.vsb \
|
|
-in .pgaw:TableInfo.f2.fr -anchor center -expand 0 -fill y -side right
|
|
place $base.f3 \
|
|
-x 15 -y 500 -width 490 -height 335 -anchor nw -bordermode ignore
|
|
pack $base.f3.ft \
|
|
-in .pgaw:TableInfo.f3 -anchor center -expand 0 -fill x -pady 1 -side top
|
|
pack $base.f3.ft.luser \
|
|
-in .pgaw:TableInfo.f3.ft -anchor center -expand 1 -fill x -side left
|
|
pack $base.f3.ft.lselect \
|
|
-in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f3.ft.lupdate \
|
|
-in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f3.ft.linsert \
|
|
-in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f3.ft.lrule \
|
|
-in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side left
|
|
pack $base.f3.ft.ls \
|
|
-in .pgaw:TableInfo.f3.ft -anchor center -expand 0 -fill none -side top
|
|
pack $base.f3.fb \
|
|
-in .pgaw:TableInfo.f3 -anchor center -expand 0 -fill x -side bottom
|
|
grid $base.f3.fb.adduserbtn \
|
|
-in .pgaw:TableInfo.f3.fb -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f3.fb.chguserbtn \
|
|
-in .pgaw:TableInfo.f3.fb -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
pack $base.f3.plb \
|
|
-in .pgaw:TableInfo.f3 -anchor center -expand 1 -fill both -pady 1 -side left
|
|
pack $base.f3.vsb \
|
|
-in .pgaw:TableInfo.f3 -anchor center -expand 0 -fill y -side right
|
|
place $base.lline \
|
|
-x 16 -y 32 -width 94 -height 6 -anchor nw -bordermode ignore
|
|
place $base.f0 \
|
|
-x 15 -y 45 -width 490 -height 335 -anchor nw -bordermode ignore
|
|
place $base.f0.fi \
|
|
-x 5 -y 15 -width 300 -height 140 -anchor nw -bordermode ignore
|
|
grid columnconf $base.f0.fi 1 -weight 1
|
|
grid rowconf $base.f0.fi 6 -weight 1
|
|
grid $base.f0.fi.l1 \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fi.l2 \
|
|
-in .pgaw:TableInfo.f0.fi -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2
|
|
grid $base.f0.fi.l3 \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fi.l4 \
|
|
-in .pgaw:TableInfo.f0.fi -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2
|
|
grid $base.f0.fi.l5 \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fi.l6 \
|
|
-in .pgaw:TableInfo.f0.fi -column 1 -row 2 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2
|
|
grid $base.f0.fi.l7 \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 3 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fi.l8 \
|
|
-in .pgaw:TableInfo.f0.fi -column 1 -row 3 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2
|
|
grid $base.f0.fi.l9 \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fi.l10 \
|
|
-in .pgaw:TableInfo.f0.fi -column 1 -row 4 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2
|
|
grid $base.f0.fi.l11 \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 5 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fi.l12 \
|
|
-in .pgaw:TableInfo.f0.fi -column 1 -row 5 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2
|
|
grid $base.f0.fi.last \
|
|
-in .pgaw:TableInfo.f0.fi -column 0 -row 6 -columnspan 1 -rowspan 1
|
|
place $base.f0.fs \
|
|
-x 310 -y 15 -width 175 -height 50 -anchor nw -bordermode ignore
|
|
grid columnconf $base.f0.fs 1 -weight 1
|
|
grid rowconf $base.f0.fs 2 -weight 1
|
|
grid $base.f0.fs.l1 \
|
|
-in .pgaw:TableInfo.f0.fs -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fs.l2 \
|
|
-in .pgaw:TableInfo.f0.fs -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2 -sticky w
|
|
grid $base.f0.fs.l3 \
|
|
-in .pgaw:TableInfo.f0.fs -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f0.fs.l4 \
|
|
-in .pgaw:TableInfo.f0.fs -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2 \
|
|
-pady 2 -sticky w
|
|
grid $base.f0.fs.last \
|
|
-in .pgaw:TableInfo.f0.fs -column 0 -row 2 -columnspan 1 -rowspan 1
|
|
place $base.f0.lstat \
|
|
-x 315 -y 5 -height 18 -anchor nw -bordermode ignore
|
|
place $base.f0.lid \
|
|
-x 10 -y 5 -height 16 -anchor nw -bordermode ignore
|
|
}
|
|
|
|
|
|
proc vTclWindow.pgaw:AddIndex {base} {
|
|
if {$base == ""} {
|
|
set base .pgaw:AddIndex
|
|
}
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel
|
|
wm focusmodel $base passive
|
|
wm geometry $base 334x203+265+266
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 1 1
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 0 0
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Add new index"]
|
|
frame $base.f \
|
|
-borderwidth 2 -height 75 -relief groove -width 125
|
|
frame $base.f.fin \
|
|
-height 75 -relief groove -width 125
|
|
label $base.f.fin.lin \
|
|
-borderwidth 0 -relief raised -text [intlmsg {Index name}]
|
|
entry $base.f.fin.ein \
|
|
-background #fefefe -borderwidth 1 -width 28 -textvariable PgAcVar(addindex,indexname)
|
|
checkbutton $base.f.cbunique -borderwidth 1 \
|
|
-offvalue { } -onvalue unique -text [intlmsg {Is unique ?}] -variable PgAcVar(addindex,unique)
|
|
label $base.f.ls1 \
|
|
-anchor w -background #dfdbdf -borderwidth 0 -foreground #000086 \
|
|
-justify left -relief raised -textvariable PgAcVar(addindex,indexfields) \
|
|
-wraplength 300
|
|
label $base.f.lif \
|
|
-borderwidth 0 -relief raised -text "[intlmsg {Index fields}]:"
|
|
label $base.f.ls2 \
|
|
-borderwidth 0 -relief raised -text { }
|
|
label $base.f.ls3 \
|
|
-borderwidth 0 -relief raised -text { }
|
|
frame $base.fb \
|
|
-height 75 -relief groove -width 125
|
|
button $base.fb.btncreate -command Tables::createNewIndex \
|
|
-padx 9 -pady 3 -text [intlmsg Create]
|
|
button $base.fb.btncancel \
|
|
-command {Window destroy .pgaw:AddIndex} -padx 9 -pady 3 -text [intlmsg Cancel]
|
|
pack $base.f \
|
|
-in .pgaw:AddIndex -anchor center -expand 1 -fill both -side top
|
|
grid $base.f.fin \
|
|
-in .pgaw:AddIndex.f -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f.fin.lin \
|
|
-in .pgaw:AddIndex.f.fin -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f.fin.ein \
|
|
-in .pgaw:AddIndex.f.fin -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f.cbunique \
|
|
-in .pgaw:AddIndex.f -column 0 -row 5 -columnspan 1 -rowspan 1
|
|
grid $base.f.ls1 \
|
|
-in .pgaw:AddIndex.f -column 0 -row 3 -columnspan 1 -rowspan 1
|
|
grid $base.f.lif \
|
|
-in .pgaw:AddIndex.f -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f.ls2 \
|
|
-in .pgaw:AddIndex.f -column 0 -row 1 -columnspan 1 -rowspan 1
|
|
grid $base.f.ls3 \
|
|
-in .pgaw:AddIndex.f -column 0 -row 4 -columnspan 1 -rowspan 1
|
|
pack $base.fb \
|
|
-in .pgaw:AddIndex -anchor center -expand 0 -fill x -side bottom
|
|
grid $base.fb.btncreate \
|
|
-in .pgaw:AddIndex.fb -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.fb.btncancel \
|
|
-in .pgaw:AddIndex.fb -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
}
|
|
|
|
|
|
proc vTclWindow.pgaw:AddField {base} {
|
|
if {$base == ""} {
|
|
set base .pgaw:AddField
|
|
}
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel
|
|
wm focusmodel $base passive
|
|
wm geometry $base 302x114+195+175
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 1 1
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 0 0
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Add new column"]
|
|
label $base.l1 \
|
|
-borderwidth 0 -text [intlmsg {Field name}]
|
|
entry $base.e1 \
|
|
-background #fefefe -borderwidth 1 -textvariable PgAcVar(addfield,name)
|
|
bind $base.e1 <Key-KP_Enter> {
|
|
focus .pgaw:AddField.e2
|
|
}
|
|
bind $base.e1 <Key-Return> {
|
|
focus .pgaw:AddField.e2
|
|
}
|
|
label $base.l2 \
|
|
-borderwidth 0 \
|
|
-text [intlmsg {Field type}]
|
|
entry $base.e2 \
|
|
-background #fefefe -borderwidth 1 -textvariable PgAcVar(addfield,type)
|
|
bind $base.e2 <Key-KP_Enter> {
|
|
Tables::addNewColumn
|
|
}
|
|
bind $base.e2 <Key-Return> {
|
|
Tables::addNewColumn
|
|
}
|
|
button $base.b1 \
|
|
-borderwidth 1 -command Tables::addNewColumn -text [intlmsg {Add field}]
|
|
button $base.b2 \
|
|
-borderwidth 1 -command {Window destroy .pgaw:AddField} -text [intlmsg Cancel]
|
|
place $base.l1 \
|
|
-x 25 -y 10 -anchor nw -bordermode ignore
|
|
place $base.e1 \
|
|
-x 98 -y 7 -width 178 -height 22 -anchor nw -bordermode ignore
|
|
place $base.l2 \
|
|
-x 25 -y 40 -anchor nw -bordermode ignore
|
|
place $base.e2 \
|
|
-x 98 -y 37 -width 178 -height 22 -anchor nw -bordermode ignore
|
|
place $base.b1 \
|
|
-x 70 -y 75 -anchor nw -bordermode ignore
|
|
place $base.b2 \
|
|
-x 160 -y 75 -anchor nw -bordermode ignore
|
|
}
|
|
|
|
|
|
proc vTclWindow.pgaw:RenameField {base} {
|
|
if {$base == ""} {
|
|
set base .pgaw:RenameField
|
|
}
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel
|
|
wm focusmodel $base passive
|
|
wm geometry $base 215x75+258+213
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 1 1
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 0 0
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Rename column"]
|
|
label $base.l1 \
|
|
-borderwidth 0 -text [intlmsg {New name}]
|
|
entry $base.e1 \
|
|
-background #fefefe -borderwidth 1 -textvariable PgAcVar(tblinfo,new_cn)
|
|
bind $base.e1 <Key-KP_Enter> "Tables::renameColumn"
|
|
bind $base.e1 <Key-Return> "Tables::renameColumn"
|
|
frame $base.f \
|
|
-height 75 -relief groove -width 147
|
|
button $base.f.b1 \
|
|
-borderwidth 1 -command Tables::renameColumn -text [intlmsg Rename]
|
|
button $base.f.b2 \
|
|
-borderwidth 1 -command {Window destroy .pgaw:RenameField} -text [intlmsg Cancel]
|
|
label $base.l2 -borderwidth 0
|
|
grid $base.l1 \
|
|
-in .pgaw:RenameField -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.e1 \
|
|
-in .pgaw:RenameField -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f \
|
|
-in .pgaw:RenameField -column 0 -row 4 -columnspan 2 -rowspan 1
|
|
grid $base.f.b1 \
|
|
-in .pgaw:RenameField.f -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f.b2 \
|
|
-in .pgaw:RenameField.f -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.l2 \
|
|
-in .pgaw:RenameField -column 0 -row 3 -columnspan 1 -rowspan 1
|
|
}
|
|
|
|
proc vTclWindow.pgaw:Permissions {base} {
|
|
if {$base == ""} {
|
|
set base .pgaw:Permissions
|
|
}
|
|
if {[winfo exists $base]} {
|
|
wm deiconify $base; return
|
|
}
|
|
toplevel $base -class Toplevel
|
|
wm focusmodel $base passive
|
|
wm geometry $base 273x147+256+266
|
|
wm maxsize $base 1280 1024
|
|
wm minsize $base 1 1
|
|
wm overrideredirect $base 0
|
|
wm resizable $base 0 0
|
|
wm deiconify $base
|
|
wm title $base [intlmsg "Permissions"]
|
|
frame $base.f1 \
|
|
-height 103 -relief groove -width 125
|
|
label $base.f1.l \
|
|
-borderwidth 0 -relief raised -text [intlmsg {User name}]
|
|
entry $base.f1.ename -textvariable PgAcVar(permission,username) \
|
|
-background #fefefe -borderwidth 1
|
|
label $base.f1.l2 \
|
|
-borderwidth 0 -relief raised -text { }
|
|
label $base.f1.l3 \
|
|
-borderwidth 0 -relief raised -text { }
|
|
frame $base.f2 \
|
|
-height 75 -relief groove -borderwidth 2 -width 125
|
|
checkbutton $base.f2.cb1 -borderwidth 1 -padx 4 -pady 4 \
|
|
-text [intlmsg select] -variable PgAcVar(permission,select)
|
|
checkbutton $base.f2.cb2 -borderwidth 1 -padx 4 -pady 4 \
|
|
-text [intlmsg update] -variable PgAcVar(permission,update)
|
|
checkbutton $base.f2.cb3 -borderwidth 1 -padx 4 -pady 4 \
|
|
-text [intlmsg insert] -variable PgAcVar(permission,insert)
|
|
checkbutton $base.f2.cb4 -borderwidth 1 -padx 4 -pady 4 \
|
|
-text [intlmsg rule] -variable PgAcVar(permission,rule)
|
|
frame $base.fb \
|
|
-height 75 -relief groove -width 125
|
|
button $base.fb.btnsave -command Tables::savePermissions \
|
|
-padx 9 -pady 3 -text [intlmsg Save]
|
|
button $base.fb.btncancel -command {Window destroy .pgaw:Permissions} \
|
|
-padx 9 -pady 3 -text [intlmsg Cancel]
|
|
pack $base.f1 \
|
|
-in .pgaw:Permissions -anchor center -expand 0 -fill none -side top
|
|
grid $base.f1.l \
|
|
-in .pgaw:Permissions.f1 -column 0 -row 1 -columnspan 1 -rowspan 1
|
|
grid $base.f1.ename \
|
|
-in .pgaw:Permissions.f1 -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 2
|
|
grid $base.f1.l2 \
|
|
-in .pgaw:Permissions.f1 -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.f1.l3 \
|
|
-in .pgaw:Permissions.f1 -column 0 -row 2 -columnspan 1 -rowspan 1
|
|
pack $base.f2 \
|
|
-in .pgaw:Permissions -anchor center -expand 0 -fill none -side top
|
|
grid $base.f2.cb1 \
|
|
-in .pgaw:Permissions.f2 -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f2.cb2 \
|
|
-in .pgaw:Permissions.f2 -column 1 -row 1 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f2.cb3 \
|
|
-in .pgaw:Permissions.f2 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w
|
|
grid $base.f2.cb4 \
|
|
-in .pgaw:Permissions.f2 -column 1 -row 2 -columnspan 1 -rowspan 1 -sticky w
|
|
pack $base.fb \
|
|
-in .pgaw:Permissions -anchor center -expand 0 -fill none -pady 3 -side bottom
|
|
grid $base.fb.btnsave \
|
|
-in .pgaw:Permissions.fb -column 0 -row 0 -columnspan 1 -rowspan 1
|
|
grid $base.fb.btncancel \
|
|
-in .pgaw:Permissions.fb -column 1 -row 0 -columnspan 1 -rowspan 1
|
|
}
|
|
|
|
#
|
|
# NOTE: following two procedures _kinput_trace_root and _kinput_trace_over
|
|
# were originaly part of kinput.tcl.
|
|
# -- Tatuso Ishii 2000/08/18
|
|
|
|
# kinput.tcl --
|
|
#
|
|
# 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 $
|
|
#
|
|
# Copyright (c) 1993 Software Research Associates, Inc.
|
|
#
|
|
# Permission to use, copy, modify, and distribute this software and its
|
|
# documentation for any purpose and without fee is hereby granted, provided
|
|
# that the above copyright notice appear in all copies and that both that
|
|
# copyright notice and this permission notice appear in supporting
|
|
# documentation, and that the name of Software Research Associates not be
|
|
# used in advertising or publicity pertaining to distribution of the
|
|
# software without specific, written prior permission. Software Research
|
|
# Associates makes no representations about the suitability of this software
|
|
# for any purpose. It is provided "as is" without express or implied
|
|
# warranty.
|
|
#
|
|
|
|
# The procedure below is invoked in order to start Japanese text input
|
|
# for the specified widget. It sends a request to the input server to
|
|
# start conversion on that widget.
|
|
# Second argument specifies input style. Valid values are "over" (for
|
|
# over-the-spot style) and "root" (for root window style). See X11R5
|
|
# Xlib manual for the meaning of these styles). The default is root
|
|
# window style.
|
|
|
|
proc pgaccess_kinput_start {w {style root}} {
|
|
global _kinput_priv
|
|
catch {unset _kinput_priv($w)}
|
|
if {$style=="over"} then {
|
|
set spot [_kinput_spot $w]
|
|
if {"$spot" != ""} then {
|
|
trace variable _kinput_priv($w) w _pgaccess_kinput_trace_$style
|
|
kanjiInput start $w \
|
|
-variable _kinput_priv($w) \
|
|
-inputStyle over \
|
|
-foreground [_kinput_attr $w -foreground] \
|
|
-background [_kinput_attr $w -background] \
|
|
-fonts [list [_kinput_attr $w -font] \
|
|
[_kinput_attr $w -kanjifont]] \
|
|
-clientArea [_kinput_area $w] \
|
|
-spot $spot
|
|
return
|
|
}
|
|
}
|
|
trace variable _kinput_priv($w) w _pgaccess_kinput_trace_root
|
|
kanjiInput start $w -variable _kinput_priv($w) -inputStyle root
|
|
}
|
|
|
|
# for root style
|
|
proc _pgaccess_kinput_trace_root {name1 name2 op} {
|
|
global PgAcVar
|
|
set wn [string trimright $name2 ".c"]
|
|
upvar #0 $name1 trvar
|
|
set c $trvar($name2)
|
|
Tables::editText $wn $c $c
|
|
unset $trvar($name2)
|
|
}
|
|
|
|
# for over-the-spot style
|
|
proc _pgaccess_kinput_trace_over {name1 name2 op} {
|
|
global PgAcVar
|
|
set wn [string trimright $name2 ".c"]
|
|
upvar #0 $name1 trvar
|
|
set c $trvar($name2)
|
|
Tables::editText $wn $c $c
|
|
kinput_send_spot $name2
|
|
unset $trvar($name2)
|
|
}
|