Updated 2009-12-03 09:16:57 by adavis

WJG (2nd January 2005) The various widget libraries around seem to lack a multi-line entry widget. So, seeing as I needed one earlier this week, I cooked up the following offering. The multiline facility is, of course, a text widget. The problem lies in using a text widget like an entry which has a text variable. I got round this matter with a crafty use of pathnames.

Here's the code, I hope that the demo procs illustrate its use.
 ############################################
 #
 # 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".