Version 5 of Serializing a text widget

Updated 2003-08-21 18:46:38

ulis, 2003-06-23 A widget can be serialized by saving its state in a string that can be used to restore later the state of the widget.

A serialized widget can be cloned or made persistent.


Here is a clone proc that shows how to serialize a text widget:

  # ==============================
  #
  #   clone a text widget
  #
  # ==============================

  # ----------
  #  text:clone proc
  # ----------
  # parm1: text widget
  # parm2: clone text widget
  # ----------

  proc text:clone {text clone} { text:restore $clone [text:save $text] }

  # ----------
  #  text:save proc
  #
  #  serialize a text widget
  # ----------
  # parm1: text widget path
  # ----------
  # return: serialized widget
  # ----------

  proc text:save {w} \
  { 
    # the resulting string
    set save {}
    # get the state of the widget
    set dump [$w dump -mark 1.0 end]
    append dump " "
    append dump [$w dump -all 1.0 {end -1 ch}]
    # add more details
    foreach {key value index} $dump \
    {
      switch $key \
      {
        image   \
        {
          # add attributes of an image
          set exec "\$w image create $index"
          foreach k {-align -image -name -padx -pady} \
          { 
            set v [$w image cget $index $k]
            if {$v != ""} { append exec " $k \{$v\}" }
          }
          lappend save exec $exec {}
        }
        mark    \
        {
          # add attributes of a mark
          lappend save $key $value $index
          set exec "$w mark gravity $value [$w mark gravity $value]"
          lappend save exec $exec {}
        }
        tagoff  \
        {
          # add attributes of a tag
          set exec "\$w tag configure $value"
          set keys {}
          lappend keys -background -bgstipple -borderwidth -elide -fgstipple
          lappend keys -font -foreground -justify -lmargin1 -lmargin2 -offset
          lappend keys -overstrike -relief -rmargin -spacing1 -spacing2
          lappend keys -spacing3 -tabs -underline -wrap
          foreach k $keys \
          { 
            set v [$w tag cget $value $k]
            if {$v != ""} { append exec " $k \{$v\}" }
          }
          lappend save exec $exec {}
          lappend save $key $value $index
        }
        window  \
        {
          # add attributes of a window
          lappend save $key $value $index
          set exec "$w window configure $index"
          foreach k {-align -create -padx -pady -stretch} \
          { 
            set v [$w window cget $index $k]
            if {$v != ""} { append exec " $k \{$v\}" }
          }
          lappend save exec $exec {}
        }
        default \
        {
          lappend save $key $value $index
        }
      }
    }
    # return the serialized widget
    return $save
  }

  # ----------
  #  text:restore proc
  #
  #  restore a serialized text widget
  # ----------
  # parm1: text widget path
  # parm2: serialized widget to restore
  # ----------

  proc text:restore {w save} \
  {
    # empty the text widget
    $w delete 1.0 end
    # create items, restoring their attributes
    foreach {key value index} $save \
    {
      switch $key \
      {
        exec    { eval $value }
        image   { $w image create $index -name $value }
        text    { $w insert $index $value }
        mark    \
        { 
          if {$value == "current"} { set current $index }
          $w mark set $value $index 
        }
        tagon   { set tag($value) $index }
        tagoff  { $w tag add $value $tag($value) $index }
        window  { $w window create $index -window $value }
      }
    }
    # restore the "current" index
    $w mark set current $current 
  }

  # ----------
  #  text:dump proc
  #
  #  display the content of a text widget
  # ----------
  # parm1: text widget path
  # ----------

  proc text:dump {w} \
  { 
    puts "$w:"
    foreach {key value index} [$w dump -all 1.0 end] \
    {
      puts "\t$key\t\"$index\"\t\"$value\""
    }
    puts "----" 
  }

And a little demo to see how to use it:

  # =========
  #   demo
  # =========

  # show debug info
  catch { console show }
  # create widgets
  pack [text .text -width 30 -height 10]
  pack [button .b -text clone -command {text:clone .text .clone}] -pady 10
  pack [text .clone -width 30 -height 10]
  # fill text widget
  .text insert end text1\n
  .text insert end text2\n
  .text tag configure blue -foreground blue
  .text tag add blue 2.0 3.0
  .text insert end text3\n
  update
  # clone the text widget
  after 1000
  text:clone .text .clone
  # add an image to the text widget
  after 1000
  image create photo img
  img put \
  {
    {#bdbdbd #949494 #7b7b7b #848484 #a5a5a5 #bdbdbd}
    {#9c9c9c #848484 #8c8c8c #949494 #9c9c9c #adadad} 
    {#949494 #949494 #9c9c9c #a5a5a5 #adadad #adadad} 
    {#a5a5a5 #adadad #adadad #b5b5b5 #b5b5b5 #bdbdbd} 
    {#bdbdbd #bdbdbd #bdbdbd #c6c6c6 #c6c6c6 #bdbdbd} 
    {#bdbdbd #c6c6c6 #c6c6c6 #cecece #c6c6c6 #bdbdbd}  
  }
  .text image create 1.2 -image img
  update
  # clone the text widget
  after 1000
  text:clone .text .clone
  # add a window to the text widget, and dump it
  after 1000
  .text window create 2.0 -window [entry .e]
  text:dump .text
  update
  # clone the text widget, and dump it
  after 1000
  text:clone .text .clone
  text:dump .clone

I omitted here to clone the embedded widgets...


See also Bryan Oakley's http://www.purl.org/net/oakley/tcl/ttd/index.html which deals with data and tags.


Category GUI | Category Widget