[Pierre Coueffin] 20-Oct-2006

I often find myself programming interactively using the tclreadline binding. During this process I end up sourcing the same file repeatedly.

In order to allow me to define widgets in the file without getting errors when I source the file next time, I wrote a proc called needwidget:

 proc needwidget {w cmds} {
    if {[info command $w] == {}} {
        uplevel $cmds
    }
 }

This allowed me to wrap the call to create the widget up neatly:

 needwidget .button {
   pack [button .button -text foo]
 }

When I think that I'm done hacking on the code, I unwrap the calls to remove clutter.... I used this method for several years, but I have become disenchanted with the wasted effort and risk of introducing typos that it produces.

Today I came up with something that I like much better:

 proc rewidget class {
    if {[llength [info commands create_$class]] != 0} {
      return
    }
    rename $class create_$class
    interp alias {} $class {} create_or_configure $class
 }

 proc create_or_configure {class w args} {
    if {[llength [info commands $w]] != 0} {
      if {[string match \
             [string tolower [winfo class $w]] \
             [string tolower $class]]} {
          eval [concat [list $w configure] $args]
          return $w
     } else {
          destroy $w
     }
   }
   return [eval [concat [list create_$class $w] $args]]
 }
 
 foreach w {
   button     canvas   entry
   frame      listbox  menu
   menubutton scale    scrollbar
   spinbox    toplevel
 } {
    rewidget $w
 }

---

What this code does is alter the behavior of the core widget commands to make them create the widget if it does not exist, but only re-configure them if they already exist. If you try to change the class of a given widget, it will destroy the original one, and create it as if it had not existed... this may play havoc with your existing layout. If you have a problem with that, you might want to change the "destroy..." line to throw an error.

---