[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 [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 [list [self] focusPrev] bind $win.txt [list [self] focusNext] } else { bind $win.txt continue bind $win.txt continue } } if { [info exists currentopts(-readonly)] } { if {$currentopts(-readonly) == 1} { # This method prevents keyboard navigation :-/ bind $win.txt break bind $win.txt break } else { bind $win.txt continue bind $win.txt 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]" label .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] .lbl configure -text [$a cget] } } # pack .frame1.lbl -side top -fill x pack .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 } ====== .frame1.lbl replaced by .lbl <> Package| GUI | Widget