Serializing a text widget

Difference between version 13 and 14 - Previous - Next
[ulis], 2003-06-23
A [text] 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.

Note that in 8.5 an alternative is to use the text widget ''peer'' functionality to
permit two text widgets to share a single underlying data tree (assuming you are serializing
to clone rather than to some storage). ''peer'' is much more efficient than clone.

----

'''The procs''' (clone, save, restore, dump)

======  # ==============================
  #
  #   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   \
        {            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
            }
        }        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 }
        }        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 "----"   }
======

----
'''The demo'''

======  # =========
  #   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.
----
So this page contains a partial example of serializing.  
Perhaps someone could take the work by these two individuals, 
and turn it into a general facility which could take 
any text widget and serialize it?

<<categories>> Example | GUI | Widget | String Processing | serializing