by Theo Verelst
This page is about a 'little chore' I did in the progress of making bwise canvasses save not just drawable elements, but also widgets, which can be part of bwise blocks like entries, the oscilloscope, shells, etc.
Much earlier I liked to save the UI of a Tk application by foreach-ing all widgets with a recursive list routine, for instance ilist, and then be able to read a prototyped UI back in the next session by sourcing the result with all options from a file. At some point, it become unclear to me how the options actually held together, because that technique generated errors with later tcl versions, which was a pity.
Now, I though I'd first have a look at the options and the non-writable ones, before starting a save-upgrade, and it seemed natural to spend a few script lines to use (at least 6/7 years old) Database routines for in core, which are list based, and simple enough to use with default settings.
Also, I'll probably find opportunity to make a upgraded complete, one-about-hundred-K-file bwise available, possibly when I'm done.
To get a list of all widgets, the latest bwise thusfar has a function called ilist, which returns a list of all widgets with default arguments.
One could also use pro_args and that procedure (or simply the right arguments, pro_args just helps with named arguments) to make another widget list in this case only one deep:
eval [pro_args ilist {{begin .fb} {maxdepth 1}}]
To make a list-contained database (a list of lists) of the configuration option values of all widgets currently present in the application:
set dbvar {} foreach w [ilist] { set t [list [list widget $w]]; foreach i [$w conf] { lappend t [list [lindex $i 0] [lindex $i end]] } ; lappend dbvar $t }
After possibly changing the routine 'onefield' from bwise (just double click it in the function window list) to use a smaller font to make the normal option list fit on your screen (I used pointsize 7 for the above), unless you have 1200 vertical pixels, then you should be fine, type:
dbaccess
which shows you the above database entry window, where you can Previous Next and other database access options through the widget database. Adapt the dbform procedure to have a 'Do' button which lets you update widgets to reflect the changes you make to the database browse window (between the #####'s is the addition):
proc dbform { {fields} {title {Database Form}} {window {.dbf}} {fw {20}} {ew {20}} } { global dbcurrent ccontent cname cvars currententry global searchstring searchfields if {[winfo exists $window] == 0} {toplevel $window} {foreach i [winfo children $window] {destroy $i} }; $window conf -bg white; label $window.t -text $title -font "helvetica 11" -bg yellow -fg blue; pack $window.t -anchor n -padx 3 -pady 3; list2array $fields foreach i $cvars { set wn [string tolower $i]; # onefield $window.$wn $cname($i) ccontent($i) $fw $ew; onefield $window.$wn $i ccontent($i) $fw $ew; } global currententry newcurrententry frame $window.wb; pack $window.wb -side bottom -anchor s -fill x -expand n button $window.wb.ne -text Next -command { global newcurrententry dbvar if {$newcurrententry < [expr [llength $dbvar] -1]} {incr newcurrententry} display_entry $newcurrententry } pack $window.wb.ne -side right button $window.wb.pre -text Previous -command { global newcurrententry incr newcurrententry -1 if {$newcurrententry < 0} {set newcurrententry 0} display_entry $newcurrententry } entry $window.wb.ee -width 5 -textvar newcurrententry pack $window.wb.ee -side right bind $window.wb.ee <Return> { global newcurrententry currententry dbvar if {$newcurrententry > [expr [llength $dbvar] -1]} { set newcurrententry $currententry } if {$newcurrententry < 0 } { set newcurrententry $currententry } display_entry $newcurrententry } pack $window.wb.pre -side right button $window.wb.undo -text Unedit -command {list2array $dbcurrent} pack $window.wb.undo -side left frame $window.ws; pack $window.ws -side bottom -anchor s -fill x -expand n label $window.ws.l -text "Field(s), Search string" -font "helvetica 12" pack $window.ws.l -side left entry $window.ws.es -textvar searchstring -width 16 pack $window.ws.es -side right entry $window.ws.ef -textvar searchfields -width 10 pack $window.ws.ef -side right bind $window.ws.es <Return> { global newcurrententry; set newcurrententry [lindex [lindex [dbsearch $searchstring $searchfields [list [expr $newcurrententry+1] end]] 0] 0]; set t [bind .dbf.wb.ee <Return>]; eval $t } ##################### button .dbf.wb.do -text Do -command { set dbcurrent [array2list]; foreach i $dbcurrent { if {[lindex $i 0] == "widget"} { set wi [lindex $i 1]} ; foreach i $dbcurrent {catch {eval $wi conf $i}} } } pack .dbf.wb.do -side left ##################### bind $window <Key-F1> "$window.wb.pre invoke" bind $window <Key-F2> "$window.wb.ne invoke" }