Version 7 of Overloading widgets

Updated 2002-02-11 14:33:45

Richard Suchenwirth - Overloading a widget means writing a new widget proc with the same name and (at least) same functionality, so when Tcl/Tk (e.g. pack) calls it internally, it reacts in the same way. This is the lightweight way of creating "mini-megawidgets" in pure Tcl without much hassle, e.g. something like this:

 proc supertext {w args} {
        eval text $w $args ;# create the "base" thing
        rename $w _$w      ;# keep the original widget command
        # Here comes the overloaded widget proc:
        proc $w {cmd args} {
            set self [lindex [info level 0] 0] ;# get name I was called with
            switch -- $cmd {
                super   {puts "super! $args" ;# added method}
                default {uplevel 1 _$self $cmd $args}   
            }
        }
        return $w ;# like the original "text" command
 } 
 supertext .t -foreground red
 pack .t -fill both -expand 1
 .t insert end "This is a.. (see stdout)"
 .t super example

This way, a supertext "inherits" all the behavior of a text widget, but in addition has the (here very stupid) "super" method. You can also overload the configure/cget "methods", but make sure the original "instance variables" are still passed through to the original widget proc. Adding "method names" like above is the easiest.

See also ANSI color control for ansicolor::text, a text widget where the insert command is intercepted to process color control escape sequences.


DKF: you can do even better for yourself if you use interpreter command aliases (i.e. your code can be simpler, more robust and less heavily nested, all by taking advantage of the ability to add extra arguments to the command via the alias - RS: which in functional programming circles is called "currying" - see Custom curry.) Taking the example listed above:

 proc supertext {w args} {
    eval text $w $args ;# create the "base" thing
    rename $w _$w      ;# keep the original widget command
    # Install the alias...
    interp alias {} $w {} supertext_instanceCmd $w
    return $w ;# like the original "text" command
 } 
 proc supertext_instanceCmd {self cmd args} {
    switch -- $cmd {
       super   {puts "super! $args" ;# added method}
       default {return [uplevel 1 [list _$self $cmd] $args]}
    }
 }
 supertext .t -foreground red
 pack .t -fill both -expand 1
 .t insert end "This is a.. (see stdout)"
 .t super example

This comes even more into its own when combined with namespaces and multiple interpreters.


A more meaningful example was triggered by a c.l.t post from Bryan Oakley: it'd be nice to create text like "some things are *bold* and some are _underlined_" and be able to put that into a widget with a single call. Here's a quick shot:

 proc markuptext {w args} {
    eval [list text $w] $args
    rename ::$w ::_$w
    proc ::$w {cmd args} {
        set w [lindex [info level 1] 0]
        switch -- $cmd {
            insert  {eval [list markuptext'insert $w] $args}
            default {eval [list ::_$w $cmd] $args}
        }
    }
    set w
 }
 proc markuptext'insert {w position args} {
    if {[llength $args]==1} {set args [lindex $args 0]}
    foreach word [split $args] {
         if {$word==""} continue
        set tag ""
        if {[regexp {^\*(.+)\*$} $word -> word]} {set tag bold}
        if {[regexp {^_(.+)_$}   $word -> word]} {set tag underline}
        ::_$w insert $position "$word " $tag
    }
 }
 #----------------------------- Test and demo code...
 pack [markuptext .t]
 .t tag configure bold      -font {Arial 10 bold}
 .t tag configure underline -font {Arial 10 underline}
 .t insert end "Test for *bold* and _underlined_ words...\
     with \"quotes\" and \{unbalanced braces"

Arts and crafts of Tcl-Tk programming