GJS 2012/5/12 This is my first attempt at an OO class for Tk.
GJS 2012/7/13 tkoo is on Google Code http://code.google.com/p/tkoo/
GJS 2013/08/31 A new version of tkoo has been released. It can be downloaded from the Google Code link above. I have included documentation in the zip file. I will add a short example of usage later.
#editor.tcl package require Tcl 8.6 package require Tk 8.6 package require tkoo 0.2 package require tkoo::widgets 0.2 proc main {} { console show pack [MainFrame .mf] -expand yes -fill both } tkoo::class MainFrame { # all tkoo classes must superclass this, or a class that superclasses it superclass tkoo::widget #standard tkoo variables #widCmd is the renamed widget command #pathname is the pathname of the widget #options is used by "option" to store information about -options #exists is used by the constructor to test if the widget has been created variable widCmd pathname options exists method Create {wid args} { #create all widgets here #if the widget is not created before "next" is called, #a blank frame will be created. #This method calls configure when finished #Leave off {*}$args to avoid this next $wid {*}$args #create a label texted $pathname.t -xscroll [list $pathname.x set] -yscroll [list $pathname.y set] -wrap word tkoo::scrollbar $pathname.x -command [list $pathname.t xview] -auto true -orient horizontal tkoo::scrollbar $pathname.y -command [list $pathname.t yview] -auto true grid $pathname.t $pathname.y -sticky nwes grid $pathname.x -sticky nwes grid columnconfigure $pathname 0 -weight 1 grid rowconfigure $pathname 0 -weight 1 #add some text to the text widget #mc will search msgcat for messages in a namespace named the same as the class $pathname.t insert end [mc "tkoo Demo"] title $pathname.t insert end \n\n $pathname.t insert end [mc "Hopefully this short demo will give an idea of the usage. \n\n"] $pathname.t insert end [mc "I know this demo needs more work, but it's a start. \n"] $pathname.t insert end [mc "Some of the code was taken from other packages, and pages on the wiki. "] $pathname.t insert end [mc "I tried to note where I got the code from. \n\n"] $pathname.t insert end [mc "Use Alt-w to change the line wrap. "] $pathname.t insert end [mc "It will change from \"none\" to \"word\" to \"char\"\n\n"] $pathname.t insert end [mc "Use Alt-s to change the state of the text widget. "] $pathname.t insert end [mc "It will change from \"disabled\" to \"normal\" to \"readonly\" "] $pathname.t insert end [mc "I added the readonly option because Windows does not handle disabled very well. \n\n"] $pathname.t insert end [mc "The scrollbars were adapted from the autoscroll package. "] $pathname.t insert end [mc "They add a -auto option, set to true to enable autoscroll, set to false to disable autoscroll. "] $pathname.t insert end [mc "I found that the scrollbars would flicker at times, so I had to add a time check to the scrollbars. \n\n"] $pathname.t insert end [mc "The tkoo::Helpers::mc procedure was a recent addition, the widgets haven't been updated to use this."] $pathname.t insert end "\n\n\n" $pathname.t tag configure code -wrap none -font "Courier 10" $pathname.t tag configure title -font "Times 14 bold" -justify center #add more text set fh [open [info script]] $pathname.t insert end [read $fh [file size [info script]]] code close $fh } method CreateOptions {} { #create all options here next } method CreateBindings {} { #This method sets up bindtags, all widgets inherit bindings from #classes they superclass #bindings to children can be made here next } method BindDestroy {} { #This method is bound to the destroy event of all tkoo widgets. #if you need to do anything on the destroy event, do it here next } } tkoo::class texted { #this widget will superclass a text class, we could also use tkoo::tk_text superclass tkoo::text #standard tkoo variables #widCmd is the renamed widget command #pathname is the pathname of the widget #options is used by "option" to store information about -options #exists is used by the constructor to test if the widget has been created variable widCmd pathname options exists method BindControlS {} { #put code to save the document here } method BindControlO {} { #put code to open the document here } method BindAltW {} { set wrap [my cget -wrap] switch -exact -- $wrap { none { my configure -wrap word } word { my configure -wrap char } char { my configure -wrap none } default { my configure -wrap none } } } method BindAltS {} { #shortened method names and option names work to. #-backgr will work, -bg will not set state [my cg -stat] switch -exact -- $state { disabled { my config -state normal } normal { my config -state readonly } readonly { my config -state disabled } default { my config -state normal } } } #bindings bind <Control-s> {my BindControlS} bind <Control-o> {my BindControlO} bind <Alt-w> {my BindAltW} bind <Alt-s> {my BindAltS} } main