gnocl::text serialization

The GTK libs include a means of serlizaing/deserializing the contents of a GtkTextBuffer but the documentation on how to craft such handlers is basically non-existent. There is one package OSXCART which will load save a buffer as an rtf which is often discussed but the process of building such handlers is cumbersome and need to be built into the gnocl sources themselves. The whole process is more speedily handled on the Tcl side using the various tag sub-commands which will provide all the necessary information. How does the process work? Each row and column of the text is parsed firsly for changes in tag states (ie on or off) and the for the text content. If a new tag is added, its name is kept in a list of applied tags. The text is then accumulated until a further tag state change occurs whereupon firstly the tag and then text changes are written an output string. The text accumulator is then reset to empty and so the process continues. If a tag is turned off, the reverse occurs; the text is first written followed by the names of tags turned off.

The following module contains two procs, serealize and desearialize. Only tags are supported at the moment but, if necessary, marks, images and widgets could be supported too.

#---------------
# textSerialize.tcl
#---------------

#---------------
# deserialize utf8 text string and insert into widget
#---------------
# Arguments
#    data    text to deserialze
#    w       
# Returns
#    serialized text string
# Notes    
proc gnocl::textDeserialize {data txt} {
    set onTAGS {}
   
    foreach {a b} $data {
        if {$a == "tags"} {
            # apply taglist to new widget
            foreach c $b { eval "$txt tag create $c" }
        }
        if {$a == "text"} {
            foreach {c d} $b {
                switch $c {
                    tagOn {
                        lappend onTAGS $d
                    }
                    tagOff {
                        set i [lsearch $onTAGS $d]
                        set onTAGS [lreplace $onTAGS $i $i] ;# remove tag from list
                    }
                    text {
                        if {$onTAGS != {}} {
                            $txt insert end $d -tags $onTAGS
                        } else {
                            $txt insert end $d
                        }
                    }
                } ;# end switch
            } ;# end foreach
        } ;# end if
    }
}

#---------------
# obtain text contents from text widget and return as a serialized utf8 string
#---------------
# Arguments
#    txt        gnoc::text widget whose contents are to serialized
# Returns
#    serialized text in the form of a paired list of op-val
# Notes
#    tagOn tag1 text {abc} tagOff tag1 text {def}    
#---------------
proc gnocl::textSerialize {txt} {
    set str(1) {}    ;# output string, ie tags + text
    set str(2) {}    ;# the text itself
    set onTAGS {}    ;# active tage
    set tagOn {}
    set tagOff {}
   
    # create tag table
    foreach {a}  [$txt tag names ] { lappend ttable "$a [$txt tag properties $a]" }
   
    # parse the text to obtain tag changes before text content     
    for {set r 0} { $r < [$txt getLineCount ] } {incr r} {
       
        for {set c 0} { $c <= [$txt getLineLength $r ] } {incr c} {
                   
            if {$c == 0} {
                set tagOn  [$txt tag get [::list $r [expr $c -1]] -on  ]
            } else {
                set tagOn  [$txt tag get [::list $r $c ] -on  ]
                set tagOff [$txt tag get [::list $r $c ] -off ]
            }
           
            # handle tagOff       
            if {$tagOff != ""} {
                foreach t $tagOff {
                    set i [lsearch $onTAGS $t]
                    set onTAGS [lreplace $onTAGS $i $i] ;# remove tag from list
                    append str(1) "text [::list $str(2)] tagOff $t "
                    set str(2) ""
                }
            }

            # handle tagOn
            if { $tagOn != "" } {
                foreach t $tagOn {
                    # check for new tag state changes
                    if { [lsearch $onTAGS $t] == -1} {
                        # first item is a special case
                        if {$r == 0 && $c == 0} {
                            set str(1) "tagOn $t "
                            set onTAGS $t
                            continue
                        }
                        #--------------
                        append str(1) "text [::list $str(2)] "
                        set str(2) ""
                        #--------------                       
                        append str(1) "tagOn $t "
                        lappend onTAGS $t
                    }
                }           
            }
           
            # get text
            append str(2) [$txt get [::list $r $c ] [::list $r [expr $c+1] ] ]
        }
    }
   
    if {$str(2) != {}} {
        append str(1) "txt [::list $str(2)] "
    }
   
    return "tags [::list $ttable]\ntext [::list [string trim $str(1)]]"
}