Bryan Oakley 02 Dec 2008 - This page gives an example of a megawidget written with the new OO features of tcl/tk 8.6. The megawidget in question looks and behaves almost identically to the standard text widget, but prevents insertion into or deletion of text that is tagged with a "readonly" tag (emphasis added to differentiate from the much simpler Read-only text widget rotext shown in Snit). I know people have asked for such a thing in the past and I thought it would make for a good programming exercise.
When I first started down this path I looked at Megawidgets with TclOO. My first thought was "wow, that's a lot of code to do just a little example". Of course, Donal's example is a little fancier than mine in that he has a widget factory that pumps out megawidgets. That seemed too complicated for my needs,and besides, I like doing things like this by hand so I better understand what is happening under the covers.
The following is what I ended up with. I'm sure there are some optimizations that can be made and I've only lightly tested it on one platform, but my day of experimentation has come to an end so I'm posting what I have for others to tinker with. I think it shows that even straight out of the box, the new OO facilities make it pretty easy to extend existing widgets without the need for a lot of overhead.
In case it's not obvious, copy this into an interpreter and type "rotext::example"
aspect 2014-12: folded in a few improvements discovered over the years:
package require TclOO
package require Tk
namespace eval rotext {
# this is a tk-like wrapper around the ReadOnlyText class so
# that object creation works like other Tk widgets.
proc rotext {path args} {
set obj [ReadOnlyText create tmp $path {*}$args]
rename $obj ::$path
return $path
}
proc example {} {
rotext::rotext .t -yscrollcommand [list .vsb set] -wrap word
scrollbar .vsb -command [list .t yview]
pack .vsb -side right -fill y -expand false
pack .t -side left -fill both -expand true
.t insert end [join [lsort [info commands]] \n]
.t tag configure readonly -foreground red
.t insert 2.0 "You can't delete me or change me!\n" readonly
}
oo::class create ReadOnlyText {
variable widget
constructor {path args} {
text $path {*}$args
# we must rename the widget command since it clashes with
# the object being created
set widget ${path}_
rename $path $widget
}
# forward all other methods to the underlying widget:
method unknown args {
$widget {*}$args
}
method isreadonly {index1 {index2 ""}} {
if {$index2 eq ""} {set index2 $index1}
foreach {ro1 ro2} [$widget tag ranges readonly] {
set c1 [$widget count $ro1 $index2]
set c2 [$widget count $index1 $ro2]
if {$c1 <= 0 || $c2 <= 0} {
continue
}
if {$c1 > 0 && $c2 > 0} {
return true
}
}
return false
}
method delete {args} {
foreach {index1 index2} $args {
if {$index2 eq ""} {
set index2 "$index1 +1c"
}
if {[my isreadonly $index1 $index2]} {
bell
return
}
}
$widget delete {*}$args
}
method replace {index1 index2 chars args} {
if {[my isreadonly $index1 $index2]} {
bell
return
}
$widget replace $index1 $index2 $chars {*}$args
}
method insert {index args} {
if {[my isreadonly $index]} {
bell
return
}
$widget insert $index {*}$args
}
}
}
## rotext::exampleJOB - 2016-07-28 10:04:16
Another possibility for method unknown in case the given command is not valid at all:
method unknown {method args} {
if {[catch {$widget $method {*}$args} result]} {
return -code error $result
}
return $result
}