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.

http://82.168.209.239/Bwise/optiondb1.jpg

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 {if [catch {eval $wi conf $i} j] {puts $i,$j} }
   }
   pack .dbf.wb.do -side left
 #####################

   bind $window <Key-F1> "$window.wb.pre invoke"
   bind $window <Key-F2> "$window.wb.ne invoke"
 } 

(subject is being worked on)