############################################
#
# LabelText.tcl
# ------------------------
#
# Copyright (C) 2005 William J Giddings
# email: giddings@freeuk.com
#
############################################
#
# 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_2See 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".
