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
