Version 6 of Text variable for text widget

Updated 2009-12-01 11:23:59 by adavis

(Kevin Kenny - 6 August 2001) People often wonder why the entry widget supports a -textvariable option while the text widget does not. The simple answer is that the text widget contains much, much more than text, and a -textvariable would lose a tremendous amount of information in the general case. Still, people often use a text as simply a multi-line entry, and keeping a text variable up to date is useful.

Herewith, then, some code I've used for a while to add text variable support to the text widget. It works by Overloading widgets -- using rename to hide the widget command and then creating a proc of the same name to wrap around it. Permission to use it is granted under the terms of the standard Tcl license agreement.


 #----------------------------------------------------------------------
 #
 # TracedText.tcl --
 #
 #      Package that implements a change to the text widget that
 #      allows a -textvariable option to be specified at creation
 #      time.
 #
 #----------------------------------------------------------------------

 # Copyright (c) 1999, by Kevin B. Kenny.  All rights reserved.

 set RCSID([info script]) \
  {$Id: 1917,v 1.5 2003-12-13 07:00:07 jcw Exp $}

 package provide TracedText 1.0

 namespace eval TracedText {

     namespace export TracedText

     # The traced text widgets have a <Destroy> binding that
     # cleans up internal storage.  Establish it here so that
     # the widget creation procedure just has to fiddle binding
     # tags.

     bind TracedText <Destroy> [namespace code {cleanup %W}]
 }

 #----------------------------------------------------------------------
 #
 # TracedText::TracedText --
 #
 #      Create a text widget that supports a -textvariable flag
 #
 # Parameters:
 #      w    -- Path name of the widget
 #      args -- Option-value pairs
 #
 # Results:
 #      Returns the path name of the newly-created widget.
 #
 # Side effects:
 #      The widget is created.  If a -textvariable option is
 #      supplied, the widget command is renamed, and an alias
 #      is installed in the global namespace.  The alias command
 #      intercepts the 'insert' and 'delete' subcommands and
 #      updates the text variable.  In addition, a trace is
 #      established on the text variable to keep the text
 #      variable up to date.
 #
 # Options:
 #      The TracedText command accepts all the options of a text
 #      widget, plus a -textvariable option that gives the name
 #      of a variable or array element in the global namespace
 #      that will contain the same content as the widget itself.
 #
 # Limitations:
 #      The code does not work entirely correctly in the presence
 #      of embedded images.  The -textvariable option cannot be
 #      set via 'configure' or interrogated via 'cget'.
 #
 #----------------------------------------------------------------------

 proc TracedText::TracedText { w args } {

     variable textvar

     # Extract the special '-textvariable' option.

     set textArgs {}
     foreach { option value } $args {
        switch -exact -- $option {
            -textvariable {
                set textvar($w) $value
            }
            default {
                lappend textArgs $option $value
            }
        }
     }

     # Create the widget

     eval [list text $w] $textArgs

     # Rename the widget command to an alias in the "TracedText"
     # namespace.  Create a new command that looks just like the
     # widget command but goes off to the "widgetCmd" procedure.

     if {[info exists textvar($w)]} {

        rename $w alias$w
        proc ::$w args {

            # p is the name of this procedure, which may or
            # may not have a :: qualifier.

            set p [lindex [info level 0] 0]

            # w is the name of the traced text widget.

            set w [namespace tail $p]

            # Go to the TracedText::widgetCmd procedure to
            # process the command.

            return [eval [list TracedText::widgetCmd $w] $args]

        }

        # Adjust the bind tags so that the <Destroy> binding will fire.

        bindtags $w [linsert [bindtags $w] 1 TracedText]

        # If the variable exists, update the widget content.
        # Otherwise, create the variable.

        upvar \#0 $textvar($w) theVariable
        if { [info exists theVariable] } {
            alias$w insert 1.0 $theVariable
        } else {
            set theVariable {}
        }

        # Put a trace on the text variable so that we can update
        # the widget if it changes.

        trace variable theVariable w \
                [namespace code [list traceCallback $w]]


     }

     return $w
 }

 #----------------------------------------------------------------------
 #
 # TracedText::widgetCmd --
 #
 #      Widget command for a text widget with a textvariable.
 #
 # Parameters:
 #      w    -- Path name of the widget
 #      args -- Arguments to the widget command
 #
 # Results:
 #      Returns whatever the text widget does in response to the
 #      widget command.
 #
 # Side effects:
 #      In addition to whatever side effects the text widget
 #      has in response to the widget command, the 'insert' and
 #      'delete' widget commands cause the text variable of the
 #      widget to be updated.
 #
 #----------------------------------------------------------------------

 proc TracedText::widgetCmd {w args} {

     # Execute the widget command

     set retval [eval [list alias$w] $args]

     # After the widget command returns, set the text variable if
     # the command was 'insert' or 'delete.'

     switch -exact [lindex $args 0] {
        del -
        dele -
        delet -
        delete -
        ins -
        inse -
        inser -
        insert {

            variable textvar
            variable busy

            # The 'busy' variable keeps the traceCallback
            # procedure from attempting to reload the widget
            # content.

            upvar \#0 $textvar($w) content
            set busy($w) {}
            set content [$w get 1.0 end]
            unset busy($w)

        }
     }

     return $retval

 }

 #----------------------------------------------------------------------
 #
 # TracedText::traceCallback --
 #
 #      Trace callback entered when the text variable of a text widget
 #      is changed.
 #
 # Parameters:
 #      w     -- Path name of the widget
 #      name1 -- Name of the text variable in the calling namespace.
 #      name2 -- Subscript name of the text variable, if any.
 #      op    -- Traced variable operation (always "w")
 #
 # Results:
 #      None.
 #
 # Side effects:
 #      If the variable was being changed in response to an 'insert'
 #      or 'delete' command on the widget, the procedure does nothing.
 #      Otherwise, it deletes the entire content of the widget and
 #      replaces it with the new contents of the variable; it does this
 #      even if the widget is disabled.
 #
 #----------------------------------------------------------------------

 proc TracedText::traceCallback { w name1 name2 op } {

     variable busy

     if { ! [info exists busy($w)] } {

        variable textvar

        # Retrieve the changed content of the textvariable

        upvar 1 $name1 theVariable
        if { [array exists theVariable] } {
            set content $theVariable($name2)
        } else {
            set content $theVariable
        }

        # Enable the widget temporarily, and adjust its content.

        set state [alias$w cget -state]
        alias$w configure -state normal
        alias$w delete 1.0 end
        alias$w insert 1.0 $content
        alias$w configure -state $state

     }

     return
 }      

 #----------------------------------------------------------------------
 #
 # TracedText::cleanup --
 #
 #      Clean up after destroyoing a text widget with a textvariable.
 #
 # Parameters:
 #      w -- Path name of the destroyed widget.
 #
 # Results:
 #      None.
 #
 # Side effects:
 #      The variables and traces that belong to the widget are deleted,
 #      as is the procedure that aliases the widget command.
 #
 #----------------------------------------------------------------------

 proc TracedText::cleanup { w } {

     variable textvar

     upvar #0 $textvar($w) theVariable
     trace vdelete theVariable w \
            [namespace code [list traceCallback $w]]
     unset textvar($w)
     rename ::$w {}

     return

 }

 # DEMO PROGRAM

 if { [info exists argv0] \
      && ![string compare [info script] $argv0]} {

     if {[string compare {} [info commands console]]} {
        console show
     }

     TracedText::TracedText .text2 -textvariable data(kevin)

     grid .text2

     .text2 configure -font systemfixed

     proc traceProc {n1 n2 op} {
        puts [info level 0]
        variable data
        puts "data(kevin) now $data(kevin)"
     }

     trace variable data(kevin) w traceProc

     grid [button .b -text "Destroy" -command { destroy .text2 }] \
            [button .q -text "Quit" -command exit]

 }

A few LOC add a textvariable also to canvas text items.


RS 2003-12-12 - Here's a minimalist solution for a text variable (it must be named the same as the widget, and in global namespace). For testing, the text content is duplicated in the window title:

 pack [text .t] -fill x            ;# create text widget .t

 trace var .t rwu textvar_tie      ;# arrange tying to the variable .t

 proc textvar_tie {name el op} {
    upvar 1 $name var
    switch $op {
        r {set var [$name get 1.0 end-1c]}
        w {$name delete 1.0 end; $name insert end $var}
        u {set var ""}
    }
 }
 set .t ""
 bind .t <KeyRelease> {wm title . ${.t}} ;# testing code

jnc 2009-11-30 - Here's a snit widget that does this as well as horizontal and vertical scroll bars.

  snit::widget editor {
        delegate option * to text

        option -yscroll -default 1
        option -xscroll -default 0
        option -textvariable -default 0

        constructor { args } {
                install text using text $win.txt
                grid $win.txt -row 0 -column 0 -sticky nswe

                $self configurelist $args

                if {[$win cget -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
                }

                if {[$win cget -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
                }

                grid rowconfigure $win 0 -weight 1
                grid columnconfigure $win 0 -weight 1

                if {[$win cget -textvariable] != 0} {
                        set varName [$win cget -textvariable]
                        upvar 3 $varName v
                        $win.txt insert 1.0 $v
                        trace add variable v write [list $self setContent]
                        trace add variable v read [list $self getContent]
                }
        }

        method setContent { name element op} {
                upvar 1 $name x
                $win.txt delete 1.0 end
                $win.txt insert 1.0 $x
        }

        method getContent { name element op } {
                upvar 1 $name x
                set x [$win.txt get 1.0 end]
        }
  }

adavis (1st December 2009): The GRIDPLUS2 way...

Here is a simple text editor based on the GRIDPLUS2 text widget with an assocaited variable, horizontal/vertical scroll bars and right-click pop-up Cut/Copy/Paste/Find functionality:-

  gridplus text .mytext -scroll xy -wrap none
  gridplus layout .main -wtitle "MyEdit" .mytext:nsew
  gridplus pack .main -resize xy

When you have entered some text...

  puts $(.mytext)

...will display the contents.

You can also use something like...

  gpset .mytext "What ever you wnat the contents of the text widget to be."

...to set the content of the text widget.


text - Arts and crafts of Tcl-Tk programming Category Package | Category GUI