**NAME**

''oowidgets'' - Tcl package to create megawidgets using Tcl object system [TclOO]

**DESCRIPTION**

This is yet another approach of creating megawidgets using [TclOO]. My first little project with [TclOO]. I had a look at [Read-Only Text Megawidget with TclOO] and [Megawidgets with TclOO] and then took some ideas from [A Scrolled Widget implemented with TclOO].

**Code**


======
package require Tk
namespace eval ::oowidgets { }

# this is a tk-like wrapper around the class,
# so that object creation works like other Tk widgets
proc oowidgets::new name { 
    eval "
    proc [string tolower $name] {path args}  { 
      set obj \[$name create tmp \$path {*}\$args\]
        rename \$obj ::\$path
        return \$path
    }
    "
}
# the BaseWidget from which your MegaWidgest should inherit
oo::class create ::oowidgets::BaseWidget {
      variable parentOptions
      variable widgetOptions

      variable widgettype
      constructor {path args} {
              my variable widgetOptions
              my variable parentOptions
              array set widgetOptions [list]
              array set parentOptions [list]
              #my configure {*}$args
      }

      # public methods starts with lower case declaration names,
      # whereas private methods starts with uppercase naming
      
      method install {wtype path args} {
          my variable parentOptions
          my variable widgetOptions
          my variable widget
          $wtype $path
          set widget ${path}_
          foreach opts [$path configure] {
              set opt [lindex $opts 0]
              set val [lindex $opts end]
              set parentOptions($opt) $val
          }
          array set nopts $args
          foreach opt [array names nopts] {
              set widgetOptions($opt) $nopts($opt)
          }
          # set widget ${path}_
          rename $path $widget
      }
      method cget { {opt "" }  } {
              my variable widgetOptions
              my variable parentOptions
              if { [string length $opt] == 0 } {
                      return [lsort [list [array get parentOptions] {*}[array get widgetOptions]]]
              }
              if { [info exists widgetOptions($opt) ] } {
                      return $widgetOptions($opt)
              } elseif {[info exists parentOptions($opt)]} {
                      return $parentOptions($opt)
              } 
              return -code error "# unknown option"
      }
      
      method configure { args } {
              my variable widget
              my variable widgetOptions
              my variable parentOptions
              
              if {[llength $args] == 0}  {
                      return [lsort [list [array get parentOptions] {*}[array get widgetOptions]]]
              } elseif {[llength $args] == 1}  {
                   # return configuration value for this option
                   set opt $args
                   if { [info exists widgetOptions($opt) ] } {
                           return $widgetOptions($opt)
                   } elseif {[info exists parentOptions($opt)]} {
                         return $parentOptions($opt)
                   } else {
                       return -code error "# unkown option"
                   }
              }
              
              # error checking
              if {[expr {[llength $args]%2}] == 1}  {
                      return -code error "value for \"[lindex $args end]\" missing"
              }
              
              # process the new configuration options...
              array set opts $args
              
              foreach opt [array names opts] {
                      set val $opts($opt)
                      
                      # overwrite with new value
                      if { [info exists widgetOptions($opt)] } {
                              set widgetOptions($opt) $val
                      } elseif {[info exists parentOptions($opt)]} {
                            set parentOptions($opt) $val
                            $widget configure $opt $val 
                      } else {
                           return -code error "unknown configuration option: \"$opt\" specified"
                          
                      }
              }
      } 
      # delegate all other methods to the widget
      method unknown {args} {
           my variable widget
           $widget {*}$args
      }
}

======

**Examples**

Let's now use this code above to create two little widget which extends the ttk::label and the ttk::button with a flash method:


======

namespace eval ::flash {}

# create the wrapper function 
# so it creates proc flash::button
oowidgets::new ::flash::Button 

# the actual implementation of our sample widget

oo::class create ::flash::Button {
    superclass oowidgets::BaseWidget

    constructor {path args} {
          my install ttk::button $path -flashtime 500
          my configure {*}$args
    }
    method flash {} {
        set ot [my cget -text]
        set ft [my cget -flashtime]
        for {set i 0} {$i < 5} {incr i} {
            my configure -text "......"
            update idletasks
            after $ft
            my configure -text $ot
            update idletasks
            after $ft
        }
        puts flashed
        my configure -text $ot
    }
}

# Now just for demonstration purposes a second widget

# wrapper
oowidgets::new ::flash::Label

# implementation
oo::class create ::flash::Label {
    superclass oowidgets::BaseWidget
    constructor {path args} {
        my install ttk::label $path -flashtime 500
        my configure {*}$args
    }
    method flash {} {
        set fg [my cget -foreground]
        for {set i 0} {$i < 10} {incr i} {
            my configure -foreground red
            update idletasks
            after [my cget -flashtime]
            my configure -foreground $fg
            update idletasks
            after [my cget -flashtime]
        }
        puts labelflashed
    }
}
======

Now example code on widget creation and using them:


======
# creating an packing the widgets
set fb [flash::button .fb -text "Exit" -flashtime 100 -command exit]
pack $fb -side top -pady 10 -pady 10 -fill both -expand true
set fl [flash::label .fl -text "FlashLabel" -flashtime 200 -anchor center]
pack $fl -side top -padx 10 -pady 10 -fill both -expand true
# call by variable
$fb flash
puts "done 1"
# call by path
.fb flash
puts "done 2"

# the flash::label
# call by  path and then variable
.fl flash
$fl flash
# calling a standard function of ttk::button (via unknown)
$fb invoke
======

**TODO's**

- composite widget demo (LabEntry)
- mixin demo (flash as mixin, might be anyway better)

**Discussion**

[DDG] - 2023-03-18: May be I missed a implementation of megawidgets using TclOO which is more widespread used. Sorry if this is the case and I come here with an other one ... It was just thought as my first exercise using TclOO.