############################################ # # LabelText.tcl # ------------------------ # # Copyright (C) 2005 William J Giddings # email: [email protected] # ############################################ # # Description: # ----------- # Provide mutliline entry widget. # # Args: # ---- # # base the full pathname of the megawidget. # args # # returns returns the pathname of megawidget created # # Accessing Label and Text Components: # ----------------------------------- # # Note: # ---- # The name of the variable associated witht the text widget is # integrated into the name of the ** TEXT ELEMENT ** of the megawidet. # If there are any changes to the variable, or text, a trace is called # and the name of the variable is then used to modify the content of the # associated widget. # # The assumption made is that this widget will be primarily used as a # form centred multi-line entry widget rather than a text editing box. # Under such cases, a textvariable should always be used. # # Ensure that textvariable exists prior to creations of the widget. # # Caveats: # ------- # This widget has only been tested using array variables in the global # namespace, consequently, some issues may arise if a custom # namespace is used. # # The widget is effectively "hard-coded" to a particular textvariable. # Whilst this is the expected case for most uses of the widget, some code # modification would be required to enable the change of tectvariable to be # reflected in the full pathanme of the text element itself. # # Should any change be made then perhaps the existing text element needs # to be replaced with one in which the textvariable name included in the pathname. # Following this, all bindings and traces need to be unset for the old textvariable # and new bindings and traces set for the new tracevariable. # # No effort has been made to trace array calls to the textvariable. # ############################################ proc LabelText {base {args {}}} { #set default values set txtargs "" set labargs "" set txtpack "" set labpack "" #parse arguments, assign to label/text components foreach {arg val} $args { switch -- $arg { -relief {append frargs " $arg $val " } -borderwidth {append frargs " $arg $val " } -labelfont {append labargs "-font \{$val\} " } -labelwidth {append labargs " -width $val "} -labelheight {append labargs " -height $val "} -labeltext {append labargs " -text \{$val\} "} -labeljustify {append labargs " -justify $val "} -labeltextanchor {append labargs " -anchor $val "} -labelbg - -labelbackground {append labargs " -background $val "} -labelfg - -labelforeground {append labargs " -foreground $val "} -labeltextvariable {append labargs " -textvariable $val" } -labelside { append labpack " -side $val " append txtpack " -side $val " } -labelanchor { append labpack " -anchor $val " append txtpack " -anchor $val " } -width - -height - -background - -foregroung - -bg - -fg - -font {append txtargs " $arg \{$val\} "} -textvariable { #todo: Create variable if one does not exist set variable $val set a $variable puts $a trace var ::$a wu _$a set ::${a}_ $base.$variable ################################################### #create bespoke trace handler ################################################### proc _$a {name i op} { # args passed to the fucntion # name variable name # i array index # op operation #upvar 1 $name var if {$::DEBUG} { puts ">> name: $name i: $i op: $op" #puts "[set ::${name}(${i})_]" } #deal with unset variables if { $op == "u" } { if { $i != {} } { rename _$name {} } else { rename _${name}(${i}) {} } return } #assuming variable to be an array, ie $i != NULL if {$i != {} } { #variable is and array [set ::${name}(${i})_] delete 1.0 end [set ::${name}(${i})_] insert end [set ::${name}(${i})] } else { #simple variable [set ::${name}_] delete 1.0 end [set ::${name}_] insert end [set ::${name}] } } ;#end proc ################################################### } ;# end textvariable block } ;#end switch } ;#end foreach # build megawidget eval frame $base $frargs eval label $base.lab $labargs eval pack $base.lab $labpack eval text $base.$variable $txtargs eval pack $base.$variable $txtpack -in $base if {$::DEBUG} { bind "$base.$variable" <Button-1> { # get variable name set tmp %W puts "%W -- [winfo parent %W]" puts "%W -- [winfo pathname [winfo id %W]]" puts [lindex [split %W .] end] } } #update variable when focus is lost bind "$base.$variable" <FocusOut> { set a [%W get 1.0 end] set b [lindex [split %W .] end] #if {$::DEBUG} { puts "a = $a b = $b \n[set $b]" } #remove any blank lines set $b [string trimright [string trimleft $a]] } #return location return $base } ################################################################################ # Demo Block ################################################################################ set ::DEBUG true proc LabelTextDemo_1 {{base {}} } { if {$::DEBUG} { console show } LabelText $base.lt1 \ -relief raised \ -borderwidth 2 \ -labeltext "Prime Minister's\nAddress" \ -labelanchor nw \ -labeltextanchor nw \ -labelside left \ -labelwidth 15 \ -labeltextvariable var1 \ -labeljustify left \ -textvariable pm_address \ -background #ffffdd \ -width 20 \ -height 7 \ -istitle 1 pack $base.lt1 -fill both -expand 1 LabelText $base.lt2 \ -relief raised \ -borderwidth 2 \ -labeltext "Chancellor's\nAddress" \ -labelanchor nw \ -labeltextanchor nw \ -labelside left \ -labelwidth 15 \ -labeltextvariable var2 \ -labeljustify left \ -textvariable ce(address) \ -width 20 \ -height 7 \ -istitle 1 pack $base.lt2 -fill both -expand 1 } proc LabelTextDemo_2 {} { toplevel .form wm title .form "LabelText Demo" LabelTextDemo_1 .form pack [button .b1 -text "Tony Blair" -command {set ::pm_address "10 Downing St.,\nLONDON"}] -fill x pack [button .b2 -text "Gordon Brown" -command {set ::ce(address) "11 Downing St.,\nLONDON"}] -fill x pack [button .b3 -text "puts pm_address" -command {puts $pm_address } ] -fill x pack [button .b4 -text "puts ce(address)" -command {puts $ce(address) } ] -fill x pack [button .b5 -text "unset pm_address" -command {unset pm_address } ] -fill x pack [button .b6 -text "unset ce(address)" -command {unset ce(address) } ] -fill x set ::ce(address) "11 Downing St.,\nLONDON" set ::pm_address "10 Downing St.,\nLONDON" } LabelTextDemo_2
See also: Multiline expanding entry widget, Multi-Line Text Entry Widget - With Entry Widget Like Field To Field Tabbing and Multi-Line Entry Widget in Snit.
The GRIDPLUS2 text command creates a widget that can be used as a "Multi-Line Text Entry".
