Version 3 of a widget serializer

Updated 2003-06-23 19:29:58

if 0 {

Limitations: text tags are saved but their individual configurations are not. text marks, images, and windows are not saved. listbox item configurations are not saved. panedwindows are not totally saved. these should be trivial to add if someone wants to.

Usage example:

 set state [serialize .frame]
 destroy .frame

 toplevel .frame
 eval [join $state \;]

--AF 23-06-03

}

 proc serialize {w} {
    upvar state state
    foreach c [winfo children $w] {
        set new $c
        if {[catch {$c configure -class} widget]} {set widget "{} {} {} [winfo class $c]"}
        set widget [string tolower [lindex $widget 3]]
        set args {}
        foreach x [$c configure] {
            if {[set opt [lindex $x 4]] != [lindex $x 3]} {lappend args [list [lindex $x 0] $opt]}
        }
        lappend state "$widget $new [join $args]"
        if {$widget == "listbox"} {
            lappend state "$new insert 0 [$c get 0 end]"
        } elseif {$widget == "entry"} {
            lappend state "$new configure -state normal"
            lappend state "$new insert 0 [list [$c get]]"
            lappend state "$new configure -state [$c cget -state]"
        } elseif {$widget == "text"} {
            lappend state "$new configure -state normal"
            lappend state "$new insert 1.0 [list [$c get 0.0 end-1c]]"
            lappend state "$new delete end end-1l"
            lappend state "addtags $new [list [$c dump -tag 0.0 end]]"
            lappend state "$new configure -state [$c cget -state]"
        } elseif {$widget == "menu"} {
            set end [$c index end]
            for {set x 0} {$x <= $end} {incr x} {
                set config {}
                foreach arg [$c entryconfigure $x] {
                    if {[set opt [lindex $arg 4]] != ""} {lappend config "[lindex $arg 0] [list $opt]"}
                }
                lappend state "$new add [$c type $x] [join $config]"
            }
        }
        lappend state "bindtags $new [list [bindtags $c]]"
        if {[set bindings [bind $c]] != ""} {
            foreach x $bindings {lappend state "bind $new $x [list [bind $c $x]]"}
        }
        if {[winfo children $c] != ""} {serialize $c}
    }
    set list {}
    if {[set manager [winfo manager [lindex [winfo children $w] 0]]] != "" && $manager != "wm"} {set list [$manager slaves $w]}
    foreach x $list {lappend state "$manager $x [lrange [$manager info $x] 2 end]"}
    set grid [grid size $w]
    if {[set cols [lindex $grid 0]] > 0} {
        for {incr cols -1} {$cols > -1} {incr cols -1} {
            lappend state "grid columnconfigure $w $cols [grid columnconfigure $w $cols]"
        }
    }
    if {[set rows [lindex $grid 1]] > 0} {
        for {incr rows -1} {$rows > -1} {incr rows -1} {
            lappend state "grid rowconfigure $w $rows [grid columnconfigure $w $rows]"
        }
    }
    return $state
 }

 proc addtags {w tags} {
    foreach {d tag pos} $tags {
        if {$d == "tagon"} {
            set t($tag) $pos
        } elseif {$d == "tagoff"} {
            if {[info exists t($tag)] && $t($tag) != ""} {
                $w tag add $tag $t($tag) $pos
                unset t($tag)
            }
        }
    }
 }