Version 2 of Multi-line TclOO Text Entry Widget

Updated 2010-05-07 20:29:47 by Bezoar

Bezoar May 7, 2010 - corrected the trace handlers to handle both arrays and scalar variables for -textvariable. Bezoar April 30,2010 - This is one of many solutions for an Multi-Line Entry Widget on the wiki, in fact this is the tclOO version of Multi-Line Entry Widget in Snit. I wondered how hard it would be to convert and it was not hard at all. Being TclOO though it is only supported for Tcl8.5 and up. I tested this on Tcl8.6b.2. This solution includes support for:

  • -textvariable
  • attaching scroll bars (vertical by default)
  • handling Tab and Shift-Tab correctly
  • optionally allowing tabs inside of the widget with the -allowtab 1 option
  • corrects some deficiencies of the Snit version
    • Paste was allowed into widget even when -readonly 1
    • All configuration options not recognized by the multiEntry object are sent to the internalized widget
    • Configuration after creation of all options is now possible.
    • array indicies can be used as textvariable
  • Example code to test widget at bottom.
 package provide multiEntry 1.0

 if { [ catch {package require TclOO } err ] != 0 } {
     puts stderr "Unable to find package TclOO\n$err\nAdjust your auto_path!";
 }
 oo::class create multiEntry {
     variable win options textvariable opts

     constructor { w args } {
         my variable win
         my variable options 
         my variable opts 
         array set options { -yscroll 1 -xscroll 0 -allowtab 0 
        -readonly 0 -textvariable "" }
         array set opts [array get options] 
         set win $w 
         text $win.txt
         grid $win.txt -row 0 -column 0 -sticky nswe
         grid rowconfigure $win 0 -weight 1
         grid columnconfigure $win 0 -weight 1
         my configure {*}$args 
         bind $win <FocusIn> [list focus $win.txt]
     }

     method cget { {opt "" }  } {
         my variable opts
         my variable options
         if { [string length $opt ] } {
             if { ![info exists opts($opt) ] } {
                 return [$win.txt cget $opt ]
             }
             return $opts($opt);
         } else {
             return [array get opts ]
         }
     }

     method configure { args } {
         my variable opts 
         my variable options
         array set options { -yscroll 1 -xscroll 0 -allowtab 0 -readonly 0 -textvariable "" }
         array set currentopts {}
         array set extraopts {}
         foreach { o def } $args { 
             if { ![info exists options($o) ] } {
                 set extraopts($o) $def
             } else {
                 set currentopts($o) $def
             }
         }
         if { [info exists currentopts(-yscroll)] } {
             if {$currentopts(-yscroll) == 1} {
                 $win.txt configure -yscrollcommand [list $win.vsb set]
                 ttk::scrollbar $win.vsb -command [list $win.txt yview]
                 grid $win.vsb -row 0 -column 1 -sticky nsw
             } else {
                 if { [ winfo exists $win.vsb ] } {
                     grid forget $win.vsb 
                     destroy $win.vsb
                     $win.txt configure -yscrollcommand {}
                 }
             }
         }
         if {  [info exists currentopts(-xscroll)] } {
             if {$currentopts(-xscroll) == 1} {
                 $win.txt configure -xscrollcommand [list $win.hsb set]
                 ttk::scrollbar $win.hsb -orient horizontal -command [list $win.txt xview]
                 grid $win.hsb -row 1 -column 0 -sticky we
                 $win.txt configure -wrap none
             } else {
                 if { [ winfo exists $win.hsb ] } {
                     grid forget $win.hsb 
                     destroy $win.hsb
                     $win.txt configure -xscrollcommand {}
                     $win.txt configure -wrap word
                 }
             }
         }
         if { [info exists currentopts(-textvariable)] } {
             set varName $currentopts(-textvariable)
             upvar 2 $varName v
             if { $varName ne [my cget -textvariable ] } { $win.txt delete 1.0 end }
             $win.txt insert 1.0 $v
             $win.txt mark set insert 1.0
             trace add variable v write [list [self] setContent]
             trace add variable v read [list [self] getContent]
         }
         if { [info exists currentopts(-allowtab)] } {
             if {$currentopts(-allowtab) == 0 } {
                 bind $win.txt <Shift-Tab> [list [self] focusPrev]
                 bind $win.txt <Tab> [list [self] focusNext]
             } else {
                 bind $win.txt <Shift-Tab> continue
                 bind $win.txt <Tab> continue
             }
         }
         if { [info exists currentopts(-readonly)] } {
             if {$currentopts(-readonly) == 1} {
                 # This method prevents keyboard navigation :-/
                 bind $win.txt <KeyPress> break
                 bind $win.txt <ButtonRelease-2> break
             } else {
                 bind $win.txt <KeyPress> continue
                 bind $win.txt <ButtonRelease-2> continue
             }
         }
         if { [array size extraopts ] } {
             $win.txt configure {*}[array get extraopts ]
         }
         # save configured opts for cget
         array set opts [array get currentopts ]
      }
     method getTextWidget {} {
         my variable win
         return $win.txt
     }

     method focusPrev {} {
         my variable win
         focus [tk_focusPrev $win]
         return -code break
     }

     method focusNext {} {
         my variable win
         focus [tk_focusNext $win.txt]
         return -code break
     }

       method setContent { name element op} {
        upvar 1 $name x
        $win.txt delete 1.0 end
        if { [array exists x ] } {
            $win.txt insert 1.0 $x($element)
        } else {
            $win.txt insert 1.0 $x
        }
    }

    method getContent { name element op } {
        upvar 1 $name x
        if { [array exists x ] } {
            set x($element) [$win.txt get 1.0 "end-1 char"]
        } else {
          set x [$win.txt get 1.0 "end-1 char"]
        }  
    }
 }
 # Example code 
 if { 1 } {
     if { [ catch {package require Tk } err ] != 0 } {
         puts stderr "Unable to find package Tk ... adjust your auto_path!";
     }
     set chuck "You the man"
     frame .frame1
     set a [multiEntry new .frame1 -textvariable chuck -readonly 0 -allowtab 0 \
 -yscroll 1 -xscroll 1  -height 3 -width 20 -wrap none]
     label .frame1.lbl -text "[$a cget]"
     frame .bframe
     button .bframe.exit -text Exit -command { exit }
     button .bframe.pub -text Publish -command { puts "chuck = $chuck" }
     label .bframe.lbl -text "Change entry one:"
     entry .bframe.optentry -textvariable ::new_opts 
     button .bframe.setoptsb -text "Set Opts" -command { 
         if { [catch { $a configure {*}$::new_opts } err ] != 0 } {
             tk_messageBox -type ok -icon error -message "$err" 
         } else {
             .frame1.lbl configure -text [$a cget]
         }
     }
     pack .frame1.lbl -side top -fill x
     pack .frame1 -side top -expand 1 -fill both
     pack .bframe.exit -side left -padx 10
     pack .bframe.pub -side left -padx 10
     pack .bframe.lbl -side left -padx 10
     pack .bframe.optentry -side left -padx 10
     pack .bframe.setoptsb -side left -padx 10
     pack .bframe -side top -fill x
 }