editRecord
Richard Suchenwirth 2006-06-07 - Here is a Tk dialog that can be used with another simple database to edit a record (a list) by fields. Similar to tk_getOpenFile etc., "" is returned when the user clicked "Cancel", else the current field contents. It is up to the caller to do something useful with the result :^)
package require Tk
proc editRecord {title headers fields} {
set oldfocus [focus]
set w [toplevel .[clock clicks]]
wm resizable $w 1 0
wm title $w $title
set n 0
foreach h $headers f $fields {
label $w.h$n -text $h -anchor e
[entry $w.e$n -width [string length $f]] insert end $f
grid $w.h$n $w.e$n -sticky news
incr n
}
button $w.ok -text OK -width 5 -command [list set $w 1]
button $w.cancel -text Cancel -command [list set $w 0]
grid $w.ok $w.cancel -pady 5
grid columnconfigure $w 1 -weight 1
vwait ::$w
if [set ::$w] { #-- collect the current entry contents
set n 0
foreach f $fields {
lappend res [$w.e$n get]
incr n
}
} else {set res {}}
destroy $w
unset ::$w ;#-- clean up the vwait variable
focus $oldfocus
return $res
}
#-- Testing:
wm withdraw .
set db {
{Author Title Year Category}
{{Puzo, Mario} {The Godfather} 1965 Drama}
{{Verne, Jules} {Around the world in 80 days} 1862 Adventure}
{{Sheldon, Sydney} {The other side of midnight} 1967 Mystery}
{{Mc Cullough, Colleen} Thornbirds 1967 Saga}
}
set res [editRecord Edit: [lindex $db 0] [lindex $db 3]]
#-- If not canceled, "commit" the changes to the database
if [llength $res] {lset db 3 $res}
#-- show the current state of the data, to verify changes were applied
puts [join $db \n]
exitRS 2006-07-19 Weeks later, I extended the proc above to also allow non-editable labels and multi-line text fields, which are distinguished by suffix (label=, text+):
proc editRecord {title headers fields} {
set oldfocus [focus]
set w [toplevel .[clock clicks]]
wm resizable $w 1 0
wm title $w $title
set n 0
foreach h $headers f $fields {
if ![regexp {(.+)([=+])} $h -> hdr type] {set hdr $h; set type ""}
label $w.h$n -text $hdr -anchor ne
switch -- $type {
= {label $w.e$n -width [string length $f] -text $f -anchor w -bg white}
+ {[text $w.e$n -width 20 -height 6] insert end $f}
default {[entry $w.e$n -width [string length $f]] insert end $f}
}
grid $w.h$n $w.e$n -sticky news
incr n
}
button $w.ok -text OK -width 5 -command [list set $w 1]
button $w.cancel -text Cancel -command [list set $w 0]
grid $w.ok $w.cancel -pady 5
grid columnconfigure $w 1 -weight 1
vwait ::$w
if [set ::$w] { #-- collect the current entry contents
set n 0
foreach h $headers f $fields {
regexp {(.+)([=+]?)} $h -> hdr type
switch -- $type {
"" {lappend res [$w.e$n get]}
= {lappend res [$w.e$n cget -text]}
+ {lappend res [$w.e$n get 1.0 end]}
}
incr n
}
} else {set res {}}
destroy $w
unset ::$w ;#-- clean up the vwait variable
focus $oldfocus
return $res
}
#-- quick test:
editRecord Test {foo= bar grill+} {one two three}