Gnocl Megawidget Creation Template

WJG (01/08/16) Gnocl provides a great toolkit for the creation of application UIs. Producing application modules which have complex layouts and can be used repeatedly calls for something more than the repetitive use of code, whether it be scripted, or loaded via a GtkBuilder UI xml description file. The following package, originally created as a template for use with the Geany IDE, provides boilerplate code for the creation of reusable UI elements in the form of megawidgets. Scripted in a way as to be as close to the C core module implementation itself, this package provides programmer with the resources to define a complex medawidget layout and to apply any necessary reconfiguration of the components during runtime. As with all Gnocl widgets, introspection is implemented along with a widget delete command. To facilitate global access to the widget, use of the -alias can be used in situations in which the widget registration name produced for the object via the Gnocl package may be difficult to obtain or, alternatively, a more descriptive name is preferred. In order to produce new UI constructions, simply apply a global replace on the keyword "_widget_" with a more relevant name.

The package itself contains a simple megawidget consisting of a container and button which can be substituted with more complex layouts and their callback handlers.

#{fileheader}

#---------------
# Boilerplate object builder package for Gnocl derived megawidgets.
# Based upon approach used in Gnocl source code.
#---------------
# USAGE: Substitute keyword "widget" for unique object type identifier.
#---------------

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

package require Gnocl
package provide _widget_

namespace eval gnocl::_widget_ {}

#---------------
# lists of valid widget options, commands and components
#---------------
#
set gnocl::_widget_::opts { -text -onClicked -data -name -icon -alias -tooltip }
set gnocl::_widget_::cmds { configure cget class opts cmds delete }

#----------------
# storage variables initialized during run-time 
#----------------
# gnocl::_widget_::names                type: array 
# gnocl::_widget_::components        type: array

#---------------
# implement widget commands
#---------------
#
proc gnocl::_widget_::cmd { wid cmd args } {

        gnocl::_widget_::check $cmd

        # apply the commands
        switch -- $cmd {
                opts -
                cmds  { return [ lsort [ set gnocl::_widget_::$cmd ] ] }
                class { return "_widget_"}
                configure -
                delete -
                cget  { eval "gnocl::_widget_::$cmd $wid $args" }
                default { # shouldn't need to get here, but... }
        }

}

#---------------
# retrieve current component values
#---------------
#
proc gnocl::_widget_::cget { wid args } {

        # get list of members
        foreach { w id } $gnocl::_widget_::components($wid) { set $w $id }

        # obtain current settings
        foreach { a b } $args {
                # apply according to each component
                switch -- $a {
                        -onClicked -
                        -text { return [ $but_1 cget $a ] }
                        -data { return [ $wid cget $a ] }
                        -name { 
                                return $::gnocl::_widget_::names($wid) }
                        default { # shouldn't need to get here, but... }
                }
        }

}

#---------------
# check options and commands for valid values
#---------------
#
proc gnocl::_widget_::check { opts } {

    # test for a valid options
    if { [string first - $opts ] >= 0 } {
        foreach { opt val } $opts {
            if { [string first $opt $gnocl::_widget_::opts] == -1 } {
                                append errmsg [string repeat - 17]\n
                                append errmsg "ERROR! Invalid gnocl::gnocl::_widget_ option \"$opt\".\n"
                                append errmsg "Should be one of: [lsort $gnocl::_widget_::opts]\n"
                                append errmsg [string repeat - 17]\n
                                error $errmsg
            }
        }
        return
    }

    # test for valid command
    foreach { cmd } $opts {
    if { [string first $cmd $gnocl::_widget_::cmds] == -1 } {
                        append errmsg [string repeat - 17]\n
                        append errmsg "ERROR! Invalid gnocl::gnocl::_widget_ command \"$cmd\".\n"
                        append errmsg "Should be one of: [lsort $gnocl::_widget_::cmds]\n"
                        append errmsg [string repeat - 17]\n
                        error $errmsg
        }
    }

}

#---------------
# configure widget components
#---------------
#
proc gnocl::_widget_::configure { wid args } {

        gnocl::_widget_::check $args

        # recover list of widget components
        foreach {w id} $::gnocl::_widget_::components($wid) {set $w $id}

        # apply new options
        foreach {a b} $args {
                # apply according to each component
                switch -- $a {
                        -alias {
                                interp alias {} $b  {}  $wid
                                }
                        -name { 
                                #interp alias {} $b {} $wid 
                                proc ::$b {} "return [string trim $wid _]"
                                set ::gnocl::_widget_::names($wid) $b
                                # parray ::gnocl::_widget_::names
                                }
                        -text -
                        -icon -
                        -onClicked { $but_1 configure $a $b }
                        -data { $wid configure $a $b ; $but_1 configure $a $b }
                        default { # shouldn't need to get here, but... }
                }
        }
}

#---------------
# delete widget and clean up
#---------------
#
proc gnocl::_widget_::delete { wid } {

        $wid delete

        array unset gnocl::_widget_::names $wid 
        array unset gnocl::_widget_::components $wid

}

#---------------
# create and assemble widget components
#---------------
#
proc gnocl::_widget_::construct {} {

        # create object container
        set vbox [gnocl::vBox]

        # create components
        set but_1 [gnocl::button -text BUTTON]

        # assemble components
        $vbox add $but_1

        # add to listing
        set ::gnocl::_widget_::components(${vbox}_) [list but_1 $but_1]

        #set ::gnocl::_widget_::components [list but_1 $but_1]

        return $vbox
}

#---------------
# the widget command itself
#---------------
#
proc gnocl::widget { args } {
                
        set wid [gnocl::_widget_::construct]

        # overload the box to add commands
        rename $wid ${wid}_

        # configure
        eval "gnocl::_widget_::configure ${wid}_ $args"

        # widget command
        proc $wid { cmd args } {
                set wid [lindex [::info level 0] 0]
        eval "gnocl::_widget_::cmd ${wid}_ $cmd $args"
        }

        return $wid

}

#===============
# DEMO
#===============

proc demo {} {
        
        set wid(1) [gnocl::widget \
                -text "HELLO CAMPERS!" \
                -onClicked {
                        puts "HI DI HI! - %d"
                        } \
                -name campers]
        
        gnocl::window \
                -child $wid(1) \
                -setSize 0.2

        $wid(1) configure -data "HO DI HO!" 

        puts "[[campers] class]"

        [campers] configure -text NEW
        
        set wid(2) [gnocl::widget -text "GOOD MORNING!" -onClicked {puts "GOOD AFTERNOON- %d"} -data BYE-BYE -name greeting ]

        gnocl::window -child $wid(2) -x 600
        puts data->[$wid(2) cget -data]
        puts opts->[$wid(1) opts]
        puts cmds->[$wid(2) cmds]

        set wid(3) [gnocl::widget -text "OM MANI PADME HUM" -onClicked {puts "%d"} -data HRIH -name mantra ]
        gnocl::window -child $wid(3) -x 800

        $wid(1) configure -icon %#Open
        $wid(2) configure -icon %#Close
        $wid(3) configure -icon %#Help

        # accessing names, set widget alias
        [campers] configure -alias BOING

        # using widget alias
        BOING configure -tooltip ABCDEFG

}

demo

Megawidget