oowidgets

Package for creating megawidgets using TclOO (WIP).

Files:

• oowidgets/oowidgets.tcl - implementation
• oowidgets/pkgIndex.tcl - the package file
• samples/flash.tcl - some sample code to create widgets

Links:

• Tutorial
• Manual
• Download
• Wiki

Usage:

oowidgets::widget CLASSNAME CODE

This creates a command name where all letters are lowercase. The class name (CLASSNAME) must contain at least one uppercase letter so it can be distinguished from a regular Tcl command name. Here is an example:

package require oowidgets
namespace eval ::flash { }
oowidgets::widget ::flash::Label {
    constructor {path args} {
        my install ttk::label $path -flashtime 200
        my configure {*}$args
    }
    method flash {} {
        set fg [my cget -foreground]
        for {set i 0} {$i < 10} {incr i} {
            my configure -foreground blue
            update idletasks
            after [my cget -flashtime]
            my configure -foreground $fg
            update idletasks
            after [my cget -flashtime]
        }
    }
}

This widget can then be used, for example, like this:

set fl [flash::label .fl -text "FlashLabel" -flashtime 50 -anchor center]
pack $fl -side top -padx 10 -pady 10 -fill both -expand true
$fl flash

For more examples, including creating composite widgets and using mixins, see the tutorial.

There is a sample project that uses TclOO and oowidgets to create megawidgets. The package paul demonstrates different programming concepts such as inheritance, composition and mixins.

• paul::basegui 📘 - base class to build Tk applications, code
• paul::cbmixins 📘 - mixin classes for ttk::combobox to extend functionality (e.g., filtering, history), code
• paul::dlabel 📘 - using inheritance to create a ttk::label with dynamic font-size adaptation, code
• paul::history 📘 - class to provide history facilities to applications, code
• paul::htext 📘 - composite widget providing a simple hypertext text widget to add help to Tk applications, code
• paul::imedit 📘 - showcase using composition of widgets like paul::labentry, tk.Text and ttk::label to create a larger megawidget, code
• paul::labentry 📘 - using composition to combine a ttk::label and a ttk::entry widget, code
• paul::notebook 📘 - using inheritance to extend a ttk::notebook with new functionality to label and to move tabs, code
• paul::rotext 📘 - read-only text widget, useful for simple text based help pages, code
• paul::splittext 📘 - split a text widget into different views to edit different parts of a document without loosing focus, code
• paul::statusbar 📘 - composite widget based on a ttk::frame, a ttk::label and a ttk::progressbar, code
• paul::txmixins 📘 - mixin classes for the tk::text widget to extend its functions, code
• paul::tvmixins 📘 - mixin classes for the ttk::treeview widget to extend its functions, code

Note: the package name was inspired by wiki code demonstrating how to create megawidgets with TclOO; some code ideas were adapted from that example.

License: BSD 3-Clause

Snit vs oowidgets

Here is an example widget in Snit. The above-mentioned dlabel (a ttk::label with dynamic font-size adaptation) looks like this:

Here is the Snit code:

package require snit
namespace eval dgw { }
snit::widget  dgw::dlabel {
    component label
    option -text "Default"
    delegate method * to label
    delegate option * to label
    option -font ""
    constructor {args} {
        install label using ttk::label $win.lbl {*}$args
        $self configurelist $args
        if {$options(-font) eq ""} {
            set mfont [font create {*}[font configure TkDefaultFont]]
            $label configure -font $mfont
            set options(-font) $mfont
        }
        pack $label -side top -fill both -expand yes -padx 10 -pady 10
        bind  $label <Configure> [mymethod ConfigureBinding %W %w %h]
    }
    method AdjustFont {width height} {
        set cw [font measure $options(-font) $options(-text)]
        set ch [font metrics $options(-font)]
        set size [font configure $options(-font) -size]
        # shrink
        set shrink false
        while {true} {
            set cw [font measure $options(-font) $options(-text)]
            set ch [font metrics $options(-font)]
            set size [font configure $options(-font) -size]

            if {$cw < $width && $ch < $height} {
                break
            }
            incr size -2
            font configure $options(-font) -size $size
            set shrink true
        }
        # grow
        while {!$shrink} {
            set cw [font measure $options(-font) $options(-text)]
            set ch [font metrics $options(-font)]
            set size [font configure $options(-font) -size]
            if {$cw > $width || $ch > $height} {
                incr size -2 ;#set back
                font configure $options(-font) -size $size
                break
            }
            incr size 2
            font configure $options(-font) -size $size
        }
    }
    
    method ConfigureBinding {mwin width height} {
        bind $mwin <Configure> {}
        $self AdjustFont $width $height
        after idle [list bind $mwin <Configure> [mymethod ConfigureBinding %W %w %h]]
    }
}

And here the oowidgets code:

package require oowidgets
namespace eval paul { }

oowidgets::widget ::paul::Dlabel {
    variable label
    constructor {path args} {
        my install ttk::label $path \
              -font [font create {*}[font configure TkDefaultFont]] \
              -text Default
        my configure {*}$args
        set label $path
        bind  $label <Configure> [callback ConfigureBinding %W %w %h]
    }
    method AdjustFont {width height} {
        set cw [font measure [my cget -font] [my cget -text]]
        set ch [font metrics [my cget -font]]
        set size [font configure [my cget -font] -size]
        # shrink
        set shrink false
        while {true} {
            set cw [font measure [my cget -font] [my cget -text]]
            set ch [font metrics [my cget -font]]
            set size [font configure [my cget -font] -size]

            if {$cw < $width && $ch < $height} {
                break
            }
            incr size -2
            font configure [my cget -font] -size $size
            set shrink true
        }
        # grow
        while {!$shrink} {
            set cw [font measure [my cget -font] [my cget -text]]
            set ch [font metrics [my cget -font]]
            set size [font configure [my cget -font] -size]
            if {$cw > $width || $ch > $height} {
                incr size -2 ;#set back
                font configure [my cget -font] -size $size
                break
            }
            incr size 2
            font configure [my cget -font] -size $size
        }
    }
    method ConfigureBinding {mwin width height} {
        bind $mwin <Configure> {}
        my AdjustFont $width $height
        after idle [list bind $mwin <Configure> [callback ConfigureBinding %W %w %h]]
    }
}

The main differences when using oowidgets:

• no hull widget; direct install of ttk::label without a frame
• Snit: $self configurelist $args — oowidgets: my configure {*}$args
• all methods and options are automatically delegated to the main widget as there is no hull widget
• not using an options array but my cget

Here's another example: the read-only text widget. Below is the Snit code (from before OOP was in the Tcl core), reimplemented with oowidgets:

package require oowidgets
namespace eval ::test { }
::oowidgets::widget ::test::Rotext {
    variable textw
    constructor {path args} {
        # we need the real widget (underscore suffix)
        set textw ${path}_
        # Create the text widget; turn off its insert cursor
        my install tk::text $path -insertwidth 0 -border 5 -relief flat
        my configure {*}$args
    }
    # Disable the text widget's insert and delete methods
    # to make this read-only even if the user writes text.
    method insert {args} { } 
    method delete {args} { }
    # programmatically we can still insert and delete ...
    method ins {args} { $textw insert {*}$args  }
    method del {args} { $textw delete {*}$args  }
}

CHANGES

• 2026-07-XX : 0.6.0
  • fix for mixin -append
  • adding tvoutliner mixin
  • starting tmedit example application — tmDoc-based editor for literate programming
  • switching documentation creation from pantcl to tmdoc
• 2025-03-06:
  • adding htext support
  • adding file-recent support using inifile for txfileproc mixin
  • adding a template example for paul::txtemplate
  • adding history class for cbmixins
• 2025-02-20 : 0.5.0
  • new public method mixin to add classes to the current object
  • new protected method option to create widget options
  • new paul widgets imedit, labentry and treeview mixins
  • sample application "Lisi - graphics made easy" to test the code extensively
• 2024-12-29 : 0.4.0 Making it Tcl 9 ready

TODO

• delegate method?
• component declaration?
• Snit compatibility?
• Tcl 9 check (done)