tkoo::etext

GJS 2012/5/6 The etext widget is a text widget with a -textvariable option and -state readonly option.
#tkoo/etext-v0.1.1.tm
package provide tkoo::etext 0.1.1

package require tkoo

tkoo::class ::tkoo::etext {
        superclass tkoo::tk_text
        variable widCmd pathname options exists busy
        constructor {wid args} {
                set busy 0
                #check to see if the class already exists
                my Exists $wid
                
                #-state option
                my Opt add -state state State normal {
                        my variable widCmd pathname options exists
                        switch -exact -- $value {
                                normal -
                                disabled {
                                        set state $value
                                }
                                readonly {
                                        set state normal
                                }
                                default {
                                        error [msgcat::mc "bad state \"%s\": must be normal, disabled, or readonly" $value]
                                }
                        }
                        if {[winfo exists $pathname]} {
                                $widCmd configure -state $state
                        }
                }
                
                #-textvariable option
                my Opt add -textvariable textVariable Variable {} {
                        my variable widCmd pathname options exists
                        
                        #delete the previous trace
                        if {[string length $old]} {
                                trace remove variable $old [list read write unset] [namespace code [list my TextVariable]]
                        }
                        
                        if {[string length $value]} {
                                upvar \#0 $value var
                                
                                #fill the widget from the variable
                                if {[info exists var]} {
                                        set busy 1
                                        set state [my Opt get -state]
                                        my configure -state normal
                                        $widCmd delete 1.0 end
                                        $widCmd insert 1.0 $var
                                        my configure -state $state
                                        set busy 0
                                } else {
                                        set var [my get 1.0 end-1c]
                                }
                                
                                #create a trace on the variable
                                trace add variable ::$value [list read write unset] [namespace code [list my TextVariable]]
                        }
                }
                
                next $wid {*}$args
        }
        
        destructor {
                #destroy the trace and set the variable
                set v [my Opt get -textvariable]
                if {[string length $v]} {
                        trace remove variable ::$v [list read write unset] [namespace code [list my TextVariable]]
                }
                
                #default code
                next
        }
        
        method TextVariable {name1 name2 op} {
                upvar \#0 [my Opt get -textvariable] var
                switch -glob -- $op {
                        w* {
                                if {$busy} {return}
                                #get the contents of the variable
                                if {[array exists var]} {
                                        set content $var($name2)
                                } else {
                                        set content $var
                                }
                                #change the contents of the text widget
                                set state [my Opt get -state]
                                my configure -state normal
                                my delete 1.0 end
                                my insert 1.0 $content
                                my configure -state $state
                        }
                        e* -
                        u* -
                        r* {
                                if {$busy} {return}
                                set busy 1
                                #if the variable is read or unset, set it to the contents of the widget
                                if {[array exists var]} {
                                        set var($name2) [my get 1.0 end-1c]
                                } else {
                                        set var [my get 1.0 end-1c]
                                }
                                set busy 0
                        }
                }
        }
        
        method insert args {
                set state [my Opt get -state]
                if {$state ne "readonly"} {
                        set ret [$widCmd insert {*}$args]
                        my TextVariable [my Opt get -textvariable] {} edit
                        return $ret
                }
        }
        method delete args {
                set state [my Opt get -state]
                if {$state ne "readonly"} {
                        set ret [$widCmd delete {*}$args]
                        my TextVariable [my Opt get -textvariable] {} edit
                        return $ret
                }
        }
        method replace args {
                set state [my Opt get -state]
                if {$state ne "readonly"} {
                        set ret [$widCmd replace {*}$args]
                        my TextVariable [my Opt get -textvariable] {} edit
                        return $ret
                }
        }
}
Category Widget
Category Object Orientation