[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: * using `method unknown` for forwards, instead of explicitly naming subcommands of the widget (first suggested by [JOB]) * more careful `isreadonly` calculation (thanks [HolgerJ] for identifying issues!) * correctly handle an odd number of indices to `delete` ====== 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::example ====== ---- '''[JOB] - 2016-07-28 10:04:16''' Just a note here: The unkown might be modified in a case the given command is unknown at all: ====== method unknown {method args} { my variable widget if {[catch {$widget $method {*}$args} result]} { return -code error $result } } ====== <> Category GUI | Category Object Orientation | Category Widget