Gnocl Megawidget Creation using TclOO

WJG (02/08/2016) Now that the OO package has been integrated into the Tcl core module I thought it about time to take a look at creating Gnocl megawidgets using this method. This task proved much easier and quicker to implement than widget overloading and with no loss of flexibility. Here's the basic megawidget template which I now stash away in my ./config/geany/filedefs folder.

#{fileheader}

#---------------
# Boilerplate object builder package for Gnocl derived megawidgets.
# Based upon approach used in Gnocl source code.
#---------------
# USAGE: Substitute keywords "_prj_" and "_widget_" for unique project and object type identifier.
#---------------

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Gnocl

#---------------
# lists of valid widget options, commands and components
#---------------
#
oo::class create _prj_:_widget_ {
        
        constructor {} {
                # declare variables to store data, settings and widget ids
                my variable container
                my variable but1
                my variable but2
                my variable parts
                
                my variable data
                
                set data "How Now Brown Cow"
                
                # create and assemble megawidget parts                
                set container [gnocl::vBox]
                set but1 [gnocl::button -text HIDIHI -icon %#Help]
                set but2 [gnocl::button -text HODIHO -icon %#Stop]
                $container add $but1
                $container add $but2

                # retain a list of parts
                set parts [list container but1 but2]
                }
                
        destructor {
                my variable container
                $container delete
                }

        method getId {} {
                my variable container
                return $container
                }

        method class {} {
                return _widget_
                }

        #---------------
        
        # generic controller, directly access all elements of widget control
        method cmd { args } {
                my variable parts
                foreach var $parts { my variable $var }
                eval [set [lindex $args 0]] [lindex $args 1] [lrange $args 2 end]
                }
        
        
                
        method configure { args } {
                my variable parts
                foreach var $parts { my variable $var }        
                eval [set [lindex $args 0]] configure [lrange $args 1 end]
                }
                
        method cget { args } {
                my variable parts
                foreach var $parts { my variable $var }
                eval [set [lindex $args 0]] cget [lrange $args 1 end]
                }


        # set or retrieve megawidget internal data
        method getData {} {
                my variable data
                return $data
                }

        method setData {val} {
                my variable data
                set data $val
                }
        
        # object operations, or specfic methods
        method tooltips { tt1 tt2 } {
                my variable parts
                foreach var $parts { my variable $var }
                
                $but1 configure -tooltip $tt1
                $but2 configure -tooltip $tt2                
                }

        # manipulate internal data
        method tocaps {} {
                my variable data
                set data [string toupper $data]
                }

}

#===============
# DEMO
#===============
proc demo {} {
        
        set b1 [_prj_:_widget_ new]
        
        puts [$b1 class]
        
        gnocl::window -child [$b1 getId] -title A -setSize 0.125 -x 200 
        $b1 configure but1 -onClicked { puts "HI %d" }  -data PING
        $b1 configure but2 -onClicked { puts "HO %d" }  -data PONG
        
        puts [$b1 cget but1 -data]
        
        $b1 tooltips "HI DI HI" "HO DI HO"

        puts [$b1 getData]

        $b1 tocaps

        puts [$b1 getData]


        set b2 [_prj_:_widget_ new]
        gnocl::window -child [$b2 getId] -title B -setSize 0.125 -x 400 

        $b2 destroy
        catch { $b2 configure but2 -onClicked { puts "HO %d" }  -data PONG } {}
        
}

demo

AMG: It looks like those [eval]s can be written in terms of {*}:

eval [set [lindex $args 0]] [lindex $args 1] [lrange $args 2 end]
{*}[set [lindex $args 0]] {*}[lrange $args 1 end]

DKF: Interesting how you are bringing variables into the scope of the methods doing the delegation, but I think you can do it more simply:

        method cmd { part subcommand args } {
                my variable parts
                if {$part ni $parts} { return -code error "no such part \"$part\"" }
                {*}[set [my varname $part]] $subcommand {*}$args
                }

This has fewer hazards (and makes a nicer error message) and yet otherwise works the same in all sane cases. Anything where it doesn't... well you're probably better off writing a method then.

[Category Megawidgets]